diff --git a/.codespellignore b/.codespellignore index 5a19054f6..cbb70d2d9 100644 --- a/.codespellignore +++ b/.codespellignore @@ -5,6 +5,7 @@ disjointness lightYears tne hge +hAA Breal ket rIn @@ -12,3 +13,4 @@ FRO Commun braket dOut +SINIC diff --git a/QuantumInfo/Finite/CPTPMap/CPTP.lean b/QuantumInfo/Finite/CPTPMap/CPTP.lean index c2dcddfd0..b8ec82534 100644 --- a/QuantumInfo/Finite/CPTPMap/CPTP.lean +++ b/QuantumInfo/Finite/CPTPMap/CPTP.lean @@ -749,6 +749,18 @@ theorem purify_trace (Λ : CPTPMap dIn dOut) : Λ = ( --TODO: Best to rewrite the "zero_prep / prep / append" as one CPTPMap.append channel when we -- define that. +/-- The Stinespring preparation `prep ∘ append` acts on a matrix entry by the Kronecker product +with the fixed pure state `|default⟩⟨default|` on `dOut × dOut`. -/ +theorem prep_append_map_entry (X : Matrix dIn dIn ℂ) + (a₁ : dIn) (b₁c₁ : dOut × dOut) (a₂ : dIn) (b₂c₂ : dOut × dOut) : + let τ := MState.pure (Ket.basis (default : dOut × dOut)) + let zero_prep : CPTPMap Unit (dOut × dOut) := replacement τ + let prep := (id ⊗ᶜᵖ zero_prep) + let append : CPTPMap dIn (dIn × Unit) := CPTPMap.ofEquiv (Equiv.prodPUnit dIn).symm + (prep ∘ₘ append).map X (a₁, b₁c₁) (a₂, b₂c₂) = + X a₁ a₂ * τ.m b₁c₁ b₂c₂ := by + simp [purify_prep_append_entry] + /-- The complementary channel comes from tracing out the other half (the right half) of the purified channel `purify`. -/ def complementary (Λ : CPTPMap dIn dOut) : CPTPMap dIn (dIn × dOut) := let zero_prep : CPTPMap Unit (dOut × dOut) := replacement (MState.pure (Ket.basis default)) diff --git a/QuantumInfo/Finite/Entropy/DPI.lean b/QuantumInfo/Finite/Entropy/DPI.lean index 0f70b6474..41a4170ac 100644 --- a/QuantumInfo/Finite/Entropy/DPI.lean +++ b/QuantumInfo/Finite/Entropy/DPI.lean @@ -7,6 +7,7 @@ module public import QuantumInfo.Finite.Entropy.Relative public import QuantumInfo.ForMathlib.HermitianMat.Sqrt +public import QuantumInfo.ForMathlib.HermitianMat.LiebConcavity @[expose] public section @@ -21,420 +22,1384 @@ variable [DecidableEq dA] [DecidableEq dB] [DecidableEq dC] [DecidableEq dA₁] variable {𝕜 : Type*} [RCLike 𝕜] variable {α : ℝ} {ρ σ : MState d} -open scoped InnerProductSpace RealInnerProductSpace HermitianMat +open HermitianMat +open scoped InnerProductSpace RealInnerProductSpace Topology /-! # DPI (Data Processing Inequality) The Data Processing Inequality (DPI) for the sandwiched Rényi relative entropy, and as a consequence, the quantum relative entropy. + +## Proof structure (for α > 1) + +Following Leditzky–Rouzé–Datta (arXiv:1306.5920), the proof proceeds as follows: + +1. Define the **trace functional** `Q̃_α(ρ‖σ) = Tr[(σ^γ ρ σ^γ)^α]` where `γ = (1 - α) / (2α)`. + The sandwiched Rényi divergence satisfies `D̃_α(ρ‖σ) = log(Q̃_α(ρ‖σ)) / (α - 1)`. + +2. The DPI for `D̃_α` reduces to **monotonicity of `Q̃_α` under partial trace**: + `Q̃_α(ρ_AB‖σ_AB) ≥ Q̃_α(ρ_A‖σ_A)` for `α > 1`. + +3. This monotonicity is proved via the **twirling argument**: + - `Q̃_α` is invariant under joint unitary conjugation. + - `Q̃_α` is jointly convex for `α > 1` (Frank–Lieb). + - A twirling set of unitaries `{V_i}` averages any state to a product with the + maximally mixed state. + - `Q̃_α` is invariant under tensoring with a fixed state. + +4. The general DPI for CPTP maps follows via **Stinespring dilation**: + any CPTP map can be decomposed as ancilla preparation + unitary + partial trace. -/ open scoped Matrix ComplexOrder open BigOperators -/-- The weighted norm \|X\|_{p, σ} defined in the paper. -/ -noncomputable def weighted_norm (p : ℝ) (σ : MState d) (X : Matrix d d ℂ) : ℝ := - let σ_pow : HermitianMat d ℂ := σ.M.cfc (fun x => x ^ (1 / (2 * p))) - schattenNorm (σ_pow.mat * X * σ_pow.mat) p - -/-- The spectral norm (operator norm) of a matrix. -/ -noncomputable def spectralNorm_mat (A : Matrix d d ℂ) : ℝ := - if h : Finset.univ.Nonempty then - let A_dag_A : HermitianMat d ℂ := ⟨A.conjTranspose * A, by - have h := Matrix.isHermitian_mul_conjTranspose_self A.conjTranspose - rwa [Matrix.conjTranspose_conjTranspose] at h⟩ - Real.sqrt ((Finset.univ.image A_dag_A.H.eigenvalues).max' (Finset.Nonempty.image h _)) - else 0 - -/-- The weighted norm for p = \infty. -/ -noncomputable def weighted_norm_infty (_ : MState d) (X : Matrix d d ℂ) : ℝ := - spectralNorm_mat X - -/-- The map Γ_σ(X) = σ^{1/2} X σ^{1/2}. -/ -noncomputable def Gamma (σ : MState d) (X : Matrix d d ℂ) : Matrix d d ℂ := - let σ_half : HermitianMat d ℂ := σ.M.cfc (fun x => x ^ (1/2 : ℝ)) - σ_half.mat * X * σ_half.mat - -/-- The inverse map Γ_σ^{-1}(X) = σ^{-1/2} X σ^{-1/2}. -/ -noncomputable def Gamma_inv (σ : MState d) (X : Matrix d d ℂ) : Matrix d d ℂ := - let σ_inv_half : HermitianMat d ℂ := σ.M.cfc (fun x => x ^ (-1/2 : ℝ)) - σ_inv_half.mat * X * σ_inv_half.mat - -/-- The operator T = Γ_{Φ(σ)}^{-1} ∘ Φ ∘ Γ_σ. -/ -noncomputable def T_op (Φ : CPTPMap d d₂) (σ : MState d) (X : Matrix d d ℂ) : Matrix d₂ d₂ ℂ := - Gamma_inv (Φ σ) (Φ.map (Gamma σ X)) - -/-- The induced norm of a map Ψ: M_d -> M_d2 with respect to weighted norms. -/ -noncomputable def induced_norm (p : ℝ) (σ : MState d) (Φ : CPTPMap d d₂) (Ψ : Matrix d d ℂ → Matrix d₂ d₂ ℂ) : ℝ := - sSup { weighted_norm p (Φ σ) (Ψ X) / weighted_norm p σ X | (X : Matrix d d ℂ) (_ : weighted_norm p σ X ≠ 0) } +/-! ## The Sandwiched Trace Functional -/ + +/-- The sandwiched trace functional `Q̃_α(ρ‖σ) = Tr[(σ^γ ρ σ^γ)^α]` where `γ = (1-α)/(2α)`. +This is the quantity underlying the sandwiched Rényi divergence: +`D̃_α(ρ‖σ) = log(Q̃_α(ρ‖σ)) / (α - 1)`. + +Note: the `conj` operation gives `A.conj B = B * A.mat * B†`, and since `σ^γ` is Hermitian +(self-adjoint), `B† = B`, so `ρ.M.conj (σ.M ^ γ).mat = σ^γ * ρ * σ^γ`. -/ +noncomputable def sandwichedTraceFunctional (α : ℝ) (ρ σ : MState d) : ℝ := + let γ := (1 - α) / (2 * α) + ((ρ.M.conj (σ.M ^ γ).mat) ^ α).trace + +notation "Q̃_" α "(" ρ "‖" σ ")" => sandwichedTraceFunctional α ρ σ + +/-! ## Properties of the Trace Functional -/ /- -The induced norm of a map Ψ with respect to the weighted infinity norm. +The sandwiched Rényi divergence equals `log(Q̃_α) / (α - 1)` for `α > 0`, `α ≠ 1`, +when `σ.M.ker ≤ ρ.M.ker`. -/ -noncomputable def induced_norm_infty_map (σ : MState d) (Φ : CPTPMap d d₂) (Ψ : Matrix d d ℂ → Matrix d₂ d₂ ℂ) : ℝ := - sSup { weighted_norm_infty (Φ σ) (Ψ X) / weighted_norm_infty σ X | (X : Matrix d d ℂ) (_ : weighted_norm_infty σ X ≠ 0) } +theorem sandwichedRelRentropy_eq_log_traceFunctional (hα₀ : 0 < α) (hα₁ : α ≠ 1) + (hker : σ.M.ker ≤ ρ.M.ker) : + D̃_ α(ρ‖σ) = ENNReal.ofReal (Real.log (Q̃_ α(ρ‖σ)) / (α - 1)) := by + rw [ENNReal.ofReal_eq_coe_nnreal] + unfold SandwichedRelRentropy sandwichedTraceFunctional + split + next h => simp_all only + next h => rfl /- -The operator T = Γ_{Φ(σ)}^{-1} ∘ Φ ∘ Γ_σ as a linear map. --/ -noncomputable def T_map (σ : MState d) (Φ : CPTPMap d d₂) : MatrixMap d d₂ ℂ := - { toFun := fun X => T_op Φ σ X, - map_add' := fun X Y => by - unfold T_op Gamma Gamma_inv - simp [Matrix.mul_add, Matrix.add_mul] - map_smul' := fun c X => by - unfold T_op - simp - unfold Gamma Gamma_inv - simp [mul_assoc] - } +`Q̃_α(ρ‖σ)` is nonneg when `α > 0`. +-/ +theorem sandwichedTraceFunctional_nonneg (ρ σ : MState d) : + 0 ≤ Q̃_ α(ρ‖σ) := by + rw [sandwichedTraceFunctional] + apply trace_nonneg + apply rpow_nonneg + positivity + +/-- The trace functional is strictly positive when the kernel condition holds. Under +`σ.M.ker ≤ ρ.M.ker` (i.e. `supp(ρ) ⊆ supp(σ)`), the sandwich `σ^γ ρ σ^γ ≠ 0` +because ρ has support inside σ's support. -/ +theorem sandwichedTraceFunctional_pos + (ρ σ : MState d) (hker : σ.M.ker ≤ ρ.M.ker) : + 0 < Q̃_ α(ρ‖σ) := by + rw [sandwichedTraceFunctional] + apply trace_pos + apply rpow_pos + apply conj_pos ρ.pos + grw [← hker] + exact ker_rpow_le_of_nonneg σ.nonneg + +/-! ## Unitary Invariance + +`Q̃_α(UρU†‖UσU†) = Q̃_α(ρ‖σ)` for any unitary `U`. + +Here, `conj U.val A` denotes `U * A * U†`, so "conjugating ρ and σ by +the same unitary" means applying `conj U.val` to both. -/ /- -Gamma_map is the conjugation by the square root of sigma. +The trace functional is invariant under joint unitary conjugation: +`Tr[(U σ U†)^γ (U ρ U†) (U σ U†)^γ)^α] = Tr[(σ^γ ρ σ^γ)^α]`. +This corresponds to equation (2.3) in the paper. +Proved using `rpow_conj_unitary` (f(UXU†) = U f(X) U†) and `conj_conj`. -/ -noncomputable def Gamma_map (σ : MState d) : MatrixMap d d ℂ := - MatrixMap.conj (σ.M.cfc (fun x => x ^ (1/2 : ℝ))).mat +theorem sandwichedTraceFunctional_conj_unitary_hermitian + (U : Matrix.unitaryGroup d ℂ) (A B : HermitianMat d ℂ) : + let γ := (1 - α) / (2 * α) + ((A.conj U.val).conj ((B.conj U.val) ^ γ).mat ^ α).trace = + ((A.conj (B ^ γ).mat) ^ α).trace := by + have h_conj_conj : ∀ (A B : HermitianMat d ℂ) (U : Matrix.unitaryGroup d ℂ), + (conj U.val A).conj ((conj U.val B).mat) = conj U.val (A.conj B.mat) := by + intros A B U + simp [conj] + have h_unitary : ∀ (U : Matrix.unitaryGroup d ℂ), U.val * U.val.conjTranspose = 1 := by + exact fun U => U.2.2 + simp [← mul_assoc] + have := h_unitary U; simp_all [Matrix.mul_assoc, mul_eq_one_comm.mp this] + simp_all [conj_apply_mat, rpow_conj_unitary] -set_option backward.isDefEq.respectTransparency false in -lemma Gamma_map_eq (σ : MState d) (X : Matrix d d ℂ) : - Gamma_map σ X = Gamma σ X := by - ext; simp [ Gamma_map, Gamma ]; - apply_rules [ IsSelfAdjoint.cfc ] +/-- The trace functional is invariant under joint unitary conjugation of MStates. -/ +theorem sandwichedTraceFunctional_conj_unitary_MState + (U : Matrix.unitaryGroup d ℂ) (ρ σ : MState d) : + Q̃_ α(ρ.U_conj U‖σ.U_conj U) = Q̃_ α(ρ‖σ) := by + unfold sandwichedTraceFunctional MState.U_conj + exact sandwichedTraceFunctional_conj_unitary_hermitian U ρ.M σ.M -/- -Gamma_map is completely positive. +/-! ## Joint Convexity for α > 1 + +The trace functional `Q̃_α` is jointly convex for `α > 1`. This is proved by +Frank and Lieb via a variational formula and strict convexity of trace functions. + +### Trace functions convexity + +The following result is used in the proof: for a convex function `g : ℝ → ℝ`, +the map `A ↦ Tr[g(A)]` on Hermitian matrices is convex (Carlen, Theorem 2.10). -/ + +namespace HermitianMat + +end HermitianMat + +/-! ### Variational formula for the trace functional +Following Frank–Lieb, for `α > 1` we define + `f_α(H, ρ, σ) = α · Tr[ρ · H] − (α−1) · Tr[(σ^{−γ} H σ^{−γ})^{α/(α−1)}]` +where `γ = (1−α)/(2α)` (so `−γ = (α−1)/(2α) > 0`). +Key facts (each stated as a lemma below): +1. `Q̃_α(ρ‖σ) = sup_{H ≥ 0} f_α(H, ρ, σ)` for α > 1. +2. For fixed `H`, `f_α` is linear in `ρ` (hence convex). +3. For fixed `H`, `f_α` is convex in `σ` (uses Lieb concavity). +4. Therefore `f_α` is jointly convex in `(ρ, σ)` for fixed `H`. +5. The supremum of jointly convex functions is jointly convex. -/ -lemma Gamma_map_CP (σ : MState d) : (Gamma_map σ).IsCompletelyPositive := by - have := @MatrixMap.conj_isCompletelyPositive; - exact this _ + +/-- The variational function `f_α(H, ρ, σ) = α · ⟪ρ, H⟫ − (α−1) · Tr[(σ^{−γ} H σ^{−γ})^{α/(α−1)}]` +where `γ = (1−α)/(2α)`. For fixed `H ≥ 0`, this is linear in `ρ` and convex in `σ`. +Frank–Lieb show that `Q̃_α(ρ‖σ) = sup_{H ≥ 0} f_α(H, ρ, σ)` for `α > 1`. -/ +noncomputable def f_alpha (α : ℝ) (H : HermitianMat d ℂ) (ρ σ : MState d) : ℝ := + let γ : ℝ := (1 - α) / (2 * α) + α * ⟪ρ.M, H⟫_ℝ - (α - 1) * ((H.conj (σ.M ^ (-γ)).mat) ^ (α / (α - 1))).trace + +/-- The optimizer in the variational formula: `H_hat = σ^γ (σ^γ ρ σ^γ)^{α−1} σ^γ` +where `γ = (1−α)/(2α)`. -/ +noncomputable def H_hat (α : ℝ) (ρ σ : MState d) : HermitianMat d ℂ := + let γ := (1 - α) / (2 * α) + ((ρ.M.conj (σ.M ^ γ).mat) ^ (α - 1)).conj (σ.M ^ γ).mat /- -Gamma_inv_map is the conjugation by the inverse square root of sigma. +**Step 1a**: The optimizer `H_hat` is PSD. -/ -noncomputable def Gamma_inv_map (σ : MState d) : MatrixMap d d ℂ := - MatrixMap.conj (σ.M.cfc (fun x => x ^ (-1/2 : ℝ))).mat +theorem H_hat_nonneg (ρ σ : MState d) : 0 ≤ H_hat α ρ σ := by + apply conj_nonneg + apply rpow_nonneg + positivity + +/-- +For a PSD Hermitian matrix B whose kernel contains A's kernel, conjugating B by A's +support projection leaves B unchanged. +-/ +private lemma conj_supportProj_eq_of_ker_le (A B : HermitianMat d ℂ) (hker : A.ker ≤ B.ker) : + B.conj (A.supportProj).mat = B := by + ext i j + simp [*, conj] + suffices h_conj : A.supportProj.mat * B.mat * A.supportProj.mat = B.mat by + exact congr($h_conj i j) + have h_unitary := mul_supportProj_of_ker_le hker + apply_fun Matrix.conjTranspose at h_unitary ⊢ + · simp_all only [Matrix.conjTranspose_mul, conjTranspose_mat] + · exact Matrix.conjTranspose_injective + +/-- +The kernel of σ is contained in the kernel of (ρ.conj (σ^γ))^{α-1} when γ ≠ 0 and α > 1. +-/ +private lemma ker_sigma_le_ker_conj_rpow (ρ σ : MState d) {γ : ℝ} (hγ : γ ≠ 0) (hα1 : α - 1 ≠ 0) : + σ.M.ker ≤ ((ρ.M.conj (σ.M ^ γ).mat) ^ (α - 1)).ker := by + rw [ker_rpow_eq_of_nonneg (by positivity) hα1] + intro x hx + have h_ker_rpow : x ∈ (σ.M ^ γ).ker := by + rwa [ker_rpow_eq_of_nonneg σ.nonneg hγ] + simp_all [ker, lin] + +/-- Sub-lemma for Step 1b: the conj of H_hat by σ^{−γ} simplifies to (ρ.M.conj (σ^γ).mat)^{α−1}. +This uses σ^{−γ} · σ^γ = identity (on support) to cancel the outer σ^γ factors. -/ +theorem H_hat_conj_sigma (hα : 1 < α) (ρ σ : MState d) : + let γ := (1 - α) / (2 * α) + (H_hat α ρ σ).conj (σ.M ^ (-γ)).mat = (ρ.M.conj (σ.M ^ γ).mat) ^ (α - 1) := by + intro γ + have hγ : γ ≠ 0 := by + simp only [γ]; rw [div_ne_zero_iff]; exact ⟨by linarith, by linarith⟩ + have hα1 : α - 1 ≠ 0 := by linarith + show (((ρ.M.conj (σ.M ^ γ).mat) ^ (α - 1)).conj (σ.M ^ γ).mat).conj (σ.M ^ (-γ)).mat = + (ρ.M.conj (σ.M ^ γ).mat) ^ (α - 1) + rw [conj_conj] + rw [rpow_neg_mul_rpow_eq_supportProj σ.nonneg hγ] + exact conj_supportProj_eq_of_ker_le σ.M _ (ker_sigma_le_ker_conj_rpow ρ σ hγ hα1) -set_option backward.isDefEq.respectTransparency false in -lemma Gamma_inv_map_eq (σ : MState d) (X : Matrix d d ℂ) : - Gamma_inv_map σ X = Gamma_inv σ X := by - simp [Gamma_inv_map, Gamma_inv]; - congr; - apply IsSelfAdjoint.cfc /- -The inverse square root of sigma. +Sub-lemma for Step 1b: the inner product ⟪ρ.M, H_hat⟫ equals Tr[(σ^γ ρ σ^γ)^α]. +By cyclicity of trace: Tr[ρ · σ^γ · (σ^γ ρ σ^γ)^{α−1} · σ^γ] = Tr[(σ^γ ρ σ^γ)^α]. -/ -noncomputable def sigma_inv_sqrt (σ : MState d) : Matrix d d ℂ := - (σ.M.cfc (fun x => x ^ (-1/2 : ℝ))).mat +theorem inner_rho_H_hat (hα : 1 < α) (ρ σ : MState d) : + let γ := (1 - α) / (2 * α) + ⟪ρ.M, H_hat α ρ σ⟫_ℝ = ((ρ.M.conj (σ.M ^ γ).mat) ^ α).trace := by + unfold H_hat; simp [inner_def] + have h_cyclic : (ρ.m * (σ.M ^ ((1 - α) / (2 * α))).mat * + ((ρ.M.conj (σ.M ^ ((1 - α) / (2 * α))).mat) ^ (α - 1)).mat * + (σ.M ^ ((1 - α) / (2 * α))).mat).trace = + ((ρ.M.conj (σ.M ^ ((1 - α) / (2 * α))).mat) ^ α).trace := by + have h_cyclic : (ρ.M.conj (σ.M ^ ((1 - α) / (2 * α))).mat).mat * + ((ρ.M.conj (σ.M ^ ((1 - α) / (2 * α))).mat) ^ (α - 1)).mat = + ((ρ.M.conj (σ.M ^ ((1 - α) / (2 * α))).mat) ^ α).mat := by + have := @mat_rpow_add + specialize this (show 0 ≤ conj (σ.M ^ ((1 - α) / (2 * α))).mat ρ.M from ?_) + (show (1 : ℝ) + (α - 1) ≠ 0 from by linarith) + · positivity + · aesop + convert congr_arg Matrix.trace h_cyclic using 1 + · rw [← Matrix.trace_mul_comm]; simp [Matrix.mul_assoc] + · simp [trace] + norm_num [Matrix.trace] + refine Finset.sum_congr rfl fun i _ => ?_ + convert Complex.ofReal_re (((conj (σ.M ^ ((1 - α) / (2 * α))).mat) ρ.M ^ α) i i).re + simp [Complex.ext_iff] + simp_all [← Matrix.mul_assoc] /- -Gamma_inv_map is conjugation by sigma_inv_sqrt. +**Step 1b**: Evaluating `f_α` at the optimizer `H_hat` gives `Q̃_α(ρ‖σ)`. +This is the key computation that verifies the variational formula at the optimizer. +Proof: f_α(H_hat, ρ, σ) = α · Tr[(σ^γ ρ σ^γ)^α] - (α-1) · Tr[(σ^γ ρ σ^γ)^α] = Tr[(σ^γ ρ σ^γ)^α] = Q̃. +-/ +theorem f_alpha_at_optimizer (hα : 1 < α) (ρ σ : MState d) : + f_alpha α (H_hat α ρ σ) ρ σ = Q̃_ α(ρ‖σ) := by + have h_inner : ⟪ρ.M, H_hat α ρ σ⟫_ℝ = ((ρ.M.conj (σ.M ^ ((1 - α) / (2 * α))).mat) ^ α).trace := by + exact inner_rho_H_hat hα ρ σ + have h_conj : (H_hat α ρ σ).conj (σ.M ^ ((α - 1) / (2 * α))).mat = + (ρ.M.conj (σ.M ^ ((1 - α) / (2 * α))).mat) ^ (α - 1) := by + convert H_hat_conj_sigma (hα := hα) (ρ := ρ) (σ := σ) using 1 + ring_nf! + unfold f_alpha sandwichedTraceFunctional + simp_all [sub_div] + rw [← rpow_mul]; norm_num [show α ≠ 0 by positivity, show α - 1 ≠ 0 by linarith] + · rw [mul_div_cancel₀ _ (by linarith)]; ring + · apply_rules [conj_nonneg] + exact ρ.nonneg + +/-- +For PSD `A` and `γ ≠ 0`, the product `A^γ * A^{-γ}` equals the support projection +of `A`. This is because `x^γ * x^{-γ} = if x = 0 then 0 else 1` for `x ≥ 0`. +-/ +lemma rpow_mul_neg_rpow_eq_supportProj {A : HermitianMat d ℂ} + (hA : 0 ≤ A) (γ : ℝ) (hγ : γ ≠ 0) : + (A ^ γ).mat * (A ^ (-γ)).mat = A.supportProj.mat := by + rw [supportProj_eq_cfc] + rw [rpow_eq_cfc, rpow_eq_cfc] + rw [← mat_cfc_mul_apply] + refine congr_arg _ (cfc_congr_of_nonneg hA ?_) + intro x (hx : 0 ≤ x) + rcases eq_or_ne x 0 with hx' | hx' + · simp [hx', hγ] + · simp [hx', Real.rpow_neg hx] + exact mul_inv_cancel₀ (by positivity) + +/-- +The support projection of `A` acts as identity on `B` when `A.ker ≤ B.ker`. +Since `A.supportProj` projects onto `ker(A)⊥` and `B` is zero on `ker(A)`, +the projection preserves `B`. -/ -lemma Gamma_inv_map_eq_conj (σ : MState d) : - Gamma_inv_map σ = MatrixMap.conj (sigma_inv_sqrt σ) := by - exact rfl +lemma supportProj_mul_of_ker_le {A B : HermitianMat d ℂ} + (hker : A.ker ≤ B.ker) : + A.supportProj.mat * B.mat = B.mat := by + contrapose! hker + simp_all [SetLike.le_def] + -- Since $B$ is not in the kernel of $A$, there exists some $x \in \ker(A)$ such that $Bx \neq 0$. + obtain ⟨x, hx⟩ : ∃ x : EuclideanSpace ℂ d, A.mat *ᵥ x = 0 ∧ B.mat *ᵥ x ≠ 0 := by + contrapose! hker + have h_support : ∀ x : EuclideanSpace ℂ d, B.mat *ᵥ x = B.mat *ᵥ (A.supportProj.mat *ᵥ x) := by + intro x + have h_support : x.ofLp = A.supportProj.mat *ᵥ x.ofLp + A.kerProj.mat *ᵥ x.ofLp := by + have h_support : A.supportProj.mat + A.kerProj.mat = 1 := by + simp [add_comm] + simp [← Matrix.ext_iff] + intro i j; exact (by + have h_support : A.kerProj + A.supportProj = 1 := by + exact kerProj_add_supportProj A + convert congr_arg (fun f => f i j) h_support using 1) + rw [← Matrix.add_mulVec, h_support, Matrix.one_mulVec] + have hsup : B.mat *ᵥ (A.kerProj.mat *ᵥ x.ofLp) = 0 := by + convert hker _ _ + have h_support : A.mat * A.kerProj.mat = 0 := by + have h_support : A.mat * A.kerProj.mat = A.mat * (1 - A.supportProj.mat) := by + congr + have h_support : A.kerProj + A.supportProj = 1 := by + exact kerProj_add_supportProj A + exact eq_sub_of_add_eq <| congr_arg Subtype.val h_support + rw [h_support, mul_sub, mul_one, sub_eq_zero] + exact Eq.symm (mul_supportProj_of_ker_le fun ⦃x⦄ a => a) + convert congr_arg (fun m => m *ᵥ x.ofLp) h_support using 1 + · simp + · simp + convert congr_arg (fun y => B.mat *ᵥ y) h_support using 1 + simp [Matrix.mulVec_add, hsup] + have h_support : B.mat = B.mat * A.supportProj.mat := by + ext i j + convert congr_fun (h_support (EuclideanSpace.single j 1)) i using 1 + · simp [Matrix.mulVec, dotProduct] + · simp [Matrix.mulVec, dotProduct] + rfl + have h_support : B.mat = B.mat.conjTranspose := by + exact B.2.symm + have h_support : (B.mat * A.supportProj.mat).conjTranspose = A.supportProj.mat * B.mat := by + simp [Matrix.conjTranspose_mul] + lia + refine ⟨x, ?_, ?_⟩ + · simpa [ker, lin, funext_iff, Matrix.toLpLin] using hx.1 + · rw [mem_ker_iff_mulVec_zero] + exact hx.right + +/-- +Under the support condition `σ.M.ker ≤ ρ.M.ker` (i.e., supp(ρ) ⊆ supp(σ)), +conjugation by `σ^γ` and `σ^{-γ}` preserves the inner product: +`⟪ρ.M, H⟫ = ⟪σ^γ ρ σ^γ, σ^{-γ} H σ^{-γ}⟫`. This holds because the kernel condition +ensures `ρ` is supported on `supp(σ)`, where `σ^γ σ^{-γ}` acts as the identity. +-/ +lemma inner_eq_inner_conj_of_ker_le (ρ σ : MState d) + (H : HermitianMat d ℂ) (hker : σ.M.ker ≤ ρ.M.ker) (γ : ℝ) (hγ : γ ≠ 0) : + ⟪ρ.M, H⟫_ℝ = ⟪ρ.M.conj (σ.M ^ γ).mat, H.conj (σ.M ^ (-γ)).mat⟫_ℝ := by + -- Since σ^γ σ^-γ acts as the identity on the support of ρ, we can simplify + have h_support : + (σ.M ^ γ).mat * (σ.M ^ (-γ)).mat = σ.M.supportProj.mat ∧ + (σ.M ^ (-γ)).mat * (σ.M ^ γ).mat = σ.M.supportProj.mat := + ⟨rpow_mul_neg_rpow_eq_supportProj σ.nonneg γ hγ, + by simpa using rpow_mul_neg_rpow_eq_supportProj σ.nonneg (-γ) (neg_ne_zero.mpr hγ)⟩ + simp only [inner_def, conj_apply_mat] + have h_support : + σ.M.supportProj.mat * ρ.M.mat = ρ.M.mat ∧ + ρ.M.mat * σ.M.supportProj.mat = ρ.M.mat := by + exact ⟨supportProj_mul_of_ker_le hker, mul_supportProj_of_ker_le hker⟩ + have h_trace_cyclic : + Matrix.trace ((σ.M ^ γ).mat * ρ.M.mat * (σ.M ^ γ).mat * + (σ.M ^ (-γ)).mat * H.mat * (σ.M ^ (-γ)).mat) = + Matrix.trace ((σ.M ^ (-γ)).mat * (σ.M ^ γ).mat * ρ.M.mat * + (σ.M ^ γ).mat * (σ.M ^ (-γ)).mat * H.mat) := by + rw [← Matrix.trace_mul_comm] + simp [Matrix.mul_assoc] + simp_all [mul_assoc, Matrix.trace_mul_comm ((σ.M ^ γ).mat)] + simp_all [← mul_assoc] + +/-- **Step 1c**: `H_hat` is a maximizer: for all `H ≥ 0`, `f_α(H) ≤ f_α(H_hat)`. +This uses the trace Young inequality: for PSD `A, B` and conjugate exponents `p, q > 1`, +`⟪A, B⟫ ≤ Tr[A^p]/p + Tr[B^q]/q`. +Applied with `A = σ^γ ρ σ^γ`, `B = σ^{-γ} H σ^{-γ}`, `p = α`, `q = α/(α-1)`, +the inner product identity `⟪ρ, H⟫ = ⟪A, B⟫` (under the support condition) yields +`f_α(H) ≤ Tr[A^α] = Q̃_α(ρ‖σ) = f_α(H_hat)`. +Note: the support condition `σ.M.ker ≤ ρ.M.ker` (i.e., supp(ρ) ⊆ supp(σ)) is necessary. +Without it, the theorem is false: taking ρ orthogonal to σ gives Q̃_α = 0 but +`f_α(H) = α · Tr[ρH] > 0` for appropriate H. -/ +theorem f_alpha_le_at_optimizer (hα : 1 < α) (ρ σ : MState d) + (H : HermitianMat d ℂ) (hH : 0 ≤ H) (hker : σ.M.ker ≤ ρ.M.ker) : + f_alpha α H ρ σ ≤ f_alpha α (H_hat α ρ σ) ρ σ := by + rw [f_alpha_at_optimizer hα] + -- Goal: f_alpha α H ρ σ ≤ Q̃_α(ρ‖σ) + set γ : ℝ := (1 - α) / (2 * α) with hγ_def + have hγ : γ ≠ 0 := by + intro h; have h1 : (1 - α) / (2 * α) = 0 := hγ_def ▸ h + have h2 : (2 : ℝ) * α ≠ 0 := by positivity + rw [div_eq_zero_iff] at h1; rcases h1 with h1 | h1 <;> linarith + set A := ρ.M.conj (σ.M ^ γ).mat + set B := H.conj (σ.M ^ (-γ)).mat + have hA_nn : 0 ≤ A := conj_nonneg _ ρ.nonneg + have hB_nn : 0 ≤ B := conj_nonneg _ hH + have h_inner : ⟪ρ.M, H⟫_ℝ = ⟪A, B⟫_ℝ := + inner_eq_inner_conj_of_ker_le ρ σ H hker γ hγ + have hpq : 1 / α + 1 / (α / (α - 1)) = 1 := by field_simp; ring + have h_young := trace_young A B hA_nn hB_nn α (α / (α - 1)) hα hpq + have hα_pos : (0 : ℝ) < α := by linarith + have hαm1_pos : (0 : ℝ) < α - 1 := by linarith + -- Multiply h_young by α and simplify + have h_scaled : α * ⟪A, B⟫_ℝ ≤ + (A ^ α).trace + (α - 1) * (B ^ (α / (α - 1))).trace := by + have := mul_le_mul_of_nonneg_left h_young hα_pos.le + have h_simp : α * ((A ^ α).trace / α + (B ^ (α / (α - 1))).trace / (α / (α - 1))) = + (A ^ α).trace + (α - 1) * (B ^ (α / (α - 1))).trace := by + field_simp + linarith + -- Goal is definitionally: α * ⟪ρ.M, H⟫ - (α-1) * (B ^ (α/(α-1))).trace ≤ (A ^ α).trace + -- which follows from h_scaled and h_inner + change α * ⟪ρ.M, H⟫_ℝ - (α - 1) * (B ^ (α / (α - 1))).trace ≤ (A ^ α).trace + have h_inner_scaled : α * ⟪ρ.M, H⟫_ℝ = α * ⟪A, B⟫_ℝ := by rw [h_inner] + linarith [h_scaled, h_inner_scaled] + +/-- +**Step 1 (Variational formula)**: For `α > 1`, the trace functional equals the +supremum of `f_α` over all PSD `H`: + `Q̃_α(ρ‖σ) = ⨆ (H : HermitianMat d ℂ) (_ : 0 ≤ H), f_alpha α H ρ σ`. +The optimizer is `H_hat = σ^γ (σ^γ ρ σ^γ)^{α−1} σ^γ`. +-/ +theorem traceFunctional_eq_iSup_f_alpha (hα : 1 < α) (ρ σ : MState d) (hker : σ.M.ker ≤ ρ.M.ker) : + Q̃_ α(ρ‖σ) = ⨆ (H : {H : HermitianMat d ℂ // 0 ≤ H}), f_alpha α H.1 ρ σ := by + rw [@ciSup_eq_of_forall_le_of_forall_lt_exists_gt] + · intro i + rw [← f_alpha_at_optimizer hα ρ σ] + exact f_alpha_le_at_optimizer hα ρ σ i i.2 hker + · intro w hw + exact ⟨⟨H_hat α ρ σ, H_hat_nonneg ρ σ⟩, hw.trans_le (f_alpha_at_optimizer hα ρ σ ▸ le_rfl)⟩ + +/-- (Convexity in σ): For fixed `H ≥ 0` and `ρ`, and `α > 1`, the map +`σ ↦ f_alpha α H ρ σ` is convex. The key is that for `p = α/(α−1) > 1`: +• `A ↦ Tr[A^p]` is convex on PSD matrices (trace function convexity, Theorem 2.10 of Carlen), +• `σ ↦ σ^{−γ} H σ^{−γ}` is *concave* in `σ` by Lieb concavity (since `−γ = (α−1)/(2α) ∈ (0,½)`), +• The composition of a convex non-decreasing function with a concave function is convex, + but we actually need the sign: the second term has a factor `−(α−1) < 0` which + flips concave → convex. +More precisely: `σ ↦ Tr[(σ^{−γ} H σ^{−γ})^p]` is concave (by Lieb + trace function convexity), +so `σ ↦ −(α−1) · Tr[(σ^{−γ} H σ^{−γ})^p]` is convex. -/ +theorem f_alpha_convex_in_sigma (hα : 1 < α) (H : HermitianMat d ℂ) (hH : 0 ≤ H) + (ρ : MState d) {ι : Type*} [Fintype ι] + (w : ι → ℝ) (hw_nonneg : ∀ i, 0 ≤ w i) (hw_sum : ∑ i, w i = 1) + (σs : ι → MState d) (σ_mix : MState d) + (hσ_mix : σ_mix.M = ∑ i, w i • (σs i).M) : + f_alpha α H ρ σ_mix ≤ ∑ i, w i * f_alpha α H ρ (σs i) := by + have hα_pos : 0 < α - 1 := by linarith + -- Define the σ-dependent trace function on HermitianMat + let s := (α - 1) / (2 * α) + let p := α / (α - 1) + let F : HermitianMat d ℂ → ℝ := fun σ => ((H.conj (σ ^ s).mat) ^ p).trace + -- f_alpha relates to F via: f_alpha α H ρ σ = α * ⟪ρ.M, H⟫ - (α-1) * F(σ.M) + -- because -γ = -((1-α)/(2α)) = (α-1)/(2α) = s + have hf_eq : ∀ σ : MState d, f_alpha α H ρ σ = α * ⟪ρ.M, H⟫_ℝ - (α - 1) * F σ.M := by + intro σ + show _ = α * ⟪ρ.M, H⟫_ℝ - (α - 1) * + ((H.conj (σ.M ^ ((α - 1) / (2 * α))).mat) ^ (α / (α - 1))).trace + unfold f_alpha; ring_nf + simp_rw [hf_eq] + -- Reduce to concavity: ∑ w_i * F(σ_i.M) ≤ F(σ_mix.M) + suffices h : ∑ i, w i * F (σs i).M ≤ F σ_mix.M by + have h1 : ∑ i, w i * ((α - 1) * F (σs i).M) = (α - 1) * ∑ i, w i * F (σs i).M := by + rw [Finset.mul_sum]; congr 1; ext i; ring + simp only [mul_sub, Finset.sum_sub_distrib, ← Finset.sum_mul, hw_sum, one_mul, h1] + linarith [mul_le_mul_of_nonneg_left h (le_of_lt hα_pos)] + -- Apply ConcaveOn.le_map_sum from trace_conj_rpow_concave + have hF_concave : ConcaveOn ℝ {σ : HermitianMat d ℂ | 0 ≤ σ} F := + trace_conj_rpow_concave hα H hH + have h_jensen := hF_concave.le_map_sum + (t := Finset.univ) (w := w) (p := fun i => (σs i).M) + (fun i _ => hw_nonneg i) + (by simp [hw_sum]) + (fun i _ => (σs i).nonneg) + rw [← hσ_mix] at h_jensen + convert h_jensen using 1 /- -Gamma_inv_map is completely positive. +**Step 4 (Joint convexity of f_α)**: For fixed `H ≥ 0` and `α > 1`, the map +`(ρ, σ) ↦ f_alpha α H ρ σ` is jointly convex. This follows from Steps 2 and 3: +f_α decomposes as a function linear in ρ (independent of σ) plus a function convex +in σ (independent of ρ). -/ -lemma Gamma_inv_map_CP (σ : MState d) : (Gamma_inv_map σ).IsCompletelyPositive := by - convert MatrixMap.conj_isCompletelyPositive _; - · infer_instance; - · infer_instance +theorem f_alpha_jointly_convex (hα : 1 < α) (H : HermitianMat d ℂ) (hH : 0 ≤ H) + {ι : Type*} [Fintype ι] + (w : ι → ℝ) (hw_nonneg : ∀ i, 0 ≤ w i) (hw_sum : ∑ i, w i = 1) + (ρs σs : ι → MState d) (ρ_mix σ_mix : MState d) + (hρ_mix : ρ_mix.M = ∑ i, w i • (ρs i).M) + (hσ_mix : σ_mix.M = ∑ i, w i • (σs i).M) : + f_alpha α H ρ_mix σ_mix ≤ ∑ i, w i * f_alpha α H (ρs i) (σs i) := by + convert f_alpha_convex_in_sigma hα H hH ρ_mix _ _ _ _ using 1 + any_goals assumption + constructor <;> intro h + · exact fun σ_mix hσ_mix => + f_alpha_convex_in_sigma hα H hH ρ_mix w hw_nonneg hw_sum σs σ_mix hσ_mix + · apply (h σ_mix hσ_mix).trans + unfold f_alpha + simp [hρ_mix] + simp [sum_inner, inner_smul_left, mul_sub, sub_mul, mul_comm, mul_left_comm, Finset.mul_sum] + simp [← Finset.mul_sum, ← Finset.sum_mul, hw_sum] /- -T_map is the composition of Gamma_inv_map, Phi, and Gamma_map. +The range of `H ↦ f_alpha α H ρ σ` over PSD `H` is bounded above. +This follows from the variational formula: the supremum equals `Q̃_α(ρ‖σ)`, +which is a finite real number. -/ -lemma T_map_eq_comp (σ : MState d) (Φ : CPTPMap d d₂) : - T_map σ Φ = (Gamma_inv_map (Φ σ)).comp (Φ.map.comp (Gamma_map σ)) := by - ext; - unfold T_map; - simp [T_op] - congr! 1; - · exact funext fun x => Gamma_inv_map_eq ( Φ σ ) x ▸ rfl; - · rw [ Gamma_map_eq ] +theorem f_alpha_bddAbove (hα : 1 < α) (ρ σ : MState d) (hker : σ.M.ker ≤ ρ.M.ker) : + BddAbove (Set.range (fun H : {H : HermitianMat d ℂ // 0 ≤ H} => f_alpha α H.1 ρ σ)) := by + exact ⟨_, Set.forall_mem_range.mpr fun H => f_alpha_le_at_optimizer hα ρ σ _ H.2 hker⟩ /- -T_map is completely positive. +**Step 5 (Sup preserves convexity)**: The supremum over `H ≥ 0` of the jointly +convex `f_alpha α H` is jointly convex. This is a standard fact: for each `H`, +`f_alpha α H (ρ_mix) (σ_mix) ≤ ∑ wᵢ f_alpha α H (ρᵢ) (σᵢ) ≤ ∑ wᵢ sup_H f_alpha ...`, +so taking sup on the left gives the result. +-/ +theorem iSup_f_alpha_jointly_convex (hα : 1 < α) + {ι : Type*} [Fintype ι] + (w : ι → ℝ) (hw_nonneg : ∀ i, 0 ≤ w i) (hw_sum : ∑ i, w i = 1) + (ρs σs : ι → MState d) (ρ_mix σ_mix : MState d) + (hρ_mix : ρ_mix.M = ∑ i, w i • (ρs i).M) + (hσ_mix : σ_mix.M = ∑ i, w i • (σs i).M) + (hker : ∀ i, (σs i).M.ker ≤ (ρs i).M.ker) : + (⨆ (H : {H : HermitianMat d ℂ // 0 ≤ H}), f_alpha α H.1 ρ_mix σ_mix) ≤ + ∑ i, w i * (⨆ (H : {H : HermitianMat d ℂ // 0 ≤ H}), f_alpha α H.1 (ρs i) (σs i)) := by + apply ciSup_le + intro H + have h_sum : f_alpha α H.1 ρ_mix σ_mix ≤ ∑ i, w i * (f_alpha α H.1 (ρs i) (σs i)) := by + apply f_alpha_jointly_convex hα H.1 H.2 w hw_nonneg hw_sum ρs σs ρ_mix σ_mix hρ_mix hσ_mix + exact h_sum.trans (Finset.sum_le_sum fun i _ => mul_le_mul_of_nonneg_left + (le_ciSup (f_alpha_bddAbove hα (ρs i) (σs i) (hker i)) H) (hw_nonneg i)) + +/-- If for all i, ker(σs i) ≤ ker(ρs i), then ker(∑ w i • σs i) ≤ ker(∑ w i • ρs i), +provided all weights are nonneg and all matrices are PSD. -/ +theorem HermitianMat.ker_weighted_sum_le {ι : Type*} [Fintype ι] + (w : ι → ℝ) (hw_nonneg : ∀ i, 0 ≤ w i) + (ρs σs : ι → HermitianMat d ℂ) + (hρs_nonneg : ∀ i, 0 ≤ ρs i) + (hσs_nonneg : ∀ i, 0 ≤ σs i) + (hker : ∀ i, (σs i).ker ≤ (ρs i).ker) : + (∑ i, w i • σs i).ker ≤ (∑ i, w i • ρs i).ker := by + rw [ker_sum, ker_sum] + · refine iInf_mono fun i ↦ ?_ + by_cases hi : w i = 0 + · simp [hi] + · simp_all [ker_pos_smul] + · exact fun i => smul_nonneg (hw_nonneg i) (hρs_nonneg i) + · exact fun i => smul_nonneg (hw_nonneg i) (hσs_nonneg i) + +/-- The trace functional `Q̃_α` is jointly convex for `α > 1`. +This is Proposition 3 of the paper, originally from Frank–Lieb. +The proof uses the variational formula: + `Q̃_α(ρ‖σ) = sup_{H ≥ 0} f_α(H, ρ, σ)` +where `f_α(H, ρ, σ) = α · Tr[ρ H] - (α-1) · Tr[(σ^{-γ} H σ^{-γ})^{α/(α-1)}]` +is jointly convex in `(ρ, σ)` for fixed `H` (since the first term is linear and +the second uses the convexity of trace functions). The supremum of jointly convex +functions is jointly convex. -/ +theorem sandwichedTraceFunctional_jointly_convex (hα : 1 < α) {ι : Type*} [Fintype ι] + (w : ι → ℝ) (hw_nonneg : ∀ i, 0 ≤ w i) (hw_sum : ∑ i, w i = 1) + (ρs σs : ι → MState d) (ρ_mix σ_mix : MState d) + (hρ_mix : ρ_mix.M = ∑ i, w i • (ρs i).M) + (hσ_mix : σ_mix.M = ∑ i, w i • (σs i).M) + (hker : ∀ i, (σs i).M.ker ≤ (ρs i).M.ker) : + Q̃_ α(ρ_mix‖σ_mix) ≤ ∑ i, w i * Q̃_ α(ρs i‖σs i) := by + have hker' : σ_mix.M.ker ≤ ρ_mix.M.ker := by + rw [hρ_mix, hσ_mix] + exact ker_weighted_sum_le w hw_nonneg _ _ (fun i => (ρs i).nonneg) (fun i => (σs i).nonneg) hker + rw [traceFunctional_eq_iSup_f_alpha hα ρ_mix σ_mix hker'] + calc ⨆ H : {H : HermitianMat d ℂ // 0 ≤ H}, f_alpha α H.1 ρ_mix σ_mix + ≤ ∑ i, w i * (⨆ H : {H : HermitianMat d ℂ // 0 ≤ H}, f_alpha α H.1 (ρs i) (σs i)) := + iSup_f_alpha_jointly_convex hα w hw_nonneg hw_sum ρs σs ρ_mix σ_mix hρ_mix hσ_mix hker + _ = ∑ i, w i * Q̃_ α(ρs i‖σs i) := by + congr 1; ext i + rw [traceFunctional_eq_iSup_f_alpha hα (ρs i) (σs i) (hker i)] + +/-! ### Twirling Construction Helpers +We construct a twirling set using κ = Perm dB × (dB → Bool). +For each (σ, f), the unitary V(σ,f) is the product of a sign-diagonal matrix +(with entries ±1 determined by f) and a permutation matrix. +The averaging property follows from: +1. Sign averaging: summing over f kills off-diagonal entries +2. Permutation averaging: summing over σ uniformizes diagonal entries -/ -lemma T_is_CP (σ : MState d) (Φ : CPTPMap d d₂) : - (T_map σ Φ).IsCompletelyPositive := by - rw [ T_map_eq_comp ]; - apply MatrixMap.IsCompletelyPositive.comp; - · apply MatrixMap.IsCompletelyPositive.comp; - · exact Gamma_map_CP σ; - · exact Φ.cp; - · exact Gamma_inv_map_CP (Φ σ) /- -T_map is positive. +A diagonal matrix with ±1 entries (determined by a Bool function) is unitary. -/ -lemma T_is_positive (σ : MState d) (Φ : CPTPMap d d₂) : - (T_map σ Φ).IsPositive := by - exact T_is_CP σ Φ |> fun h => h.IsPositive +private lemma signDiag_mem_unitaryGroup (f : dB → Bool) : + Matrix.diagonal (fun i : dB => (if f i then (-1 : ℂ) else 1)) ∈ Matrix.unitaryGroup dB ℂ := by + constructor + · ext i j; by_cases hi : i = j <;> simp [hi] + · split_ifs <;> simp [*, Matrix.one_apply] + · rw [Matrix.diagonal_apply_ne _ (.symm hi)] + simp + · ext i j; by_cases hi : i = j <;> simp [hi] + · split_ifs <;> simp [*, Matrix.one_apply] + · rw [Matrix.diagonal_apply_ne _ (.symm hi)] + simp + +/-- The product of a ±1 diagonal matrix and a permutation matrix is unitary. -/ +private lemma twirlingU_mem_unitaryGroup (σ : Equiv.Perm dB) (f : dB → Bool) : + Matrix.diagonal (fun i : dB => (if f i then (-1 : ℂ) else 1)) * σ.permMatrix ℂ ∈ + Matrix.unitaryGroup dB ℂ := + mul_mem (signDiag_mem_unitaryGroup f) (σ.permMatrix_mem_unitaryGroup) + +/-- The twirling unitary for a given permutation and sign function. -/ +private def twirlingU (σ : Equiv.Perm dB) (f : dB → Bool) : Matrix.unitaryGroup dB ℂ := + ⟨Matrix.diagonal (fun i : dB => (if f i then (-1 : ℂ) else 1)) * σ.permMatrix ℂ, + twirlingU_mem_unitaryGroup σ f⟩ /- -The weighted 1-norm of X is the trace norm of Gamma(X). +Entry of the conjugation by a twirling unitary: + (X.conj (twirlingU σ f))_{pq} = sign(f,p) * sign(f,q) * X_{σp, σq}. -/ -lemma weighted_norm_one_eq_trace_norm_Gamma (σ : MState d) (X : Matrix d d ℂ) : - weighted_norm 1 σ X = schattenNorm (Gamma σ X) 1 := by - unfold weighted_norm Gamma; - norm_num +private lemma twirlingU_conj_entry (X : HermitianMat dB ℂ) (σ : Equiv.Perm dB) (f : dB → Bool) + (p q : dB) : + (X.conj (twirlingU σ f : Matrix dB dB ℂ)) p q = + (if f p then (-1 : ℂ) else 1) * (if f q then (-1 : ℂ) else 1) * X (σ p) (σ q) := by + have h_conj_apply : ∀ u : Matrix.unitaryGroup dB ℂ, (conj u.val X).mat = + u.val * X.mat * u.val.conjTranspose := by + intro u + simp_all only [conj_apply_mat] + convert congr_fun (congr_fun (h_conj_apply (twirlingU σ f)) p) q using 1 + unfold twirlingU + simp [Matrix.mul_apply, Matrix.diagonal] + simp [Finset.sum_ite] + rw [Finset.sum_eq_single (σ q)] + · simp_all only [conj_apply_mat, implies_true, Equiv.symm_apply_apply, ↓reduceIte] + split + next h => + simp_all only [map_neg, map_one, mul_neg, mul_one, neg_neg] + split + next h_1 => simp_all only [neg_neg] + next h_1 => simp_all only [Bool.not_eq_true] + next h => simp_all only [Bool.not_eq_true, map_one, mul_one] + · aesop + · simp /- -The induced norm of a super-operator between weighted Schatten spaces. +Summing the sign product over all Bool functions. + For p = q, each term is 1, giving 2^(card dB). + For p ≠ q, terms cancel in pairs (flip f at p). -/ -noncomputable def general_induced_norm - (p q : ℝ) (σ : MState d) (σ' : MState d₂) - (Ψ : MatrixMap d d₂ ℂ) : ℝ := - sSup { weighted_norm q σ' (Ψ X) / weighted_norm p σ X | (X : Matrix d d ℂ) (_ : weighted_norm p σ X ≠ 0) } +private lemma sum_sign_prod (p q : dB) : + ∑ f : dB → Bool, ((if f p then (-1 : ℂ) else 1) * (if f q then (-1 : ℂ) else 1)) = + if p = q then (2 ^ Fintype.card dB : ℕ) else 0 := by + split_ifs with h + · simp +contextual [h] + simp +contextual + -- By pairing each function with its p-flip, we can see that the sum of each pair is zero. + have h_pair : + ∑ f : dB → Bool, (if f q then -if f p then -1 else 1 else if f p then -1 else 1 : ℂ) = + ∑ f : dB → Bool, - (if f q then -if f p then -1 else 1 else if f p then -1 else 1 : ℂ) := by + apply Finset.sum_bij (fun f _ => Function.update f p (¬f p)) (by simp) + · intro a₁ _ a₂ _ h; ext x; by_cases hx : x = p + · replace h := congr_fun h x + subst hx + simp_all only [Finset.mem_univ, Bool.not_eq_true, Bool.decide_eq_false, + Function.update_self, Bool.not_eq_eq_eq_not, Bool.not_not] + · replace h := congr_fun h x + simp_all only [Finset.mem_univ, Bool.not_eq_true, Bool.decide_eq_false, ne_eq, + not_false_eq_true, Function.update_of_ne] + · exact fun b _ => ⟨Function.update b p (decide ¬b p = true), Finset.mem_univ _, by simp⟩ + · grind + rw [Finset.sum_neg_distrib] at h_pair + linear_combination h_pair / 2 /- -Multiplication property for HermitianMat functional calculus. +Summing X_{σ(p), σ(p)} over all permutations σ. + For each target k, exactly (card dB - 1)! permutations send p to k. -/ -lemma HermitianMat.cfc_mul {d : Type*} [Fintype d] [DecidableEq d] - (A : HermitianMat d ℂ) (f g : ℝ → ℝ) : - (A.cfc f).mat * (A.cfc g).mat = (A.cfc (fun x => f x * g x)).mat := by - symm - apply mat_cfc_mul +private lemma sum_perm_diag_entry (X : HermitianMat dB ℂ) (p : dB) : + ∑ σ : Equiv.Perm dB, X (σ p) (σ p) = + ((Fintype.card dB - 1).factorial : ℂ) * ∑ k : dB, X k k := by + -- For each fixed k, the number of permutations σ with σ p = k is (card dB - 1)! + have h_card (k : dB) : (Finset.univ.filter (fun σ : Equiv.Perm dB => σ p = k)).card = + (Nat.factorial (Fintype.card dB - 1) : ℕ) := by + have h_fixed : Finset.card (Finset.filter (fun σ : Equiv.Perm dB => σ p = k) Finset.univ) = + Finset.card (Finset.univ : Finset (Equiv.Perm dB)) / Fintype.card dB := by + have h_card : ∀ k : dB, (Finset.univ.filter (fun σ : Equiv.Perm dB => σ p = k)).card = + (Finset.univ.filter (fun σ : Equiv.Perm dB => σ p = p)).card := by + intro k + apply Finset.card_bij (fun σ _ => Equiv.swap p k * σ) + · intro a ha + simp_all only [Finset.mem_filter, Finset.mem_univ, true_and, Equiv.Perm.coe_mul, + Function.comp_apply, Equiv.swap_apply_right, and_self] + · simp + · simp + exact fun b hb => ⟨Equiv.swap p k * b, by simp [hb], by simp⟩ + have hc2 : (Finset.univ.filter (fun σ : Equiv.Perm dB => σ p = p)).card * Fintype.card dB = + Finset.card (Finset.univ : Finset (Equiv.Perm dB)) := by + have hc : ∑ k : dB, (Finset.univ.filter (fun σ : Equiv.Perm dB => σ p = k)).card = + Finset.card (Finset.univ : Finset (Equiv.Perm dB)) := by + simp only [Finset.card_eq_sum_ones, Finset.sum_fiberwise] + simp_all [mul_comm] + rw [← hc2, h_card k, Nat.mul_div_cancel _ (Fintype.card_pos_iff.mpr ⟨p⟩)] + rcases n : Fintype.card dB with (_ | _ | n) <;> simp_all [Nat.factorial_succ, Fintype.card_perm] + exact absurd n (Nat.ne_of_gt (Fintype.card_pos_iff.mpr ⟨p⟩)) + -- By Fubini's theorem, we can interchange the order of summation. + have h_fubini : ∑ σ : Equiv.Perm dB, X (σ p) (σ p) = ∑ k : dB, ∑ σ ∈ Finset.univ.filter + (fun σ : Equiv.Perm dB => σ p = k), X k k := by + simp only [Finset.sum_filter] + rw [Finset.sum_comm, Finset.sum_congr rfl] + intro x a + simp_all only [Finset.mem_univ, Finset.sum_ite_eq, ↓reduceIte] + simp_all [Finset.mul_sum] /- -Gamma of identity is sigma. --/ -set_option backward.isDefEq.respectTransparency false in -lemma Gamma_one (σ : MState d) : Gamma σ 1 = σ.M.mat := by - have h_gamma_one : (σ.M.cfc (fun x => x^(1/2 : ℝ))).mat * (σ.M.cfc (fun x => x^(1/2 : ℝ))).mat = σ.M.cfc (fun x => x^(1/2 : ℝ) * x^(1/2 : ℝ)) := by - symm - exact HermitianMat.mat_cfc_mul σ.M ( fun x => x ^ ( 1 / 2 : ℝ ) ) ( fun x => x ^ ( 1 / 2 : ℝ ) ) - convert h_gamma_one using 1; - · unfold Gamma; aesop; - · norm_num [ ← Real.sqrt_eq_rpow, Real.sqrt_mul_self ( show 0 ≤ _ from _ ) ]; - have h_gamma_one : ∀ x ∈ spectrum ℝ σ.m, Real.sqrt x * Real.sqrt x = x := by - intro x hx; rw [ Real.mul_self_sqrt ] ; exact (by - rw [ spectrum.mem_iff ] at hx; - exact Matrix.PosSemidef.pos_of_mem_spectrum σ.psd x hx); - rw [ cfc ]; - split_ifs <;> simp_all - · convert rfl; - convert cfcHom_id _; - ext x; aesop; - · exact False.elim ( ‹IsSelfAdjoint σ.m → ¬ContinuousOn ( fun x => Real.sqrt x * Real.sqrt x ) ( spectrum ℝ σ.m ) › σ.M.prop <| ContinuousOn.mul ( Real.continuous_sqrt.continuousOn ) ( Real.continuous_sqrt.continuousOn ) ) +The sum formula for twirling: summing the conjugation entries over all (σ, f) pairs. +-/ +private lemma twirling_sum_eq [Nonempty dB] (X : HermitianMat dB ℂ) (p q : dB) : + ∑ i : Equiv.Perm dB × (dB → Bool), (X.conj (twirlingU i.1 i.2 : Matrix dB dB ℂ)) p q = + if p = q then ((Fintype.card dB - 1).factorial * 2 ^ Fintype.card dB : ℕ) * ∑ k, X k k + else 0 := by + -- Rewrite the sum as a double sum over σ and f using Finset.sum_product'. + have h_double_sum : ∑ i : Equiv.Perm dB × (dB → Bool), + ((conj (twirlingU i.1 i.2 : Matrix dB dB ℂ)) X) p q = + ∑ σ : Equiv.Perm dB, ∑ f : dB → Bool, ((if f p then (-1 : ℂ) else 1) * + (if f q then (-1 : ℂ) else 1) * X (σ p) (σ q)) := by + rw [← Finset.sum_product'] + refine Finset.sum_bij (fun i _ => (i.1, i.2)) ?_ ?_ ?_ ?_ + · simp + · simp + · simp + · simp [twirlingU_conj_entry] + split_ifs with h + · simp_all [← Finset.mul_sum] + have := sum_perm_diag_entry X q; simp_all [mul_assoc, mul_comm] + · rw [h_double_sum, Finset.sum_eq_zero] + intro σ _ + rw [← Finset.sum_mul, sum_sign_prod p q] + simp_all only [mul_ite, mul_neg, mul_one, ite_mul, neg_mul, one_mul, Finset.mem_univ, reduceIte, + CharP.cast_eq_zero, zero_mul] /- -Gamma inverse of sigma is identity. --/ -lemma Gamma_inv_self (σ : MState d) (hσ : σ.m.PosDef) : - Gamma_inv σ σ.M.mat = 1 := by - -- We use `HermitianMat.cfc_mul` and the fact that $x^{-1/2} * x * x^{-1/2} = 1$ for $x > 0$. - have h_gamma_inv_sigma : (σ.M.cfc (fun x => x ^ (-1/2 : ℝ))).mat * (σ.M.mat) * (σ.M.cfc (fun x => x ^ (-1/2 : ℝ))).mat = (σ.M.cfc (fun x => x ^ (-1/2 : ℝ) * x * x ^ (-1/2 : ℝ))).mat := by - have h_gamma_inv_sigma : (σ.M.cfc (fun x => x ^ (-1/2 : ℝ))).mat * (σ.M.cfc id).mat * (σ.M.cfc (fun x => x ^ (-1/2 : ℝ))).mat = (σ.M.cfc (fun x => x ^ (-1/2 : ℝ) * x * x ^ (-1/2 : ℝ))).mat := by - have h_gamma_inv_sigma : ∀ (f g h : ℝ → ℝ), ContinuousOn f (spectrum ℝ σ.M.mat) → ContinuousOn g (spectrum ℝ σ.M.mat) → ContinuousOn h (spectrum ℝ σ.M.mat) → (σ.M.cfc f).mat * (σ.M.cfc g).mat * (σ.M.cfc h).mat = (σ.M.cfc (fun x => f x * g x * h x)).mat := by - intro f g h hf hg hh - have h_gamma_inv_sigma : (σ.M.cfc f).mat * (σ.M.cfc g).mat = (σ.M.cfc (fun x => f x * g x)).mat := by - symm - convert HermitianMat.mat_cfc_mul σ.M f g using 1; - rw [ h_gamma_inv_sigma, ← HermitianMat.mat_cfc_mul ]; - congr! 2 - have h : ∀ x ∈ spectrum ℝ σ.M.mat, x ≠ 0 := by - norm_num - intro x hx h_zero - have h_eigenvalue : ∃ v : d → ℂ, v ≠ 0 ∧ σ.m.mulVec v = x • v := by - simp_all [ spectrum.mem_iff] - contrapose! hx; - exact Matrix.PosDef.isUnit hσ; - obtain ⟨ v, hv_ne_zero, hv_eigenvalue ⟩ := h_eigenvalue - rw [Matrix.posDef_iff_dotProduct_mulVec] at hσ - have := hσ.2 hv_ne_zero - simp [hv_eigenvalue, h_zero] at this - apply h_gamma_inv_sigma - · fun_prop - · fun_prop - · fun_prop - convert h_gamma_inv_sigma using 1; - ext i j ; simp [ Matrix.mul_apply] - -- Since $x^{-1/2} * x * x^{-1/2} = 1$ for $x > 0$, we have $(σ.M.cfc (fun x => x ^ (-1/2 : ℝ))).mat * (σ.M.mat) * (σ.M.cfc (fun x => x ^ (-1/2 : ℝ))).mat = (σ.M.cfc (fun x => 1)).mat$. - have h_gamma_inv_sigma_simplified : (σ.M.cfc (fun x => x ^ (-1/2 : ℝ))).mat * (σ.M.mat) * (σ.M.cfc (fun x => x ^ (-1/2 : ℝ))).mat = (σ.M.cfc (fun x => 1)).mat := by - convert h_gamma_inv_sigma using 1; - congr! 1; - -- Since $x^{-1/2} * x * x^{-1/2} = 1$ for all $x > 0$, the functions are equal. - have h_eq : ∀ x : ℝ, 0 < x → x ^ (-1 / 2 : ℝ) * x * x ^ (-1 / 2 : ℝ) = 1 := by - intro x hx - ring_nf - norm_num [ hx.ne' ]; - rw [ ← Real.rpow_natCast, ← Real.rpow_mul hx.le ] ; norm_num [ hx.ne' ]; - rw [ Real.rpow_neg_one, inv_mul_cancel₀ hx.ne' ]; - exact Eq.symm (HermitianMat.cfc_congr_of_posDef hσ h_eq); - convert h_gamma_inv_sigma_simplified using 1; - ext i j - simp +The identity for the twirling set, stated for κ = Perm dB × (dB → Bool). +-/ +private lemma twirling_identity [Nonempty dB] (X : HermitianMat dB ℂ) : + (Fintype.card (Equiv.Perm dB × (dB → Bool)) : ℝ)⁻¹ • + ∑ i : Equiv.Perm dB × (dB → Bool), X.conj (twirlingU i.1 i.2 : Matrix dB dB ℂ) = + (X.trace / Fintype.card dB) • (1 : HermitianMat dB ℂ) := by + ext p q + simp [Fintype.card_prod, Fintype.card_perm, Fintype.card_pi] + ring_nf + convert congr_arg ((2⁻¹ ^ Fintype.card dB * (Fintype.card dB |> Nat.factorial : ℂ)⁻¹) * ·) + (twirling_sum_eq X p q) using 1 + · norm_num [Matrix.one_apply] + convert Or.inl rfl + induction (Finset.univ : Finset (Equiv.Perm dB × (dB → Bool))) using Finset.induction + · simp_all only [Finset.sum_empty, zero_apply] + · rename_i a s a_1 a_2 + obtain ⟨fst, snd⟩ := a + simp only [not_false_eq_true, Finset.sum_insert, *] + rfl + · norm_num [Matrix.one_apply] + rw [show X.trace = ∑ k, X k k from X.trace_eq_trace] + rcases n : Fintype.card dB with (_ | n) + · simp_all + · simp_all [Nat.factorial_succ, mul_assoc, mul_comm, mul_left_comm] + simp [Nat.factorial_ne_zero] + +/-! ## Twirling Set + +A twirling set for a finite-dimensional system `dB` is a set of unitary matrices +`{V_i}` on `dB` (indexed by some finite type `κ`) such that the average +`(1/|κ|) Σ_i V_i X V_i†` equals `Tr(X) · (1/dim(dB))` for all `X`. +When applied as `1_A ⊗ V_i` on a bipartite system `dA × dB`, this gives: +`(1/|κ|) Σ_i (1_A ⊗ V_i) ρ_AB (1_A ⊗ V_i)† = ρ_A ⊗ π_B` +where `π_B = 1/dim(dB)` is the maximally mixed state. + +The standard construction uses the Heisenberg–Weyl (discrete Weyl) operators. -/ + +/-- A twirling set for the system `dB` exists: there is a finite collection of unitaries +whose average conjugation action twirls any matrix to a multiple of the identity. +Specifically, `(1/|κ|) Σ_i V_i X V_i† = (Tr X / dim dB) · I` for all Hermitian X on dB. +The standard construction uses the discrete Heisenberg-Weyl group of order `|dB|²`. -/ +private lemma exists_twirling_unitaries [Nonempty dB] : + ∃ (κ : Type) (_ : Fintype κ) (_ : Nonempty κ) (V : κ → Matrix.unitaryGroup dB ℂ), + ∀ (X : HermitianMat dB ℂ), + (Fintype.card κ : ℝ)⁻¹ • ∑ i : κ, X.conj (V i : Matrix dB dB ℂ) = + (X.trace / Fintype.card dB) • (1 : HermitianMat dB ℂ) := by + use Shrink (Equiv.Perm dB × (dB → Bool)), inferInstance, inferInstance + use fun i => twirlingU ((equivShrink _).symm i).1 ((equivShrink _).symm i).2 + intro X + rw [Fintype.card_shrink] + convert twirling_identity X using 2 + refine Finset.sum_bij (fun i _ => (equivShrink _).symm i) ?_ ?_ ?_ ?_ + · simp + · simp + · simp + exact fun a b => ⟨_, Equiv.apply_symm_apply _ _⟩ + · simp + + +-- /-- Twirling on a bipartite system: applying `1_A ⊗ V_i` and averaging produces the +-- partial trace tensored with the maximally mixed state. -/ +-- theorem twirling_bipartite [Nonempty dB] +-- (κ : Type) [Fintype κ] (V : κ → Matrix.unitaryGroup dB ℂ) +-- (hV : ∀ (X : HermitianMat dB ℂ), +-- (Fintype.card κ : ℝ)⁻¹ • ∑ i : κ, X.conj (V i : Matrix dB dB ℂ) = +-- (X.trace / Fintype.card dB) • (1 : HermitianMat dB ℂ)) +-- (A : HermitianMat (dA × dB) ℂ) : +-- (Fintype.card κ : ℝ)⁻¹ • ∑ i : κ, +-- A.conj (Matrix.kroneckerMap (· * ·) (1 : Matrix dA dA ℂ) (V i : Matrix dB dB ℂ)) = +-- A.traceRight ⊗ₖ ((Fintype.card dB : ℝ)⁻¹ • (1 : HermitianMat dB ℂ)) := by +-- not needed... + +/-! ## Tensor Invariance + +`Q̃_α(ρ ⊗ τ ‖ σ ⊗ τ) = Q̃_α(ρ ‖ σ)` for any state `τ`. +This corresponds to equation (2.4) in the paper. -/ /- -The matrix of the output state is the map applied to the input matrix. +The trace functional is multiplicative over tensor products: +`Q̃_α(ρ₁ ⊗ ρ₂ ‖ σ₁ ⊗ σ₂) = Q̃_α(ρ₁‖σ₁) · Q̃_α(ρ₂‖σ₂)`. -/ -lemma CPTPMap_apply_MState_M (Φ : CPTPMap d d₂) (σ : MState d) : - (Φ σ).M.mat = Φ.map σ.M.mat := by - exact rfl +theorem sandwichedTraceFunctional_mul + (ρ₁ σ₁ : MState dA) (ρ₂ σ₂ : MState dB) : + Q̃_ α(ρ₁ ⊗ᴹ ρ₂‖σ₁ ⊗ᴹ σ₂) = Q̃_ α(ρ₁‖σ₁) * Q̃_ α(ρ₂‖σ₂) := by + exact sandwiched_term_product ρ₁ σ₁ ρ₂ σ₂ α ((1 - α) / (2 * α)) /- -The map T is unital. +The trace functional of a state with itself equals 1. +This follows from the calculation: `γ = (1-α)/(2α)` gives `2γ + 1 = 1/α`, +so `σ^γ · σ · σ^γ = σ^(2γ+1) = σ^(1/α)`, and `(σ^(1/α))^α = σ^1`, +whose trace equals 1 since σ is a state. -/ -theorem T_map_unital (σ : MState d) (Φ : CPTPMap d d₂) (hΦσ : (Φ σ).m.PosDef) : - (T_map σ Φ) 1 = 1 := by - dsimp [T_map, T_op] - rw [Gamma_one σ] - rw [← CPTPMap_apply_MState_M] - rw [Gamma_inv_self (Φ σ) hΦσ] +theorem sandwichedTraceFunctional_self (hα : 0 < α) (ρ : MState d) : + Q̃_ α(ρ‖ρ) = 1 := by + by_cases h : α = 1 + · subst h; simp [sandwichedTraceFunctional] + · unfold sandwichedTraceFunctional + have := ρ.pos + have h_simp : (ρ.M.conj (ρ.M ^ ((1 - α) / (2 * α))).mat) = + ρ.M ^ (1 + 2 * ((1 - α) / (2 * α))) := by + rw [← conj_rpow] + · rw [rpow_one] + · exact le_of_lt this + · exact div_ne_zero (sub_ne_zero_of_ne (Ne.symm h)) (mul_ne_zero two_ne_zero hα.ne') + · nlinarith [mul_div_cancel₀ (1 - α) (by positivity : (2 * α) ≠ 0)] + have h_simp : (ρ.M ^ (1 + 2 * ((1 - α) / (2 * α)))) ^ α = + ρ.M ^ ((1 + 2 * ((1 - α) / (2 * α))) * α) := by + rw [← rpow_mul] + exact le_of_lt this + field_simp at * + simp_all only [add_sub_cancel, one_div, rpow_one, MState.tr] + +/-- The trace functional is invariant under tensoring with a fixed state. +This follows from multiplicativity (`sandwichedTraceFunctional_mul`) and +the self-trace-functional being 1 (`sandwichedTraceFunctional_self`). -/ +theorem sandwichedTraceFunctional_tensor_invariant (hα : 0 < α) + (ρ σ : MState dA) (τ : MState dB) : + Q̃_ α(ρ ⊗ᴹ τ‖σ ⊗ᴹ τ) = Q̃_ α(ρ‖σ) := by + rw [sandwichedTraceFunctional_mul, sandwichedTraceFunctional_self hα, mul_one] + +/-! ## Twirling MState Helpers + +Helper lemmas for constructing MStates via the twirling argument. -/ + +/-- The MState obtained by conjugating a bipartite state by `1_A ⊗ V` where `V` is a unitary +on the `B` system. This is `(1_A ⊗ V) ρ_AB (1_A ⊗ V)†`. -/ +def MState.conjTensorUnitary (ρ : MState (dA × dB)) (V : Matrix.unitaryGroup dB ℂ) : + MState (dA × dB) := + ρ.U_conj ((1 : Matrix.unitaryGroup dA ℂ) ⊗ᵤ V) + +/-- The twirled MState: averaging conjugation by `1_A ⊗ V_i` over all elements of +the twirling set gives `ρ_A ⊗ uniform_B`. We state the HermitianMat-level +equality needed for the joint convexity argument. -/ +theorem MState.conjTensorUnitary_M (ρ : MState (dA × dB)) (V : Matrix.unitaryGroup dB ℂ) : + (ρ.conjTensorUnitary V).M = ρ.M.conj ((1 : Matrix.unitaryGroup dA ℂ) ⊗ᵤ V).val := by + rfl + +/-- The trace functional is invariant under `1_A ⊗ V` conjugation. -/ +theorem sandwichedTraceFunctional_conj_tensorUnitary + (ρ σ : MState (dA × dB)) (V : Matrix.unitaryGroup dB ℂ) : + Q̃_ α(ρ.conjTensorUnitary V‖σ.conjTensorUnitary V) = Q̃_ α(ρ‖σ) := by + exact sandwichedTraceFunctional_conj_unitary_MState _ ρ σ + +section twirling + +variable {dA dB : Type*} +variable [Fintype dA] [Fintype dB] +variable [DecidableEq dA] [DecidableEq dB] +open scoped InnerProductSpace RealInnerProductSpace HermitianMat Matrix + +omit [DecidableEq dB] in +-- The ((a₁,b₁),(a₂,b₂)) entry of (1⊗V)*M*(1⊗V)† +-- equals (V * block_{a₁,a₂} * V†)_{b₁,b₂}. +lemma conj_kron_one_entry (M : Matrix (dA × dB) (dA × dB) ℂ) + (V : Matrix dB dB ℂ) (a₁ a₂ : dA) (b₁ b₂ : dB) : + (Matrix.kroneckerMap (· * ·) (1 : Matrix dA dA ℂ) V * M * + (Matrix.kroneckerMap (· * ·) (1 : Matrix dA dA ℂ) V).conjTranspose) (a₁, b₁) (a₂, b₂) = + (V * (Matrix.of fun b₁' b₂' => M (a₁, b₁') (a₂, b₂')) * V.conjTranspose) b₁ b₂ := by + norm_num [Matrix.mul_apply, Matrix.adjugate_apply, Matrix.det_apply', Matrix.trace] + simp [Matrix.one_apply, Finset.sum_ite] + apply Finset.sum_bij (fun x _ => x.2) + · simp + · simp + · simp + simp + intro a b rfl + left + apply Finset.sum_bij (fun x _ => x.2) + · simp + · simp + · simp + simp +contextual /- -The map T is completely positive. +For a Hermitian matrix, the twirling identity at the entry level. +Extracts from hV the entry-level equation. -/ -theorem T_map_is_CP_proof (σ : MState d) (Φ : CPTPMap d d₂) : - (T_map σ Φ).IsCompletelyPositive := by - apply T_is_CP +lemma twirling_hermitian_entry + (κ : Type) [Fintype κ] (V : κ → Matrix.unitaryGroup dB ℂ) + (hV : ∀ (X : HermitianMat dB ℂ), + (Fintype.card κ : ℝ)⁻¹ • ∑ i : κ, X.conj (V i : Matrix dB dB ℂ) = + (X.trace / Fintype.card dB) • (1 : HermitianMat dB ℂ)) + (X : HermitianMat dB ℂ) (b₁ b₂ : dB) : + ∑ i : κ, ((V i).val * X.val * (V i).val.conjTranspose) b₁ b₂ = + (X.val.trace / (Fintype.card dB : ℂ)) * (Fintype.card κ : ℂ) * + (if b₁ = b₂ then 1 else 0) := by + replace hV := congr_arg (fun s => s.val b₁ b₂) (hV X); simp_all [div_eq_inv_mul] + convert congr_arg (fun x : ℂ => x * Fintype.card κ) hV using 1 <;> ring_nf + · by_cases h : Fintype.card κ = 0 <;> simp_all [conj] + · rw [Fintype.card_eq_zero_iff] at h + simp_all only [Finset.univ_eq_empty, Finset.sum_empty] + · classical induction (Finset.univ : Finset κ) using Finset.induction + · simp_all [Matrix.mul_assoc] + · simp_all [Matrix.mul_assoc] + rfl + · simp [Matrix.one_apply, mul_assoc, mul_comm] + simp [Matrix.trace, trace] + congr! 2 + exact Finset.sum_congr rfl fun _ _ => by simp [Complex.ext_iff] +/- +Extension of the twirling property from HermitianMat to general matrices. +-/ +lemma twirling_general_matrix + (κ : Type) [Fintype κ] (V : κ → Matrix.unitaryGroup dB ℂ) + (hV : ∀ (X : HermitianMat dB ℂ), + (Fintype.card κ : ℝ)⁻¹ • ∑ i : κ, X.conj (V i : Matrix dB dB ℂ) = + (X.trace / Fintype.card dB) • (1 : HermitianMat dB ℂ)) + (X : Matrix dB dB ℂ) (b₁ b₂ : dB) : + ∑ i : κ, ((V i).val * X * (V i).val.conjTranspose) b₁ b₂ = + (X.trace / (Fintype.card dB : ℂ)) * (Fintype.card κ : ℂ) * + (if b₁ = b₂ then 1 else 0) := by + -- Decompose X into Hermitian and anti-Hermitian parts. + set X_herm : Matrix dB dB ℂ := (1 / 2 : ℂ) • (X + X.conjTranspose) + set X_anti_herm : Matrix dB dB ℂ := (1 / (2 * Complex.I) : ℂ) • (X - X.conjTranspose) + have h_decomp : X = X_herm + Complex.I • X_anti_herm := by + ext i j; norm_num [X_herm, X_anti_herm]; ring_nf + norm_num; ring + -- Apply thetwirling property to X_herm and X_anti_herm. + have h_tw_h : ∑ i : κ, ((V i).val * X_herm * (V i).val.conjTranspose) b₁ b₂ = + (X_herm.trace / (Fintype.card dB)) * (Fintype.card κ) * (if b₁ = b₂ then 1 else 0) := by + convert twirling_hermitian_entry κ V hV ⟨X_herm, _⟩ b₁ b₂ using 1 + simp +zetaDelta at * + ext i j; simp [Matrix.conjTranspose_apply]; ring + have h_tw_a : ∑ i : κ, ((V i).val * X_anti_herm * (V i).val.conjTranspose) b₁ b₂ = + (X_anti_herm.trace / (Fintype.card dB)) * (Fintype.card κ) * (if b₁ = b₂ then 1 else 0) := by + convert twirling_hermitian_entry κ V hV ⟨X_anti_herm, ?_⟩ b₁ b₂ using 1 + ext i j; simp [X_anti_herm, Matrix.conjTranspose_apply]; ring + rw [h_decomp] + convert congr_arg₂ (· + ·) h_tw_h (congr_arg (fun x : ℂ => Complex.I * x) h_tw_a) using 1 + <;> simp [mul_add, add_mul, mul_assoc, Finset.mul_sum, Finset.sum_add_distrib] + ring_nf + split_ifs <;> ring + +/-- The MState obtained by conjugating a bipartite state by `1_A ⊗ V`. -/ +def MState.conjTensorUnitary' (ρ : MState (dA × dB)) (V : Matrix.unitaryGroup dB ℂ) : + MState (dA × dB) := + ρ.U_conj ((1 : Matrix.unitaryGroup dA ℂ) ⊗ᵤ V) + +-- Entry-level form of the conjTensorUnitary. +lemma conjTensorUnitary'_entry (ρ : MState (dA × dB)) (V : Matrix.unitaryGroup dB ℂ) + (a₁ a₂ : dA) (b₁ b₂ : dB) : + (ρ.conjTensorUnitary' V).M.val (a₁, b₁) (a₂, b₂) = + ((V : Matrix dB dB ℂ) * (Matrix.of fun b₁' b₂' => ρ.M.val (a₁, b₁') (a₂, b₂')) * + (V : Matrix dB dB ℂ).conjTranspose) b₁ b₂ := by + apply conj_kron_one_entry + +-- The RHS entry: (ρ.traceRight ⊗ᴹ uniform).M at ((a₁,b₁),(a₂,b₂)). +lemma prod_traceRight_uniform_entry [Nonempty dB] (ρ : MState (dA × dB)) + (a₁ a₂ : dA) (b₁ b₂ : dB) : + (ρ.traceRight ⊗ᴹ MState.uniform).M.val (a₁, b₁) (a₂, b₂) = + ρ.M.val.traceRight a₁ a₂ * ((Fintype.card dB : ℂ)⁻¹ * if b₁ = b₂ then 1 else 0) := by + unfold MState.traceRight MState.uniform + unfold MState.ofClassical + unfold diagonal + unfold MState.prod + unfold kronecker + simp [Matrix.kroneckerMap_apply] + rw [Matrix.diagonal_apply] + simp only [mul_ite, mul_zero] + +theorem twirling_average_eq [Nonempty dB] + (κ : Type) [Fintype κ] (V : κ → Matrix.unitaryGroup dB ℂ) + (hV : ∀ (X : HermitianMat dB ℂ), + (Fintype.card κ : ℝ)⁻¹ • ∑ i : κ, X.conj (V i : Matrix dB dB ℂ) = + (X.trace / Fintype.card dB) • (1 : HermitianMat dB ℂ)) + (ρ : MState (dA × dB)) : + ∑ i : κ, ((Fintype.card κ : ℝ)⁻¹ • (ρ.conjTensorUnitary' (V i)).M) = + (ρ.traceRight ⊗ᴹ MState.uniform).M := by + -- Apply the twirling hypothesis to each term in the sum. + have h_sum : ∀ a₁ a₂ : dA, ∀ b₁ b₂ : dB, (∑ i, (1 / (Fintype.card κ : ℂ)) • + (ρ.conjTensorUnitary' (V i)).M.val (a₁, b₁) (a₂, b₂)) = + (ρ.M.val.traceRight a₁ a₂) * (1 / (Fintype.card dB : ℂ)) * (if b₁ = b₂ then 1 else 0) := by + intro a₁ a₂ b₁ b₂ + have h_sum : ∑ i : κ, ((V i : Matrix dB dB ℂ) * (Matrix.of fun b₁' b₂' => + ρ.M.val (a₁, b₁') (a₂, b₂')) * (V i : Matrix dB dB ℂ).conjTranspose) b₁ b₂ = + (ρ.M.val.traceRight a₁ a₂) * (Fintype.card κ : ℂ) * (1 / (Fintype.card dB : ℂ)) * + (if b₁ = b₂ then 1 else 0) := by + convert twirling_general_matrix κ V hV + (Matrix.of fun b₁' b₂' => ρ.M.val (a₁, b₁') (a₂, b₂')) b₁ b₂ using 1 + simp [Matrix.trace] + ring_nf! + convert congr_arg (fun x : ℂ => (1 / (Fintype.card κ : ℂ)) * x) h_sum using 1 + · norm_num [conjTensorUnitary'_entry] + ring_nf + rw [Finset.mul_sum] + · norm_num [conjTensorUnitary'_entry] + by_cases h : Fintype.card κ = 0 <;> simp_all [mul_assoc, mul_comm, mul_left_comm] + specialize hV 1; norm_num at hV + convert h_sum using 1 + constructor <;> intro h + · exact h_sum + · ext ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ + convert h a₁ a₂ b₁ b₂ using 1 + · classical induction (Finset.univ : Finset κ) using Finset.induction + · simp_all + · simp_all + convert congr_arg₂ (· + ·) rfl ‹_› using 1 + simp [Algebra.smul_def] + · convert prod_traceRight_uniform_entry ρ a₁ a₂ b₁ b₂ using 1 + ring + +end twirling + +/-! ## Monotonicity Under Partial Trace (α > 1) + +The main intermediate result: for `α > 1`, the trace functional `Q̃_α` is monotone +under partial trace: +`Q̃_α(ρ_AB ‖ σ_AB) ≥ Q̃_α(ρ_A ‖ σ_A)`. + +The proof uses the twirling argument: +1. By unitary invariance, `Q̃_α(ρ_AB‖σ_AB) = Q̃_α(V_i ρ_AB V_i†‖V_i σ_AB V_i†)` for each `i`. +2. Averaging: `Q̃_α(ρ_AB‖σ_AB) = (1/|κ|) Σ_i Q̃_α(V_i ρ_AB V_i†‖V_i σ_AB V_i†)`. +3. By joint convexity (α > 1): `≥ Q̃_α((1/|κ|) Σ_i V_i ρ_AB V_i†‖(1/|κ|) Σ_i V_i σ_AB V_i†)`. +4. By twirling: `= Q̃_α(ρ_A ⊗ π_B ‖ σ_A ⊗ π_B)`. +5. By tensor invariance: `= Q̃_α(ρ_A ‖ σ_A)`. -/ + +/-- If `σ.M.ker ≤ ρ.M.ker`, then `(σ.conj B).ker ≤ (ρ.conj B).ker` for any matrix `B`. +This follows from `ker_conj` (which expresses `(A.conj B).ker` as a `comap`) and +`Submodule.comap_mono`. -/ +lemma ker_conj_le_of_ker_le {n : Type*} [Fintype n] [DecidableEq n] + {A B : HermitianMat n ℂ} (hA : 0 ≤ A) (hB : 0 ≤ B) (h : A.ker ≤ B.ker) + (C : Matrix n n ℂ) : (A.conj C).ker ≤ (B.conj C).ker := by + rw [ker_conj hA, ker_conj hB] + exact Submodule.comap_mono h + +/-- Unitary conjugation preserves the kernel ordering between MStates. +If `σ.M.ker ≤ ρ.M.ker`, then `(σ.conjTensorUnitary V).M.ker ≤ (ρ.conjTensorUnitary V).M.ker`. -/ +lemma MState.ker_conjTensorUnitary_le {dA dB : Type*} [Fintype dA] [Fintype dB] + [DecidableEq dA] [DecidableEq dB] + (ρ σ : MState (dA × dB)) (V : Matrix.unitaryGroup dB ℂ) + (hker : σ.M.ker ≤ ρ.M.ker) : + (σ.conjTensorUnitary V).M.ker ≤ (ρ.conjTensorUnitary V).M.ker := by + simp only [MState.conjTensorUnitary_M] + exact ker_conj_le_of_ker_le σ.nonneg ρ.nonneg hker _ + +/-- Monotonicity of the trace functional under partial trace for `α > 1`. +Equation (2.8) of the paper (second line). -/ +theorem sandwichedTraceFunctional_mono_traceRight [Nonempty dB] + (hα : 1 < α) (ρ σ : MState (dA × dB)) (hker : σ.M.ker ≤ ρ.M.ker) : + Q̃_ α(ρ.traceRight‖σ.traceRight) ≤ Q̃_ α(ρ‖σ) := by + -- Obtain the twirling unitaries + obtain ⟨κ, hκ_fin, hκ_ne, V, hV⟩ := exists_twirling_unitaries (dB := dB) + letI : Fintype κ := hκ_fin + letI : Nonempty κ := hκ_ne + -- By unitary invariance, Q̃_α(ρ‖σ) = Q̃_α(V_i ρ V_i†‖V_i σ V_i†) for each i + have h_inv (i) : Q̃_ α(ρ.conjTensorUnitary (V i)‖σ.conjTensorUnitary (V i)) = Q̃_ α(ρ‖σ) := + sandwichedTraceFunctional_conj_tensorUnitary ρ σ (V i) + -- Step 2: Q̃_α(ρ‖σ) = Σ_i (1/|κ|) * Q̃_α(V_i ρ V_i†‖V_i σ V_i†) + have hcard_ne : (Fintype.card κ : ℝ) ≠ 0 := + Nat.cast_ne_zero.mpr Fintype.card_ne_zero + have h_avg : Q̃_ α(ρ‖σ) = ∑ i : κ, (Fintype.card κ : ℝ)⁻¹ * + Q̃_ α(ρ.conjTensorUnitary (V i)‖σ.conjTensorUnitary (V i)) := by + simp only [h_inv, Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + field_simp + -- Step 3: By joint convexity (α > 1) + have hw_sum : ∑ i : κ, (Fintype.card κ : ℝ)⁻¹ = 1 := by + rw [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + exact mul_inv_cancel₀ hcard_ne + set ρ_mix := ρ.traceRight ⊗ᴹ MState.uniform (d := dB) + set σ_mix := σ.traceRight ⊗ᴹ MState.uniform (d := dB) + have hρ_mix : ρ_mix.M = ∑ i : κ, (Fintype.card κ : ℝ)⁻¹ • (ρ.conjTensorUnitary (V i)).M := + (twirling_average_eq κ V hV ρ).symm + have hσ_mix : σ_mix.M = ∑ i : κ, (Fintype.card κ : ℝ)⁻¹ • (σ.conjTensorUnitary (V i)).M := + (twirling_average_eq κ V hV σ).symm + have h_convex := sandwichedTraceFunctional_jointly_convex hα + (fun (_ : κ) => (Fintype.card κ : ℝ)⁻¹) (by intro; positivity) hw_sum + (fun i => ρ.conjTensorUnitary (V i)) (fun i => σ.conjTensorUnitary (V i)) + ρ_mix σ_mix hρ_mix hσ_mix + (fun i => MState.ker_conjTensorUnitary_le ρ σ (V i) hker) + -- Step 4 + 5: Q̃_α(ρ_A ⊗ π_B‖σ_A ⊗ π_B) = Q̃_α(ρ_A‖σ_A) by tensor invariance + have h_tensor : Q̃_ α(ρ_mix‖σ_mix) = Q̃_ α(ρ.traceRight‖σ.traceRight) := + sandwichedTraceFunctional_tensor_invariant (by linarith) ρ.traceRight σ.traceRight .uniform + -- Combine + calc Q̃_ α(ρ.traceRight‖σ.traceRight) + = Q̃_ α(ρ_mix‖σ_mix) := h_tensor.symm + _ ≤ ∑ i : κ, (Fintype.card κ : ℝ)⁻¹ * + Q̃_ α(ρ.conjTensorUnitary (V i)‖σ.conjTensorUnitary (V i)) := h_convex + _ = Q̃_ α(ρ‖σ) := h_avg.symm + +/-! ## DPI for Sandwiched Rényi Divergence Under Partial Trace -/ + +/-- The "tensor product" of a vector v with basis vector e_b: + (v ⊗ e_b)(a, b') = v(a) if b' = b, else 0 -/ +private def vecTensorBasis (v : dA → ℂ) (b : dB) : (dA × dB) → ℂ := + fun ⟨a, b'⟩ => if b' = b then v a else 0 + +omit [DecidableEq dA] in +/-- Key identity: ⟨v, (Tr_B A)v⟩ = ∑_b ⟨v⊗e_b, A(v⊗e_b)⟩ -/ +private lemma inner_traceRight_eq_sum_inner_vecTensorBasis + (A : Matrix (dA × dB) (dA × dB) ℂ) (v : dA → ℂ) : + star v ⬝ᵥ A.traceRight *ᵥ v = + ∑ b : dB, star (vecTensorBasis v b) ⬝ᵥ A *ᵥ (vecTensorBasis v b) := by + simp [Matrix.traceRight, Matrix.mulVec, dotProduct] + simp [vecTensorBasis, Fintype.sum_prod_type] + rw [Finset.sum_comm, Finset.sum_congr rfl] + simp [Finset.mul_sum _ _ _, mul_assoc, mul_comm] + intro x + rw [Finset.sum_comm] + congr + ext y + rw [Finset.sum_comm, Finset.sum_comm, Finset.sum_eq_single y] + · simp + · simp +contextual + · simp + +omit [DecidableEq dA] in +/-- If A.mulVec(v⊗e_b) = 0 for all b, then (Tr_B A) *ᵥ v = 0 -/ +private lemma traceRight_mulVec_zero_of_vecTensorBasis_zero + (A : Matrix (dA × dB) (dA × dB) ℂ) (v : dA → ℂ) + (h : ∀ b : dB, A *ᵥ (vecTensorBasis v b) = 0) : + A.traceRight *ᵥ v = 0 := by + ext i + simp_all [funext_iff, Matrix.mulVec, dotProduct] + convert Finset.sum_congr rfl fun j _ => h j i j using 1 + any_goals exact Finset.univ + · unfold Matrix.traceRight vecTensorBasis; simp [Finset.sum_ite] + simp [Finset.sum_mul, Finset.sum_sigma'] + apply Finset.sum_bij (fun x _ => ⟨x.2, x.1, x.2⟩) + · simp + · rintro ⟨fst, snd⟩ ha₁ ⟨fst_1, snd_1⟩ ha₂ ⟨rfl, ⟨rfl, right⟩⟩ + rfl + · intro ⟨fst, ⟨fst_1, snd⟩⟩ a + simp_all only [Finset.mem_sigma, Finset.mem_univ, Finset.mem_filter, true_and, Sigma.mk.injEq, + heq_eq_eq, Prod.mk.injEq, exists_const, Sigma.exists, exists_eq_left, and_true, exists_eq] + · simp + · norm_num + +/-- The kernel condition `σ.M.ker ≤ ρ.M.ker` is preserved under partial trace. +This follows because `supp(ρ) ⊆ supp(σ)` implies `supp(Tr_B ρ) ⊆ supp(Tr_B σ)`: +if `v ∈ supp(Tr_B ρ)`, then `⟨v, (Tr_B ρ) v⟩ > 0`, so for some basis vector `e_b` +we have `v ⊗ e_b ∈ supp(ρ) ⊆ supp(σ)`, hence `⟨v, (Tr_B σ) v⟩ ≥ ⟨v ⊗ e_b, σ (v ⊗ e_b)⟩ > 0`. -/ +theorem ker_le_traceRight {ρ σ : MState (dA × dB)} + (hker : σ.M.ker ≤ ρ.M.ker) : + σ.traceRight.M.ker ≤ ρ.traceRight.M.ker := by + simp only [MState.traceRight_M] + intro v hv + rw [mem_ker_iff_mulVec_zero] at hv ⊢ + have hv' : σ.M.mat.traceRight *ᵥ v.ofLp = 0 := by + rwa [traceRight_mat] at hv + have hin : star v.ofLp ⬝ᵥ σ.M.mat.traceRight *ᵥ v.ofLp = 0 := by + rw [hv']; simp [dotProduct] + rw [inner_traceRight_eq_sum_inner_vecTensorBasis] at hin + have hσ_psd := zero_le_iff.mp σ.nonneg + have h_each_zero : ∀ b : dB, + star (vecTensorBasis v.ofLp b) ⬝ᵥ σ.M.mat *ᵥ (vecTensorBasis v.ofLp b) = 0 := by + have h_nonneg : ∀ b, (0 : ℂ) ≤ + star (vecTensorBasis v.ofLp b) ⬝ᵥ σ.M.mat *ᵥ (vecTensorBasis v.ofLp b) := + fun b => hσ_psd.dotProduct_mulVec_nonneg _ + intro b + exact Finset.sum_eq_zero_iff_of_nonneg (fun b _ => h_nonneg b) |>.mp hin b (Finset.mem_univ _) + have h_σ_zero : ∀ b : dB, σ.M.mat *ᵥ (vecTensorBasis v.ofLp b) = 0 := + fun b => (hσ_psd.dotProduct_mulVec_zero_iff _).mp (h_each_zero b) + have h_ρ_zero : ∀ b : dB, ρ.M.mat *ᵥ (vecTensorBasis v.ofLp b) = 0 := by + intro b + have hmem_σ : (WithLp.toLp 2 (vecTensorBasis v.ofLp b) : EuclideanSpace ℂ _) ∈ σ.M.ker := by + rw [mem_ker_iff_mulVec_zero]; exact h_σ_zero b + have hmem_ρ := hker hmem_σ + rwa [mem_ker_iff_mulVec_zero] at hmem_ρ + exact traceRight_mulVec_zero_of_vecTensorBasis_zero ρ.M.mat v.ofLp h_ρ_zero + +/-- The sandwiched Rényi divergence is monotone under partial trace for `α > 1`. +This follows from monotonicity of the trace functional together with the fact that +`D̃_α = log(Q̃_α) / (α - 1)` and both `log` and `1/(α-1)` are order-preserving for α > 1. -/ +theorem sandwichedRenyiEntropy_mono_traceRight [Nonempty dB] + (hα : 1 < α) (ρ σ : MState (dA × dB)) + (hker : σ.M.ker ≤ ρ.M.ker) : + D̃_ α(ρ.traceRight‖σ.traceRight) ≤ D̃_ α(ρ‖σ) := by + have hα₀ : 0 < α := by linarith + have hα₁ : α ≠ 1 := hα.ne' + have hker_tr := ker_le_traceRight hker + -- Rewrite both sides as log(Q̃) / (α - 1) + rw [sandwichedRelRentropy_eq_log_traceFunctional hα₀ hα₁ hker, + sandwichedRelRentropy_eq_log_traceFunctional hα₀ hα₁ hker_tr] + apply ENNReal.ofReal_le_ofReal + apply div_le_div_of_nonneg_right _ (by linarith : 0 < α - 1).le + exact Real.log_le_log (sandwichedTraceFunctional_pos ρ.traceRight σ.traceRight hker_tr) + (sandwichedTraceFunctional_mono_traceRight hα ρ σ hker) + +/-! ## DPI via Stinespring Dilation -/ /- -Gamma composed with Gamma inverse is identity. --/ -set_option backward.isDefEq.respectTransparency false in -lemma Gamma_Gamma_inv (σ : MState d) (hσ : σ.m.PosDef) (X : Matrix d d ℂ) : - Gamma σ (Gamma_inv σ X) = X := by - -- By definition of Gamma and Gamma_inv, we can simplify the expression. - have h_simp : (σ.M.cfc (fun x => x ^ (1 / 2 : ℝ))).mat * (σ.M.cfc (fun x => x ^ (-1 / 2 : ℝ))).mat = 1 := by - symm - convert HermitianMat.mat_cfc_mul _ _ _ using 1; - · have h_gamma_gamma_inv : ∀ x ∈ spectrum ℝ σ.M.mat, x ^ (1 / 2 : ℝ) * x ^ (-1 / 2 : ℝ) = 1 := by - intro x hx - have hx_pos : 0 < x := by - have := (Matrix.posDef_iff_dotProduct_mulVec.mp hσ).2; - obtain ⟨v, hv⟩ : ∃ v : d → ℂ, v ≠ 0 ∧ σ.m.mulVec v = x • v := by - rw [ spectrum.mem_iff ] at hx; - simp_all [ Matrix.isUnit_iff_isUnit_det ]; - obtain ⟨ v, hv ⟩ := Matrix.exists_mulVec_eq_zero_iff.mpr hx; - simp_all [ sub_eq_iff_eq_add, Matrix.sub_mulVec ]; - exact ⟨ v, hv.1, hv.2.symm.trans ( by ext i; erw [ Matrix.mulVec_diagonal ] ; aesop ) ⟩; - specialize this hv.1; - simp_all [ dotProduct]; - simp_all [ mul_assoc, mul_comm]; - simp_all [ mul_left_comm ( v _ ), Complex.mul_conj, Complex.normSq_eq_norm_sq ]; - norm_cast at this; - exact lt_of_not_ge fun hx' => this.not_ge <| Finset.sum_nonpos fun i _ => mul_nonpos_of_nonpos_of_nonneg hx' <| sq_nonneg _; - rw [ ← Real.rpow_add hx_pos ] ; norm_num; - rw [HermitianMat.cfc_congr (g := fun x ↦ 1)] - · rw [ HermitianMat.cfc_const ] - norm_num - · exact fun x hx => h_gamma_gamma_inv x hx; - unfold Gamma Gamma_inv; simp_all [ ← mul_assoc ] ; - simp_all [ mul_assoc, mul_eq_one_comm.mp h_simp ] +The sandwiched Rényi divergence is invariant under unitary conjugation. +-/ +set_option maxHeartbeats 400000 in +theorem sandwichedRenyiEntropy_conj_unitary (hα : 0 < α) (ρ σ : MState d) + (U : Matrix.unitaryGroup d ℂ) : + D̃_ α(ρ.U_conj U‖σ.U_conj U) = D̃_ α(ρ‖σ) := by + -- Since unitary conjugation preserves the kernel, the condition σ.M.ker ≤ ρ.M.ker is + -- equivalent to (σ.U_conj U).M.ker ≤ (ρ.U_conj U).M.ker. + have h_kernel : σ.M.ker ≤ ρ.M.ker ↔ (σ.U_conj U).M.ker ≤ (ρ.U_conj U).M.ker := by + have hk (A : HermitianMat d ℂ) : (A.conj U.val).ker = A.ker.map (U.val.toEuclideanLin) := by + ext x + simp [conj] + constructor <;> intro hx + all_goals generalize_proofs at * + · use (U.val.conjTranspose.toEuclideanLin x) + simp_all [ker, Matrix.toEuclideanLin] + simp_all [lin, Matrix.toLpLin] + have h_unitary : (U.val * U.val.conjTranspose) = 1 := by + exact U.2.2 + generalize_proofs at *; ( + apply_fun (U.val.conjTranspose *ᵥ ·) at hx + simp_all [Matrix.mul_assoc, Matrix.mulVec_mulVec] + simp_all [← Matrix.mul_assoc, mul_eq_one_comm.mp h_unitary]) + · obtain ⟨y, hy, rfl⟩ := hx; simp_all [Matrix.toEuclideanLin, Matrix.mul_assoc] + simp_all [ker, Matrix.toLpLin] + simp_all [lin] + simp_all [Matrix.toLpLin, Matrix.mulVec, funext_iff] + simp_all [Matrix.mul_apply, dotProduct] + -- Since U is unitary, we have ∑_{x_3} ⟨U_{x_3 x}, U_{x_3 x_1⟩ = δ_{x x_1}. + have h_unitary : ∀ x x_1, ∑ x_3, (starRingEnd ℂ) (U.val x_3 x) * U.val x_3 x_1 = + if x = x_1 then 1 else 0 := by + intro x x_1 + have this := congr_fun (congr_fun U.2.1 x) x_1 + simp_all [Matrix.mul_apply, Matrix.one_apply] + simp_all [mul_assoc, Finset.sum_mul] + intro x; rw [Finset.sum_comm]; simp_all [← Finset.mul_sum] + simp [hk, MState.U_conj] + constructor <;> intro h <;> simp_all [SetLike.le_def] + · exact fun x hx => ⟨x, h hx, rfl⟩ + · intro x hx + obtain ⟨y, hy, hy'⟩ := h x hx + obtain ⟨⟩ : y = x := by + apply_fun (U.val⁻¹).mulVec at hy' + simp_all [Matrix.mulVec_mulVec] + exact PiLp.ext (congrFun hy') + exact hy + by_cases h : σ.M.ker ≤ ρ.M.ker <;> simp_all [SandwichedRelRentropy] + split_ifs <;> simp_all [MState.U_conj] + · congr 1 + rw [inner_sub_right, inner_sub_right] + grind only [log_conj_unitary, inner_conj_unitary] + · ext1 + dsimp + congr! 1 + convert congr_arg Real.log (sandwichedTraceFunctional_conj_unitary_MState U ρ σ) using 1 /- -If a Hermitian matrix is bounded by M*I, then all its eigenvalues are at most M. --/ -set_option backward.isDefEq.respectTransparency false in -theorem HermitianMat.le_smul_one_imp_eigenvalues_le (A : HermitianMat d ℂ) (M : ℝ) - (h : A ≤ M • (1 : HermitianMat d ℂ)) (i : d) : - A.H.eigenvalues i ≤ M := by - -- By definition of eigenvalues, for any unit vector $v$, we have $\langle v, A v \rangle \leq M$. - have h_eigenvalue_le_M_step : ∀ (v : EuclideanSpace ℂ d), ‖v‖ = 1 → ⟪v, .toLp 2 <| A.mat.mulVec v⟫_ℂ ≤ M := by - intro v hv - have h_inner : ⟪v, .toLp 2 <| A.mat.mulVec v⟫_ℂ ≤ ⟪v, .toLp 2 <| (M • 1 : Matrix d d ℂ).mulVec v⟫_ℂ := by - have h_inner : ⟪v, .toLp 2 <| ((M • 1 : Matrix d d ℂ) - A.mat).mulVec v⟫_ℂ ≥ 0 := by - have h_inner_le_M : ∀ (X : HermitianMat d ℂ), X ≥ 0 → ∀ (v : EuclideanSpace ℂ d), ⟪v, .toLp 2 <| X.mat.mulVec v⟫_ℂ ≥ 0 := by - intro X hX v - rw [ge_iff_le, HermitianMat.zero_le_iff, Matrix.posSemidef_iff_dotProduct_mulVec] at hX - have := hX.2 v - simp [ Matrix.mulVec, dotProduct ] at * - convert this using 1; - refine Finset.sum_congr rfl fun _ _ => ?_ - sorry - convert h_inner_le_M ⟨ _, _ ⟩ _ v; - all_goals norm_num [ HermitianMat.le_iff ] at *; - · convert h.1; - · exact h; - simp_all [ Matrix.sub_mulVec] - simp_all [ EuclideanSpace.norm_eq ]; - convert h_inner using 1; - simp [ Matrix.mulVec, dotProduct, inner ]; - simp [ Matrix.one_apply,mul_assoc]; - simp [ ← Finset.mul_sum]; - simp [ Complex.mul_conj, Complex.normSq_eq_norm_sq ]; - norm_cast ; aesop; - have := A.H.eigenvectorBasis.orthonormal; - have := this.1 i; - have := h_eigenvalue_le_M_step ( A.H.eigenvectorBasis i ) this; - rw [ show A.mat.mulVec _ = ( Matrix.IsHermitian.eigenvalues A.H i : ℂ ) • ( Matrix.IsHermitian.eigenvectorBasis A.H i ) from ?_ ] at this; - · simp_all - · convert A.H.mulVec_eigenvectorBasis i using 1 +The sandwiched Rényi divergence is invariant under tensoring with a fixed pure state: +`D̃_α(ρ ⊗ |ψ⟩⟨ψ| ‖ σ ⊗ |ψ⟩⟨ψ|) = D̃_α(ρ ‖ σ)`. +-/ +theorem sandwichedRenyiEntropy_tensor_pure (hα : 0 < α) (ρ σ : MState d₁) (ψ : Ket d₂) : + D̃_ α(ρ ⊗ᴹ MState.pure ψ‖σ ⊗ᴹ MState.pure ψ) = D̃_ α(ρ‖σ) := by + simp [hα] + +/-- The sandwiched Rényi divergence is invariant under SWAP. -/ +@[simp] +theorem sandwichedRenyiEntropy_SWAP (ρ σ : MState (dA × dB)) : + D̃_ α(ρ.SWAP‖σ.SWAP) = D̃_ α(ρ‖σ) := by + exact sandwichedRelRentropy_relabel ρ σ _ -set_option maxHeartbeats 400000 in -open MatrixOrder in /- -If all eigenvalues of a Hermitian matrix are at most M, then the matrix is bounded by M*I. --/ -theorem HermitianMat.eigenvalues_le_imp_le_smul_one (A : HermitianMat d ℂ) (M : ℝ) - (h : ∀ i, A.H.eigenvalues i ≤ M) : - A ≤ M • (1 : HermitianMat d ℂ) := by - have := A.H.spectral_theorem.symm; - -- Since $A$ is Hermitian, we can write it as $A = UDU^*$ where $U$ is unitary and $D$ is diagonal with eigenvalues $\lambda_i$. - have h_decomp : ∃ U : Matrix d d ℂ, U * star U = 1 ∧ ∃ D : HermitianMat d ℂ, A = U * D * star U ∧ ∀ i, D i i ≤ M := by - use A.H.eigenvectorUnitary - constructor; · simp - use HermitianMat.diagonal ℂ A.H.eigenvalues - constructor - · exact this.symm - · simpa [HermitianMat.diagonal, ← HermitianMat.mat_apply] using h - obtain ⟨U, hU_unitary, D, hA_eq, hD_le⟩ := h_decomp; - have hA_le : U * D * star U ≤ U * (M • 1) * star U := by - have hD_le : D ≤ M • (1 : HermitianMat d ℂ) := by - sorry - have := HermitianMat.conj_mono (M := U) hD_le - simp only [conj, AddMonoidHom.coe_mk, ZeroHom.coe_mk] at this - replace this := Subtype.coe_le_coe.mpr this - simp only [mat_smul] at this - exact this - rw [ ← hA_eq ] at hA_le - simp only [Algebra.mul_smul_comm, mul_one, Algebra.smul_mul_assoc, hU_unitary] at hA_le - exact hA_le - -set_option backward.isDefEq.respectTransparency false in -/-- The block matrix [[1, X], [X†, X†X]] is positive semidefinite. -/ -theorem block_matrix_posSemidef {m n k : Type*} [Fintype m] [Fintype n] [Fintype k] - (X : Matrix k n ℂ) (Y : Matrix k m ℂ): - (Matrix.fromBlocks (Yᴴ * Y) (Yᴴ * X) (Xᴴ * Y) (Xᴴ * X)).PosSemidef := by - set Z : Matrix (m ⊕ n) (m ⊕ n) ℂ := Matrix.fromBlocks (Yᴴ * Y) (Yᴴ * X) (Xᴴ * Y) (Xᴴ * X) - have hZ : Z = Matrix.fromBlocks (m := k) Yᴴ 0 Xᴴ 0 * Matrix.fromBlocks Y X 0 0 := by - simp +zetaDelta [Matrix.fromBlocks_multiply] - have hZ : Z = (Matrix.fromBlocks (o := k) Y X 0 0)ᴴ * Matrix.fromBlocks Y X 0 0 := by - rw [hZ] - ext i j ; simp [ Matrix.mul_apply]; - cases i <;> cases j <;> simp [ Matrix.fromBlocks ]; - rw [hZ] - exact Matrix.posSemidef_conjTranspose_mul_self _ - -theorem block_matrix_one_posSemidef {m n : Type*} [Fintype m] [Fintype n] [DecidableEq m] - (X : Matrix m n ℂ) : - (Matrix.fromBlocks 1 X Xᴴ (Xᴴ * X)).PosSemidef := by - simpa using block_matrix_posSemidef X (1 : Matrix m m ℂ) +Monotonicity of the sandwiched Rényi divergence under traceRight for `α > 1`, +without the kernel condition. When the kernel condition fails, `D̃_α = ⊤` and +the inequality is trivial. +-/ +theorem sandwichedRenyiEntropy_mono_traceRight' [Nonempty dB] + (hα : 1 < α) (ρ σ : MState (dA × dB)) : + D̃_ α(ρ.traceRight‖σ.traceRight) ≤ D̃_ α(ρ‖σ) := by + by_cases hker : σ.M.ker ≤ ρ.M.ker + · exact sandwichedRenyiEntropy_mono_traceRight hα ρ σ hker + · simp only [SandwichedRelRentropy, MState.traceRight_M] + split + next h => simp_all only [le_top] + next h => simp_all only [not_lt, le_refl] -/-- The Data Processing Inequality for the Sandwiched Renyi relative entropy. -Proved in `https://arxiv.org/pdf/1306.5920`. Seems kind of involved. -/ -theorem sandwichedRenyiEntropy_DPI (hα : 1 ≤ α) (ρ σ : MState d) (Φ : CPTPMap d d₂) : - D̃_ α(Φ ρ‖Φ σ) ≤ D̃_ α(ρ‖σ) := by - --If we want, we can prove this just for 1 < α, and then use continuity (above) to take the limit as - -- α → 1. - sorry +/-- Monotonicity of the sandwiched Rényi divergence under `traceLeft` for `α > 1`. +Follows from `sandwichedRenyiEntropy_mono_traceRight'` + SWAP invariance. -/ +theorem sandwichedRenyiEntropy_mono_traceLeft [Nonempty dA] + (hα : 1 < α) (ρ σ : MState (dA × dB)) : + D̃_ α(ρ.traceLeft‖σ.traceLeft) ≤ D̃_ α(ρ‖σ) := by + -- traceLeft = SWAP.traceRight, and SWAP preserves the SRD + rw [← MState.traceRight_SWAP, ← MState.traceRight_SWAP] + calc D̃_ α(ρ.SWAP.traceRight‖σ.SWAP.traceRight) + ≤ D̃_ α(ρ.SWAP‖σ.SWAP) := + sandwichedRenyiEntropy_mono_traceRight' hα ρ.SWAP σ.SWAP + _ = D̃_ α(ρ‖σ) := sandwichedRenyiEntropy_SWAP ρ σ + +/-- Helper: The Stinespring preparation `prep ∘ append` equals tensoring with a fixed pure state. +`append = ofEquiv (Equiv.prodPUnit d₁).symm`. +TODO: PULLOUT to a more reasonable place. -/ +theorem prep_append_eq_tensor_pure [Inhabited d₂] (ρ : MState d₁) : + let ψ₀ : Ket (d₂ × d₂) := Ket.basis default + let τ := MState.pure ψ₀ + let zero_prep : CPTPMap Unit (d₂ × d₂) := CPTPMap.replacement τ + let prep := (CPTPMap.id ⊗ᶜᵖ zero_prep) + let append : CPTPMap d₁ (d₁ × Unit) := CPTPMap.ofEquiv (Equiv.prodPUnit d₁).symm + (prep ∘ₘ append) ρ = ρ ⊗ᴹ τ := by + apply MState.ext + ext1 + funext ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ + have h := CPTPMap.prep_append_map_entry ρ.m a₁ b₁ a₂ b₂ + simp only [MState.prod, kronecker] + exact h ---Helps us track this one sorry for the GQSL -axiom sandwichedRenyiEntropy_DPI_ax : type_of% @sandwichedRenyiEntropy_DPI +/-- The Data Processing Inequality for the Sandwiched Rényi relative entropy (α > 1). +Every CPTP map `Φ` satisfies `D̃_α(Φρ‖Φσ) ≤ D̃_α(ρ‖σ)`. + +The proof uses the Stinespring representation (see `CPTPMap.exists_purify`): +every CPTP map can be written as ancilla preparation + unitary conjugation + partial trace. +Since the sandwiched Rényi divergence is invariant under the first two operations +(by additivity and relabel invariance) and monotone under partial trace +(by `sandwichedRenyiEntropy_mono_traceRight`), the DPI follows. -/ +theorem sandwichedRenyiEntropy_DPI_gt_one (hα : 1 < α) (ρ σ : MState d₁) (Φ : CPTPMap d₁ d₂) : + D̃_ α(Φ ρ‖Φ σ) ≤ D̃_ α(ρ‖σ) := by + have _ : Nonempty d₁ := ρ.nonempty + have _ : Nonempty d₂ := (Φ ρ).nonempty + haveI : Inhabited d₂ := Classical.inhabited_of_nonempty ‹_› + let ψ₀ : Ket (d₂ × d₂) := Ket.basis default + let τ := MState.pure ψ₀ + obtain ⟨U, hU⟩ := Φ.purify_IsUnitary + -- USe the `zero_prep` / `prep` / `append` from `CPTPMap.purify_trace` + let zero_prep : CPTPMap Unit (d₂ × d₂) := CPTPMap.replacement τ + let prep := ((CPTPMap.id : CPTPMap d₁ d₁) ⊗ᶜᵖ zero_prep) + let append : CPTPMap d₁ (d₁ × Unit) := CPTPMap.ofEquiv (Equiv.prodPUnit d₁).symm + calc D̃_ α(Φ ρ‖Φ σ) + _ = D̃_ α((Φ.purify ((prep ∘ₘ append) ρ)).traceLeft.traceLeft‖ + (Φ.purify ((prep ∘ₘ append) σ)).traceLeft.traceLeft) := by + have h_trace (ξ) : Φ ξ = (Φ.purify ((prep ∘ₘ append) ξ)).traceLeft.traceLeft := by + simpa using congr($Φ.purify_trace ξ) + rw [h_trace ρ, h_trace σ] + _ = D̃_ α(((ρ ⊗ᴹ τ).U_conj U).traceLeft.traceLeft‖ + ((σ ⊗ᴹ τ).U_conj U).traceLeft.traceLeft) := by + have h_app (ξ) : Φ.purify ξ = ξ.U_conj U := congr($hU ξ) + rw [prep_append_eq_tensor_pure ρ, prep_append_eq_tensor_pure σ, h_app, h_app] + _ ≤ D̃_ α(((ρ ⊗ᴹ τ).U_conj U).traceLeft‖((σ ⊗ᴹ τ).U_conj U).traceLeft) := + sandwichedRenyiEntropy_mono_traceLeft hα .. + _ ≤ D̃_ α((ρ ⊗ᴹ τ).U_conj U‖(σ ⊗ᴹ τ).U_conj U) := + sandwichedRenyiEntropy_mono_traceLeft hα .. + _ = D̃_ α(ρ ⊗ᴹ τ‖σ ⊗ᴹ τ) := + sandwichedRenyiEntropy_conj_unitary (by positivity) _ _ _ + _ = D̃_ α(ρ‖σ) := + sandwichedRenyiEntropy_tensor_pure (by positivity) ρ σ ψ₀ /- -info: 'sandwichedRenyiEntropy_DPI_ax' depends on axioms: [propext, - sandwichedRenyiEntropy_DPI_ax, - Classical.choice, - Quot.sound] +The DPI for the sandwiched Rényi divergence at α = 1 (the quantum relative entropy). +This follows from the α > 1 case by taking a limit, using the continuity of +`α ↦ D̃_α(ρ‖σ)` established in `sandwichedRelRentropy.continuousOn`. -/ +theorem sandwichedRenyiEntropy_DPI_eq_one (ρ σ : MState d₁) (Φ : CPTPMap d₁ d₂) : + D̃_ 1(Φ ρ‖Φ σ) ≤ D̃_ 1(ρ‖σ) := by + -- Since α → D_α(ρ‖σ) is continuous on (0, ∞), we can take the limit as α → 1. + have h_cont : + Filter.Tendsto (fun α : ℝ => D̃_ α(Φ ρ‖Φ σ)) (𝓝[>] 1) (𝓝 (D̃_ 1(Φ ρ‖Φ σ))) ∧ + Filter.Tendsto (fun α : ℝ => D̃_ α(ρ‖σ)) (𝓝[>] 1) (𝓝 (D̃_ 1(ρ‖σ))) := by + constructor + · exact tendsto_nhdsWithin_of_tendsto_nhds (sandwichedRelRentropy.continuousOn (Φ ρ) (Φ σ) |> + ContinuousOn.continuousAt <| Ioi_mem_nhds zero_lt_one) + · exact tendsto_nhdsWithin_of_tendsto_nhds (sandwichedRelRentropy.continuousOn ρ σ |> + ContinuousOn.continuousAt <| Ioi_mem_nhds zero_lt_one) + exact le_of_tendsto_of_tendsto h_cont.1 h_cont.2 <| Filter.eventually_of_mem + self_mem_nhdsWithin fun x hx => sandwichedRenyiEntropy_DPI_gt_one hx ρ σ Φ -/- Removed due to module system. -#guard_msgs in -#print axioms sandwichedRenyiEntropy_DPI_ax --/ +/-- The Data Processing Inequality for the Sandwiched Renyi relative entropy. +Proved following the approach of Frank–Lieb and Leditzky–Rouzé–Datta. -/ +theorem sandwichedRenyiEntropy_DPI (hα : 1 ≤ α) (ρ σ : MState d₁) (Φ : CPTPMap d₁ d₂) : + D̃_ α(Φ ρ‖Φ σ) ≤ D̃_ α(ρ‖σ) := by + rcases hα.lt_or_eq with hα | rfl + · exact sandwichedRenyiEntropy_DPI_gt_one hα ρ σ Φ + · exact sandwichedRenyiEntropy_DPI_eq_one ρ σ Φ diff --git a/QuantumInfo/Finite/MState.lean b/QuantumInfo/Finite/MState.lean index 73c5d12cc..bf5b0defe 100644 --- a/QuantumInfo/Finite/MState.lean +++ b/QuantumInfo/Finite/MState.lean @@ -1304,7 +1304,7 @@ theorem Continuous_HermitianMat : Continuous (MState.M (d := d)) := @[fun_prop] theorem Continuous_Matrix : Continuous (MState.m (d := d)) := by - unfold MState.m + show Continuous (fun ρ : MState d => ρ.M.mat) fun_prop theorem image_M_isBounded (S : Set (MState d)) : Bornology.IsBounded (MState.M '' S) := by diff --git a/QuantumInfo/Finite/ResourceTheory/HypothesisTesting.lean b/QuantumInfo/Finite/ResourceTheory/HypothesisTesting.lean index dbf272470..17f4e9813 100644 --- a/QuantumInfo/Finite/ResourceTheory/HypothesisTesting.lean +++ b/QuantumInfo/Finite/ResourceTheory/HypothesisTesting.lean @@ -431,7 +431,7 @@ theorem Ref81Lem5 (ρ σ : MState d) (ε : Prob) (hε : ε < 1) (α : ℝ) (hα rw [← hT₁] exact HermitianMat.inner_comm _ _ rw [hΦ₁, hΦ₂] - exact sandwichedRenyiEntropy_DPI_ax hα.le ρ σ Φ + exact sandwichedRenyiEntropy_DPI hα.le ρ σ Φ --If q = 1, this inequality is trivial by_cases hq₂ : q = 1 diff --git a/QuantumInfo/Finite/ResourceTheory/SteinsLemma.lean b/QuantumInfo/Finite/ResourceTheory/SteinsLemma.lean index b802ff7a3..8ea72af14 100644 --- a/QuantumInfo/Finite/ResourceTheory/SteinsLemma.lean +++ b/QuantumInfo/Finite/ResourceTheory/SteinsLemma.lean @@ -17,17 +17,10 @@ public import Mathlib.Tactic.Bound @[expose] public section -open NNReal -open scoped ENNReal -open ComplexOrder -open Topology -open scoped Prob +open NNReal ComplexOrder Topology +open ResourcePretheory FreeStateTheory UnitalPretheory UnitalFreeStateTheory +open scoped ENNReal Prob RealInnerProductSpace InnerProductSpace open scoped OptimalHypothesisRate -open ResourcePretheory -open FreeStateTheory -open UnitalPretheory -open UnitalFreeStateTheory -open scoped RealInnerProductSpace InnerProductSpace namespace SteinsLemma @@ -2137,15 +2130,3 @@ theorem limit_hypotesting_eq_limit_rel_entropy (ρ : MState (H i)) (ε : Prob) ( constructor · exact GeneralizedQSteinsLemma ρ hε -- Theorem 1 in Hayashi & Yamasaki · exact RelativeEntResource.tendsto_ennreal ρ -- The regularized relative entropy of resource is not infinity - -/- -info: 'SteinsLemma.limit_hypotesting_eq_limit_rel_entropy' depends on axioms: [propext, - sandwichedRenyiEntropy_DPI_ax, - Classical.choice, - Quot.sound] --/ -/- -Commented out because of module system. -#guard_msgs in -#print axioms limit_hypotesting_eq_limit_rel_entropy --/ diff --git a/QuantumInfo/Finite/Unitary.lean b/QuantumInfo/Finite/Unitary.lean index 57ae3d717..4dd4d7e41 100644 --- a/QuantumInfo/Finite/Unitary.lean +++ b/QuantumInfo/Finite/Unitary.lean @@ -22,43 +22,6 @@ noncomputable section open RealInnerProductSpace open InnerProductSpace -namespace HermitianMat - -variable {𝕜 : Type*} [RCLike 𝕜] {n : Type*} [Fintype n] [DecidableEq n] -variable (A B : HermitianMat n 𝕜) (U : Matrix.unitaryGroup n 𝕜) - -@[simp] -theorem trace_conj_unitary : (conj U.val A).trace = A.trace := by - simp [Matrix.trace_mul_cycle, conj, ← Matrix.star_eq_conjTranspose, trace] - -@[simp] -theorem le_conj_unitary : A.conj U.val ≤ B.conj U ↔ A ≤ B := by - rw [← sub_nonneg, ← sub_nonneg (b := A), ← map_sub] - constructor - · intro h - simpa [HermitianMat.conj_conj] using conj_nonneg (star U).val h - · exact fun h ↦ conj_nonneg U.val h - -@[simp] -theorem inner_conj_unitary : ⟪A.conj U.val, B.conj U.val⟫ = ⟪A, B⟫ := by - dsimp [conj] - simp only [inner_eq_re_trace, mat_mk] - rw [← mul_assoc, ← mul_assoc, mul_assoc _ _ U.val] - rw [Matrix.trace_mul_cycle, ← mul_assoc, ← mul_assoc _ _ A.mat] - simp [← Matrix.star_eq_conjTranspose] - -/-- -The eigenvalues of a Hermitian matrix conjugated by a unitary matrix are the same -as the eigenvalues of the original matrix. --/ -@[simp] -theorem eigenvalues_conj:(A.conj U.val).H.eigenvalues = A.H.eigenvalues := by - rw [Matrix.IsHermitian.eigenvalues_eq_eigenvalues_iff] - change (U.val * A.mat * star U.val).charpoly = _ - rw [Matrix.charpoly_mul_comm, ← mul_assoc, U.2.1, one_mul] - -end HermitianMat - namespace MState variable {d d₁ d₂ d₃ : Type*} diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/BlockDiagonal.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/BlockDiagonal.lean new file mode 100644 index 000000000..8159a8e38 --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/BlockDiagonal.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2026 Hayata Yamasaki. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kei Tsukamoto, Kento Mori, Hayata Yamasaki +-/ +module + +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.LownerHeinzTheorem +public import Mathlib.Analysis.InnerProductSpace.Adjoint +public import Mathlib.Analysis.InnerProductSpace.PiL2 +public import Mathlib.Topology.Algebra.Module.LinearMapPiProd + +@[expose] public section + +namespace JensenOperatorInequality + +universe u + +open LownerHeinzTheorem + +variable {ℋ : Type u} +variable [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] +variable [Nontrivial ℋ] + +/-- A two-fold Hilbert sum used for the block-operator proof of Jensen's inequality. -/ +abbrev HSum (ℋ : Type u) [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] : Type u := + PiLp 2 (fun _ : Fin 2 => ℋ) + +noncomputable def hsumEquiv (ℋ : Type u) [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] : + HSum ℋ ≃L[ℂ] (Fin 2 → ℋ) := + PiLp.continuousLinearEquiv (p := (2 : ENNReal)) (𝕜 := ℂ) (β := fun _ : Fin 2 => ℋ) + +noncomputable def hsumProj (ℋ : Type u) [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] + (i : Fin 2) : HSum ℋ →L[ℂ] ℋ := + (ContinuousLinearMap.proj (R := ℂ) (φ := fun _ : Fin 2 => ℋ) i) ∘L + (hsumEquiv ℋ).toContinuousLinearMap + +noncomputable def hsumIncl (ℋ : Type u) [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] + (i : Fin 2) : ℋ →L[ℂ] HSum ℋ := + (hsumEquiv ℋ).symm.toContinuousLinearMap ∘L + (ContinuousLinearMap.single ℂ (fun _ : Fin 2 => ℋ) i) + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +@[simp] theorem hsumProj_hsumIncl_apply (i j : Fin 2) (x : ℋ) : + hsumProj ℋ i (hsumIncl ℋ j x) = if i = j then x else 0 := by + fin_cases i <;> fin_cases j <;> simp [hsumProj, hsumIncl, hsumEquiv] + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +@[simp] theorem inner_hsumIncl_hsumIncl (i j : Fin 2) (x y : ℋ) : + inner ℂ (hsumIncl ℋ i x) (hsumIncl ℋ j y) = if i = j then inner ℂ x y else 0 := by + fin_cases i <;> fin_cases j <;> simp [hsumIncl, hsumEquiv, PiLp.inner_apply] + +omit [Nontrivial ℋ] in +@[simp] theorem hsumIncl_adjoint (i : Fin 2) : + (hsumIncl ℋ i).adjoint = hsumProj ℋ i := by + fin_cases i + · ext x + refine ext_inner_right ℂ fun y => ?_ + rw [ContinuousLinearMap.adjoint_inner_left] + simp [hsumProj, hsumIncl, hsumEquiv, PiLp.inner_apply] + · ext x + refine ext_inner_right ℂ fun y => ?_ + rw [ContinuousLinearMap.adjoint_inner_left] + simp [hsumProj, hsumIncl, hsumEquiv, PiLp.inner_apply] + +omit [Nontrivial ℋ] in +@[simp] theorem hsumProj_adjoint (i : Fin 2) : + (hsumProj ℋ i).adjoint = hsumIncl ℋ i := by + calc + (hsumProj ℋ i).adjoint = ((hsumIncl ℋ i).adjoint).adjoint := by + rw [hsumIncl_adjoint (ℋ := ℋ) i] + _ = hsumIncl ℋ i := ContinuousLinearMap.adjoint_adjoint _ + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +@[simp] theorem hsumIncl_proj_sum (z : HSum ℋ) : + hsumIncl ℋ 0 (hsumProj ℋ 0 z) + hsumIncl ℋ 1 (hsumProj ℋ 1 z) = z := by + ext i + fin_cases i <;> simp [hsumProj, hsumIncl, hsumEquiv] + +/-- The block diagonal operator `diag(A, B)` on the two-fold Hilbert sum. -/ +noncomputable def blockDiagonal (A B : L ℋ) : L (HSum ℋ) := + hsumIncl ℋ 0 ∘L A ∘L hsumProj ℋ 0 + hsumIncl ℋ 1 ∘L B ∘L hsumProj ℋ 1 + +/-- A general `2 × 2` block operator on `HSum ℋ`. -/ +noncomputable def blockOp (A00 A01 A10 A11 : L ℋ) : L (HSum ℋ) := + hsumIncl ℋ 0 ∘L A00 ∘L hsumProj ℋ 0 + + hsumIncl ℋ 0 ∘L A01 ∘L hsumProj ℋ 1 + + hsumIncl ℋ 1 ∘L A10 ∘L hsumProj ℋ 0 + + hsumIncl ℋ 1 ∘L A11 ∘L hsumProj ℋ 1 + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +theorem blockOp_ext {T S : L (HSum ℋ)} + (h0 : ∀ z : HSum ℋ, hsumProj ℋ 0 (T z) = hsumProj ℋ 0 (S z)) + (h1 : ∀ z : HSum ℋ, hsumProj ℋ 1 (T z) = hsumProj ℋ 1 (S z)) : + T = S := by + ext z i + fin_cases i + · simpa using h0 z + · simpa using h1 z + +omit [Nontrivial ℋ] in +@[simp] theorem blockDiagonal_star (A B : L ℋ) : + star (blockDiagonal (ℋ := ℋ) A B) = blockDiagonal (ℋ := ℋ) (star A) (star B) := by + ext z i + fin_cases i + · simp [blockDiagonal, ContinuousLinearMap.star_eq_adjoint, ContinuousLinearMap.adjoint_comp] + · simp [blockDiagonal, ContinuousLinearMap.star_eq_adjoint, ContinuousLinearMap.adjoint_comp] + +noncomputable def blockDiagonalHom : (L ℋ × L ℋ) →⋆ₐ[ℝ] L (HSum ℋ) where + toFun p := blockDiagonal (ℋ := ℋ) p.1 p.2 + map_one' := by + ext z + simp [blockDiagonal] + map_mul' := by + intro p q + ext z i + fin_cases i <;> + simp [blockDiagonal, hsumProj, hsumIncl, hsumEquiv, ContinuousLinearMap.mul_def] + map_zero' := by + ext z i + fin_cases i <;> simp [blockDiagonal] + map_add' := by + intro p q + ext z i + fin_cases i <;> + simp [blockDiagonal, hsumProj, hsumIncl, hsumEquiv, ContinuousLinearMap.add_apply] + commutes' := by + intro r + ext z i + fin_cases i <;> { + simp [blockDiagonal, hsumProj, hsumIncl, hsumEquiv, Algebra.algebraMap_eq_smul_one] + rfl + } + map_star' := by + intro p + simp + +omit [Nontrivial ℋ] in +@[simp] theorem blockDiagonalHom_apply (p : L ℋ × L ℋ) : + blockDiagonalHom (ℋ := ℋ) p = blockDiagonal (ℋ := ℋ) p.1 p.2 := + rfl + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +@[simp] theorem hsumProj_blockDiagonal_zero (A B : L ℋ) (z : HSum ℋ) : + hsumProj ℋ 0 (blockDiagonal A B z) = A (hsumProj ℋ 0 z) := by + simp [blockDiagonal] + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +@[simp] theorem hsumProj_blockDiagonal_one (A B : L ℋ) (z : HSum ℋ) : + hsumProj ℋ 1 (blockDiagonal A B z) = B (hsumProj ℋ 1 z) := by + simp [blockDiagonal] + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +@[simp] theorem blockDiagonal_one : + blockDiagonal (ℋ := ℋ) (1 : L ℋ) (1 : L ℋ) = (1 : L (HSum ℋ)) := by + ext z i + fin_cases i <;> simp [blockDiagonal] + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +theorem blockDiagonal_nonneg {A B : L ℋ} (hA : 0 ≤ A) (hB : 0 ≤ B) : + 0 ≤ blockDiagonal (ℋ := ℋ) A B := by + have hApos : A.IsPositive := (ContinuousLinearMap.nonneg_iff_isPositive A).mp hA + have hBpos : B.IsPositive := (ContinuousLinearMap.nonneg_iff_isPositive B).mp hB + refine (ContinuousLinearMap.nonneg_iff_isPositive _).mpr ?_ + rw [ContinuousLinearMap.isPositive_iff_complex] + intro z + have hAz := (ContinuousLinearMap.isPositive_iff_complex A).mp hApos (hsumProj ℋ 0 z) + have hBz := (ContinuousLinearMap.isPositive_iff_complex B).mp hBpos (hsumProj ℋ 1 z) + have hz0 : + inner ℂ ((hsumIncl ℋ 0) (A (hsumProj ℋ 0 z))) z = + inner ℂ (A (hsumProj ℋ 0 z)) (hsumProj ℋ 0 z) := by + simp [hsumProj, hsumIncl, hsumEquiv, PiLp.inner_apply] + have hz1 : + inner ℂ ((hsumIncl ℋ 1) (B (hsumProj ℋ 1 z))) z = + inner ℂ (B (hsumProj ℋ 1 z)) (hsumProj ℋ 1 z) := by + simp [hsumProj, hsumIncl, hsumEquiv, PiLp.inner_apply] + constructor + · dsimp [blockDiagonal] + rw [inner_add_left, hz0, hz1] + calc + ↑(RCLike.re + (inner ℂ (A (hsumProj ℋ 0 z)) (hsumProj ℋ 0 z) + + inner ℂ (B (hsumProj ℋ 1 z)) (hsumProj ℋ 1 z))) = + ↑(RCLike.re (inner ℂ (A (hsumProj ℋ 0 z)) (hsumProj ℋ 0 z)) + + RCLike.re (inner ℂ (B (hsumProj ℋ 1 z)) (hsumProj ℋ 1 z))) := by + simp + _ = inner ℂ (A (hsumProj ℋ 0 z)) (hsumProj ℋ 0 z) + + inner ℂ (B (hsumProj ℋ 1 z)) (hsumProj ℋ 1 z) := by + have hsumre : + (↑(RCLike.re (inner ℂ (A (hsumProj ℋ 0 z)) (hsumProj ℋ 0 z)) + + RCLike.re (inner ℂ (B (hsumProj ℋ 1 z)) (hsumProj ℋ 1 z))) : ℂ) = + ((RCLike.re (inner ℂ (A (hsumProj ℋ 0 z)) (hsumProj ℋ 0 z)) : ℂ) + + (RCLike.re (inner ℂ (B (hsumProj ℋ 1 z)) (hsumProj ℋ 1 z)) : ℂ)) := by + simp + rw [hsumre, hAz.1, hBz.1] + · dsimp [blockDiagonal] + rw [inner_add_left, hz0, hz1] + exact add_nonneg hAz.2 hBz.2 + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +@[simp] theorem hsumProj_blockOp_zero (A00 A01 A10 A11 : L ℋ) (z : HSum ℋ) : + hsumProj ℋ 0 (blockOp (ℋ := ℋ) A00 A01 A10 A11 z) = + A00 (hsumProj ℋ 0 z) + A01 (hsumProj ℋ 1 z) := by + simp [blockOp] + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +@[simp] theorem hsumProj_blockOp_one (A00 A01 A10 A11 : L ℋ) (z : HSum ℋ) : + hsumProj ℋ 1 (blockOp (ℋ := ℋ) A00 A01 A10 A11 z) = + A10 (hsumProj ℋ 0 z) + A11 (hsumProj ℋ 1 z) := by + simp [blockOp] + +omit [Nontrivial ℋ] in +@[simp] theorem blockOp_star (A00 A01 A10 A11 : L ℋ) : + star (blockOp (ℋ := ℋ) A00 A01 A10 A11) = + blockOp (ℋ := ℋ) (star A00) (star A10) (star A01) (star A11) := by + ext z i + fin_cases i + · simp [blockOp, ContinuousLinearMap.star_eq_adjoint, ContinuousLinearMap.adjoint_comp] + abel + · simp [blockOp, ContinuousLinearMap.star_eq_adjoint, ContinuousLinearMap.adjoint_comp] + abel + +end JensenOperatorInequality diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/GeneralizedPerspectiveFunction.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/GeneralizedPerspectiveFunction.lean new file mode 100644 index 000000000..519d6bc11 --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/GeneralizedPerspectiveFunction.lean @@ -0,0 +1,559 @@ +/- +Copyright (c) 2026 Hayata Yamasaki. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kei Tsukamoto, Kento Mori, Hayata Yamasaki +-/ +module + +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.JensenOperatorInequality +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.LownerHeinzTheorem + +@[expose] public section + +namespace GeneralizedPerspectiveFunction + +universe u + +open LownerHeinzTheorem +open JensenOperatorInequality + +section Convexity + +variable {E F G : Type*} +variable [AddCommMonoid E] [Module ℝ E] +variable [AddCommMonoid F] [Module ℝ F] +variable [Preorder G] [AddCommMonoid G] [Module ℝ G] + +/-- Joint convexity of a two-variable map on prescribed domains in each argument. -/ +def JointlyConvexOn (s : Set E) (t : Set F) (Φ : E → F → G) : Prop := + ∀ ⦃A₁ A₂ : E⦄ ⦃B₁ B₂ : F⦄ ⦃θ : ℝ⦄, + A₁ ∈ s → A₂ ∈ s → B₁ ∈ t → B₂ ∈ t → + 0 ≤ θ → θ ≤ 1 → + Φ ((1 - θ) • A₁ + θ • A₂) ((1 - θ) • B₁ + θ • B₂) + ≤ (1 - θ) • Φ A₁ B₁ + θ • Φ A₂ B₂ + +/-- Joint convexity of a two-variable map without domain restrictions. -/ +def JointlyConvex (Φ : E → F → G) : Prop := + JointlyConvexOn (Set.univ : Set E) (Set.univ : Set F) Φ + +/-- Joint concavity of a two-variable map on prescribed domains in each argument. -/ +def JointlyConcaveOn (s : Set E) (t : Set F) (Φ : E → F → G) : Prop := + ∀ ⦃A₁ A₂ : E⦄ ⦃B₁ B₂ : F⦄ ⦃θ : ℝ⦄, + A₁ ∈ s → A₂ ∈ s → B₁ ∈ t → B₂ ∈ t → + 0 ≤ θ → θ ≤ 1 → + (1 - θ) • Φ A₁ B₁ + θ • Φ A₂ B₂ + ≤ Φ ((1 - θ) • A₁ + θ • A₂) ((1 - θ) • B₁ + θ • B₂) + +/-- Joint concavity of a two-variable map without domain restrictions. -/ +def JointlyConcave (Φ : E → F → G) : Prop := + JointlyConcaveOn (Set.univ : Set E) (Set.univ : Set F) Φ + +end Convexity + +section Definition + +variable {ℋ : Type u} +variable [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] +variable [Nontrivial ℋ] + +/-- The operator `h(B)^(1/2)` defined by real continuous functional calculus. -/ +noncomputable def hSqrt (h : ℝ → ℝ) (B : L ℋ) : L ℋ := + cfcR (fun x : ℝ ↦ (h x) ^ ((1 : ℝ) / 2)) B + +/-- The operator `h(B)^(-1/2)` defined by real continuous functional calculus. -/ +noncomputable def hInvSqrt (h : ℝ → ℝ) (B : L ℋ) : L ℋ := + cfcR (fun x : ℝ ↦ (h x) ^ ((-1 : ℝ) / 2)) B + +/-- +The generalized perspective function +`(fΔh)(A, B) = h(B)^(1/2) f(h(B)^(-1/2) A h(B)^(-1/2)) h(B)^(1/2)`. + +This definition is intended to be used when `A` is Hermitian and `h(B)` is positive/invertible. +-/ +noncomputable def GeneralizedPerspective (f h : ℝ → ℝ) (A B : L ℋ) : L ℋ := + hSqrt h B * cfcR f (hInvSqrt h B * A * hInvSqrt h B) * hSqrt h B + +/-- Infix notation for generalized perspective: `(f Δ h) A B = GeneralizedPerspective f h A B`. -/ +scoped infixl:70 " Δ " => GeneralizedPerspective + +end Definition + +section Theorem25Forward + +variable {ℋ : Type u} +variable [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] +variable [Nontrivial ℋ] + +/-- Positive semidefinite operators. -/ +def psdSet : Set (L ℋ) := + {A | IsSelfAdjoint A ∧ spectrum ℝ A ⊆ Set.Ici (0 : ℝ)} + +/-- Strictly positive operators. -/ +def pdSet : Set (L ℋ) := + {A | IsSelfAdjoint A ∧ spectrum ℝ A ⊆ Set.Ioi (0 : ℝ)} + +private lemma spectrum_convexCombo_Ioi {A B : L ℋ} {t : ℝ} + (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + (As : spectrum ℝ A ⊆ Set.Ioi (0 : ℝ)) (Bs : spectrum ℝ B ⊆ Set.Ioi (0 : ℝ)) : + spectrum ℝ ((1 - t) • A + t • B) ⊆ Set.Ioi (0 : ℝ) := by + set C : L ℋ := (1 - t) • A + t • B + have hC : IsSelfAdjoint C := by + simpa [C] using (IsSelfAdjoint.all (1 - t)).smul hA |>.add ((IsSelfAdjoint.all t).smul hB) + have hApos : ∃ r > 0, algebraMap ℝ (L ℋ) r ≤ A := by + refine (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := A) (ha := hA)).2 ?_ + intro x hx + exact As hx + have hBpos : ∃ r > 0, algebraMap ℝ (L ℋ) r ≤ B := by + refine (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := B) (ha := hB)).2 ?_ + intro x hx + exact Bs hx + rcases hApos with ⟨rA, hrA, hrA_le⟩ + rcases hBpos with ⟨rB, hrB, hrB_le⟩ + set rC : ℝ := (1 - t) * rA + t * rB + have hrC : 0 < rC := by + by_cases h1t : (1 - t) = 0 + · have ht' : t = 1 := by linarith + subst ht' + simpa [rC] using hrB + · have h1t_pos : 0 < 1 - t := lt_of_le_of_ne (sub_nonneg.mpr ht1) (Ne.symm h1t) + simpa [rC] using + add_pos_of_pos_of_nonneg (mul_pos h1t_pos hrA) (mul_nonneg ht0 (le_of_lt hrB)) + have hrC_le : algebraMap ℝ (L ℋ) rC ≤ C := by + have hsum : + (1 - t) • algebraMap ℝ (L ℋ) rA + t • algebraMap ℝ (L ℋ) rB ≤ C := by + simpa [C] using + add_le_add (smul_le_smul_of_nonneg_left hrA_le (sub_nonneg.mpr ht1)) + (smul_le_smul_of_nonneg_left hrB_le ht0) + have hLHS : + (1 - t) • algebraMap ℝ (L ℋ) rA + t • algebraMap ℝ (L ℋ) rB = + algebraMap ℝ (L ℋ) rC := by + simp [rC, Algebra.smul_def] + simpa [hLHS] using hsum + intro x hx + simpa [C] using + (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := C) (ha := hC)).1 ⟨rC, hrC, hrC_le⟩ x hx + +omit [Nontrivial ℋ] in +private lemma cfcR_sq_eq {g k : ℝ → ℝ} {A : L ℋ} + (hA : IsSelfAdjoint A) + (hg : ContinuousOn g (spectrum ℝ A)) + (hk : ContinuousOn k (spectrum ℝ A)) + (hmul : ∀ x ∈ spectrum ℝ A, g x * k x = 1) : + cfcR (ℋ := ℋ) g A * cfcR (ℋ := ℋ) k A = (1 : L ℋ) := by + rw [← cfc_mul (R := ℝ) (A := L ℋ) (p := IsSelfAdjoint) + (f := g) (g := k) (a := A) hg hk, ← cfc_const_one ℝ A] + apply cfc_congr + intro x hx + simpa using hmul x hx + +omit [Nontrivial ℋ] in +private lemma cfcR_mul_eq {g k m : ℝ → ℝ} {A : L ℋ} + (hg : ContinuousOn g (spectrum ℝ A)) + (hk : ContinuousOn k (spectrum ℝ A)) + (hmul : ∀ x ∈ spectrum ℝ A, g x * k x = m x) : + cfcR (ℋ := ℋ) g A * cfcR (ℋ := ℋ) k A = cfcR (ℋ := ℋ) m A := by + rw [← cfc_mul (R := ℝ) (A := L ℋ) (p := IsSelfAdjoint) + (f := g) (g := k) (a := A) hg hk] + apply cfc_congr + intro x hx + simpa using hmul x hx + +private lemma hpow_continuousOn + (h : ℝ → ℝ) (p : ℝ) + (hcont : ContinuousOn h (Set.Ioi (0 : ℝ))) + (hpos : ∀ x ∈ Set.Ioi (0 : ℝ), 0 < h x) : + ContinuousOn (fun x : ℝ ↦ (h x) ^ p) (Set.Ioi (0 : ℝ)) := by + intro x hx + have hg : ContinuousWithinAt (fun y : ℝ ↦ y ^ p) (Set.Ioi (0 : ℝ)) (h x) := + (Real.continuousAt_rpow_const (h x) p (Or.inl (ne_of_gt (hpos x hx)))).continuousWithinAt + exact hg.comp (hcont x hx) (by + intro y hy + exact hpos y hy) + +omit [Nontrivial ℋ] in +private lemma hSqrt_selfAdjoint (h : ℝ → ℝ) (B : L ℋ) : + IsSelfAdjoint (hSqrt (ℋ := ℋ) h B) := by + dsimp [hSqrt, cfcR] + exact cfc_predicate _ _ + +omit [Nontrivial ℋ] in +private lemma hInvSqrt_selfAdjoint (h : ℝ → ℝ) (B : L ℋ) : + IsSelfAdjoint (hInvSqrt (ℋ := ℋ) h B) := by + dsimp [hInvSqrt, cfcR] + exact cfc_predicate _ _ + +omit [Nontrivial ℋ] in +private lemma hSqrt_mul_hInvSqrt_eq_one + {h : ℝ → ℝ} {B : L ℋ} + (hB : IsSelfAdjoint B) (Bs : spectrum ℝ B ⊆ Set.Ioi (0 : ℝ)) + (hcont : ContinuousOn h (Set.Ioi (0 : ℝ))) + (hpos : ∀ x ∈ Set.Ioi (0 : ℝ), 0 < h x) : + hSqrt (ℋ := ℋ) h B * hInvSqrt (ℋ := ℋ) h B = (1 : L ℋ) := by + have hsqrt : + ContinuousOn (fun x : ℝ ↦ (h x) ^ ((1 : ℝ) / 2)) (spectrum ℝ B) := + (hpow_continuousOn h ((1 : ℝ) / 2) hcont hpos).mono (by intro x hx; exact Bs hx) + have hinv : + ContinuousOn (fun x : ℝ ↦ (h x) ^ ((-1 : ℝ) / 2)) (spectrum ℝ B) := + (hpow_continuousOn h ((-1 : ℝ) / 2) hcont hpos).mono (by intro x hx; exact Bs hx) + have hmul : + ∀ x ∈ spectrum ℝ B, + (h x) ^ ((1 : ℝ) / 2) * (h x) ^ ((-1 : ℝ) / 2) = 1 := by + intro x hx + have hxpos : 0 < h x := hpos x (Bs hx) + rw [← Real.rpow_add hxpos] + norm_num + simpa [hSqrt, hInvSqrt] using cfcR_sq_eq (ℋ := ℋ) (A := B) hB hsqrt hinv hmul + +omit [Nontrivial ℋ] in +private lemma hInvSqrt_mul_hSqrt_eq_one + {h : ℝ → ℝ} {B : L ℋ} + (hB : IsSelfAdjoint B) (Bs : spectrum ℝ B ⊆ Set.Ioi (0 : ℝ)) + (hcont : ContinuousOn h (Set.Ioi (0 : ℝ))) + (hpos : ∀ x ∈ Set.Ioi (0 : ℝ), 0 < h x) : + hInvSqrt (ℋ := ℋ) h B * hSqrt (ℋ := ℋ) h B = (1 : L ℋ) := by + have hsqrt : + ContinuousOn (fun x : ℝ ↦ (h x) ^ ((1 : ℝ) / 2)) (spectrum ℝ B) := + (hpow_continuousOn h ((1 : ℝ) / 2) hcont hpos).mono (by intro x hx; exact Bs hx) + have hinv : + ContinuousOn (fun x : ℝ ↦ (h x) ^ ((-1 : ℝ) / 2)) (spectrum ℝ B) := + (hpow_continuousOn h ((-1 : ℝ) / 2) hcont hpos).mono (by intro x hx; exact Bs hx) + have hmul : + ∀ x ∈ spectrum ℝ B, + (h x) ^ ((-1 : ℝ) / 2) * (h x) ^ ((1 : ℝ) / 2) = 1 := by + intro x hx + have hxpos : 0 < h x := hpos x (Bs hx) + rw [← Real.rpow_add hxpos] + norm_num + simpa [hSqrt, hInvSqrt] using cfcR_sq_eq (ℋ := ℋ) (A := B) hB hinv hsqrt hmul + +omit [Nontrivial ℋ] in +private lemma hSqrt_mul_hSqrt_eq + {h : ℝ → ℝ} {B : L ℋ} + (Bs : spectrum ℝ B ⊆ Set.Ioi (0 : ℝ)) + (hcont : ContinuousOn h (Set.Ioi (0 : ℝ))) + (hpos : ∀ x ∈ Set.Ioi (0 : ℝ), 0 < h x) : + hSqrt (ℋ := ℋ) h B * hSqrt (ℋ := ℋ) h B = cfcR (ℋ := ℋ) h B := by + have hsqrt : + ContinuousOn (fun x : ℝ ↦ (h x) ^ ((1 : ℝ) / 2)) (spectrum ℝ B) := + (hpow_continuousOn h ((1 : ℝ) / 2) hcont hpos).mono (by intro x hx; exact Bs hx) + have hmul : + ∀ x ∈ spectrum ℝ B, + (h x) ^ ((1 : ℝ) / 2) * (h x) ^ ((1 : ℝ) / 2) = h x := by + intro x hx + have hxpos : 0 < h x := hpos x (Bs hx) + rw [← Real.rpow_add hxpos] + norm_num + simpa [hSqrt] using cfcR_mul_eq (ℋ := ℋ) (A := B) hsqrt hsqrt hmul + +omit [Nontrivial ℋ] in +private lemma conj_le_conj {X Y T : L ℋ} (hXY : X ≤ Y) (hT : IsSelfAdjoint T) : + T * X * T ≤ T * Y * T := by + have hnonneg : 0 ≤ Y - X := sub_nonneg.mpr hXY + have hconj : 0 ≤ T * (Y - X) * T := by + simpa using hT.conjugate_nonneg hnonneg + have hsub : T * (Y - X) * T = T * Y * T - T * X * T := by + simp [sub_eq_add_neg, mul_add, add_mul, mul_assoc] + exact sub_nonneg.mp (by simpa [hsub] using hconj) + +set_option maxHeartbeats 800000 in +-- The generalized-perspective normalization expands several nested CFC products. +private theorem theorem_2_5_forward_jointlyConvexOn_psd_pd_of_condV + {f h : ℝ → ℝ} + (hcoreV : CondV (ℋ := ℋ) f) + (hconc : OperatorConcaveOn (ℋ := ℋ) (Set.Ioi (0 : ℝ)) h) + (hcont : ContinuousOn h (Set.Ioi (0 : ℝ))) + (hpos : ∀ x ∈ Set.Ioi (0 : ℝ), 0 < h x) : + JointlyConvexOn (psdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) (fun A B ↦ (f Δ h) A B) := by + intro A₁ A₂ B₁ B₂ θ hA₁ hA₂ hB₁ hB₂ hθ0 hθ1 + rcases hA₁ with ⟨hA₁_sa, hA₁_spec⟩ + rcases hA₂ with ⟨hA₂_sa, hA₂_spec⟩ + rcases hB₁ with ⟨hB₁_sa, hB₁_spec⟩ + rcases hB₂ with ⟨hB₂_sa, hB₂_spec⟩ + let A : L ℋ := (1 - θ) • A₁ + θ • A₂ + let B : L ℋ := (1 - θ) • B₁ + θ • B₂ + have hA₁_nonneg : (0 : L ℋ) ≤ A₁ := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A₁ (ha := hA₁_sa)).2 ?_ + intro x hx + simpa [Set.Ici] using hA₁_spec hx + have hA₂_nonneg : (0 : L ℋ) ≤ A₂ := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A₂ (ha := hA₂_sa)).2 ?_ + intro x hx + simpa [Set.Ici] using hA₂_spec hx + have hB_sa : IsSelfAdjoint B := by + dsimp [B] + simpa using (IsSelfAdjoint.all (1 - θ)).smul hB₁_sa |>.add ((IsSelfAdjoint.all θ).smul hB₂_sa) + have hB_spec : spectrum ℝ B ⊆ Set.Ioi (0 : ℝ) := + spectrum_convexCombo_Ioi (ℋ := ℋ) hB₁_sa hB₂_sa hθ0 hθ1 hB₁_spec hB₂_spec + have hB_conc : + (1 - θ) • cfcR (ℋ := ℋ) h B₁ + θ • cfcR (ℋ := ℋ) h B₂ ≤ cfcR (ℋ := ℋ) h B := by + have hconc' := hconc + dsimp [OperatorConcaveOn, OperatorConvexOn] at hconc' + have hneg : + cfcR (ℋ := ℋ) (fun x : ℝ ↦ -h x) B ≤ + (1 - θ) • cfcR (ℋ := ℋ) (fun x : ℝ ↦ -h x) B₁ + + θ • cfcR (ℋ := ℋ) (fun x : ℝ ↦ -h x) B₂ := by + simpa [B] using + hconc' (A := B₁) (B := B₂) (t := θ) hB₁_sa hB₂_sa hθ0 hθ1 hB₁_spec hB₂_spec + simpa [cfcR, cfc_neg, smul_neg, neg_add, add_comm, add_left_comm, add_assoc] using + neg_le_neg hneg + let S : L ℋ := hSqrt (ℋ := ℋ) h B + let IR : L ℋ := hInvSqrt (ℋ := ℋ) h B + let S₁ : L ℋ := hSqrt (ℋ := ℋ) h B₁ + let S₂ : L ℋ := hSqrt (ℋ := ℋ) h B₂ + let IR₁ : L ℋ := hInvSqrt (ℋ := ℋ) h B₁ + let IR₂ : L ℋ := hInvSqrt (ℋ := ℋ) h B₂ + let T₁ : L ℋ := Real.sqrt (1 - θ) • (S₁ * IR) + let T₂ : L ℋ := Real.sqrt θ • (S₂ * IR) + let M₁ : L ℋ := IR₁ * A₁ * IR₁ + let M₂ : L ℋ := IR₂ * A₂ * IR₂ + have hS_sa : IsSelfAdjoint S := hSqrt_selfAdjoint (ℋ := ℋ) h B + have hIR_sa : IsSelfAdjoint IR := hInvSqrt_selfAdjoint (ℋ := ℋ) h B + have hS₁_sa : IsSelfAdjoint S₁ := hSqrt_selfAdjoint (ℋ := ℋ) h B₁ + have hS₂_sa : IsSelfAdjoint S₂ := hSqrt_selfAdjoint (ℋ := ℋ) h B₂ + have hIR₁_sa : IsSelfAdjoint IR₁ := hInvSqrt_selfAdjoint (ℋ := ℋ) h B₁ + have hIR₂_sa : IsSelfAdjoint IR₂ := hInvSqrt_selfAdjoint (ℋ := ℋ) h B₂ + have hSIR : S * IR = (1 : L ℋ) := + hSqrt_mul_hInvSqrt_eq_one (ℋ := ℋ) hB_sa hB_spec hcont hpos + have hIRS : IR * S = (1 : L ℋ) := + hInvSqrt_mul_hSqrt_eq_one (ℋ := ℋ) hB_sa hB_spec hcont hpos + have hS₁IR₁ : S₁ * IR₁ = (1 : L ℋ) := + hSqrt_mul_hInvSqrt_eq_one (ℋ := ℋ) hB₁_sa hB₁_spec hcont hpos + have hIR₁S₁ : IR₁ * S₁ = (1 : L ℋ) := + hInvSqrt_mul_hSqrt_eq_one (ℋ := ℋ) hB₁_sa hB₁_spec hcont hpos + have hS₂IR₂ : S₂ * IR₂ = (1 : L ℋ) := + hSqrt_mul_hInvSqrt_eq_one (ℋ := ℋ) hB₂_sa hB₂_spec hcont hpos + have hIR₂S₂ : IR₂ * S₂ = (1 : L ℋ) := + hInvSqrt_mul_hSqrt_eq_one (ℋ := ℋ) hB₂_sa hB₂_spec hcont hpos + have hM₁_nonneg : (0 : L ℋ) ≤ M₁ := by + dsimp [M₁] + simpa [mul_assoc] using hIR₁_sa.conjugate_nonneg hA₁_nonneg + have hM₂_nonneg : (0 : L ℋ) ≤ M₂ := by + dsimp [M₂] + simpa [mul_assoc] using hIR₂_sa.conjugate_nonneg hA₂_nonneg + have hM₁_sa : IsSelfAdjoint M₁ := IsSelfAdjoint.of_nonneg hM₁_nonneg + have hM₂_sa : IsSelfAdjoint M₂ := IsSelfAdjoint.of_nonneg hM₂_nonneg + have hM₁_spec : spectrum ℝ M₁ ⊆ Set.Ici (0 : ℝ) := by + intro x hx + simpa [Set.Ici] using spectrum_nonneg_of_nonneg hM₁_nonneg hx + have hM₂_spec : spectrum ℝ M₂ ⊆ Set.Ici (0 : ℝ) := by + intro x hx + simpa [Set.Ici] using spectrum_nonneg_of_nonneg hM₂_nonneg hx + have hT₁ : + star T₁ * T₁ = (1 - θ) • (IR * cfcR (ℋ := ℋ) h B₁ * IR) := by + calc + star T₁ * T₁ + = (Real.sqrt (1 - θ) * Real.sqrt (1 - θ)) • (IR * (S₁ * S₁) * IR) := by + simp [T₁, hS₁_sa.star_eq, hIR_sa.star_eq, mul_assoc, smul_smul] + _ = (1 - θ) • (IR * (S₁ * S₁) * IR) := by + rw [Real.mul_self_sqrt (sub_nonneg.mpr hθ1)] + _ = (1 - θ) • (IR * cfcR (ℋ := ℋ) h B₁ * IR) := by + rw [hSqrt_mul_hSqrt_eq (ℋ := ℋ) (B := B₁) hB₁_spec hcont hpos] + have hT₂ : + star T₂ * T₂ = θ • (IR * cfcR (ℋ := ℋ) h B₂ * IR) := by + calc + star T₂ * T₂ + = (Real.sqrt θ * Real.sqrt θ) • (IR * (S₂ * S₂) * IR) := by + simp [T₂, hS₂_sa.star_eq, hIR_sa.star_eq, mul_assoc, smul_smul] + _ = θ • (IR * (S₂ * S₂) * IR) := by + rw [Real.mul_self_sqrt hθ0] + _ = θ • (IR * cfcR (ℋ := ℋ) h B₂ * IR) := by + rw [hSqrt_mul_hSqrt_eq (ℋ := ℋ) (B := B₂) hB₂_spec hcont hpos] + have hTsum : star T₁ * T₁ + star T₂ * T₂ ≤ (1 : L ℋ) := by + rw [hT₁, hT₂] + have hmid : + (1 - θ) • (IR * cfcR (ℋ := ℋ) h B₁ * IR) + θ • (IR * cfcR (ℋ := ℋ) h B₂ * IR) + ≤ IR * cfcR (ℋ := ℋ) h B * IR := by + calc + (1 - θ) • (IR * cfcR (ℋ := ℋ) h B₁ * IR) + θ • (IR * cfcR (ℋ := ℋ) h B₂ * IR) + = IR * ((1 - θ) • cfcR (ℋ := ℋ) h B₁ + θ • cfcR (ℋ := ℋ) h B₂) * IR := by + simp [mul_add, add_mul, mul_assoc] + _ ≤ IR * cfcR (ℋ := ℋ) h B * IR := conj_le_conj (ℋ := ℋ) hB_conc hIR_sa + have hunit : IR * cfcR (ℋ := ℋ) h B * IR = (1 : L ℋ) := by + calc + IR * cfcR (ℋ := ℋ) h B * IR = IR * (S * S) * IR := by + rw [hSqrt_mul_hSqrt_eq (ℋ := ℋ) (B := B) hB_spec hcont hpos] + _ = (IR * S) * (S * IR) := by simp [mul_assoc] + _ = 1 := by simp [hIRS, hSIR] + exact hmid.trans_eq hunit + have hterm₁ : + star T₁ * M₁ * T₁ = (1 - θ) • (IR * A₁ * IR) := by + calc + star T₁ * M₁ * T₁ + = (Real.sqrt (1 - θ) * Real.sqrt (1 - θ)) • + (IR * (S₁ * (IR₁ * A₁ * IR₁) * S₁) * IR) := by + simp [T₁, M₁, hS₁_sa.star_eq, hIR_sa.star_eq, mul_assoc, smul_smul] + _ = (1 - θ) • (IR * (S₁ * (IR₁ * A₁ * IR₁) * S₁) * IR) := by + rw [Real.mul_self_sqrt (sub_nonneg.mpr hθ1)] + _ = (1 - θ) • (IR * A₁ * IR) := by + rw [show IR * (S₁ * (IR₁ * A₁ * IR₁) * S₁) * IR = + IR * (((S₁ * IR₁) * A₁) * (IR₁ * S₁)) * IR by simp [mul_assoc]] + rw [hS₁IR₁, hIR₁S₁] + simp [mul_assoc] + have hterm₂ : + star T₂ * M₂ * T₂ = θ • (IR * A₂ * IR) := by + calc + star T₂ * M₂ * T₂ + = (Real.sqrt θ * Real.sqrt θ) • + (IR * (S₂ * (IR₂ * A₂ * IR₂) * S₂) * IR) := by + simp [T₂, M₂, hS₂_sa.star_eq, hIR_sa.star_eq, mul_assoc, smul_smul] + _ = θ • (IR * (S₂ * (IR₂ * A₂ * IR₂) * S₂) * IR) := by + rw [Real.mul_self_sqrt hθ0] + _ = θ • (IR * A₂ * IR) := by + rw [show IR * (S₂ * (IR₂ * A₂ * IR₂) * S₂) * IR = + IR * (((S₂ * IR₂) * A₂) * (IR₂ * S₂)) * IR by simp [mul_assoc]] + rw [hS₂IR₂, hIR₂S₂] + simp [mul_assoc] + have hleft_inner : + star T₁ * M₁ * T₁ + star T₂ * M₂ * T₂ = IR * A * IR := by + rw [hterm₁, hterm₂] + simp [A, mul_add, add_mul, mul_assoc] + have hcore := + hcoreV (A := M₁) (B := M₂) (X := T₁) (Y := T₂) hM₁_sa hM₂_sa hM₁_spec hM₂_spec hTsum + have houter := conj_le_conj (ℋ := ℋ) hcore hS_sa + rw [hleft_inner] at houter + have hright₁ : + S * (star T₁ * cfcR (ℋ := ℋ) f M₁ * T₁) * S = + (1 - θ) • ((f Δ h) A₁ B₁) := by + calc + S * (star T₁ * cfcR (ℋ := ℋ) f M₁ * T₁) * S + = (Real.sqrt (1 - θ) * Real.sqrt (1 - θ)) • + (S * IR * (S₁ * cfcR (ℋ := ℋ) f M₁ * S₁) * IR * S) := by + simp [T₁, hS₁_sa.star_eq, hIR_sa.star_eq, mul_assoc, smul_smul] + _ = (1 - θ) • (S * IR * (S₁ * cfcR (ℋ := ℋ) f M₁ * S₁) * IR * S) := by + rw [Real.mul_self_sqrt (sub_nonneg.mpr hθ1)] + _ = (1 - θ) • (S₁ * cfcR (ℋ := ℋ) f M₁ * S₁) := by + simp [mul_assoc, hSIR, hIRS] + _ = (1 - θ) • ((f Δ h) A₁ B₁) := by + rfl + have hright₂ : + S * (star T₂ * cfcR (ℋ := ℋ) f M₂ * T₂) * S = + θ • ((f Δ h) A₂ B₂) := by + calc + S * (star T₂ * cfcR (ℋ := ℋ) f M₂ * T₂) * S + = (Real.sqrt θ * Real.sqrt θ) • + (S * IR * (S₂ * cfcR (ℋ := ℋ) f M₂ * S₂) * IR * S) := by + simp [T₂, hS₂_sa.star_eq, hIR_sa.star_eq, mul_assoc, smul_smul] + _ = θ • (S * IR * (S₂ * cfcR (ℋ := ℋ) f M₂ * S₂) * IR * S) := by + rw [Real.mul_self_sqrt hθ0] + _ = θ • (S₂ * cfcR (ℋ := ℋ) f M₂ * S₂) := by + simp [mul_assoc, hSIR, hIRS] + _ = θ • ((f Δ h) A₂ B₂) := by + rfl + have hright : + S * (star T₁ * cfcR (ℋ := ℋ) f M₁ * T₁ + star T₂ * cfcR (ℋ := ℋ) f M₂ * T₂) * S = + (1 - θ) • ((f Δ h) A₁ B₁) + θ • ((f Δ h) A₂ B₂) := by + rw [mul_add, add_mul, hright₁, hright₂] + have hleft : + S * cfcR (ℋ := ℋ) f (IR * A * IR) * S = (f Δ h) A B := by + rfl + simpa [hleft, hright] using houter + +-- Restricted forward form of Theorem 2.5 on the positive cone. +theorem theorem_2_5_forward_jointlyConvexOn_psd_pd + {f h : ℝ → ℝ} + (hf : CondIAll.{u} f) + (hconc : OperatorConcaveOn (ℋ := ℋ) (Set.Ioi (0 : ℝ)) h) + (hcont : ContinuousOn h (Set.Ioi (0 : ℝ))) + (hpos : ∀ x ∈ Set.Ioi (0 : ℝ), 0 < h x) : + JointlyConvexOn (psdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) (fun A B ↦ (f Δ h) A B) := by + have hcoreV : CondV (ℋ := ℋ) f := + theorem_2_5_2_i_all_imp_v (ℋ := ℋ) (f := f) hf + exact theorem_2_5_forward_jointlyConvexOn_psd_pd_of_condV + (ℋ := ℋ) (f := f) (h := h) hcoreV hconc hcont hpos + +-- Restricted localized forward form of Theorem 2.5 on the positive cone. +theorem theorem_2_5_forward_jointlyConvexOn_psd_pd_Ici + {f h : ℝ → ℝ} + (hf : CondIciAll.{u} f) + (hconc : OperatorConcaveOn (ℋ := ℋ) (Set.Ioi (0 : ℝ)) h) + (hcont : ContinuousOn h (Set.Ioi (0 : ℝ))) + (hpos : ∀ x ∈ Set.Ioi (0 : ℝ), 0 < h x) : + JointlyConvexOn (psdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) (fun A B ↦ (f Δ h) A B) := by + have hcoreV : CondV (ℋ := ℋ) f := + theorem_2_5_2_i_ici_all_imp_v (ℋ := ℋ) (f := f) hf + exact theorem_2_5_forward_jointlyConvexOn_psd_pd_of_condV + (ℋ := ℋ) (f := f) (h := h) hcoreV hconc hcont hpos + +omit [Nontrivial ℋ] in +private lemma generalizedPerspective_neg + (f h : ℝ → ℝ) (A B : L ℋ) : + ((fun x : ℝ ↦ -f x) Δ h) A B = -((f Δ h) A B) := by + simp [GeneralizedPerspective, cfcR, cfc_neg, mul_assoc] + +omit [Nontrivial ℋ] in +private lemma jointlyConvexOn_neg + {s : Set (L ℋ)} {t : Set (L ℋ)} {Φ : L ℋ → L ℋ → L ℋ} + (hΦ : JointlyConvexOn s t (fun A B ↦ -Φ A B)) : + JointlyConcaveOn s t Φ := by + intro A₁ A₂ B₁ B₂ θ hA₁ hA₂ hB₁ hB₂ hθ0 hθ1 + have hneg := hΦ hA₁ hA₂ hB₁ hB₂ hθ0 hθ1 + have hneg' : + -Φ ((1 - θ) • A₁ + θ • A₂) ((1 - θ) • B₁ + θ • B₂) ≤ + -((1 - θ) • Φ A₁ B₁ + θ • Φ A₂ B₂) := by + simpa [smul_neg, neg_add, add_comm, add_left_comm, add_assoc] using hneg + exact (neg_le_neg_iff.mp hneg') + +/-- Restricted forward form of Corollary 2.6 on the positive cone. -/ +theorem theorem_2_6_forward_jointlyConcaveOn_psd_pd + {f h : ℝ → ℝ} + (hfconc : OperatorConcaveAll.{u} f) + (hf0 : 0 ≤ f 0) + (hconc : OperatorConcaveOn (ℋ := ℋ) (Set.Ioi (0 : ℝ)) h) + (hcont : ContinuousOn h (Set.Ioi (0 : ℝ))) + (hpos : ∀ x ∈ Set.Ioi (0 : ℝ), 0 < h x) : + JointlyConcaveOn (psdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) (fun A B ↦ (f Δ h) A B) := by + have hfneg : CondIAll.{u} (fun x : ℝ ↦ -f x) := by + refine ⟨?_, ?_⟩ + · intro K _ _ _ _ + simpa [OperatorConcave] using (hfconc (K := K)) + · simpa using (neg_nonpos.mpr hf0) + have hconv_neg : + JointlyConvexOn (psdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) + (fun A B ↦ -((f Δ h) A B)) := by + simpa [generalizedPerspective_neg] using + (theorem_2_5_forward_jointlyConvexOn_psd_pd + (ℋ := ℋ) (f := fun x : ℝ ↦ -f x) (h := h) hfneg hconc hcont hpos) + exact jointlyConvexOn_neg (ℋ := ℋ) hconv_neg + +/-- Restricted localized forward form of Corollary 2.6 on the positive cone. -/ +theorem theorem_2_6_forward_jointlyConcaveOn_psd_pd_Ici + {f h : ℝ → ℝ} + (hfconc : OperatorConcaveOnAll.{u} (Set.Ici (0 : ℝ)) f) + (hfcont : ContinuousOn f (Set.Ici (0 : ℝ))) + (hf0 : 0 ≤ f 0) + (hconc : OperatorConcaveOn (ℋ := ℋ) (Set.Ioi (0 : ℝ)) h) + (hcont : ContinuousOn h (Set.Ioi (0 : ℝ))) + (hpos : ∀ x ∈ Set.Ioi (0 : ℝ), 0 < h x) : + JointlyConcaveOn (psdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) (fun A B ↦ (f Δ h) A B) := by + have hfneg : CondIciAll.{u} (fun x : ℝ ↦ -f x) := by + refine ⟨?_, ?_, ?_⟩ + · intro K _ _ _ _ + simpa [OperatorConcaveOn, OperatorConvexOn] using (hfconc (K := K)) + · simpa using hfcont.neg + · simpa using (neg_nonpos.mpr hf0) + have hconv_neg : + JointlyConvexOn (psdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) + (fun A B ↦ -((f Δ h) A B)) := by + simpa [generalizedPerspective_neg] using + (theorem_2_5_forward_jointlyConvexOn_psd_pd_Ici + (ℋ := ℋ) (f := fun x : ℝ ↦ -f x) (h := h) hfneg hconc hcont hpos) + exact jointlyConvexOn_neg (ℋ := ℋ) hconv_neg + +end Theorem25Forward + +-- GeneralizedPerspectiveFunction Page 1 https://www.pnas.org/doi/10.1073/pnas.1102518108 +-- For any qudit ℋ, any A ∈ Herm(ℋ), any B ∈ Pd(ℋ), +-- any real-valued continuous function f, any positive-valued continuous function h>0, +-- (fΔh)(A,B) := h(B)^{1/2} f(h(B)^{-1/2} A h(B)^{-1/2}) h(B)^{1/2} + +-- Theorem 2.5 https://www.pnas.org/doi/10.1073/pnas.1102518108 +-- Suppose that f is a continuous function with f(0) ≤ 0, and h is a continuous function with h > 0. +-- If f is operator convex and h is operator concave, +-- then fΔh is jointly convex + +end GeneralizedPerspectiveFunction + +-- Corollary 2.6 https://www.pnas.org/doi/10.1073/pnas.1102518108 +-- Suppose that f is a continuous function with f(0) ≥ 0, and h is a continuous function with h > 0. +-- If f is operator convcave and h is operator concave, +-- then fΔh is jointly concave diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/HilbertSchmidtOperatorSpace.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/HilbertSchmidtOperatorSpace.lean new file mode 100644 index 000000000..5416c8c1d --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/HilbertSchmidtOperatorSpace.lean @@ -0,0 +1,659 @@ +/- +Copyright (c) 2026 Hayata Yamasaki. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kei Tsukamoto, Kento Mori, Hayata Yamasaki +-/ +module + +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.LownerHeinzTheorem +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.GeneralizedPerspectiveFunction + +public import Mathlib.Analysis.InnerProductSpace.PiL2 +public import Mathlib.Analysis.InnerProductSpace.Trace +public import Mathlib.Analysis.Normed.Lp.PiLp +public import Mathlib.LinearAlgebra.Complex.FiniteDimensional +public import Mathlib.LinearAlgebra.Matrix.ToLin +public import Mathlib.Topology.Algebra.Module.FiniteDimension + +@[expose] public section + +namespace HilbertSchmidtOperatorSpace + +open LownerHeinzTheorem + +universe u + +noncomputable section + +variable {ℋ : Type u} +variable [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] +variable [FiniteDimensional ℂ ℋ] + +/-- The canonical finite index used for Hilbert-Schmidt coordinates. -/ +abbrev HSIndex (ℋ : Type u) [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] + [FiniteDimensional ℂ ℋ] := + Fin (Module.finrank ℂ ℋ) + +/-- The standard orthonormal basis on a finite-dimensional Hilbert space. -/ +noncomputable abbrev hsOrthonormalBasis : + OrthonormalBasis (HSIndex ℋ) ℂ ℋ := + stdOrthonormalBasis ℂ ℋ + +/-- Coordinate space for Hilbert-Schmidt operators. -/ +abbrev HSCoords (ℋ : Type u) [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] + [FiniteDimensional ℂ ℋ] := + EuclideanSpace ℂ (HSIndex ℋ × HSIndex ℋ) + +/-- The underlying coordinate function space for Hilbert-Schmidt operators. -/ +abbrev HSCoordFun (ℋ : Type u) [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] + [FiniteDimensional ℂ ℋ] := + HSIndex ℋ × HSIndex ℋ → ℂ + +/-- The operator space `L ℋ`, viewed later with the Hilbert-Schmidt structure. -/ +def HSOp (ℋ : Type u) [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] : Type u := + L ℋ + +instance : AddCommGroup (HSOp ℋ) := by + delta HSOp + infer_instance + +set_option synthInstance.maxHeartbeats 200000 in +instance : Module ℂ (HSOp ℋ) := by + show Module ℂ (ℋ →L[ℂ] ℋ) + infer_instance + +instance : Star (HSOp ℋ) := by + delta HSOp + infer_instance + +instance : Mul (HSOp ℋ) := by + delta HSOp + infer_instance + +instance : One (HSOp ℋ) := by + delta HSOp + infer_instance + +instance : Inhabited (HSOp ℋ) := by + delta HSOp + infer_instance + +instance : Zero (HSOp ℋ) := by + delta HSOp + infer_instance + +set_option synthInstance.maxHeartbeats 200000 in +instance : FiniteDimensional ℂ (HSOp ℋ) := by + show FiniteDimensional ℂ (ℋ →L[ℂ] ℋ) + infer_instance + +noncomputable def hsCoordsLinearEquiv : + HSCoords ℋ ≃ₗ[ℂ] (HSCoordFun ℋ) := by + simpa [HSCoords, HSCoordFun] using + (WithLp.linearEquiv (2 : ENNReal) ℂ (HSCoordFun ℋ)) + +def matrixToFun : + Matrix (HSIndex ℋ) (HSIndex ℋ) ℂ ≃ₗ[ℂ] HSCoordFun ℋ where + toFun M p := M p.1 p.2 + invFun f i j := f (i, j) + map_add' M N := by + ext ⟨i, j⟩ + rfl + map_smul' c M := by + ext ⟨i, j⟩ + rfl + left_inv M := by + ext i j + rfl + right_inv f := by + ext ⟨i, j⟩ + rfl + +noncomputable def matrixToCoords : + Matrix (HSIndex ℋ) (HSIndex ℋ) ℂ ≃ₗ[ℂ] HSCoords ℋ := + (matrixToFun (ℋ := ℋ)).trans hsCoordsLinearEquiv.symm + +/-- Forget continuity and identify continuous linear operators with linear endomorphisms. -/ +noncomputable def hsLinearMapEquiv : + HSOp ℋ ≃ₗ[ℂ] (ℋ →ₗ[ℂ] ℋ) := + LinearMap.toContinuousLinearMap.symm + +/-- Hilbert-Schmidt coordinates on `L ℋ`. -/ +noncomputable def toHSCoordsLinearEquiv : + HSOp ℋ ≃ₗ[ℂ] HSCoords ℋ := + (hsLinearMapEquiv (ℋ := ℋ)).trans <| + (LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis).trans <| + matrixToCoords (ℋ := ℋ) + +omit [CompleteSpace ℋ] in +@[simp] lemma toHSCoordsLinearEquiv_apply_apply + (T : HSOp ℋ) (i j : HSIndex ℋ) : + toHSCoordsLinearEquiv (ℋ := ℋ) T (i, j) = + LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis + ((hsLinearMapEquiv (ℋ := ℋ)) T) i j := by + change hsCoordsLinearEquiv (toHSCoordsLinearEquiv (ℋ := ℋ) T) (i, j) = + LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis + ((hsLinearMapEquiv (ℋ := ℋ)) T) i j + let f : HSCoordFun ℋ := fun p => + LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis + ((hsLinearMapEquiv (ℋ := ℋ)) T) p.1 p.2 + have h : hsCoordsLinearEquiv (toHSCoordsLinearEquiv (ℋ := ℋ) T) = f := by + simp [toHSCoordsLinearEquiv, matrixToCoords, matrixToFun, f] + have hEval := congrArg (fun g : HSCoordFun ℋ => g (i, j)) h + simpa [f] using hEval + +instance : NormedAddCommGroup (HSOp ℋ) := + NormedAddCommGroup.induced (HSOp ℋ) (HSCoords ℋ) + (toHSCoordsLinearEquiv (ℋ := ℋ)) (toHSCoordsLinearEquiv (ℋ := ℋ)).injective + +instance : NormedSpace ℂ (HSOp ℋ) := + NormedSpace.induced ℂ (HSOp ℋ) (HSCoords ℋ) (toHSCoordsLinearEquiv (ℋ := ℋ)) + +instance : Inner ℂ (HSOp ℋ) where + inner T S := inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) T) (toHSCoordsLinearEquiv (ℋ := ℋ) S) + +instance : InnerProductSpace ℂ (HSOp ℋ) where + norm_sq_eq_re_inner T := by + change ‖toHSCoordsLinearEquiv (ℋ := ℋ) T‖ ^ 2 = + Complex.re (inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) T) + (toHSCoordsLinearEquiv (ℋ := ℋ) T)) + simpa using + (inner_self_eq_norm_sq (𝕜 := ℂ) (toHSCoordsLinearEquiv (ℋ := ℋ) T)).symm + conj_inner_symm T S := by + change star (inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) S) + (toHSCoordsLinearEquiv (ℋ := ℋ) T)) = + inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) T) (toHSCoordsLinearEquiv (ℋ := ℋ) S) + simp [inner_conj_symm (toHSCoordsLinearEquiv (ℋ := ℋ) T) + (toHSCoordsLinearEquiv (ℋ := ℋ) S)] + add_left T S R := by + change inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) (T + S)) + (toHSCoordsLinearEquiv (ℋ := ℋ) R) = + inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) T) + (toHSCoordsLinearEquiv (ℋ := ℋ) R) + + inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) S) + (toHSCoordsLinearEquiv (ℋ := ℋ) R) + simp [inner_add_left, map_add] + smul_left T S z := by + change inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) (z • T)) + (toHSCoordsLinearEquiv (ℋ := ℋ) S) = + star z * inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) T) + (toHSCoordsLinearEquiv (ℋ := ℋ) S) + simp [inner_smul_left, map_smul] + +/-- Hilbert-Schmidt coordinates as a linear isometry. -/ +noncomputable def toHSCoordsLinearIsometryEquiv : + HSOp ℋ ≃ₗᵢ[ℂ] HSCoords ℋ := + LinearEquiv.isometryOfInner (toHSCoordsLinearEquiv (ℋ := ℋ)) <| by + intro T S + change inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) T) + (toHSCoordsLinearEquiv (ℋ := ℋ) S) = + inner ℂ T S + rfl + +instance : CompleteSpace (HSOp ℋ) := + let e : HSOp ℋ ≃ HSCoords ℋ := + (toHSCoordsLinearIsometryEquiv.toContinuousLinearEquiv.toLinearEquiv.toEquiv) + (completeSpace_congr (e := e) <| by + simpa using + (toHSCoordsLinearIsometryEquiv.toContinuousLinearEquiv.isUniformEmbedding)).2 + inferInstance + +instance : ContinuousSMul ℂ (HSOp ℋ) := + (toHSCoordsLinearIsometryEquiv (ℋ := ℋ)).isometry.isUniformInducing.isInducing.continuousSMul + continuous_id fun {c x} => map_smul (toHSCoordsLinearEquiv (ℋ := ℋ)) c x + +/-- Reinterpret an operator as an element of the Hilbert-Schmidt operator space. -/ +abbrev ofOp (T : L ℋ) : HSOp ℋ := T + +/-- Forget the Hilbert-Schmidt structure and recover the underlying operator. -/ +abbrev toOp (T : HSOp ℋ) : L ℋ := T + +/-- Left multiplication on the Hilbert-Schmidt operator space. -/ +noncomputable def leftMulHS (A : L ℋ) : HSOp ℋ →L[ℂ] HSOp ℋ := + LinearMap.toContinuousLinearMap + { toFun := fun T => ofOp (A * toOp T) + map_add' := fun T S => mul_add A (toOp T) (toOp S) + map_smul' := fun z T => mul_smul_comm z A (toOp T) } + +/-- Right multiplication on the Hilbert-Schmidt operator space. -/ +noncomputable def rightMulHS (B : L ℋ) : HSOp ℋ →L[ℂ] HSOp ℋ := + LinearMap.toContinuousLinearMap + { toFun := fun T => ofOp (toOp T * B) + map_add' := fun T S => add_mul (toOp T) (toOp S) B + map_smul' := fun z T => smul_mul_assoc z (toOp T) B } + +omit [CompleteSpace ℋ] in +@[simp] lemma leftMulHS_apply (A : L ℋ) (T : HSOp ℋ) : + toOp (leftMulHS (ℋ := ℋ) A T) = A * toOp T := rfl + +omit [CompleteSpace ℋ] in +@[simp] lemma rightMulHS_apply (B : L ℋ) (T : HSOp ℋ) : + toOp (rightMulHS (ℋ := ℋ) B T) = toOp T * B := rfl + +omit [CompleteSpace ℋ] in +@[simp] lemma leftMulHS_mul (A B : L ℋ) : + leftMulHS (ℋ := ℋ) (A * B) = leftMulHS (ℋ := ℋ) A * leftMulHS (ℋ := ℋ) B := by + ext T + simp [mul_assoc] + +omit [CompleteSpace ℋ] in +@[simp] lemma rightMulHS_mul (A B : L ℋ) : + rightMulHS (ℋ := ℋ) (A * B) = rightMulHS (ℋ := ℋ) B * rightMulHS (ℋ := ℋ) A := by + ext T + simp [mul_assoc] + +omit [CompleteSpace ℋ] in +@[simp] lemma leftMulHS_one : + leftMulHS (ℋ := ℋ) (1 : L ℋ) = (1 : L (HSOp ℋ)) := by + ext T + simp + +omit [CompleteSpace ℋ] in +@[simp] lemma rightMulHS_one : + rightMulHS (ℋ := ℋ) (1 : L ℋ) = (1 : L (HSOp ℋ)) := by + ext T + simp + +omit [CompleteSpace ℋ] in +lemma leftMulHS_rightMulHS_commute (A B : L ℋ) : + Commute (leftMulHS (ℋ := ℋ) A) (rightMulHS (ℋ := ℋ) B) := by + ext T + simp [mul_assoc] + +omit [CompleteSpace ℋ] in +private lemma hsInner_eq_pairSum (X Y : L ℋ) : + inner ℂ (ofOp X) (ofOp Y) = + ∑ p : HSIndex ℋ × HSIndex ℋ, + LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis Y.toLinearMap p.1 p.2 * + star + (LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis X.toLinearMap p.1 p.2) := by + have hXfun : + ((toHSCoordsLinearEquiv (ℋ := ℋ) (ofOp X) : HSCoords ℋ).ofLp : HSCoordFun ℋ) = + fun p => + LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis X.toLinearMap p.1 p.2 := by + funext p + change (toHSCoordsLinearEquiv (ℋ := ℋ) (ofOp X) : + EuclideanSpace ℂ (HSIndex ℋ × HSIndex ℋ)) p = _ + exact toHSCoordsLinearEquiv_apply_apply (ℋ := ℋ) (T := ofOp X) p.1 p.2 + have hYfun : + ((toHSCoordsLinearEquiv (ℋ := ℋ) (ofOp Y) : HSCoords ℋ).ofLp : HSCoordFun ℋ) = + fun p => + LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis Y.toLinearMap p.1 p.2 := by + funext p + change (toHSCoordsLinearEquiv (ℋ := ℋ) (ofOp Y) : + EuclideanSpace ℂ (HSIndex ℋ × HSIndex ℋ)) p = _ + exact toHSCoordsLinearEquiv_apply_apply (ℋ := ℋ) (T := ofOp Y) p.1 p.2 + change inner ℂ (toHSCoordsLinearEquiv (ℋ := ℋ) (ofOp X)) + (toHSCoordsLinearEquiv (ℋ := ℋ) (ofOp Y)) = _ + rw [EuclideanSpace.inner_eq_star_dotProduct, hXfun, hYfun] + simp [dotProduct] + +private lemma trace_star_mul_eq_pairSum (X Y : L ℋ) : + LinearMap.trace ℂ ℋ ((star X * Y).toLinearMap) = + ∑ p : HSIndex ℋ × HSIndex ℋ, + LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis Y.toLinearMap p.1 p.2 * + star + (LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis X.toLinearMap p.1 p.2) := by + let b := hsOrthonormalBasis (ℋ := ℋ) + calc + LinearMap.trace ℂ ℋ ((star X * Y).toLinearMap) + = ∑ i : HSIndex ℋ, ∑ j : HSIndex ℋ, + LinearMap.toMatrix b.toBasis b.toBasis Y.toLinearMap j i * + star (LinearMap.toMatrix b.toBasis b.toBasis X.toLinearMap j i) := by + rw [LinearMap.trace_eq_sum_inner ((star X * Y).toLinearMap) b] + apply Finset.sum_congr rfl + intro i hi + calc + inner ℂ (b i) (((star X * Y).toLinearMap) (b i)) = inner ℂ (X (b i)) (Y (b i)) := by + simpa [ContinuousLinearMap.star_eq_adjoint] using + (ContinuousLinearMap.adjoint_inner_right (A := X) (x := b i) (y := Y (b i))) + _ = ∑ j : HSIndex ℋ, inner ℂ (X (b i)) (b j) * inner ℂ (b j) (Y (b i)) := by + symm + exact OrthonormalBasis.sum_inner_mul_inner b (X (b i)) (Y (b i)) + _ = ∑ j : HSIndex ℋ, + LinearMap.toMatrix b.toBasis b.toBasis Y.toLinearMap j i * + star (LinearMap.toMatrix b.toBasis b.toBasis X.toLinearMap j i) := by + apply Finset.sum_congr rfl + intro j hj + simp [LinearMap.toMatrix_apply, OrthonormalBasis.repr_apply_apply, mul_comm] + _ = ∑ p : HSIndex ℋ × HSIndex ℋ, + LinearMap.toMatrix b.toBasis b.toBasis Y.toLinearMap p.1 p.2 * + star (LinearMap.toMatrix b.toBasis b.toBasis X.toLinearMap p.1 p.2) := by + rw [Finset.sum_comm] + symm + simpa [Finset.univ_product_univ] using + (Finset.sum_product' (s := (Finset.univ : Finset (HSIndex ℋ))) + (t := (Finset.univ : Finset (HSIndex ℋ))) + (f := fun j i => + LinearMap.toMatrix b.toBasis b.toBasis Y.toLinearMap j i * + star (LinearMap.toMatrix b.toBasis b.toBasis X.toLinearMap j i))) + +lemma hsInner_eq_trace (X Y : L ℋ) : + inner ℂ (ofOp X) (ofOp Y) = LinearMap.trace ℂ ℋ ((star X * Y).toLinearMap) := by + calc + inner ℂ (ofOp X) (ofOp Y) + = ∑ p : HSIndex ℋ × HSIndex ℋ, + LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis Y.toLinearMap p.1 p.2 * + star + (LinearMap.toMatrix (hsOrthonormalBasis (ℋ := ℋ)).toBasis + (hsOrthonormalBasis (ℋ := ℋ)).toBasis X.toLinearMap p.1 p.2) := + hsInner_eq_pairSum (X := X) (Y := Y) + _ = LinearMap.trace ℂ ℋ ((star X * Y).toLinearMap) := by + symm + exact trace_star_mul_eq_pairSum (X := X) (Y := Y) + +lemma re_hsInner_eq_traceRe (X Y : L ℋ) : + Complex.re (inner ℂ (ofOp X) (ofOp Y)) = + Complex.re (LinearMap.trace ℂ ℋ ((star X * Y).toLinearMap)) := by + simpa using congrArg Complex.re (hsInner_eq_trace (X := X) (Y := Y)) + +@[simp] lemma leftMulHS_star (A : L ℋ) : + star (leftMulHS (ℋ := ℋ) A) = leftMulHS (ℋ := ℋ) (star A) := by + rw [eq_comm, ContinuousLinearMap.star_eq_adjoint] + refine (ContinuousLinearMap.eq_adjoint_iff + (A := leftMulHS (ℋ := ℋ) (star A)) (B := leftMulHS (ℋ := ℋ) A)).2 ?_ + intro X Y + change inner ℂ (ofOp ((star A) * toOp X)) (ofOp (toOp Y)) = + inner ℂ (ofOp (toOp X)) (ofOp (A * toOp Y)) + rw [hsInner_eq_trace] + rw [hsInner_eq_trace] + simp [mul_assoc] + +@[simp] lemma leftMulHS_real_smul_one (r : ℝ) : + leftMulHS (ℋ := ℋ) (r • (1 : L ℋ)) = r • (1 : L (HSOp ℋ)) := by + ext T + change ofOp ((r • (1 : L ℋ)) * toOp T) = ofOp (r • toOp T) + simp [Algebra.smul_def] + +@[simp] lemma rightMulHS_real_smul_one (r : ℝ) : + rightMulHS (ℋ := ℋ) (r • (1 : L ℋ)) = r • (1 : L (HSOp ℋ)) := by + ext T + change ofOp (toOp T * (r • (1 : L ℋ))) = ofOp (r • toOp T) + simp [Algebra.smul_def, Algebra.commutes (R := ℝ) (A := L ℋ) r (toOp T)] + +lemma leftMulHS_nonneg {A : L ℋ} (hA0 : 0 ≤ A) : + 0 ≤ leftMulHS (ℋ := ℋ) A := by + have hApos : A.IsPositive := (ContinuousLinearMap.nonneg_iff_isPositive A).1 hA0 + have hA_sa : IsSelfAdjoint A := hApos.isSelfAdjoint + have hleft_sa : IsSelfAdjoint (leftMulHS (ℋ := ℋ) A) := by + change star (leftMulHS (ℋ := ℋ) A) = leftMulHS (ℋ := ℋ) A + simp [hA_sa.star_eq, leftMulHS_star (ℋ := ℋ) A] + refine (ContinuousLinearMap.nonneg_iff_isPositive _).2 ?_ + rw [ContinuousLinearMap.isPositive_iff_complex] + intro X + constructor + · have hsymm : + ((leftMulHS (ℋ := ℋ) A : HSOp ℋ →L[ℂ] HSOp ℋ) : HSOp ℋ →ₗ[ℂ] HSOp ℋ).IsSymmetric := + (ContinuousLinearMap.isSelfAdjoint_iff_isSymmetric).mp hleft_sa + simpa using LinearMap.IsSymmetric.coe_re_inner_apply_self hsymm X + · let b := hsOrthonormalBasis (ℋ := ℋ) + have htrace : + Complex.re (inner ℂ (leftMulHS (ℋ := ℋ) A X) X) = + ∑ i : HSIndex ℋ, Complex.re (inner ℂ (A (toOp X (b i))) (toOp X (b i))) := by + calc + Complex.re (inner ℂ (leftMulHS (ℋ := ℋ) A X) X) + = Complex.re (LinearMap.trace ℂ ℋ + ((star (A * toOp X) * toOp X).toLinearMap)) := by + simpa [leftMulHS_apply] using + re_hsInner_eq_traceRe (ℋ := ℋ) (X := A * toOp X) (Y := toOp X) + _ = ∑ i : HSIndex ℋ, + Complex.re (inner ℂ (b i) + (((star (A * toOp X) * toOp X).toLinearMap) (b i))) := by + rw [LinearMap.trace_eq_sum_inner ((star (A * toOp X) * toOp X).toLinearMap) b] + simp + _ = ∑ i : HSIndex ℋ, + Complex.re (inner ℂ (A (toOp X (b i))) (toOp X (b i))) := by + apply Finset.sum_congr rfl + intro i hi + exact congrArg Complex.re <| by + simpa [ContinuousLinearMap.star_eq_adjoint, mul_assoc] using + (ContinuousLinearMap.adjoint_inner_right + (A := A * toOp X) (x := b i) (y := toOp X (b i))) + have htrace' : + RCLike.re (inner ℂ (leftMulHS (ℋ := ℋ) A X) X) = + ∑ i : HSIndex ℋ, Complex.re (inner ℂ (A (toOp X (b i))) (toOp X (b i))) := by + simpa using htrace + rw [htrace'] + exact Finset.sum_nonneg fun i _ => hApos.re_inner_nonneg_left (toOp X (b i)) + +lemma leftMulHS_le_leftMulHS {A B : L ℋ} (hAB : A ≤ B) : + leftMulHS (ℋ := ℋ) A ≤ leftMulHS (ℋ := ℋ) B := by + have hnonneg : 0 ≤ leftMulHS (ℋ := ℋ) (B - A) := + leftMulHS_nonneg (ℋ := ℋ) (sub_nonneg.mpr hAB) + have hsub : + leftMulHS (ℋ := ℋ) B - leftMulHS (ℋ := ℋ) A = + leftMulHS (ℋ := ℋ) (B - A) := by + ext T; exact congrArg ofOp (sub_mul B A (toOp T)).symm + exact sub_nonneg.mp (by simpa [hsub] using hnonneg) + +lemma leftMulHS_pdSet [ContinuousFunctionalCalculus ℝ (L ℋ) IsSelfAdjoint] [Nontrivial (L ℋ)] + {A : L ℋ} (hA : A ∈ GeneralizedPerspectiveFunction.pdSet (ℋ := ℋ)) : + leftMulHS (ℋ := ℋ) A ∈ GeneralizedPerspectiveFunction.pdSet (ℋ := HSOp ℋ) := by + rcases hA with ⟨hA_sa, hA_spec⟩ + have hleft_sa : IsSelfAdjoint (leftMulHS (ℋ := ℋ) A) := by + change star (leftMulHS (ℋ := ℋ) A) = leftMulHS (ℋ := ℋ) A + simp [hA_sa.star_eq, leftMulHS_star (ℋ := ℋ) A] + letI : Nontrivial (HSOp ℋ) := by + delta HSOp + infer_instance + letI : Nontrivial (L (HSOp ℋ)) := inferInstance + refine ⟨?_, ?_⟩ + · exact hleft_sa + · rcases (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := A) (ha := hA_sa)).2 hA_spec + with ⟨r, hr, hrA⟩ + refine (CFC.exists_pos_algebraMap_le_iff + (A := L (HSOp ℋ)) (a := leftMulHS (ℋ := ℋ) A) (ha := hleft_sa)).1 ?_ + refine ⟨r, hr, ?_⟩ + simpa [Algebra.algebraMap_eq_smul_one, leftMulHS_real_smul_one (r := r)] using + leftMulHS_le_leftMulHS (ℋ := ℋ) hrA + +@[simp] lemma rightMulHS_star (A : L ℋ) : + star (rightMulHS (ℋ := ℋ) A) = rightMulHS (ℋ := ℋ) (star A) := by + rw [eq_comm, ContinuousLinearMap.star_eq_adjoint] + refine (ContinuousLinearMap.eq_adjoint_iff + (A := rightMulHS (ℋ := ℋ) (star A)) (B := rightMulHS (ℋ := ℋ) A)).2 ?_ + intro X Y + change inner ℂ (ofOp (toOp X * star A)) (ofOp (toOp Y)) = + inner ℂ (ofOp (toOp X)) (ofOp (toOp Y * A)) + rw [hsInner_eq_trace] + rw [hsInner_eq_trace] + rw [star_mul, star_star, mul_assoc] + symm + simpa [mul_assoc] using + (LinearMap.trace_mul_cycle (R := ℂ) (M := ℋ) + (f := (star (toOp X)).toLinearMap) (g := (toOp Y).toLinearMap) (h := A.toLinearMap)) + +/-- Left multiplication as a real `⋆`-algebra homomorphism on the Hilbert-Schmidt operator space. -/ +noncomputable def leftMulHSStarAlgHom : L ℋ →⋆ₐ[ℝ] L (HSOp ℋ) where + toFun := leftMulHS (ℋ := ℋ) + map_one' := leftMulHS_one (ℋ := ℋ) + map_mul' := leftMulHS_mul (ℋ := ℋ) + map_zero' := by ext T; exact congrArg ofOp (zero_mul (toOp T)) + map_add' := fun A B => by ext T; exact congrArg ofOp (add_mul A B (toOp T)) + commutes' := by + intro r + simp only [Algebra.algebraMap_eq_smul_one] + exact leftMulHS_real_smul_one (ℋ := ℋ) r + map_star' := by + intro A + simp [leftMulHS_star (ℋ := ℋ) A] + +/-- Right multiplication as a real `⋆`-algebra homomorphism out of the opposite algebra. -/ +noncomputable def rightMulHSStarAlgHom : (L ℋ)ᵐᵒᵖ →⋆ₐ[ℝ] L (HSOp ℋ) where + toFun := fun A => rightMulHS (ℋ := ℋ) (MulOpposite.unop A) + map_one' := by simp [rightMulHS_one (ℋ := ℋ)] + map_mul' := by intro A B; ext T; simp [rightMulHS_apply, mul_assoc] + map_zero' := by + ext T + change ofOp (toOp T * MulOpposite.unop (0 : (L ℋ)ᵐᵒᵖ)) = ofOp (0 : L ℋ) + congr 1; simp + map_add' := fun A B => by + ext T + change ofOp (toOp T * MulOpposite.unop (A + B)) = + ofOp (toOp T * MulOpposite.unop A + toOp T * MulOpposite.unop B) + congr 1; simp [MulOpposite.unop_add, mul_add] + commutes' := by + intro r + show rightMulHS (ℋ := ℋ) (MulOpposite.unop (MulOpposite.op (r • (1 : L ℋ)))) = + r • (1 : L (HSOp ℋ)) + simp [rightMulHS_real_smul_one (ℋ := ℋ) r] + map_star' := by + intro A + simp [rightMulHS_star (ℋ := ℋ) (MulOpposite.unop A)] + +@[simp] theorem rightMulHSStarAlgHom_apply (A : (L ℋ)ᵐᵒᵖ) : + rightMulHSStarAlgHom (ℋ := ℋ) A = rightMulHS (ℋ := ℋ) (MulOpposite.unop A) := + rfl + +/-- The `⋆`-algebra hom sending `A` to `op (star A)`. On selfadjoint operators this is just `op`. -/ +noncomputable def opStarHSStarAlgHom : L ℋ →⋆ₐ[ℝ] (L ℋ)ᵐᵒᵖ where + toFun := fun A => MulOpposite.op (star A) + map_one' := by simp + map_mul' := by + intro A B + simp [star_mul] + map_zero' := by simp + map_add' := by + intro A B + simp + commutes' := by + intro r + apply congrArg MulOpposite.op + simp [Algebra.algebraMap_eq_smul_one] + map_star' := by + intro A + simp + +private noncomputable def opStarHSAlgEquiv : L ℋ ≃ₐ[ℝ] (L ℋ)ᵐᵒᵖ where + toFun A := MulOpposite.op (star A) + invFun A := star (MulOpposite.unop A) + left_inv A := by simp + right_inv A := by simp + map_mul' A B := by simp [star_mul] + map_add' A B := by simp + commutes' r := by + apply congrArg MulOpposite.op + simp [Algebra.algebraMap_eq_smul_one] + +omit [FiniteDimensional ℂ ℋ] in +lemma op_isSelfAdjoint (A : L ℋ) (hA : IsSelfAdjoint A) : + IsSelfAdjoint (MulOpposite.op A : (L ℋ)ᵐᵒᵖ) := by + exact congrArg MulOpposite.op hA.star_eq + +private noncomputable def opStarHSLinearMap : L ℋ →ₗ[ℝ] (L ℋ)ᵐᵒᵖ where + toFun := fun A => MulOpposite.op (star A) + map_add' A B := by simp + map_smul' r A := by + apply MulOpposite.unop_injective + rw [MulOpposite.unop_op, MulOpposite.unop_smul, MulOpposite.unop_op] + rw [Algebra.smul_def, star_mul] + show star A * star ((algebraMap ℝ (L ℋ)) r) = (algebraMap ℝ (L ℋ)) r * star A + have hstar : star ((algebraMap ℝ (L ℋ)) r) = (algebraMap ℝ (L ℋ)) r := by + rw [Algebra.algebraMap_eq_smul_one, star_smul, star_one] + simp + rw [hstar] + simpa using (Algebra.commutes (R := ℝ) (A := L ℋ) r (star A)).symm + +private noncomputable def leftMulHSLinearMap : L ℋ →ₗ[ℝ] L (HSOp ℋ) where + toFun := leftMulHS (ℋ := ℋ) + map_add' A B := by ext T; exact congrArg ofOp (add_mul A B (toOp T)) + map_smul' r A := by + ext T + show ((r • A) * toOp T : L ℋ) = r • (A * toOp T) + rw [smul_mul_assoc] + +private noncomputable def rightMulHSLinearMap : (L ℋ)ᵐᵒᵖ →ₗ[ℝ] L (HSOp ℋ) where + toFun := fun A => rightMulHS (ℋ := ℋ) (MulOpposite.unop A) + map_add' A B := by + ext T + change ofOp (toOp T * MulOpposite.unop (A + B)) = + ofOp (toOp T * MulOpposite.unop A + toOp T * MulOpposite.unop B) + congr 1; simp [MulOpposite.unop_add, mul_add] + map_smul' r A := by + ext T + change ofOp (toOp T * MulOpposite.unop (r • A)) = + ofOp (r • (toOp T * MulOpposite.unop A)) + congr 1 + rw [MulOpposite.unop_smul, mul_smul_comm] + +omit [FiniteDimensional ℂ ℋ] in +lemma spectrum_op_eq [ContinuousFunctionalCalculus ℝ (L ℋ) IsSelfAdjoint] [Nontrivial (L ℋ)] + (A : L ℋ) (hA : IsSelfAdjoint A) : + spectrum ℝ (MulOpposite.op A : (L ℋ)ᵐᵒᵖ) = spectrum ℝ A := by + have hopA : IsSelfAdjoint (MulOpposite.op A : (L ℋ)ᵐᵒᵖ) := op_isSelfAdjoint (A := A) hA + simpa [opStarHSAlgEquiv, hA.star_eq, hopA.star_eq] using + (AlgEquiv.spectrum_eq (opStarHSAlgEquiv (ℋ := ℋ)) A) + +lemma cfc_op_eq_op_cfc [ContinuousFunctionalCalculus ℝ (L ℋ) IsSelfAdjoint] + [ContinuousFunctionalCalculus ℝ ((L ℋ)ᵐᵒᵖ) IsSelfAdjoint] [Nontrivial (L ℋ)] + (f : ℝ → ℝ) (A : L ℋ) (hA : IsSelfAdjoint A) + (hf : ContinuousOn f (spectrum ℝ A)) : + cfc (R := ℝ) (A := (L ℋ)ᵐᵒᵖ) (p := IsSelfAdjoint) f (MulOpposite.op A) = + MulOpposite.op (cfcR f A) := by + let φ : L ℋ →⋆ₐ[ℝ] (L ℋ)ᵐᵒᵖ := opStarHSStarAlgHom (ℋ := ℋ) + have hφ : Continuous φ := by + simpa [opStarHSLinearMap] using + (LinearMap.continuous_of_finiteDimensional (opStarHSLinearMap (ℋ := ℋ))) + have hopA : IsSelfAdjoint (MulOpposite.op A : (L ℋ)ᵐᵒᵖ) := op_isSelfAdjoint (A := A) hA + have hφA : IsSelfAdjoint (φ A) := hA.map φ + have hcfcA : + IsSelfAdjoint (cfc (R := ℝ) (A := L ℋ) (p := IsSelfAdjoint) f A) := by + simp [IsSelfAdjoint.cfc (f := f) (a := A)] + have hopcfcA : + IsSelfAdjoint + (MulOpposite.op (cfc (R := ℝ) (A := L ℋ) (p := IsSelfAdjoint) f A) : (L ℋ)ᵐᵒᵖ) := + op_isSelfAdjoint (A := cfc (R := ℝ) (A := L ℋ) (p := IsSelfAdjoint) f A) hcfcA + have hmap := StarAlgHom.map_cfc (φ := φ) (f := f) (a := A) + (hf := hf) (hφ := hφ) (ha := hA) (hφa := hφA) + simpa [φ, opStarHSStarAlgHom, cfcR, hA.star_eq, hopA.star_eq, hcfcA.star_eq, + hopcfcA.star_eq] using hmap.symm + +lemma leftMulHS_cfcR [ContinuousFunctionalCalculus ℝ (L ℋ) IsSelfAdjoint] [Nontrivial (L ℋ)] + (f : ℝ → ℝ) (A : L ℋ) (hA : IsSelfAdjoint A) + (hf : ContinuousOn f (spectrum ℝ A)) : + leftMulHS (ℋ := ℋ) (cfcR f A) = + cfcR (ℋ := HSOp ℋ) f (leftMulHS (ℋ := ℋ) A) := by + let φ : L ℋ →⋆ₐ[ℝ] L (HSOp ℋ) := leftMulHSStarAlgHom (ℋ := ℋ) + have hφ : Continuous φ := by + simpa [leftMulHSLinearMap] using + (LinearMap.continuous_of_finiteDimensional (leftMulHSLinearMap (ℋ := ℋ))) + have hφA : IsSelfAdjoint (φ A) := hA.map φ + have hmap := StarAlgHom.map_cfc (φ := φ) (f := f) (a := A) + (hf := hf) (hφ := hφ) (ha := hA) (hφa := hφA) + simpa [φ, cfcR] using hmap + +lemma rightMulHS_cfcR [ContinuousFunctionalCalculus ℝ (L ℋ) IsSelfAdjoint] + [ContinuousFunctionalCalculus ℝ ((L ℋ)ᵐᵒᵖ) IsSelfAdjoint] [Nontrivial (L ℋ)] + (f : ℝ → ℝ) (A : L ℋ) (hA : IsSelfAdjoint A) + (hf : ContinuousOn f (spectrum ℝ A)) : + rightMulHS (ℋ := ℋ) (cfcR f A) = + cfcR (ℋ := HSOp ℋ) f (rightMulHS (ℋ := ℋ) A) := by + let φ : (L ℋ)ᵐᵒᵖ →⋆ₐ[ℝ] L (HSOp ℋ) := rightMulHSStarAlgHom (ℋ := ℋ) + have hφ : Continuous φ := by + simpa [rightMulHSLinearMap] using + (LinearMap.continuous_of_finiteDimensional (rightMulHSLinearMap (ℋ := ℋ))) + have hopA : IsSelfAdjoint (MulOpposite.op A : (L ℋ)ᵐᵒᵖ) := op_isSelfAdjoint (A := A) hA + have hφA : IsSelfAdjoint (φ (MulOpposite.op A)) := hopA.map φ + have hmap := StarAlgHom.map_cfc (φ := φ) (f := f) (a := MulOpposite.op A) + (hf := by simpa [spectrum_op_eq (A := A) hA] using hf) + (hφ := hφ) (ha := hopA) (hφa := hφA) + have hopcfc : + cfc (R := ℝ) (A := (L ℋ)ᵐᵒᵖ) (p := IsSelfAdjoint) f (MulOpposite.op A) = + MulOpposite.op (cfcR f A) := + cfc_op_eq_op_cfc (ℋ := ℋ) f A hA hf + simpa [φ, cfcR, rightMulHSStarAlgHom, hopcfc] using hmap + +end + +end HilbertSchmidtOperatorSpace diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequality.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequality.lean new file mode 100644 index 000000000..118e2e51c --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequality.lean @@ -0,0 +1,420 @@ +/- +Copyright (c) 2026 Hayata Yamasaki. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kei Tsukamoto, Kento Mori, Hayata Yamasaki +-/ +module + +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.JensenOperatorInequalityIImpIV + +@[expose] public section + +namespace JensenOperatorInequality + +universe u + +open LownerHeinzTheorem + +section Theorem252 + +variable {ℋ : Type u} +variable [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] + +set_option synthInstance.maxHeartbeats 400000 in +-- IsStarNormal CFC is only a theorem in Mathlib; CStarAlgebra chain through WithLp is deep. +noncomputable local instance : ContinuousFunctionalCalculus ℂ (L ℋ × L ℋ) IsStarNormal := + IsStarNormal.instContinuousFunctionalCalculus +set_option synthInstance.maxHeartbeats 400000 in +-- IsSelfAdjoint CFC for the product type, derived from IsStarNormal above. +noncomputable local instance : ContinuousFunctionalCalculus ℝ (L ℋ × L ℋ) IsSelfAdjoint := + IsSelfAdjoint.instContinuousFunctionalCalculus +set_option synthInstance.maxHeartbeats 400000 in +-- CStarAlgebra → NonnegSpectrumClass chain through WithLp is too deep for default heartbeats. +noncomputable local instance : NonnegSpectrumClass ℝ (L (HSum ℋ)) := inferInstance +set_option synthInstance.maxHeartbeats 400000 in +-- Module ℝ for L (HSum ℋ) requires deep WithLp / CStarAlgebra chain. +noncomputable local instance : Module ℝ (L (HSum ℋ)) := inferInstance + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] in +/-- +Uniform version of Condition (iv), with the Hilbert space arbitrary in the same universe. +This is the theorem-level uniform counterpart to the operator-level `...All` predicates. +-/ +def CondIVAll (f : ℝ → ℝ) : Prop := + ∀ {K : Type u} + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + [Nontrivial K], + CondIV (ℋ := K) f + +omit [CompleteSpace ℋ] in +/-- `L (HSum ℋ)` is nontrivial once `L ℋ` is. -/ +private theorem nontrivial_hsumL_wrap [Nontrivial ℋ] : Nontrivial (L (HSum ℋ)) := by + have h_not_sub : ¬ Subsingleton ℋ := by + intro hsub + letI : Subsingleton ℋ := hsub + letI : Subsingleton (L ℋ) := by infer_instance + exact (not_nontrivial_iff_subsingleton.mpr (by infer_instance)) + (inferInstance : Nontrivial (L ℋ)) + have hH_nontriv : Nontrivial ℋ := (not_subsingleton_iff_nontrivial.mp h_not_sub) + letI : Nontrivial ℋ := hH_nontriv + rcases exists_pair_ne ℋ with ⟨x, y, hxy⟩ + let w : ℋ := x - y + have hw : w ≠ 0 := sub_ne_zero.mpr hxy + have hdiag_ne_zero : (blockDiagonal (ℋ := ℋ) (1 : L ℋ) 0 : L (HSum ℋ)) ≠ 0 := by + intro h0 + have hz : + blockDiagonal (ℋ := ℋ) (1 : L ℋ) 0 (hsumIncl ℋ 0 w) = 0 := by + simp [h0] + have hw0 : w = 0 := by + have hz0 := congrArg (fun z : HSum ℋ => hsumProj ℋ 0 z) hz + simpa [blockDiagonal] using hz0 + exact hw hw0 + exact ⟨0, blockDiagonal (ℋ := ℋ) (1 : L ℋ) 0, hdiag_ne_zero.symm⟩ + +private lemma blockDiagonal_selfAdjoint_wrap {A B : L ℋ} + (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) : + IsSelfAdjoint (blockDiagonal (ℋ := ℋ) A B) := by + change star (blockDiagonal (ℋ := ℋ) A B) = blockDiagonal (ℋ := ℋ) A B + simp [blockDiagonal_star, hA.star_eq, hB.star_eq] + +omit [CompleteSpace ℋ] in +private lemma blockDiagonal_eq_blockOp_wrap (A B : L ℋ) : + blockDiagonal (ℋ := ℋ) A B = blockOp (ℋ := ℋ) A 0 0 B := by + ext z i + fin_cases i <;> simp [blockDiagonal, blockOp] + +-- Multiplication of generic block operators is elaboration-heavy even in the wrapper. +set_option maxHeartbeats 400000 in +-- The generic `blockOp` product expands into large block normal forms. +omit [CompleteSpace ℋ] in +private lemma blockOp_mul_wrap (A00 A01 A10 A11 B00 B01 B10 B11 : L ℋ) : + blockOp (ℋ := ℋ) A00 A01 A10 A11 * blockOp (ℋ := ℋ) B00 B01 B10 B11 = + blockOp (ℋ := ℋ) + (A00 * B00 + A01 * B10) + (A00 * B01 + A01 * B11) + (A10 * B00 + A11 * B10) + (A10 * B01 + A11 * B11) := by + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [ContinuousLinearMap.mul_def, add_left_comm, add_comm] + · intro z + simp [ContinuousLinearMap.mul_def, add_left_comm, add_comm] + +private lemma cfcR_blockDiagonal_wrap (f : ℝ → ℝ) + (A B : L ℋ) (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) + (hcont : ContinuousOn f (spectrum ℝ A ∪ spectrum ℝ B)) : + cfcR (ℋ := HSum ℋ) f (blockDiagonal (ℋ := ℋ) A B) = + blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f A) (cfcR (ℋ := ℋ) f B) := by + let φ : (L ℋ × L ℋ) →⋆ₐ[ℝ] L (HSum ℋ) := blockDiagonalHom (ℋ := ℋ) + have hφ : Continuous φ := by + change Continuous (fun p : L ℋ × L ℋ => blockDiagonal (ℋ := ℋ) p.1 p.2) + change Continuous (fun p : L ℋ × L ℋ => + hsumIncl ℋ 0 ∘L p.1 ∘L hsumProj ℋ 0 + hsumIncl ℋ 1 ∘L p.2 ∘L hsumProj ℋ 1) + fun_prop + have hpair : IsSelfAdjoint (A, B) := by + change star (A, B) = (A, B) + ext <;> simp [hA.star_eq, hB.star_eq] + have hpair' : IsSelfAdjoint (φ (A, B)) := hpair.map φ + have hmap := StarAlgHom.map_cfc (φ := φ) (f := f) (a := (A, B)) + (hf := by simpa [Prod.spectrum_eq] using hcont) + (hφ := hφ) (ha := hpair) (hφa := hpair') + have hprod : + cfc (R := ℝ) (A := L ℋ × L ℋ) (p := IsSelfAdjoint) f (A, B) = + (cfcR (ℋ := ℋ) f A, cfcR (ℋ := ℋ) f B) := by + simpa [cfcR] using + (cfc_map_prod (R := ℝ) (S := ℝ) + (A := L ℋ) (B := L ℋ) + (pab := IsSelfAdjoint) (pa := IsSelfAdjoint) (pb := IsSelfAdjoint) + f A B + (hf := hcont) + (hab := hpair) (ha := hA) (hb := hB)) + calc + cfcR (ℋ := HSum ℋ) f (blockDiagonal (ℋ := ℋ) A B) + = cfc (R := ℝ) (A := L (HSum ℋ)) (p := IsSelfAdjoint) f (φ (A, B)) := by + simp [cfcR, φ] + _ = φ (cfc (R := ℝ) (A := L ℋ × L ℋ) (p := IsSelfAdjoint) f (A, B)) := by + simpa using hmap.symm + _ = φ (cfcR (ℋ := ℋ) f A, cfcR (ℋ := ℋ) f B) := by + rw [hprod] + _ = blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f A) (cfcR (ℋ := ℋ) f B) := by + simp [φ, blockDiagonalHom] + +private lemma continuousOn_union_of_subset_Ici_wrap {f : ℝ → ℝ} + (hcont : ContinuousOn f (Set.Ici (0 : ℝ))) {s t : Set ℝ} + (hs : s ⊆ Set.Ici (0 : ℝ)) (ht : t ⊆ Set.Ici (0 : ℝ)) : + ContinuousOn f (s ∪ t) := by + refine hcont.mono ?_ + intro x hx + rcases hx with hx | hx + · exact hs hx + · exact ht hx + +private lemma spectrum_Ici_of_nonneg_wrap {A : L ℋ} (hA0 : (0 : L ℋ) ≤ A) : + spectrum ℝ A ⊆ Set.Ici (0 : ℝ) := by + exact + (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A + (ha := IsSelfAdjoint.of_nonneg hA0)).1 hA0 + +variable [Nontrivial ℋ] + +private lemma spectrum_zero_subset_Ici_wrap : + spectrum ℝ (0 : L ℋ) ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : x = 0 := by + simpa using hx + simp [Set.Ici, hx0] + +omit [Nontrivial ℋ] in +private lemma blockDiagonal_le_left_wrap {A0 A1 B0 B1 : L ℋ} + (h : blockDiagonal (ℋ := ℋ) A0 A1 ≤ blockDiagonal (ℋ := ℋ) B0 B1) : + A0 ≤ B0 := by + have hnonneg : 0 ≤ blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1) := by + have hsub : + blockDiagonal (ℋ := ℋ) B0 B1 - blockDiagonal (ℋ := ℋ) A0 A1 = + blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1) := by + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [sub_eq_add_neg] + · intro z + simp [sub_eq_add_neg] + exact hsub ▸ sub_nonneg.mpr h + have hpos : + (blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1)).IsPositive := + (ContinuousLinearMap.nonneg_iff_isPositive _).1 hnonneg + have hleftPos : (B0 - A0).IsPositive := by + rw [ContinuousLinearMap.isPositive_iff_complex] + intro x + have hx := + (ContinuousLinearMap.isPositive_iff_complex + (blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1))).1 hpos (hsumIncl ℋ 0 x) + simpa [blockDiagonal, hsumProj, hsumIncl, hsumEquiv, PiLp.inner_apply] using hx + exact sub_nonneg.mp ((ContinuousLinearMap.nonneg_iff_isPositive _).2 hleftPos) + +-- Theorem 2.5.2 `(iv) → (v)`. +set_option maxHeartbeats 3000000 in +-- Block-matrix normalization in this wrapper needs a larger local heartbeat budget. +theorem theorem_2_5_2_iv_imp_v {f : ℝ → ℝ} (hiv : CondIVAll.{u} f) + (hcont : ContinuousOn f Set.univ) : + CondV (ℋ := ℋ) f := by + intro A B X Y hA hB hAs hBs hXY + have hA0 : (0 : L ℋ) ≤ A := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA)).2 ?_ + intro x hx + simpa [Set.Ici] using hAs hx + have hB0 : (0 : L ℋ) ≤ B := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B (ha := hB)).2 ?_ + intro x hx + simpa [Set.Ici] using hBs hx + let Atilde : L (HSum ℋ) := blockDiagonal (ℋ := ℋ) A B + let Xtilde : L (HSum ℋ) := blockOp (ℋ := ℋ) X 0 Y 0 + letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL_wrap (ℋ := ℋ) + have hAtilde_sa : IsSelfAdjoint Atilde := by + simpa [Atilde] using blockDiagonal_selfAdjoint_wrap (ℋ := ℋ) hA hB + have hAtilde0 : (0 : L (HSum ℋ)) ≤ Atilde := by + simpa [Atilde] using blockDiagonal_nonneg (ℋ := ℋ) hA0 hB0 + have hAtilde_spec : spectrum ℝ Atilde ⊆ Set.Ici (0 : ℝ) := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) Atilde (ha := hAtilde_sa)).1 hAtilde0 + have hXtilde_star_mul : + star Xtilde * Xtilde = + blockDiagonal (ℋ := ℋ) (star X * X + star Y * Y) 0 := by + rw [show star Xtilde = blockOp (ℋ := ℋ) (star X) (star Y) 0 0 by + simp [Xtilde]] + rw [show Xtilde = blockOp (ℋ := ℋ) X 0 Y 0 by rfl] + rw [blockOp_mul_wrap, blockDiagonal_eq_blockOp_wrap] + simp + have hXtilde_star_mul_le : star Xtilde * Xtilde ≤ (1 : L (HSum ℋ)) := by + have hblock_nonneg : + (0 : L (HSum ℋ)) ≤ + blockDiagonal (ℋ := ℋ) (1 - (star X * X + star Y * Y)) (1 : L ℋ) := by + refine blockDiagonal_nonneg (ℋ := ℋ) ?_ ?_ + · exact sub_nonneg.mpr hXY + · simp + have hsub : + (1 : L (HSum ℋ)) - blockDiagonal (ℋ := ℋ) (star X * X + star Y * Y) 0 = + blockDiagonal (ℋ := ℋ) (1 - (star X * X + star Y * Y)) (1 : L ℋ) := by + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [sub_eq_add_neg] + · intro z + simp [sub_eq_add_neg] + have hblock : + blockDiagonal (ℋ := ℋ) (star X * X + star Y * Y) 0 ≤ (1 : L (HSum ℋ)) := by + exact sub_nonneg.mp (by simpa [hsub] using hblock_nonneg) + simpa [hXtilde_star_mul] using hblock + have hXtilde_star_mul_nonneg : (0 : L (HSum ℋ)) ≤ star Xtilde * Xtilde := by + simp + have hXtilde_norm : ‖Xtilde‖ ≤ 1 := by + have hnormSq : ‖star Xtilde * Xtilde‖ ≤ 1 := + (CStarAlgebra.norm_le_one_iff_of_nonneg _ hXtilde_star_mul_nonneg).2 hXtilde_star_mul_le + have hnormSq' : ‖Xtilde‖ * ‖Xtilde‖ ≤ 1 := by + simpa [CStarRing.norm_star_mul_self] using hnormSq + have hsq : ‖Xtilde‖ ^ 2 ≤ 1 := by + simpa [pow_two] using hnormSq' + nlinarith [norm_nonneg Xtilde] + have hiv_hsum : CondIV (ℋ := HSum ℋ) f := @hiv (HSum ℋ) _ _ _ _ + have hcore := hiv_hsum (A := Atilde) (X := Xtilde) hAtilde_sa hAtilde_spec hXtilde_norm + have hsum_sa : IsSelfAdjoint (star X * A * X + star Y * B * Y) := by + change star (star X * A * X + star Y * B * Y) = star X * A * X + star Y * B * Y + simp [hA.star_eq, hB.star_eq, mul_assoc] + have hmul_block : + star Xtilde * Atilde * Xtilde = + blockDiagonal (ℋ := ℋ) (star X * A * X + star Y * B * Y) 0 := by + rw [show star Xtilde = blockOp (ℋ := ℋ) (star X) (star Y) 0 0 by + simp [Xtilde]] + rw [show Atilde = blockOp (ℋ := ℋ) A 0 0 B by + simpa [Atilde] using blockDiagonal_eq_blockOp_wrap (ℋ := ℋ) A B] + rw [show Xtilde = blockOp (ℋ := ℋ) X 0 Y 0 by rfl] + rw [blockOp_mul_wrap, blockOp_mul_wrap, blockDiagonal_eq_blockOp_wrap] + congr 1 <;> simp [mul_assoc] + have hAtilde_cfc : + cfcR (ℋ := HSum ℋ) f Atilde = + blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f A) (cfcR (ℋ := ℋ) f B) := by + simpa [Atilde] using + cfcR_blockDiagonal_wrap (ℋ := ℋ) (f := f) A B hA hB + (hcont.mono (by intro x hx; simp)) + have hright_block : + star Xtilde * cfcR (ℋ := HSum ℋ) f Atilde * Xtilde = + blockDiagonal (star X * cfcR (ℋ := ℋ) f A * X + star Y * cfcR (ℋ := ℋ) f B * Y) 0 := by + rw [hAtilde_cfc] + rw [show star Xtilde = blockOp (ℋ := ℋ) (star X) (star Y) 0 0 by + simp [Xtilde]] + rw [show Xtilde = blockOp (ℋ := ℋ) X 0 Y 0 by rfl] + rw [blockDiagonal_eq_blockOp_wrap, blockOp_mul_wrap, blockOp_mul_wrap, blockDiagonal_eq_blockOp_wrap] + congr 1 <;> simp [mul_assoc] + have hleft_block : + cfcR (ℋ := HSum ℋ) f (star Xtilde * Atilde * Xtilde) = + blockDiagonal (cfcR f (star X * A * X + star Y * B * Y)) (cfcR f 0) := by + rw [hmul_block] + simpa using + cfcR_blockDiagonal_wrap f (star X * A * X + star Y * B * Y) 0 hsum_sa (by simp) + (hcont.mono (by intro x hx; simp)) + rw [hleft_block, hright_block] at hcore + exact blockDiagonal_le_left_wrap (ℋ := ℋ) hcore + +/-- Uniform consequence of Theorem 2.5.2: `(i) → (v)` via `(iv)`. -/ +theorem theorem_2_5_2_i_all_imp_v {f : ℝ → ℝ} (hf : CondIAll.{u} f) : + CondV (ℋ := ℋ) f := by + have hconv : OperatorConvex (ℋ := ℋ) f := by + exact hf.1 + have hcont : ContinuousOn f Set.univ := + operatorConvex_continuousOn_univ (ℋ := ℋ) hconv + refine theorem_2_5_2_iv_imp_v (ℋ := ℋ) ?_ hcont + intro K _ _ _ _ + exact theorem_2_5_2_i_all_imp_iv (ℋ := K) (f := f) hf + +-- Uniform localized consequence of Theorem 2.5.2: `(i) → (v)` on `Set.Ici 0`. +set_option maxHeartbeats 3000000 in +-- The localized wrapper repeats the same block-operator normalization as +-- `theorem_2_5_2_iv_imp_v`. +theorem theorem_2_5_2_i_ici_all_imp_v {f : ℝ → ℝ} + (hf : CondIciAll.{u} f) : + CondV (ℋ := ℋ) f := by + have hfIci := hf + rcases hf with ⟨_, hcontIci, _⟩ + intro A B X Y hA hB hAs hBs hXY + have hA0 : (0 : L ℋ) ≤ A := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA)).2 ?_ + intro x hx + simpa [Set.Ici] using hAs hx + have hB0 : (0 : L ℋ) ≤ B := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B (ha := hB)).2 ?_ + intro x hx + simpa [Set.Ici] using hBs hx + let Atilde : L (HSum ℋ) := blockDiagonal (ℋ := ℋ) A B + let Xtilde : L (HSum ℋ) := blockOp (ℋ := ℋ) X 0 Y 0 + letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL_wrap (ℋ := ℋ) + have hAtilde_sa : IsSelfAdjoint Atilde := by + simpa [Atilde] using blockDiagonal_selfAdjoint_wrap (ℋ := ℋ) hA hB + have hAtilde0 : (0 : L (HSum ℋ)) ≤ Atilde := by + simpa [Atilde] using blockDiagonal_nonneg (ℋ := ℋ) hA0 hB0 + have hAtilde_spec : spectrum ℝ Atilde ⊆ Set.Ici (0 : ℝ) := + spectrum_Ici_of_nonneg_wrap (ℋ := HSum ℋ) hAtilde0 + have hXtilde_star_mul : + star Xtilde * Xtilde = + blockDiagonal (ℋ := ℋ) (star X * X + star Y * Y) 0 := by + rw [show star Xtilde = blockOp (ℋ := ℋ) (star X) (star Y) 0 0 by + simp [Xtilde]] + rw [show Xtilde = blockOp (ℋ := ℋ) X 0 Y 0 by rfl] + rw [blockOp_mul_wrap, blockDiagonal_eq_blockOp_wrap] + simp + have hXtilde_star_mul_le : star Xtilde * Xtilde ≤ (1 : L (HSum ℋ)) := by + have hblock_nonneg : + (0 : L (HSum ℋ)) ≤ + blockDiagonal (ℋ := ℋ) (1 - (star X * X + star Y * Y)) (1 : L ℋ) := by + refine blockDiagonal_nonneg (ℋ := ℋ) ?_ ?_ + · exact sub_nonneg.mpr hXY + · simp + have hsub : + (1 : L (HSum ℋ)) - blockDiagonal (ℋ := ℋ) (star X * X + star Y * Y) 0 = + blockDiagonal (ℋ := ℋ) (1 - (star X * X + star Y * Y)) (1 : L ℋ) := by + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [sub_eq_add_neg] + · intro z + simp [sub_eq_add_neg] + have hblock : + blockDiagonal (ℋ := ℋ) (star X * X + star Y * Y) 0 ≤ (1 : L (HSum ℋ)) := by + exact sub_nonneg.mp (by simpa [hsub] using hblock_nonneg) + simpa [hXtilde_star_mul] using hblock + have hXtilde_star_mul_nonneg : (0 : L (HSum ℋ)) ≤ star Xtilde * Xtilde := by + simp + have hXtilde_norm : ‖Xtilde‖ ≤ 1 := by + have hnormSq : ‖star Xtilde * Xtilde‖ ≤ 1 := + (CStarAlgebra.norm_le_one_iff_of_nonneg _ hXtilde_star_mul_nonneg).2 hXtilde_star_mul_le + have hnormSq' : ‖Xtilde‖ * ‖Xtilde‖ ≤ 1 := by + simpa [CStarRing.norm_star_mul_self] using hnormSq + have hsq : ‖Xtilde‖ ^ 2 ≤ 1 := by + simpa [pow_two] using hnormSq' + nlinarith [norm_nonneg Xtilde] + have hiv_hsum : CondIV (ℋ := HSum ℋ) f := + theorem_2_5_2_i_ici_all_imp_iv (ℋ := HSum ℋ) (f := f) hfIci + have hcore := hiv_hsum (A := Atilde) (X := Xtilde) hAtilde_sa hAtilde_spec hXtilde_norm + have hsum_nonneg : (0 : L ℋ) ≤ star X * A * X + star Y * B * Y := by + have hXA : (0 : L ℋ) ≤ star X * A * X := by + simpa [mul_assoc] using star_left_conjugate_nonneg hA0 X + have hYB : (0 : L ℋ) ≤ star Y * B * Y := by + simpa [mul_assoc] using star_left_conjugate_nonneg hB0 Y + exact add_nonneg hXA hYB + have hsum_sa : IsSelfAdjoint (star X * A * X + star Y * B * Y) := + IsSelfAdjoint.of_nonneg hsum_nonneg + have hmul_block : + star Xtilde * Atilde * Xtilde = + blockDiagonal (ℋ := ℋ) (star X * A * X + star Y * B * Y) 0 := by + rw [show star Xtilde = blockOp (ℋ := ℋ) (star X) (star Y) 0 0 by + simp [Xtilde]] + rw [show Atilde = blockOp (ℋ := ℋ) A 0 0 B by + simpa [Atilde] using blockDiagonal_eq_blockOp_wrap (ℋ := ℋ) A B] + rw [show Xtilde = blockOp (ℋ := ℋ) X 0 Y 0 by rfl] + rw [blockOp_mul_wrap, blockOp_mul_wrap, blockDiagonal_eq_blockOp_wrap] + congr 1 <;> simp [mul_assoc] + have hAtilde_cfc : + cfcR (ℋ := HSum ℋ) f Atilde = + blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f A) (cfcR (ℋ := ℋ) f B) := by + simpa [Atilde] using + cfcR_blockDiagonal_wrap (ℋ := ℋ) (f := f) A B hA hB + (continuousOn_union_of_subset_Ici_wrap (f := f) hcontIci hAs hBs) + have hright_block : + star Xtilde * cfcR (ℋ := HSum ℋ) f Atilde * Xtilde = + blockDiagonal (ℋ := ℋ) + (star X * cfcR (ℋ := ℋ) f A * X + star Y * cfcR (ℋ := ℋ) f B * Y) 0 := by + rw [hAtilde_cfc] + rw [show star Xtilde = blockOp (ℋ := ℋ) (star X) (star Y) 0 0 by + simp [Xtilde]] + rw [show Xtilde = blockOp (ℋ := ℋ) X 0 Y 0 by rfl, blockDiagonal_eq_blockOp_wrap, + blockOp_mul_wrap, blockOp_mul_wrap, blockDiagonal_eq_blockOp_wrap] + congr 1 <;> simp [mul_assoc] + have hsum_spec : spectrum ℝ (star X * A * X + star Y * B * Y) ⊆ Set.Ici (0 : ℝ) := + spectrum_Ici_of_nonneg_wrap (ℋ := ℋ) hsum_nonneg + have hleft_block : + cfcR (ℋ := HSum ℋ) f (star Xtilde * Atilde * Xtilde) = + blockDiagonal (cfcR f (star X * A * X + star Y * B * Y)) (cfcR f 0) := by + rw [hmul_block] + simpa using + cfcR_blockDiagonal_wrap f (star X * A * X + star Y * B * Y) 0 hsum_sa (by simp) + (continuousOn_union_of_subset_Ici_wrap hcontIci hsum_spec spectrum_zero_subset_Ici_wrap) + rw [hleft_block, hright_block] at hcore + exact blockDiagonal_le_left_wrap (ℋ := ℋ) hcore + +end Theorem252 + +end JensenOperatorInequality diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequalityIImpIV.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequalityIImpIV.lean new file mode 100644 index 000000000..c6be7b4a0 --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequalityIImpIV.lean @@ -0,0 +1,1027 @@ +/- +Copyright (c) 2026 Hayata Yamasaki. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kei Tsukamoto, Kento Mori, Hayata Yamasaki +-/ +module + +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.BlockDiagonal +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.LownerHeinzTheorem +public import Mathlib.Analysis.CStarAlgebra.Unitary.Span +public import Mathlib.Algebra.Star.UnitaryStarAlgAut + +@[expose] public section + +namespace JensenOperatorInequality + +universe u + +open LownerHeinzTheorem + +section Theorem252 + +variable {ℋ : Type u} +variable [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] + +set_option synthInstance.maxHeartbeats 400000 in +-- IsStarNormal CFC is only a theorem in Mathlib; CStarAlgebra chain through WithLp is deep. +noncomputable local instance : ContinuousFunctionalCalculus ℂ (L ℋ × L ℋ) IsStarNormal := + IsStarNormal.instContinuousFunctionalCalculus +set_option synthInstance.maxHeartbeats 400000 in +-- IsSelfAdjoint CFC for the product type, derived from IsStarNormal above. +noncomputable local instance : ContinuousFunctionalCalculus ℝ (L ℋ × L ℋ) IsSelfAdjoint := + IsSelfAdjoint.instContinuousFunctionalCalculus +set_option synthInstance.maxHeartbeats 400000 in +-- CStarAlgebra → NonnegSpectrumClass chain through WithLp is too deep for default heartbeats. +noncomputable local instance : NonnegSpectrumClass ℝ (L (HSum ℋ)) := inferInstance + +/-- Condition (iv) in Theorem 2.5.2. -/ +def CondIV (f : ℝ → ℝ) : Prop := + ∀ ⦃A X : L ℋ⦄, IsSelfAdjoint A → spectrum ℝ A ⊆ Set.Ici (0 : ℝ) → ‖X‖ ≤ 1 → + cfcR (ℋ := ℋ) f (star X * A * X) ≤ star X * cfcR (ℋ := ℋ) f A * X + +/-- Condition (i) in Theorem 2.5.2 on the fixed Hilbert space `ℋ`. -/ +def CondI (f : ℝ → ℝ) : Prop := + OperatorConvex (ℋ := ℋ) f ∧ f 0 ≤ 0 + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] in +/-- +Uniform version of Condition (i), packaged as `OperatorConvexAll` together with `f 0 ≤ 0`. +-/ +def CondIAll (f : ℝ → ℝ) : Prop := + OperatorConvexAll.{u} f ∧ + f 0 ≤ 0 + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] in +/-- +Uniform localized version of Condition (i), packaged as +`OperatorConvexOnAll (Set.Ici 0)` together with continuity and `f 0 ≤ 0`. +-/ +def CondIciAll (f : ℝ → ℝ) : Prop := + OperatorConvexOnAll.{u} (Set.Ici (0 : ℝ)) f ∧ + ContinuousOn f (Set.Ici (0 : ℝ)) ∧ + f 0 ≤ 0 + +/-- Condition (v) in Theorem 2.5.2. -/ +def CondV (f : ℝ → ℝ) : Prop := + ∀ ⦃A B X Y : L ℋ⦄, + IsSelfAdjoint A → IsSelfAdjoint B → + spectrum ℝ A ⊆ Set.Ici (0 : ℝ) → spectrum ℝ B ⊆ Set.Ici (0 : ℝ) → + star X * X + star Y * Y ≤ (1 : L ℋ) → + cfcR (ℋ := ℋ) f (star X * A * X + star Y * B * Y) ≤ + star X * cfcR (ℋ := ℋ) f A * X + star Y * cfcR (ℋ := ℋ) f B * Y + +/-- Selfadjoint `2 × 2` block built from a contraction candidate `X`. -/ +private noncomputable def blockSwap (X : L ℋ) : L (HSum ℋ) := + blockOp (ℋ := ℋ) 0 (star X) X 0 + +private lemma blockSwap_star (X : L ℋ) : + star (blockSwap (ℋ := ℋ) X) = blockSwap (ℋ := ℋ) X := by + simp [blockSwap, blockOp_star] + +private lemma blockSwap_sq (X : L ℋ) : + blockSwap (ℋ := ℋ) X * blockSwap (ℋ := ℋ) X = + blockDiagonal (ℋ := ℋ) (star X * X) (X * star X) := by + ext z i + fin_cases i <;> + simp [blockSwap, blockOp, blockDiagonal, ContinuousLinearMap.mul_def] <;> abel + +omit [CompleteSpace ℋ] in +private lemma blockDiagonal_eq_blockOp (A B : L ℋ) : + blockDiagonal (ℋ := ℋ) A B = blockOp (ℋ := ℋ) A 0 0 B := by + ext z i + fin_cases i <;> simp [blockDiagonal, blockOp] + +set_option maxHeartbeats 400000 in +-- Multiplying two generic `blockOp` expressions is elaboration-heavy. +omit [CompleteSpace ℋ] in +private lemma blockOp_mul (A00 A01 A10 A11 B00 B01 B10 B11 : L ℋ) : + blockOp (ℋ := ℋ) A00 A01 A10 A11 * blockOp (ℋ := ℋ) B00 B01 B10 B11 = + blockOp (ℋ := ℋ) + (A00 * B00 + A01 * B10) + (A00 * B01 + A01 * B11) + (A10 * B00 + A11 * B10) + (A10 * B01 + A11 * B11) := by + -- The extra heartbeat budget stays local to this normalization lemma. + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [ContinuousLinearMap.mul_def, add_left_comm, add_comm] + · intro z + simp [ContinuousLinearMap.mul_def, add_left_comm, add_comm] + +omit [CompleteSpace ℋ] in +private lemma blockOp_add + (A00 A01 A10 A11 B00 B01 B10 B11 : L ℋ) : + blockOp (ℋ := ℋ) A00 A01 A10 A11 + blockOp (ℋ := ℋ) B00 B01 B10 B11 = + blockOp (ℋ := ℋ) (A00 + B00) (A01 + B01) (A10 + B10) (A11 + B11) := by + ext z i + fin_cases i <;> simp [blockOp] <;> abel + +set_option synthInstance.maxHeartbeats 100000 in +-- Scalar action on `blockOp` triggers expensive instance search for nested operator expressions. +private lemma blockOp_smulR + (r : ℝ) (A00 A01 A10 A11 : L ℋ) : + r • blockOp (ℋ := ℋ) A00 A01 A10 A11 = + blockOp (ℋ := ℋ) (r • A00) (r • A01) (r • A10) (r • A11) := by + have coe_smul_hsum : ∀ (f : L (HSum ℋ)) (x : HSum ℋ), (r • f) x = r • (f x) := by + intros; rfl + have coe_smul_h : ∀ (f : L ℋ) (x : ℋ), (r • f) x = r • (f x) := by + intros; rfl + ext z i + fin_cases i <;> { + simp only [blockOp, ContinuousLinearMap.add_apply, ContinuousLinearMap.comp_apply, + smul_add, coe_smul_hsum, coe_smul_h] + simp [hsumProj, hsumIncl, hsumEquiv] + } + +private lemma blockSwap_add_I_smul_blockDiagonal (X R0 R1 : L ℋ) : + blockSwap (ℋ := ℋ) X + Complex.I • blockDiagonal (ℋ := ℋ) R0 R1 = + blockOp (ℋ := ℋ) (Complex.I • R0) (star X) X (Complex.I • R1) := by + rw [blockDiagonal_eq_blockOp] + ext z i + fin_cases i <;> simp [blockSwap, blockOp] <;> abel + +omit [CompleteSpace ℋ] in +private lemma blockOp_mul_blockDiagonal_zero_right + (P00 P01 P10 P11 A Q00 Q01 Q10 Q11 : L ℋ) : + blockOp (ℋ := ℋ) P00 P01 P10 P11 * blockDiagonal (ℋ := ℋ) 0 A * + blockOp (ℋ := ℋ) Q00 Q01 Q10 Q11 = + blockOp (ℋ := ℋ) + (P01 * A * Q10) + (P01 * A * Q11) + (P11 * A * Q10) + (P11 * A * Q11) := by + rw [blockDiagonal_eq_blockOp, blockOp_mul, blockOp_mul] + simp [mul_assoc, add_comm] + +set_option synthInstance.maxHeartbeats 400000 in +-- `StarAlgHom.map_cfc` needs `MulAction ℝ (L (HSum ℋ))`; search is deep without section CFC. +private lemma cfcR_blockDiagonal (f : ℝ → ℝ) + (A B : L ℋ) (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) + (hcont : ContinuousOn f (spectrum ℝ A ∪ spectrum ℝ B)) : + cfcR (ℋ := HSum ℋ) f (blockDiagonal (ℋ := ℋ) A B) = + blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f A) (cfcR (ℋ := ℋ) f B) := by + let φ : (L ℋ × L ℋ) →⋆ₐ[ℝ] L (HSum ℋ) := blockDiagonalHom (ℋ := ℋ) + have hφ : Continuous φ := by + change Continuous (fun p : L ℋ × L ℋ => blockDiagonal (ℋ := ℋ) p.1 p.2) + change Continuous (fun p : L ℋ × L ℋ => + hsumIncl ℋ 0 ∘L p.1 ∘L hsumProj ℋ 0 + hsumIncl ℋ 1 ∘L p.2 ∘L hsumProj ℋ 1) + fun_prop + have hpair : IsSelfAdjoint (A, B) := by + change star (A, B) = (A, B) + ext <;> simp [hA.star_eq, hB.star_eq] + have hpair' : IsSelfAdjoint (φ (A, B)) := hpair.map φ + have hmap := StarAlgHom.map_cfc (φ := φ) (f := f) (a := (A, B)) + (hf := by simpa [Prod.spectrum_eq] using hcont) + (hφ := hφ) (ha := hpair) (hφa := hpair') + have hprod : + cfc (R := ℝ) (A := L ℋ × L ℋ) (p := IsSelfAdjoint) f (A, B) = + (cfcR (ℋ := ℋ) f A, cfcR (ℋ := ℋ) f B) := by + simpa [cfcR] using + (cfc_map_prod (R := ℝ) (S := ℝ) + (A := L ℋ) (B := L ℋ) + (pab := IsSelfAdjoint) (pa := IsSelfAdjoint) (pb := IsSelfAdjoint) + f A B + (hf := hcont) + (hab := hpair) (ha := hA) (hb := hB)) + calc + cfcR (ℋ := HSum ℋ) f (blockDiagonal (ℋ := ℋ) A B) + = cfc (R := ℝ) (A := L (HSum ℋ)) (p := IsSelfAdjoint) f (φ (A, B)) := by + simp [cfcR, φ] + _ = φ (cfc (R := ℝ) (A := L ℋ × L ℋ) (p := IsSelfAdjoint) f (A, B)) := by + simpa using hmap.symm + _ = φ (cfcR (ℋ := ℋ) f A, cfcR (ℋ := ℋ) f B) := by + rw [hprod] + _ = blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f A) (cfcR (ℋ := ℋ) f B) := by + simp [φ, blockDiagonalHom] + +-- Converting positivity on a block-diagonal operator to each diagonal block is expensive. +private lemma blockDiagonal_le_left {A0 A1 B0 B1 : L ℋ} + (h : blockDiagonal (ℋ := ℋ) A0 A1 ≤ blockDiagonal (ℋ := ℋ) B0 B1) : + A0 ≤ B0 := by + have hnonneg : 0 ≤ blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1) := by + have hsub : + blockDiagonal (ℋ := ℋ) B0 B1 - blockDiagonal (ℋ := ℋ) A0 A1 = + blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1) := by + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [sub_eq_add_neg] + · intro z + simp [sub_eq_add_neg] + exact hsub ▸ sub_nonneg.mpr h + have hpos : + (blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1)).IsPositive := + (ContinuousLinearMap.nonneg_iff_isPositive _).1 hnonneg + have hleftPos : (B0 - A0).IsPositive := by + rw [ContinuousLinearMap.isPositive_iff_complex] + intro x + have hx := + (ContinuousLinearMap.isPositive_iff_complex + (blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1))).1 hpos (hsumIncl ℋ 0 x) + simpa [blockDiagonal, hsumProj, hsumIncl, hsumEquiv, PiLp.inner_apply] using hx + exact (sub_nonneg.mp ((ContinuousLinearMap.nonneg_iff_isPositive _).2 hleftPos)) + +private lemma blockDiagonal_selfAdjoint {A B : L ℋ} + (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) : + IsSelfAdjoint (blockDiagonal (ℋ := ℋ) A B) := by + change star (blockDiagonal (ℋ := ℋ) A B) = blockDiagonal (ℋ := ℋ) A B + simp [blockDiagonal_star, hA.star_eq, hB.star_eq] + +private lemma cfcR_zero (f : ℝ → ℝ) : + cfcR (ℋ := ℋ) f (0 : L ℋ) = algebraMap ℝ (L ℋ) (f 0) := by + change cfc (R := ℝ) (A := L ℋ) (p := IsSelfAdjoint) f (0 : L ℋ) = + algebraMap ℝ (L ℋ) (f 0) + simp + +private lemma cfcR_conj_unitary (f : ℝ → ℝ) (hcont : ContinuousOn f Set.univ) + (u : unitary (L ℋ)) (A : L ℋ) (hA : IsSelfAdjoint A) : + cfcR (ℋ := ℋ) f (star u * A * u) = star u * cfcR (ℋ := ℋ) f A * u := by + let φ : L ℋ →⋆ₐ[ℝ] L ℋ := Unitary.conjStarAlgAut ℝ (L ℋ) (star u) + have hφ : Continuous φ := by + have h1 : Continuous (fun x : L ℋ => (star u : L ℋ) * x * (u : L ℋ)) := by + fun_prop + have hEq : (fun x : L ℋ => φ x) = (fun x : L ℋ => (star u : L ℋ) * x * (u : L ℋ)) := by + funext x + simp [φ, Unitary.conjStarAlgAut_apply, mul_assoc] + simpa [hEq] using h1 + have hφA : IsSelfAdjoint (φ A) := hA.map φ + have hmap := StarAlgHom.map_cfc (φ := φ) (f := f) (a := A) + (hf := hcont.mono (by intro x hx; simp)) + (hφ := hφ) (ha := hA) (hφa := hφA) + simpa [φ, cfcR, Unitary.conjStarAlgAut_apply, mul_assoc] using hmap.symm + +private lemma cfcR_conj_unitary_on (s : Set ℝ) (f : ℝ → ℝ) (hcont : ContinuousOn f s) + {A : L ℋ} (hAs : spectrum ℝ A ⊆ s) + (u : unitary (L ℋ)) (hA : IsSelfAdjoint A) : + cfcR (ℋ := ℋ) f (star u * A * u) = star u * cfcR (ℋ := ℋ) f A * u := by + let φ : L ℋ →⋆ₐ[ℝ] L ℋ := Unitary.conjStarAlgAut ℝ (L ℋ) (star u) + have hφ : Continuous φ := by + have h1 : Continuous (fun x : L ℋ => (star u : L ℋ) * x * (u : L ℋ)) := by + fun_prop + have hEq : (fun x : L ℋ => φ x) = (fun x : L ℋ => (star u : L ℋ) * x * (u : L ℋ)) := by + funext x + simp [φ, Unitary.conjStarAlgAut_apply, mul_assoc] + simpa [hEq] using h1 + have hφA : IsSelfAdjoint (φ A) := hA.map φ + have hmap := StarAlgHom.map_cfc (φ := φ) (f := f) (a := A) + (hf := hcont.mono hAs) + (hφ := hφ) (ha := hA) (hφa := hφA) + simpa [φ, cfcR, Unitary.conjStarAlgAut_apply, mul_assoc] using hmap.symm + +private lemma cfcR_real_sqrt_eq_sqrt {A : L ℋ} (hA : (0 : L ℋ) ≤ A) : + cfcR (ℋ := ℋ) Real.sqrt A = CFC.sqrt A := by + rw [CFC.sqrt_eq_real_sqrt A hA, cfcₙ_eq_cfc (f := Real.sqrt) (a := A) (hf0 := by simp), cfcR] + +omit [CompleteSpace ℋ] in +private theorem nontrivial_hsumL [Nontrivial ℋ] : Nontrivial (L (HSum ℋ)) := by + have h_not_sub : ¬ Subsingleton ℋ := by + intro hsub + letI : Subsingleton ℋ := hsub + letI : Subsingleton (L ℋ) := by infer_instance + exact (not_nontrivial_iff_subsingleton.mpr (by infer_instance)) + (inferInstance : Nontrivial (L ℋ)) + have hH_nontriv : Nontrivial ℋ := (not_subsingleton_iff_nontrivial.mp h_not_sub) + letI : Nontrivial ℋ := hH_nontriv + rcases exists_pair_ne ℋ with ⟨x, y, hxy⟩ + let w : ℋ := x - y + have hw : w ≠ 0 := sub_ne_zero.mpr hxy + have hdiag_ne_zero : (blockDiagonal (ℋ := ℋ) (1 : L ℋ) 0 : L (HSum ℋ)) ≠ 0 := by + intro h0 + have hz : + blockDiagonal (ℋ := ℋ) (1 : L ℋ) 0 (hsumIncl ℋ 0 w) = 0 := by + exact congrArg (fun T : L (HSum ℋ) => T (hsumIncl ℋ 0 w)) h0 + have hw0 : w = 0 := by + have hz0 := congrArg (fun z : HSum ℋ => hsumProj ℋ 0 z) hz + simpa [blockDiagonal] using hz0 + exact hw hw0 + exact ⟨0, blockDiagonal (ℋ := ℋ) (1 : L ℋ) 0, hdiag_ne_zero.symm⟩ + +set_option synthInstance.maxHeartbeats 100000 in +-- `CFC.sqrt` on block-diagonal operators triggers expensive instance search through the product map. +set_option linter.unusedSectionVars false in +set_option maxHeartbeats 400000 in +private lemma sqrt_blockDiagonal_of_nonneg + [Nontrivial ℋ] + {A B : L ℋ} (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) + (hA_nonneg : (0 : L ℋ) ≤ A) (hB_nonneg : (0 : L ℋ) ≤ B) : + CFC.sqrt (blockDiagonal (ℋ := ℋ) A B) = + blockDiagonal (ℋ := ℋ) (CFC.sqrt A) (CFC.sqrt B) := by + letI : Algebra ℝ (L (HSum ℋ)) := by infer_instance + letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL (ℋ := ℋ) + have hdiag_nonneg : (0 : L (HSum ℋ)) ≤ blockDiagonal (ℋ := ℋ) A B := + blockDiagonal_nonneg (ℋ := ℋ) hA_nonneg hB_nonneg + rw [← cfcR_real_sqrt_eq_sqrt (ℋ := HSum ℋ) hdiag_nonneg] + rw [cfcR_blockDiagonal (ℋ := ℋ) (f := Real.sqrt) (A := A) (B := B) hA hB] + · rw [← cfcR_real_sqrt_eq_sqrt (ℋ := ℋ) hA_nonneg, ← cfcR_real_sqrt_eq_sqrt (ℋ := ℋ) hB_nonneg] + · simpa using + (by cfc_cont_tac : ContinuousOn Real.sqrt (spectrum ℝ A ∪ spectrum ℝ B)) + +--BUG? In v4.28, this didn't require CompleteSpace ℋ. Then it did. +-- The `NormedAlgebra ℝ (L ℋ)` instances comes from a `CStarAlgebra (ℋ →L[ℂ] ℋ)`, which is +-- `instCStarAlgebraContinuousLinearMapComplexIdOfCompleteSpace`, which requires CompleteSpace ℋ. +-- In principle this isn't necessary. +private lemma complex_I_smul_real_I_smul_invTwo (r : ℝ) (T : L ℋ) : + Complex.I • r • Complex.I • (2⁻¹ : ℝ) • T = + -((2⁻¹ : ℝ) * r) • T := by + ext x + have hcomm : r • (Complex.I • ((2⁻¹ : ℝ) • T x)) = Complex.I • (r • ((2⁻¹ : ℝ) • T x)) := by + simpa using (smul_comm r (Complex.I : ℂ) ((2⁻¹ : ℝ) • T x)) + calc + Complex.I • r • Complex.I • (2⁻¹ : ℝ) • T x + = Complex.I • (r • (Complex.I • ((2⁻¹ : ℝ) • T x))) := by + rfl + _ = Complex.I • (Complex.I • (r • ((2⁻¹ : ℝ) • T x))) := by + rw [hcomm] + _ = ((Complex.I : ℂ) * Complex.I) • (r • ((2⁻¹ : ℝ) • T x)) := by + rw [smul_smul] + _ = (-1 : ℂ) • (r • ((2⁻¹ : ℝ) • T x)) := by + norm_num + _ = (-1 : ℂ) • (((r * 2⁻¹ : ℝ)) • T x) := by + rw [smul_smul] + _ = -((2⁻¹ : ℝ) * r) • T x := by + simp [neg_smul, mul_comm] + +private lemma real_smul_complex_I_real_smul_complex_I_comm (s r : ℝ) (T : L ℋ) : + (s : ℝ) • Complex.I • r • Complex.I • T = + Complex.I • r • Complex.I • (s : ℝ) • T := by + calc + (s : ℝ) • Complex.I • r • Complex.I • T + = Complex.I • ((s : ℝ) • (r • (Complex.I • T))) := by + simpa [smul_smul] using (smul_comm (s : ℝ) (Complex.I : ℂ) (r • (Complex.I • T))) + _ = Complex.I • (r • ((s : ℝ) • (Complex.I • T))) := by + rw [smul_comm (s : ℝ) r (Complex.I • T)] + _ = Complex.I • (r • (Complex.I • ((s : ℝ) • T))) := by + rw [smul_comm (s : ℝ) (Complex.I : ℂ) T] + _ = Complex.I • r • Complex.I • (s : ℝ) • T := by + rfl + +private lemma half_add_half_eq (T : L ℋ) : + (2⁻¹ : ℝ) • T + (2⁻¹ : ℝ) • T = T := by + calc + (2⁻¹ : ℝ) • T + (2⁻¹ : ℝ) • T = (2⁻¹ + 2⁻¹ : ℝ) • T := by + simp [add_smul] + _ = (1 : ℝ) • T := by norm_num + _ = T := by simp + +private lemma half_mul_real_add_half_mul_real_eq (r : ℝ) (T : L ℋ) : + ((2⁻¹ : ℝ) * r) • T + ((2⁻¹ : ℝ) * r) • T = r • T := by + calc + ((2⁻¹ : ℝ) * r) • T + ((2⁻¹ : ℝ) * r) • T = + (((2⁻¹ : ℝ) * r) + ((2⁻¹ : ℝ) * r)) • T := by + simp [add_smul] + _ = r • T := by ring_nf + +private lemma rightEval_topLeft_scalar + (r : ℝ) (R0 X T : L ℋ) : + (2⁻¹ : ℝ) • (star X * (T * X)) + + ((2⁻¹ : ℝ) • (star X * (T * X)) + + (-((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)) + + -((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)))) = + star X * (T * X) + r • (R0 * R0) := by + have hP : + (2⁻¹ : ℝ) • (star X * (T * X)) + + (2⁻¹ : ℝ) • (star X * (T * X)) = + star X * (T * X) := by + simpa using half_add_half_eq (ℋ := ℋ) (star X * (T * X)) + have hQhalf : + -((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)) + + -((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)) = + r • (R0 * R0) := by + have hterm : + -((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)) = + ((2⁻¹ : ℝ) * r) • (R0 * R0) := by + calc + -((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)) + = -(Complex.I • r • Complex.I • (2⁻¹ : ℝ) • (R0 * R0)) := by + rw [real_smul_complex_I_real_smul_complex_I_comm + (ℋ := ℋ) (s := (2⁻¹ : ℝ)) (r := r) (T := R0 * R0)] + _ = ((2⁻¹ : ℝ) * r) • (R0 * R0) := by + rw [complex_I_smul_real_I_smul_invTwo (ℋ := ℋ) (r := r) (T := R0 * R0)] + simp + calc + -((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)) + + -((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)) = + ((2⁻¹ : ℝ) * r) • (R0 * R0) + ((2⁻¹ : ℝ) * r) • (R0 * R0) := by + simp [hterm] + _ = r • (R0 * R0) := half_mul_real_add_half_mul_real_eq (ℋ := ℋ) r (R0 * R0) + calc + (2⁻¹ : ℝ) • (star X * (T * X)) + + ((2⁻¹ : ℝ) • (star X * (T * X)) + + (-((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)) + + -((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)))) + = + ((2⁻¹ : ℝ) • (star X * (T * X)) + + (2⁻¹ : ℝ) • (star X * (T * X))) + + (-((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0)) + + -((2⁻¹ : ℝ) • Complex.I • r • Complex.I • (R0 * R0))) := by + abel + _ = star X * (T * X) + r • (R0 * R0) := by rw [hP, hQhalf] + +private lemma rightEval_bottomRight_scalar + (r : ℝ) (R1 X T : L ℋ) : + (2⁻¹ * r) • (X * star X) + + ((2⁻¹ * r) • (X * star X) + + ((2⁻¹ : ℝ) • (R1 * (T * R1)) + + (2⁻¹ : ℝ) • (R1 * (T * R1)))) = + (R1 * T * R1) + r • (X * star X) := by + have hS : + (2⁻¹ * r) • (X * star X) + (2⁻¹ * r) • (X * star X) = r • (X * star X) := by + simpa using half_mul_real_add_half_mul_real_eq (ℋ := ℋ) r (X * star X) + have hT : + (2⁻¹ : ℝ) • (R1 * (T * R1)) + (2⁻¹ : ℝ) • (R1 * (T * R1)) = + R1 * (T * R1) := by + simpa using half_add_half_eq (ℋ := ℋ) (R1 * (T * R1)) + calc + (2⁻¹ * r) • (X * star X) + + ((2⁻¹ * r) • (X * star X) + + ((2⁻¹ : ℝ) • (R1 * (T * R1)) + + (2⁻¹ : ℝ) • (R1 * (T * R1)))) + = + ((2⁻¹ * r) • (X * star X) + (2⁻¹ * r) • (X * star X)) + + ((2⁻¹ : ℝ) • (R1 * (T * R1)) + (2⁻¹ : ℝ) • (R1 * (T * R1))) := by + abel + _ = r • (X * star X) + R1 * (T * R1) := by rw [hS, hT] + _ = (R1 * T * R1) + r • (X * star X) := by simp [mul_assoc, add_comm] + +private lemma star_mul_le_one [Nontrivial ℋ] (X : L ℋ) (hX : ‖X‖ ≤ 1) : + (star X * X : L ℋ) ≤ 1 := by + have h1 : star X * X ≤ algebraMap ℝ (L ℋ) (‖X‖ ^ 2) := by + simpa [pow_two] using (CStarAlgebra.star_mul_le_algebraMap_norm_sq (a := X)) + have hsq : ‖X‖ ^ 2 ≤ 1 := by + nlinarith [hX, norm_nonneg X] + exact h1.trans (by simpa [Algebra.algebraMap_eq_smul_one] using hsq) + +private lemma mul_star_le_one [Nontrivial ℋ] (X : L ℋ) (hX : ‖X‖ ≤ 1) : + (X * star X : L ℋ) ≤ 1 := by + have h1 : X * star X ≤ algebraMap ℝ (L ℋ) (‖X‖ ^ 2) := by + simpa [pow_two] using (CStarAlgebra.star_mul_le_algebraMap_norm_sq (a := star X)) + have hsq : ‖X‖ ^ 2 ≤ 1 := by + nlinarith [hX, norm_nonneg X] + exact h1.trans (by simpa [Algebra.algebraMap_eq_smul_one] using hsq) + +-- `simp` and normalization over block expressions are expensive here. +private lemma blockSwap_norm_le_one [Nontrivial ℋ] (X : L ℋ) (hX : ‖X‖ ≤ 1) : + ‖blockSwap (ℋ := ℋ) X‖ ≤ 1 := by + have hSstar : star (blockSwap (ℋ := ℋ) X) = blockSwap (ℋ := ℋ) X := + blockSwap_star (ℋ := ℋ) X + have hSstarS : + star (blockSwap (ℋ := ℋ) X) * blockSwap (ℋ := ℋ) X = + blockDiagonal (ℋ := ℋ) (star X * X) (X * star X) := by + simpa [hSstar] using blockSwap_sq (ℋ := ℋ) X + have hDiagLe : + blockDiagonal (ℋ := ℋ) (star X * X) (X * star X) ≤ (1 : L (HSum ℋ)) := by + have hA : 0 ≤ (1 : L ℋ) - star X * X := sub_nonneg.mpr (star_mul_le_one (ℋ := ℋ) X hX) + have hB : 0 ≤ (1 : L ℋ) - X * star X := sub_nonneg.mpr (mul_star_le_one (ℋ := ℋ) X hX) + have hnonneg : 0 ≤ blockDiagonal (ℋ := ℋ) (1 - star X * X) (1 - X * star X) := + blockDiagonal_nonneg (ℋ := ℋ) hA hB + have hle : + blockDiagonal (ℋ := ℋ) (star X * X) (X * star X) ≤ + blockDiagonal (ℋ := ℋ) (star X * X) (X * star X) + + blockDiagonal (ℋ := ℋ) (1 - star X * X) (1 - X * star X) := + le_add_of_nonneg_right hnonneg + have hsum : + blockDiagonal (ℋ := ℋ) (star X * X) (X * star X) + + blockDiagonal (ℋ := ℋ) (1 - star X * X) (1 - X * star X) = + blockDiagonal (ℋ := ℋ) (1 : L ℋ) (1 : L ℋ) := by + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [sub_eq_add_neg, add_left_comm, add_comm] + · intro z + simp [sub_eq_add_neg, add_left_comm, add_comm] + have hle' : + blockDiagonal (ℋ := ℋ) (star X * X) (X * star X) ≤ + blockDiagonal (ℋ := ℋ) (1 : L ℋ) (1 : L ℋ) := by + simpa [hsum] using hle + simpa [blockDiagonal_one] using hle' + have hSstarSle : + star (blockSwap (ℋ := ℋ) X) * blockSwap (ℋ := ℋ) X ≤ (1 : L (HSum ℋ)) := by + simpa [hSstarS] using hDiagLe + have hSstarSnonneg : 0 ≤ star (blockSwap (ℋ := ℋ) X) * blockSwap (ℋ := ℋ) X := by + exact star_mul_self_nonneg (blockSwap (ℋ := ℋ) X) + have hnormSq : ‖star (blockSwap (ℋ := ℋ) X) * blockSwap (ℋ := ℋ) X‖ ≤ 1 := + (CStarAlgebra.norm_le_one_iff_of_nonneg _ hSstarSnonneg).2 hSstarSle + have hnormSq' : ‖blockSwap (ℋ := ℋ) X‖ * ‖blockSwap (ℋ := ℋ) X‖ ≤ 1 := by + simpa [CStarRing.norm_star_mul_self] using hnormSq + have hsq : ‖blockSwap (ℋ := ℋ) X‖ ^ 2 ≤ 1 := by + simpa [pow_two] using hnormSq' + have hnonneg : 0 ≤ ‖blockSwap (ℋ := ℋ) X‖ := norm_nonneg _ + nlinarith + +private lemma continuousOn_union_of_subset_Ici {f : ℝ → ℝ} + (hcont : ContinuousOn f (Set.Ici (0 : ℝ))) {s t : Set ℝ} + (hs : s ⊆ Set.Ici (0 : ℝ)) (ht : t ⊆ Set.Ici (0 : ℝ)) : + ContinuousOn f (s ∪ t) := by + refine hcont.mono ?_ + intro x hx + rcases hx with hx | hx + · exact hs hx + · exact ht hx + +private lemma spectrum_Ici_of_nonneg {A : L ℋ} (hA0 : (0 : L ℋ) ≤ A) : + spectrum ℝ A ⊆ Set.Ici (0 : ℝ) := by + exact + (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A + (ha := IsSelfAdjoint.of_nonneg hA0)).1 hA0 + +variable [Nontrivial ℋ] + +private lemma spectrum_zero_subset_Ici : + spectrum ℝ (0 : L ℋ) ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : x = 0 := by + simpa using hx + simp [Set.Ici, hx0] + + +--Theorem 2.5.2 `(i) → (iv)`. + +set_option maxHeartbeats 2000000 in +-- The localized proof duplicates the block-matrix normalization from the global theorem. +theorem theorem_2_5_2_i_ici_all_imp_iv {f : ℝ → ℝ} (hf : CondIciAll.{u} f) : + CondIV (ℋ := ℋ) f := by + rcases hf with ⟨hconvAll, hcontIci, hf0⟩ + intro A X hA hAs hX + have hconv : OperatorConvexOn (ℋ := ℋ) (Set.Ici (0 : ℝ)) f := hconvAll (K := ℋ) + have hA0 : (0 : L ℋ) ≤ A := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA)).2 ?_ + intro x hx + simpa [Set.Ici] using hAs hx + let S : L (HSum ℋ) := blockSwap (ℋ := ℋ) X + have hSsa : IsSelfAdjoint S := by + change star S = S + simpa [S] using blockSwap_star (ℋ := ℋ) X + have hSnorm : ‖S‖ ≤ 1 := by + simpa [S] using blockSwap_norm_le_one (ℋ := ℋ) X hX + letI : Algebra ℝ (L (HSum ℋ)) := by + infer_instance + have hU_mem : S + Complex.I • CFC.sqrt (1 - S ^ 2) ∈ unitary (L (HSum ℋ)) := by + exact IsSelfAdjoint.self_add_I_smul_cfcSqrt_sub_sq_mem_unitary S hSsa hSnorm + let U : unitary (L (HSum ℋ)) := + ⟨S + Complex.I • CFC.sqrt (1 - S ^ 2), hU_mem⟩ + let V : unitary (L (HSum ℋ)) := star U + let Atilde : L (HSum ℋ) := blockDiagonal (ℋ := ℋ) 0 A + letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL (ℋ := ℋ) + have hconv₂ : OperatorConvexOn (ℋ := HSum ℋ) (Set.Ici (0 : ℝ)) f := + hconvAll (K := HSum ℋ) + have hR0nonneg : (0 : L ℋ) ≤ 1 - star X * X := sub_nonneg.mpr (star_mul_le_one (ℋ := ℋ) X hX) + have hR1nonneg : (0 : L ℋ) ≤ 1 - X * star X := sub_nonneg.mpr (mul_star_le_one (ℋ := ℋ) X hX) + let R0 : L ℋ := CFC.sqrt (1 - star X * X) + let R1 : L ℋ := CFC.sqrt (1 - X * star X) + have hR0sa : IsSelfAdjoint (1 - star X * X) := by + change star (1 - star X * X) = 1 - star X * X + simp + have hR1sa : IsSelfAdjoint (1 - X * star X) := by + change star (1 - X * star X) = 1 - X * star X + simp + have hSsq : S ^ 2 = blockDiagonal (ℋ := ℋ) (star X * X) (X * star X) := by + simpa [pow_two, S] using blockSwap_sq (ℋ := ℋ) X + have hOneMinusSq : + 1 - S ^ 2 = blockDiagonal (ℋ := ℋ) (1 - star X * X) (1 - X * star X) := by + rw [hSsq] + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [sub_eq_add_neg, add_comm] + · intro z + simp [sub_eq_add_neg, add_comm] + have hOneMinusSqNonneg : (0 : L (HSum ℋ)) ≤ 1 - S ^ 2 := by + have hdiag : (0 : L (HSum ℋ)) ≤ + blockDiagonal (ℋ := ℋ) (1 - star X * X) (1 - X * star X) := + blockDiagonal_nonneg (ℋ := ℋ) hR0nonneg hR1nonneg + simpa [hOneMinusSq] using hdiag + have hRblock : CFC.sqrt (1 - S ^ 2) = blockDiagonal (ℋ := ℋ) R0 R1 := by + rw [hOneMinusSq] + simp [R0, R1] + simpa using + (sqrt_blockDiagonal_of_nonneg (ℋ := ℋ) (A := 1 - star X * X) (B := 1 - X * star X) + hR0sa hR1sa hR0nonneg hR1nonneg) + have hR0self : IsSelfAdjoint R0 := by + have h : IsSelfAdjoint (CFC.sqrt (1 - star X * X)) := + (CFC.sqrt_nonneg (1 - star X * X)).isSelfAdjoint + simpa [R0] using h + have hR1self : IsSelfAdjoint R1 := by + have h : IsSelfAdjoint (CFC.sqrt (1 - X * star X)) := + (CFC.sqrt_nonneg (1 - X * star X)).isSelfAdjoint + simpa [R1] using h + have hU_block : + (U : L (HSum ℋ)) = blockOp (ℋ := ℋ) (Complex.I • R0) (star X) X (Complex.I • R1) := by + change S + Complex.I • CFC.sqrt (1 - S ^ 2) = _ + rw [hRblock] + simpa [S] using blockSwap_add_I_smul_blockDiagonal (ℋ := ℋ) X R0 R1 + have hV_block : + (V : L (HSum ℋ)) = blockOp (ℋ := ℋ) (-Complex.I • R0) (star X) X (-Complex.I • R1) := by + change star (U : L (HSum ℋ)) = _ + rw [hU_block] + ext z i + fin_cases i <;> + simp [blockOp_star, hR0self.star_eq, hR1self.star_eq] + have hB1_block : + (star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ)) = + blockOp (ℋ := ℋ) + (star X * A * X) + (star X * A * (Complex.I • R1)) + ((-Complex.I • R1) * A * X) + ((-Complex.I • R1) * A * (Complex.I • R1)) := by + rw [show (star U : L (HSum ℋ)) = (V : L (HSum ℋ)) by rfl, hV_block, hU_block] + simpa [Atilde, mul_assoc] using + (blockOp_mul_blockDiagonal_zero_right (ℋ := ℋ) + (-Complex.I • R0) (star X) X (-Complex.I • R1) A + (Complex.I • R0) (star X) X (Complex.I • R1)) + have hB2_block : + (star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)) = + blockOp (ℋ := ℋ) + (star X * A * X) + (star X * A * (-Complex.I • R1)) + ((Complex.I • R1) * A * X) + ((Complex.I • R1) * A * (-Complex.I • R1)) := by + rw [show (star V : L (HSum ℋ)) = (U : L (HSum ℋ)) by simp [V], hU_block, hV_block] + simpa [Atilde, mul_assoc] using + (blockOp_mul_blockDiagonal_zero_right (ℋ := ℋ) + (Complex.I • R0) (star X) X (Complex.I • R1) A + (-Complex.I • R0) (star X) X (-Complex.I • R1)) + have hmid_block : + (1 / 2 : ℝ) • ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ)) ) + + (1 / 2 : ℝ) • ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ))) = + blockDiagonal (ℋ := ℋ) (star X * A * X) (R1 * A * R1) := by + rw [hB1_block, hB2_block] + rw [blockOp_smulR, blockOp_smulR, blockOp_add, blockDiagonal_eq_blockOp] + congr 1 + · have hhalf : (2⁻¹ + 2⁻¹ : ℝ) = (1 : ℝ) := by norm_num + calc + (1 / 2 : ℝ) • (star X * A * X) + (1 / 2 : ℝ) • (star X * A * X) + = (2⁻¹ + 2⁻¹ : ℝ) • (star X * (A * X)) := by + simp [add_smul, mul_assoc] + _ = (1 : ℝ) • (star X * (A * X)) := by rw [hhalf] + _ = star X * (A * X) := by simp + _ = star X * A * X := by simp [mul_assoc] + · simp [mul_assoc] + · simp [mul_assoc] + · have hhalf : (2⁻¹ + 2⁻¹ : ℝ) = (1 : ℝ) := by norm_num + calc + (1 / 2 : ℝ) • (-Complex.I • R1 * A * (Complex.I • R1)) + + (1 / 2 : ℝ) • (Complex.I • R1 * A * (-Complex.I • R1)) + = (2⁻¹ + 2⁻¹ : ℝ) • (R1 * (A * R1)) := by + simp [Complex.I_mul_I, smul_smul, add_smul, mul_assoc] + _ = (1 : ℝ) • (R1 * (A * R1)) := by rw [hhalf] + _ = R1 * A * R1 := by simp [mul_assoc] + have hAtilde_sa : IsSelfAdjoint Atilde := by + simpa [Atilde] using blockDiagonal_selfAdjoint (ℋ := ℋ) (hA := by simp) hA + have hAtilde0 : (0 : L (HSum ℋ)) ≤ Atilde := by + simpa [Atilde] using blockDiagonal_nonneg (ℋ := ℋ) (show (0 : L ℋ) ≤ 0 by simp) hA0 + have hAtilde_spec : spectrum ℝ Atilde ⊆ Set.Ici (0 : ℝ) := spectrum_Ici_of_nonneg hAtilde0 + have hB1_nonneg : (0 : L (HSum ℋ)) ≤ (star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ)) := by + simpa [mul_assoc] using star_left_conjugate_nonneg hAtilde0 (U : L (HSum ℋ)) + have hB2_nonneg : (0 : L (HSum ℋ)) ≤ (star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)) := by + simpa [mul_assoc] using star_left_conjugate_nonneg hAtilde0 (V : L (HSum ℋ)) + have hB1_sa : IsSelfAdjoint ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) := + IsSelfAdjoint.of_nonneg hB1_nonneg + have hB2_sa : IsSelfAdjoint ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ))) := + IsSelfAdjoint.of_nonneg hB2_nonneg + have hB1_spec : spectrum ℝ (star U * Atilde * (U : L (HSum ℋ))) ⊆ Set.Ici (0 : ℝ) := + spectrum_Ici_of_nonneg (ℋ := HSum ℋ) hB1_nonneg + have hB2_spec : spectrum ℝ (star V * Atilde * (V : L (HSum ℋ))) ⊆ Set.Ici (0 : ℝ) := + spectrum_Ici_of_nonneg (ℋ := HSum ℋ) hB2_nonneg + have hmid_conv : + cfcR (ℋ := HSum ℋ) f + ((1 / 2 : ℝ) • ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) + + (1 / 2 : ℝ) • ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)))) ≤ + ((1 / 2 : ℝ) • cfcR (ℋ := HSum ℋ) f ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) + + (1 / 2 : ℝ) • cfcR (ℋ := HSum ℋ) f ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)))) := by + have hhalf : (1 - (2⁻¹ : ℝ)) = (2⁻¹ : ℝ) := by norm_num + simpa [hhalf] using + (hconv₂ + (A := (star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) + (B := (star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ))) + (t := (1 / 2 : ℝ)) + hB1_sa hB2_sa (by positivity) (by norm_num) hB1_spec hB2_spec) + have hAtilde_cfc : + cfcR (ℋ := HSum ℋ) f Atilde = + blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f 0) (cfcR (ℋ := ℋ) f A) := by + simpa [Atilde] using + (cfcR_blockDiagonal (ℋ := ℋ) (f := f) (A := 0) (B := A) (by simp) hA + (continuousOn_union_of_subset_Ici (f := f) hcontIci + (s := spectrum ℝ (0 : L ℋ)) (t := spectrum ℝ A) + spectrum_zero_subset_Ici hAs)) + have hUcfc : + cfcR (ℋ := HSum ℋ) f ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ)) ) = + (star U : L (HSum ℋ)) * cfcR (ℋ := HSum ℋ) f Atilde * (U : L (HSum ℋ)) := by + simpa [mul_assoc] using + cfcR_conj_unitary_on (ℋ := HSum ℋ) (s := Set.Ici (0 : ℝ)) (f := f) hcontIci + hAtilde_spec U hAtilde_sa + have hVcfc : + cfcR (ℋ := HSum ℋ) f ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)) ) = + (star V : L (HSum ℋ)) * cfcR (ℋ := HSum ℋ) f Atilde * (V : L (HSum ℋ)) := by + simpa [mul_assoc] using + cfcR_conj_unitary_on (ℋ := HSum ℋ) (s := Set.Ici (0 : ℝ)) (f := f) hcontIci + hAtilde_spec V hAtilde_sa + have hLeftEval : + cfcR (ℋ := HSum ℋ) f + ((1 / 2 : ℝ) • ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) + + (1 / 2 : ℝ) • ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)))) = + blockDiagonal (cfcR f (star X * A * X)) (cfcR (ℋ := ℋ) f (R1 * A * R1)) := by + have hXAX_nonneg : (0 : L ℋ) ≤ star X * A * X := by + simpa [mul_assoc] using star_left_conjugate_nonneg hA0 X + have hR1AR1_nonneg : (0 : L ℋ) ≤ R1 * A * R1 := by + simpa [hR1self.star_eq, mul_assoc] using star_right_conjugate_nonneg hA0 R1 + have hXAX_sa : IsSelfAdjoint (star X * A * X) := IsSelfAdjoint.of_nonneg hXAX_nonneg + have hR1AR1_sa : IsSelfAdjoint (R1 * A * R1) := IsSelfAdjoint.of_nonneg hR1AR1_nonneg + have hXAX_spec : spectrum ℝ (star X * A * X) ⊆ Set.Ici (0 : ℝ) := + spectrum_Ici_of_nonneg (ℋ := ℋ) hXAX_nonneg + have hR1AR1_spec : spectrum ℝ (R1 * A * R1) ⊆ Set.Ici (0 : ℝ) := + spectrum_Ici_of_nonneg (ℋ := ℋ) hR1AR1_nonneg + rw [hmid_block] + refine cfcR_blockDiagonal (ℋ := ℋ) (f := f) (A := star X * A * X) (B := R1 * A * R1) + hXAX_sa hR1AR1_sa ?_ + exact continuousOn_union_of_subset_Ici (f := f) hcontIci hXAX_spec hR1AR1_spec + have hRightEval : + ((1 / 2 : ℝ) • cfcR (ℋ := HSum ℋ) f ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) + + (1 / 2 : ℝ) • cfcR (ℋ := HSum ℋ) f ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)))) = + blockDiagonal (ℋ := ℋ) + (star X * cfcR (ℋ := ℋ) f A * X + (f 0) • (R0 * R0)) + ((R1 * cfcR (ℋ := ℋ) f A * R1) + (f 0) • (X * star X)) := by + rw [hUcfc, hVcfc, hAtilde_cfc, cfcR_zero] + rw [hU_block, hV_block, blockDiagonal_eq_blockOp] + rw [blockOp_star, blockOp_star] + simp_rw [mul_assoc] + rw [blockOp_mul, blockOp_mul, blockOp_mul, blockOp_mul] + rw [blockOp_smulR, blockOp_smulR, blockOp_add, blockDiagonal_eq_blockOp] + have hTopLeft : + (2⁻¹ : ℝ) • (star X * (cfcR (ℋ := ℋ) f A * X)) + + ((2⁻¹ : ℝ) • (star X * (cfcR (ℋ := ℋ) f A * X)) + + (-((2⁻¹ : ℝ) • Complex.I • f 0 • Complex.I • (R0 * R0)) + + -((2⁻¹ : ℝ) • Complex.I • f 0 • Complex.I • (R0 * R0)))) = + star X * (cfcR (ℋ := ℋ) f A * X) + (f 0) • (R0 * R0) := by + simpa using + rightEval_topLeft_scalar (ℋ := ℋ) (r := f 0) (R0 := R0) (X := X) + (T := cfcR (ℋ := ℋ) f A) + have hBottomRight : + (2⁻¹ * f 0) • (X * star X) + + ((2⁻¹ * f 0) • (X * star X) + + ((2⁻¹ : ℝ) • (R1 * (cfcR (ℋ := ℋ) f A * R1)) + + (2⁻¹ : ℝ) • (R1 * (cfcR (ℋ := ℋ) f A * R1)))) = + (R1 * cfcR (ℋ := ℋ) f A * R1) + (f 0) • (X * star X) := by + simpa [mul_assoc] using + rightEval_bottomRight_scalar (ℋ := ℋ) (r := f 0) (R1 := R1) (X := X) + (T := cfcR (ℋ := ℋ) f A) + congr 1 + · simpa [hR0self.star_eq, Algebra.algebraMap_eq_smul_one, mul_assoc, + add_assoc, add_left_comm, add_comm] using hTopLeft + · simp [Algebra.algebraMap_eq_smul_one] + abel + · simp [Algebra.algebraMap_eq_smul_one] + abel + · simpa [hR1self.star_eq, Algebra.algebraMap_eq_smul_one, Complex.I_mul_I, smul_smul, + mul_assoc, add_assoc, add_left_comm, add_comm] using hBottomRight + have hcore : + blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f (star X * A * X)) (cfcR (ℋ := ℋ) f (R1 * A * R1)) ≤ + blockDiagonal (ℋ := ℋ) + (star X * cfcR (ℋ := ℋ) f A * X + (f 0) • (R0 * R0)) + ((R1 * cfcR (ℋ := ℋ) f A * R1) + (f 0) • (X * star X)) := by + rw [hLeftEval, hRightEval] at hmid_conv + exact hmid_conv + have hterm_nonpos : (f 0) • (R0 * R0) ≤ (0 : L ℋ) := by + have hR0sq_nonneg : (0 : L ℋ) ≤ R0 * R0 := by + simpa [hR0self.star_eq] using star_mul_self_nonneg R0 + have hneg : (0 : L ℋ) ≤ (- (f 0)) • (R0 * R0) := by + exact smul_nonneg (by linarith [hf0]) hR0sq_nonneg + exact (neg_nonneg.mp (by simpa [neg_smul] using hneg)) + have htop : + cfcR (ℋ := ℋ) f (star X * A * X) ≤ star X * cfcR (ℋ := ℋ) f A * X + (f 0) • (R0 * R0) := by + exact blockDiagonal_le_left (ℋ := ℋ) hcore + have hdrop : + star X * cfcR (ℋ := ℋ) f A * X + (f 0) • (R0 * R0) ≤ star X * cfcR (ℋ := ℋ) f A * X := by + simpa [add_comm, add_left_comm, add_assoc] using + add_le_add_left hterm_nonpos (star X * cfcR (ℋ := ℋ) f A * X) + exact htop.trans hdrop + +set_option maxHeartbeats 2000000 in +-- The global proof repeats the same block-matrix normalization and unitary conjugation pattern. +theorem theorem_2_5_2_i_all_imp_iv {f : ℝ → ℝ} (hf : CondIAll.{u} f) : + CondIV (ℋ := ℋ) f := by + rcases hf with ⟨hconvAll, hf0⟩ + intro A X hA hAs hX + have hconv : OperatorConvex (ℋ := ℋ) f := hconvAll (K := ℋ) + let S : L (HSum ℋ) := blockSwap (ℋ := ℋ) X + have hSsa : IsSelfAdjoint S := by + change star S = S + simpa [S] using blockSwap_star (ℋ := ℋ) X + have hSnorm : ‖S‖ ≤ 1 := by + simpa [S] using blockSwap_norm_le_one (ℋ := ℋ) X hX + letI : Algebra ℝ (L (HSum ℋ)) := by + infer_instance + have hU_mem : S + Complex.I • CFC.sqrt (1 - S ^ 2) ∈ unitary (L (HSum ℋ)) := by + exact IsSelfAdjoint.self_add_I_smul_cfcSqrt_sub_sq_mem_unitary S hSsa hSnorm + let U : unitary (L (HSum ℋ)) := + ⟨S + Complex.I • CFC.sqrt (1 - S ^ 2), hU_mem⟩ + let V : unitary (L (HSum ℋ)) := star U + let Atilde : L (HSum ℋ) := blockDiagonal (ℋ := ℋ) 0 A + letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL (ℋ := ℋ) + have hconv₂ : OperatorConvex (ℋ := HSum ℋ) f := hconvAll (K := HSum ℋ) + have hcont₂ : ContinuousOn f Set.univ := + operatorConvex_continuousOn_univ (ℋ := HSum ℋ) hconv₂ + have hR0nonneg : (0 : L ℋ) ≤ 1 - star X * X := sub_nonneg.mpr (star_mul_le_one (ℋ := ℋ) X hX) + have hR1nonneg : (0 : L ℋ) ≤ 1 - X * star X := sub_nonneg.mpr (mul_star_le_one (ℋ := ℋ) X hX) + let R0 : L ℋ := CFC.sqrt (1 - star X * X) + let R1 : L ℋ := CFC.sqrt (1 - X * star X) + have hR0sa : IsSelfAdjoint (1 - star X * X) := by + change star (1 - star X * X) = 1 - star X * X + simp + have hR1sa : IsSelfAdjoint (1 - X * star X) := by + change star (1 - X * star X) = 1 - X * star X + simp + have hSsq : S ^ 2 = blockDiagonal (ℋ := ℋ) (star X * X) (X * star X) := by + simpa [pow_two, S] using blockSwap_sq (ℋ := ℋ) X + have hOneMinusSq : + 1 - S ^ 2 = blockDiagonal (ℋ := ℋ) (1 - star X * X) (1 - X * star X) := by + rw [hSsq] + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [sub_eq_add_neg, add_comm] + · intro z + simp [sub_eq_add_neg, add_comm] + have hOneMinusSqNonneg : (0 : L (HSum ℋ)) ≤ 1 - S ^ 2 := by + have hdiag : (0 : L (HSum ℋ)) ≤ + blockDiagonal (ℋ := ℋ) (1 - star X * X) (1 - X * star X) := + blockDiagonal_nonneg (ℋ := ℋ) hR0nonneg hR1nonneg + simpa [hOneMinusSq] using hdiag + have hRblock : CFC.sqrt (1 - S ^ 2) = blockDiagonal (ℋ := ℋ) R0 R1 := by + rw [hOneMinusSq] + simp [R0, R1] + simpa using + (sqrt_blockDiagonal_of_nonneg (ℋ := ℋ) (A := 1 - star X * X) (B := 1 - X * star X) + hR0sa hR1sa hR0nonneg hR1nonneg) + have hR0self : IsSelfAdjoint R0 := by + have h : IsSelfAdjoint (CFC.sqrt (1 - star X * X)) := + (CFC.sqrt_nonneg (1 - star X * X)).isSelfAdjoint + simpa [R0] using h + have hR1self : IsSelfAdjoint R1 := by + have h : IsSelfAdjoint (CFC.sqrt (1 - X * star X)) := + (CFC.sqrt_nonneg (1 - X * star X)).isSelfAdjoint + simpa [R1] using h + have hU_block : + (U : L (HSum ℋ)) = blockOp (ℋ := ℋ) (Complex.I • R0) (star X) X (Complex.I • R1) := by + change S + Complex.I • CFC.sqrt (1 - S ^ 2) = _ + rw [hRblock] + simpa [S] using blockSwap_add_I_smul_blockDiagonal (ℋ := ℋ) X R0 R1 + have hV_block : + (V : L (HSum ℋ)) = blockOp (ℋ := ℋ) (-Complex.I • R0) (star X) X (-Complex.I • R1) := by + change star (U : L (HSum ℋ)) = _ + rw [hU_block] + ext z i + fin_cases i <;> + simp [blockOp_star, hR0self.star_eq, hR1self.star_eq] + have hB1_block : + (star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ)) = + blockOp (ℋ := ℋ) + (star X * A * X) + (star X * A * (Complex.I • R1)) + ((-Complex.I • R1) * A * X) + ((-Complex.I • R1) * A * (Complex.I • R1)) := by + rw [show (star U : L (HSum ℋ)) = (V : L (HSum ℋ)) by rfl, hV_block, hU_block] + simpa [Atilde, mul_assoc] using + (blockOp_mul_blockDiagonal_zero_right (ℋ := ℋ) + (-Complex.I • R0) (star X) X (-Complex.I • R1) A + (Complex.I • R0) (star X) X (Complex.I • R1)) + have hB2_block : + (star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)) = + blockOp (ℋ := ℋ) + (star X * A * X) + (star X * A * (-Complex.I • R1)) + ((Complex.I • R1) * A * X) + ((Complex.I • R1) * A * (-Complex.I • R1)) := by + rw [show (star V : L (HSum ℋ)) = (U : L (HSum ℋ)) by simp [V], hU_block, hV_block] + simpa [Atilde, mul_assoc] using + (blockOp_mul_blockDiagonal_zero_right (ℋ := ℋ) + (Complex.I • R0) (star X) X (Complex.I • R1) A + (-Complex.I • R0) (star X) X (-Complex.I • R1)) + have hmid_block : + (1 / 2 : ℝ) • ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ)) ) + + (1 / 2 : ℝ) • ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ))) = + blockDiagonal (ℋ := ℋ) (star X * A * X) (R1 * A * R1) := by + rw [hB1_block, hB2_block] + rw [blockOp_smulR, blockOp_smulR, blockOp_add, blockDiagonal_eq_blockOp] + congr 1 + · have hhalf : (2⁻¹ + 2⁻¹ : ℝ) = (1 : ℝ) := by norm_num + calc + (1 / 2 : ℝ) • (star X * A * X) + (1 / 2 : ℝ) • (star X * A * X) + = (2⁻¹ + 2⁻¹ : ℝ) • (star X * (A * X)) := by + simp [add_smul, mul_assoc] + _ = (1 : ℝ) • (star X * (A * X)) := by rw [hhalf] + _ = star X * (A * X) := by simp + _ = star X * A * X := by simp [mul_assoc] + · simp [mul_assoc] + · simp [mul_assoc] + · have hhalf : (2⁻¹ + 2⁻¹ : ℝ) = (1 : ℝ) := by norm_num + calc + (1 / 2 : ℝ) • (-Complex.I • R1 * A * (Complex.I • R1)) + + (1 / 2 : ℝ) • (Complex.I • R1 * A * (-Complex.I • R1)) + = (2⁻¹ + 2⁻¹ : ℝ) • (R1 * (A * R1)) := by + simp [Complex.I_mul_I, smul_smul, add_smul, mul_assoc] + _ = (1 : ℝ) • (R1 * (A * R1)) := by rw [hhalf] + _ = R1 * A * R1 := by simp [mul_assoc] + have hmid_conv : + cfcR (ℋ := HSum ℋ) f + ((1 / 2 : ℝ) • ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) + + (1 / 2 : ℝ) • ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)))) ≤ + ((1 / 2 : ℝ) • cfcR f ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) + + (1 / 2 : ℝ) • cfcR f ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)))) := by + have hhalf : (1 - (2⁻¹ : ℝ)) = (2⁻¹ : ℝ) := by norm_num + simpa [hhalf] using + (hconv₂ + (A := (star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) + (B := (star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ))) + (t := (1 / 2 : ℝ)) + (by positivity) (by norm_num)) + have hAtilde_sa : IsSelfAdjoint Atilde := by + simpa [Atilde] using blockDiagonal_selfAdjoint (ℋ := ℋ) (hA := by simp) hA + have hAtilde_cfc : + cfcR (ℋ := HSum ℋ) f Atilde = + blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f 0) (cfcR (ℋ := ℋ) f A) := by + simpa [Atilde] using + (cfcR_blockDiagonal (ℋ := ℋ) (f := f) (A := 0) (B := A) (by simp) hA + ((operatorConvex_continuousOn_univ (ℋ := ℋ) hconv).mono (by intro x hx; simp))) + have hUcfc : + cfcR (ℋ := HSum ℋ) f ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ)) ) = + (star U : L (HSum ℋ)) * cfcR (ℋ := HSum ℋ) f Atilde * (U : L (HSum ℋ)) := by + simpa [mul_assoc] using cfcR_conj_unitary (ℋ := HSum ℋ) f hcont₂ U Atilde hAtilde_sa + have hVcfc : + cfcR (ℋ := HSum ℋ) f ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)) ) = + (star V : L (HSum ℋ)) * cfcR (ℋ := HSum ℋ) f Atilde * (V : L (HSum ℋ)) := by + simpa [mul_assoc] using cfcR_conj_unitary (ℋ := HSum ℋ) f hcont₂ V Atilde hAtilde_sa + have hLeftEval : + cfcR (ℋ := HSum ℋ) f + ((1 / 2 : ℝ) • ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) + + (1 / 2 : ℝ) • ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)))) = + blockDiagonal (cfcR f (star X * A * X)) (cfcR f (R1 * A * R1)) := by + have hXAX_sa : IsSelfAdjoint (star X * A * X) := by + change star (star X * A * X) = star X * A * X + simp [hA.star_eq, mul_assoc] + have hR1AR1_sa : IsSelfAdjoint (R1 * A * R1) := by + change star (R1 * A * R1) = R1 * A * R1 + simp [hR1self.star_eq, hA.star_eq, mul_assoc] + rw [hmid_block] + refine cfcR_blockDiagonal (f := f) (A := star X * A * X) (B := R1 * A * R1) hXAX_sa hR1AR1_sa ?_ + · exact (operatorConvex_continuousOn_univ (ℋ := ℋ) hconv).mono (by intro x hx; simp) + have hRightEval : + ((1 / 2 : ℝ) • cfcR (ℋ := HSum ℋ) f ((star U : L (HSum ℋ)) * Atilde * (U : L (HSum ℋ))) + + (1 / 2 : ℝ) • cfcR (ℋ := HSum ℋ) f ((star V : L (HSum ℋ)) * Atilde * (V : L (HSum ℋ)))) = + blockDiagonal (ℋ := ℋ) + (star X * cfcR (ℋ := ℋ) f A * X + (f 0) • (R0 * R0)) + ((R1 * cfcR (ℋ := ℋ) f A * R1) + (f 0) • (X * star X)) := by + rw [hUcfc, hVcfc, hAtilde_cfc, cfcR_zero] + rw [hU_block, hV_block, blockDiagonal_eq_blockOp] + rw [blockOp_star, blockOp_star] + simp_rw [mul_assoc] + rw [blockOp_mul, blockOp_mul, blockOp_mul, blockOp_mul] + rw [blockOp_smulR, blockOp_smulR, blockOp_add, blockDiagonal_eq_blockOp] + have hTopLeft : + (2⁻¹ : ℝ) • (star X * (cfcR (ℋ := ℋ) f A * X)) + + ((2⁻¹ : ℝ) • (star X * (cfcR (ℋ := ℋ) f A * X)) + + (-((2⁻¹ : ℝ) • Complex.I • f 0 • Complex.I • (R0 * R0)) + + -((2⁻¹ : ℝ) • Complex.I • f 0 • Complex.I • (R0 * R0)))) = + star X * (cfcR (ℋ := ℋ) f A * X) + (f 0) • (R0 * R0) := by + simpa using + rightEval_topLeft_scalar (ℋ := ℋ) (r := f 0) (R0 := R0) (X := X) + (T := cfcR (ℋ := ℋ) f A) + have hBottomRight : + (2⁻¹ * f 0) • (X * star X) + + ((2⁻¹ * f 0) • (X * star X) + + ((2⁻¹ : ℝ) • (R1 * (cfcR (ℋ := ℋ) f A * R1)) + + (2⁻¹ : ℝ) • (R1 * (cfcR (ℋ := ℋ) f A * R1)))) = + (R1 * cfcR (ℋ := ℋ) f A * R1) + (f 0) • (X * star X) := by + simpa [mul_assoc] using + rightEval_bottomRight_scalar (ℋ := ℋ) (r := f 0) (R1 := R1) (X := X) + (T := cfcR (ℋ := ℋ) f A) + congr 1 + · simpa [hR0self.star_eq, Algebra.algebraMap_eq_smul_one, mul_assoc, + add_assoc, add_left_comm, add_comm] using hTopLeft + · simp [Algebra.algebraMap_eq_smul_one] + abel + · simp [Algebra.algebraMap_eq_smul_one] + abel + · simpa [hR1self.star_eq, Algebra.algebraMap_eq_smul_one, Complex.I_mul_I, smul_smul, + mul_assoc, add_assoc, add_left_comm, add_comm] using hBottomRight + have hcore : + blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f (star X * A * X)) (cfcR (ℋ := ℋ) f (R1 * A * R1)) ≤ + blockDiagonal (ℋ := ℋ) + (star X * cfcR (ℋ := ℋ) f A * X + (f 0) • (R0 * R0)) + ((R1 * cfcR (ℋ := ℋ) f A * R1) + (f 0) • (X * star X)) := by + rw [hLeftEval, hRightEval] at hmid_conv + exact hmid_conv + have hterm_nonpos : (f 0) • (R0 * R0) ≤ (0 : L ℋ) := by + have hR0sq_nonneg : (0 : L ℋ) ≤ R0 * R0 := by + simpa [hR0self.star_eq] using star_mul_self_nonneg R0 + have hneg : (0 : L ℋ) ≤ (- (f 0)) • (R0 * R0) := by + exact smul_nonneg (by linarith [hf0]) hR0sq_nonneg + exact (neg_nonneg.mp (by simpa [neg_smul] using hneg)) + have htop : + cfcR (ℋ := ℋ) f (star X * A * X) ≤ star X * cfcR (ℋ := ℋ) f A * X + (f 0) • (R0 * R0) := by + exact blockDiagonal_le_left (ℋ := ℋ) hcore + have hdrop : + star X * cfcR (ℋ := ℋ) f A * X + (f 0) • (R0 * R0) ≤ star X * cfcR (ℋ := ℋ) f A * X := by + simpa [add_comm, add_left_comm, add_assoc] using + add_le_add_left hterm_nonpos (star X * cfcR f A * X) + exact htop.trans hdrop + +end Theorem252 + +end JensenOperatorInequality diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequalityIVtoV.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequalityIVtoV.lean new file mode 100644 index 000000000..d2a205392 --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequalityIVtoV.lean @@ -0,0 +1,288 @@ +/- +Copyright (c) 2026 Hayata Yamasaki. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kei Tsukamoto, Kento Mori, Hayata Yamasaki +-/ +module + +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.BlockDiagonal +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.LownerHeinzTheorem +public import Mathlib.Analysis.CStarAlgebra.Unitary.Span + +@[expose] public section + +namespace JensenOperatorInequalityScratch + +universe u + +open LownerHeinzTheorem +open JensenOperatorInequality + +section Theorem252 + +variable {ℋ : Type u} +variable [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] +variable [Nontrivial ℋ] + +set_option synthInstance.maxHeartbeats 400000 in +noncomputable local instance : ContinuousFunctionalCalculus ℂ (L ℋ × L ℋ) IsStarNormal := + IsStarNormal.instContinuousFunctionalCalculus +set_option synthInstance.maxHeartbeats 400000 in +noncomputable local instance : ContinuousFunctionalCalculus ℝ (L ℋ × L ℋ) IsSelfAdjoint := + IsSelfAdjoint.instContinuousFunctionalCalculus +set_option synthInstance.maxHeartbeats 400000 in +noncomputable local instance : NonnegSpectrumClass ℝ (L (HSum ℋ)) := inferInstance + +/-- Local copy of condition (iv) for fast iteration on `(iv) → (v)`. -/ +def CondIV (f : ℝ → ℝ) : Prop := + ∀ ⦃A X : L ℋ⦄, IsSelfAdjoint A → spectrum ℝ A ⊆ Set.Ici (0 : ℝ) → ‖X‖ ≤ 1 → + cfcR (ℋ := ℋ) f (star X * A * X) ≤ star X * cfcR (ℋ := ℋ) f A * X + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] [Nontrivial ℋ] in +/-- +Uniform version of Condition (iv), with the Hilbert space arbitrary in the same universe. +This scratch copy follows the same `...All` naming convention as the main Jensen file. +-/ +def CondIVAll (f : ℝ → ℝ) : Prop := + ∀ {K : Type u} + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + [Nontrivial K], + CondIV (ℋ := K) f + +/-- Local copy of condition (v) for fast iteration on `(iv) → (v)`. -/ +def CondV (f : ℝ → ℝ) : Prop := + ∀ ⦃A B X Y : L ℋ⦄, + IsSelfAdjoint A → IsSelfAdjoint B → + spectrum ℝ A ⊆ Set.Ici (0 : ℝ) → spectrum ℝ B ⊆ Set.Ici (0 : ℝ) → + star X * X + star Y * Y ≤ (1 : L ℋ) → + cfcR (ℋ := ℋ) f (star X * A * X + star Y * B * Y) ≤ + star X * cfcR (ℋ := ℋ) f A * X + star Y * cfcR (ℋ := ℋ) f B * Y + +/-- `L (HSum ℋ)` is nontrivial once `L ℋ` is. -/ +private theorem nontrivial_hsumL : Nontrivial (L (HSum ℋ)) := by + have h_not_sub : ¬ Subsingleton ℋ := by + intro hsub + letI : Subsingleton ℋ := hsub + letI : Subsingleton (L ℋ) := by infer_instance + exact (not_nontrivial_iff_subsingleton.mpr (by infer_instance)) + (inferInstance : Nontrivial (L ℋ)) + have hH_nontriv : Nontrivial ℋ := (not_subsingleton_iff_nontrivial.mp h_not_sub) + letI : Nontrivial ℋ := hH_nontriv + rcases exists_pair_ne ℋ with ⟨x, y, hxy⟩ + let w : ℋ := x - y + have hw : w ≠ 0 := sub_ne_zero.mpr hxy + have hdiag_ne_zero : (blockDiagonal (ℋ := ℋ) (1 : L ℋ) 0 : L (HSum ℋ)) ≠ 0 := by + intro h0 + have hz : + blockDiagonal (ℋ := ℋ) (1 : L ℋ) 0 (hsumIncl ℋ 0 w) = 0 := by + simp [h0] + have hw0 : w = 0 := by + have hz0 := congrArg (fun z : HSum ℋ => hsumProj ℋ 0 z) hz + simpa [blockDiagonal] using hz0 + exact hw hw0 + exact ⟨0, blockDiagonal (ℋ := ℋ) (1 : L ℋ) 0, hdiag_ne_zero.symm⟩ + +omit [Nontrivial ℋ] in +private lemma blockDiagonal_selfAdjoint {A B : L ℋ} + (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) : + IsSelfAdjoint (blockDiagonal (ℋ := ℋ) A B) := by + change star (blockDiagonal (ℋ := ℋ) A B) = blockDiagonal (ℋ := ℋ) A B + simp [blockDiagonal_star, hA.star_eq, hB.star_eq] + +omit [Nontrivial ℋ] in +private lemma blockDiagonal_eq_blockOp (A B : L ℋ) : + blockDiagonal (ℋ := ℋ) A B = blockOp (ℋ := ℋ) A 0 0 B := by + ext z i + fin_cases i <;> simp [blockDiagonal, blockOp] + +-- Multiplication of generic block operators is elaboration-heavy even in the scratch file. +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +set_option maxHeartbeats 400000 in +-- The generic `blockOp` product expands into large block normal forms. +private lemma blockOp_mul (A00 A01 A10 A11 B00 B01 B10 B11 : L ℋ) : + blockOp (ℋ := ℋ) A00 A01 A10 A11 * blockOp (ℋ := ℋ) B00 B01 B10 B11 = + blockOp (ℋ := ℋ) + (A00 * B00 + A01 * B10) + (A00 * B01 + A01 * B11) + (A10 * B00 + A11 * B10) + (A10 * B01 + A11 * B11) := by + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [ContinuousLinearMap.mul_def, add_left_comm, add_comm] + · intro z + simp [ContinuousLinearMap.mul_def, add_left_comm, add_comm] + +set_option synthInstance.maxHeartbeats 400000 in +set_option maxHeartbeats 800000 in +omit [Nontrivial ℋ] in +private lemma cfcR_blockDiagonal (f : ℝ → ℝ) + (A B : L ℋ) (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) + (hcont : ContinuousOn f (spectrum ℝ A ∪ spectrum ℝ B)) : + cfcR (ℋ := HSum ℋ) f (blockDiagonal (ℋ := ℋ) A B) = + blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f A) (cfcR (ℋ := ℋ) f B) := by + let φ : (L ℋ × L ℋ) →⋆ₐ[ℝ] L (HSum ℋ) := blockDiagonalHom (ℋ := ℋ) + have hφ : Continuous φ := by + change Continuous (fun p : L ℋ × L ℋ => blockDiagonal (ℋ := ℋ) p.1 p.2) + change Continuous (fun p : L ℋ × L ℋ => + hsumIncl ℋ 0 ∘L p.1 ∘L hsumProj ℋ 0 + hsumIncl ℋ 1 ∘L p.2 ∘L hsumProj ℋ 1) + fun_prop + have hpair : IsSelfAdjoint (A, B) := by + change star (A, B) = (A, B) + ext <;> simp [hA.star_eq, hB.star_eq] + have hpair' : IsSelfAdjoint (φ (A, B)) := hpair.map φ + have hmap := StarAlgHom.map_cfc (φ := φ) (f := f) (a := (A, B)) + (hf := by simpa [Prod.spectrum_eq] using hcont) + (hφ := hφ) (ha := hpair) (hφa := hpair') + have hprod : + cfc (R := ℝ) (A := L ℋ × L ℋ) (p := IsSelfAdjoint) f (A, B) = + (cfcR (ℋ := ℋ) f A, cfcR (ℋ := ℋ) f B) := by + simpa [cfcR] using + (cfc_map_prod (R := ℝ) (S := ℝ) + (A := L ℋ) (B := L ℋ) + (pab := IsSelfAdjoint) (pa := IsSelfAdjoint) (pb := IsSelfAdjoint) + f A B + (hf := hcont) + (hab := hpair) (ha := hA) (hb := hB)) + calc + cfcR (ℋ := HSum ℋ) f (blockDiagonal (ℋ := ℋ) A B) + = cfc (R := ℝ) (A := L (HSum ℋ)) (p := IsSelfAdjoint) f (φ (A, B)) := by + simp [cfcR, φ] + _ = φ (cfc (R := ℝ) (A := L ℋ × L ℋ) (p := IsSelfAdjoint) f (A, B)) := by + simpa using hmap.symm + _ = φ (cfcR (ℋ := ℋ) f A, cfcR (ℋ := ℋ) f B) := by + rw [hprod] + _ = blockDiagonal (ℋ := ℋ) (cfcR (ℋ := ℋ) f A) (cfcR (ℋ := ℋ) f B) := by + simp [φ, blockDiagonalHom] + +omit [Nontrivial ℋ] in +private lemma blockDiagonal_le_left {A0 A1 B0 B1 : L ℋ} + (h : blockDiagonal (ℋ := ℋ) A0 A1 ≤ blockDiagonal (ℋ := ℋ) B0 B1) : + A0 ≤ B0 := by + have hnonneg : 0 ≤ blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1) := by + have hsub : + blockDiagonal (ℋ := ℋ) B0 B1 - blockDiagonal (ℋ := ℋ) A0 A1 = + blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1) := by + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [sub_eq_add_neg] + · intro z + simp [sub_eq_add_neg] + exact hsub ▸ sub_nonneg.mpr h + have hpos : + (blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1)).IsPositive := + (ContinuousLinearMap.nonneg_iff_isPositive _).1 hnonneg + have hleftPos : (B0 - A0).IsPositive := by + rw [ContinuousLinearMap.isPositive_iff_complex] + intro x + have hx := + (ContinuousLinearMap.isPositive_iff_complex + (blockDiagonal (ℋ := ℋ) (B0 - A0) (B1 - A1))).1 hpos (hsumIncl ℋ 0 x) + simpa [blockDiagonal, hsumProj, hsumIncl, hsumEquiv, PiLp.inner_apply] using hx + exact sub_nonneg.mp ((ContinuousLinearMap.nonneg_iff_isPositive _).2 hleftPos) + +-- Scratch theorem for fast feedback while formalizing Theorem 2.5.2 `(iv) → (v)`. +-- This file intentionally avoids importing the heavy `(i) → (iv)` proof. +set_option synthInstance.maxHeartbeats 400000 in +set_option maxHeartbeats 3000000 in +-- The block-matrix reduction creates large normalization goals in this scratch file. +theorem theorem_2_5_2_iv_imp_v {f : ℝ → ℝ} (hiv : CondIVAll.{u} f) + (hcont : ContinuousOn f Set.univ) : + CondV (ℋ := ℋ) f := by + intro A B X Y hA hB hAs hBs hXY + have hA0 : (0 : L ℋ) ≤ A := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA)).2 ?_ + intro x hx + simpa [Set.Ici] using hAs hx + have hB0 : (0 : L ℋ) ≤ B := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B (ha := hB)).2 ?_ + intro x hx + simpa [Set.Ici] using hBs hx + let Atilde : L (HSum ℋ) := blockDiagonal (ℋ := ℋ) A B + let Xtilde : L (HSum ℋ) := blockOp (ℋ := ℋ) X 0 Y 0 + letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL (ℋ := ℋ) + have hAtilde_sa : IsSelfAdjoint Atilde := by + simpa [Atilde] using blockDiagonal_selfAdjoint (ℋ := ℋ) hA hB + have hAtilde0 : (0 : L (HSum ℋ)) ≤ Atilde := by + simpa [Atilde] using blockDiagonal_nonneg (ℋ := ℋ) hA0 hB0 + have hAtilde_spec : spectrum ℝ Atilde ⊆ Set.Ici (0 : ℝ) := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) Atilde (ha := hAtilde_sa)).1 hAtilde0 + have hXtilde_star_mul : + star Xtilde * Xtilde = + blockDiagonal (ℋ := ℋ) (star X * X + star Y * Y) 0 := by + rw [show star Xtilde = blockOp (ℋ := ℋ) (star X) (star Y) 0 0 by + simp [Xtilde]] + rw [show Xtilde = blockOp (ℋ := ℋ) X 0 Y 0 by rfl] + rw [blockOp_mul, blockDiagonal_eq_blockOp] + simp + have hXtilde_star_mul_le : star Xtilde * Xtilde ≤ (1 : L (HSum ℋ)) := by + have hblock_nonneg : + (0 : L (HSum ℋ)) ≤ + blockDiagonal (ℋ := ℋ) (1 - (star X * X + star Y * Y)) (1 : L ℋ) := by + refine blockDiagonal_nonneg (ℋ := ℋ) ?_ ?_ + · exact sub_nonneg.mpr hXY + · simp + have hsub : + (1 : L (HSum ℋ)) - blockDiagonal (ℋ := ℋ) (star X * X + star Y * Y) 0 = + blockDiagonal (ℋ := ℋ) (1 - (star X * X + star Y * Y)) (1 : L ℋ) := by + refine blockOp_ext (ℋ := ℋ) ?_ ?_ + · intro z + simp [sub_eq_add_neg] + · intro z + simp [sub_eq_add_neg] + have hblock : + blockDiagonal (ℋ := ℋ) (star X * X + star Y * Y) 0 ≤ (1 : L (HSum ℋ)) := by + exact sub_nonneg.mp (by simpa [hsub] using hblock_nonneg) + simpa [hXtilde_star_mul] using hblock + have hXtilde_star_mul_nonneg : (0 : L (HSum ℋ)) ≤ star Xtilde * Xtilde := by + simp + have hXtilde_norm : ‖Xtilde‖ ≤ 1 := by + have hnormSq : ‖star Xtilde * Xtilde‖ ≤ 1 := + (CStarAlgebra.norm_le_one_iff_of_nonneg _ hXtilde_star_mul_nonneg).2 hXtilde_star_mul_le + have hnormSq' : ‖Xtilde‖ * ‖Xtilde‖ ≤ 1 := by + simpa [CStarRing.norm_star_mul_self] using hnormSq + have hsq : ‖Xtilde‖ ^ 2 ≤ 1 := by + simpa [pow_two] using hnormSq' + nlinarith [norm_nonneg Xtilde] + have hiv_hsum : CondIV (ℋ := HSum ℋ) f := @hiv (HSum ℋ) _ _ _ _ + have hcore := hiv_hsum (A := Atilde) (X := Xtilde) hAtilde_sa hAtilde_spec hXtilde_norm + have hsum_sa : IsSelfAdjoint (star X * A * X + star Y * B * Y) := by + change star (star X * A * X + star Y * B * Y) = star X * A * X + star Y * B * Y + simp [hA.star_eq, hB.star_eq, mul_assoc] + have hmul_block : + star Xtilde * Atilde * Xtilde = + blockDiagonal (ℋ := ℋ) (star X * A * X + star Y * B * Y) 0 := by + rw [show star Xtilde = blockOp (ℋ := ℋ) (star X) (star Y) 0 0 by + simp [Xtilde]] + rw [show Atilde = blockOp (ℋ := ℋ) A 0 0 B by + simpa [Atilde] using blockDiagonal_eq_blockOp (ℋ := ℋ) A B] + rw [show Xtilde = blockOp (ℋ := ℋ) X 0 Y 0 by rfl] + rw [blockOp_mul, blockOp_mul, blockDiagonal_eq_blockOp] + congr 1 <;> simp [mul_assoc] + have hAtilde_cfc : + cfcR (ℋ := HSum ℋ) f Atilde = + blockDiagonal (cfcR (ℋ := ℋ) f A) (cfcR (ℋ := ℋ) f B) := by + simpa [Atilde] using + cfcR_blockDiagonal (ℋ := ℋ) (f := f) A B hA hB + (hcont.mono (by intro x hx; simp)) + have hright_block : + star Xtilde * cfcR (ℋ := HSum ℋ) f Atilde * Xtilde = + blockDiagonal (ℋ := ℋ) (star X * cfcR f A * X + star Y * cfcR f B * Y) 0 := by + rw [hAtilde_cfc] + rw [show star Xtilde = blockOp (ℋ := ℋ) (star X) (star Y) 0 0 by + simp [Xtilde]] + rw [show Xtilde = blockOp (ℋ := ℋ) X 0 Y 0 by rfl] + rw [blockDiagonal_eq_blockOp, blockOp_mul, blockOp_mul, blockDiagonal_eq_blockOp] + congr 1 <;> simp [mul_assoc] + have hleft_block : + cfcR (ℋ := HSum ℋ) f (star Xtilde * Atilde * Xtilde) = + blockDiagonal (cfcR f (star X * A * X + star Y * B * Y)) (cfcR f 0) := by + rw [hmul_block] + simpa using + cfcR_blockDiagonal (ℋ := ℋ) (f := f) (star X * A * X + star Y * B * Y) 0 hsum_sa (by simp) + (hcont.mono (by intro x hx; simp)) + rw [hleft_block, hright_block] at hcore + exact blockDiagonal_le_left (ℋ := ℋ) hcore + +end Theorem252 + +end JensenOperatorInequalityScratch diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LiebAndoTrace.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LiebAndoTrace.lean new file mode 100644 index 000000000..19253677e --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LiebAndoTrace.lean @@ -0,0 +1,1454 @@ +/- +Copyright (c) 2026 Hayata Yamasaki. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kei Tsukamoto, Kento Mori, Hayata Yamasaki +-/ +module + +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.OperatorGeometricMean +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.HilbertSchmidtOperatorSpace +public import Mathlib.Analysis.CStarAlgebra.Matrix +public import Mathlib.Analysis.InnerProductSpace.JointEigenspace +public import Mathlib.Analysis.Matrix.HermitianFunctionalCalculus +public import Mathlib.LinearAlgebra.Lagrange +public import Mathlib.LinearAlgebra.Trace + +@[expose] public section + +namespace LiebAndoTrace + +universe u + +open LownerHeinzTheorem +open GeneralizedPerspectiveFunction +open HilbertSchmidtOperatorSpace +open OperatorGeometricMean +open Module.End Polynomial + +variable {ℋ : Type u} +variable [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] +variable [FiniteDimensional ℂ ℋ] [Nontrivial ℋ] + +set_option synthInstance.maxHeartbeats 80000 in +noncomputable local instance : NonnegSpectrumClass ℝ ((L ℋ)ᵐᵒᵖ) := inferInstance + +set_option synthInstance.maxHeartbeats 80000 in +noncomputable local instance : + IsometricContinuousFunctionalCalculus ℂ ((L ℋ)ᵐᵒᵖ) IsStarNormal := inferInstance + +set_option backward.isDefEq.respectTransparency false in +set_option synthInstance.maxHeartbeats 80000 in +noncomputable instance instCFCRealSelfAdjointMop : + ContinuousFunctionalCalculus ℝ ((L ℋ)ᵐᵒᵖ) IsSelfAdjoint := inferInstance + +/-- The real part of the finite-dimensional trace on bounded operators. -/ +noncomputable def traceRe (T : L ℋ) : ℝ := + Complex.re (LinearMap.trace ℂ ℋ T.toLinearMap) + +/-- Trace functional appearing in Lieb's concavity theorem. -/ +noncomputable def liebTraceMap (s : ℝ) (K : L ℋ) (A B : L ℋ) : ℝ := + traceRe (ℋ := ℋ) (A ^ s * star K * B ^ (1 - s) * K) + +/-- Trace functional appearing in Lieb's extension theorem. -/ +noncomputable def liebExtensionTraceMap (q p : ℝ) (K : L ℋ) (A B : L ℋ) : ℝ := + traceRe (ℋ := ℋ) (A ^ q * star K * B ^ p * K) + +/-- Trace functional appearing in Corollary 1.3. -/ +noncomputable def liebCorollaryTraceMap (q r : ℝ) (K : L ℋ) (A B : L ℋ) : ℝ := + traceRe (ℋ := ℋ) (A ^ q * star K * B ^ (1 - r) * K) + +/-- Trace functional appearing in Ando's convexity theorem. -/ +noncomputable def andoTraceMap (q r : ℝ) (K : L ℋ) (A B : L ℋ) : ℝ := + traceRe (ℋ := ℋ) (A ^ q * star K * B ^ (-r) * K) + +omit [Nontrivial ℋ] in +private lemma rightMulHS_real_smul_one (r : ℝ) : + rightMulHS (ℋ := ℋ) (r • (1 : L ℋ)) = r • (1 : L (HSOp ℋ)) := by + ext T + change ofOp (toOp T * ((algebraMap ℝ (L ℋ)) r)) = + r • ofOp (toOp T * (1 : L ℋ)) + calc + ofOp (toOp T * ((algebraMap ℝ (L ℋ)) r)) + = ofOp (((algebraMap ℝ (L ℋ)) r * toOp T) * (1 : L ℋ)) := by + have hcomm := Algebra.commutes (R := ℝ) (A := L ℋ) r (toOp T) + simpa [mul_assoc] using congrArg (fun X => X * (1 : L ℋ)) hcomm.symm + _ = r • ofOp (toOp T) := by + delta HSOp + rfl + _ = r • ofOp (toOp T * (1 : L ℋ)) := by simp + +omit [Nontrivial ℋ] in +private lemma rightMulHS_nonneg {A : L ℋ} (hA0 : 0 ≤ A) : + 0 ≤ rightMulHS (ℋ := ℋ) A := by + let sqrtA : L ℋ := A ^ ((1 : ℝ) / 2) + have hsqrt_sq_pow : sqrtA ^ (2 : ℕ) = A := by + calc + sqrtA ^ (2 : ℕ) = sqrtA ^ (2 : ℝ) := by + simpa using (CFC.rpow_natCast sqrtA 2).symm + _ = A ^ (((1 : ℝ) / 2) * 2) := by + simpa [sqrtA] using + (CFC.rpow_rpow_of_exponent_nonneg A ((1 : ℝ) / 2) 2 + (by positivity) (by positivity) (ha := hA0)) + _ = A ^ (1 : ℝ) := by ring_nf + _ = A := by simpa using CFC.rpow_one A + have hsqrt_sq : sqrtA * sqrtA = A := by + simpa [pow_two] using hsqrt_sq_pow + have hsqrt_sa : IsSelfAdjoint sqrtA := IsSelfAdjoint.of_nonneg (by + simp [sqrtA]) + let S : L (HSOp ℋ) := rightMulHS (ℋ := ℋ) sqrtA + have hSstar : star S = S := by + change star (rightMulHS (ℋ := ℋ) sqrtA) = rightMulHS (ℋ := ℋ) sqrtA + simp [hsqrt_sa.star_eq] + have hSq : rightMulHS (ℋ := ℋ) A = star S * S := by + calc + rightMulHS (ℋ := ℋ) A = rightMulHS (ℋ := ℋ) (sqrtA * sqrtA) := by simp [hsqrt_sq] + _ = S * S := by simp [S] + _ = star S * S := by simp [hSstar] + simp [hSq] + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +private lemma rightMulHS_le_rightMulHS {A B : L ℋ} (hAB : A ≤ B) : + rightMulHS (ℋ := ℋ) A ≤ rightMulHS (ℋ := ℋ) B := by + have hnonneg : 0 ≤ rightMulHS (ℋ := ℋ) (B - A) := + rightMulHS_nonneg (ℋ := ℋ) (sub_nonneg.mpr hAB) + have hsub : + rightMulHS (ℋ := ℋ) B - rightMulHS (ℋ := ℋ) A = + rightMulHS (ℋ := ℋ) (B - A) := by + ext T + simpa [sub_eq_add_neg] using (mul_add (toOp T) B (-A)).symm + exact sub_nonneg.mp (by simpa [hsub] using hnonneg) + +private lemma rightMulHS_pdSet {A : L ℋ} (hA : A ∈ pdSet (ℋ := ℋ)) : + rightMulHS (ℋ := ℋ) A ∈ pdSet (ℋ := HSOp ℋ) := by + rcases hA with ⟨hA_sa, hA_spec⟩ + have hright_sa : IsSelfAdjoint (rightMulHS (ℋ := ℋ) A) := by + change star (rightMulHS (ℋ := ℋ) A) = rightMulHS (ℋ := ℋ) A + simp [hA_sa.star_eq] + letI : Nontrivial (HSOp ℋ) := by + delta HSOp + infer_instance + letI : Nontrivial (L (HSOp ℋ)) := inferInstance + refine ⟨hright_sa, ?_⟩ + rcases (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := A) (ha := hA_sa)).2 hA_spec + with ⟨r, hr, hrA⟩ + refine (CFC.exists_pos_algebraMap_le_iff + (A := L (HSOp ℋ)) (a := rightMulHS (ℋ := ℋ) A) (ha := hright_sa)).1 ?_ + refine ⟨r, hr, ?_⟩ + simpa [Algebra.algebraMap_eq_smul_one, rightMulHS_real_smul_one (ℋ := ℋ) (r := r)] using + rightMulHS_le_rightMulHS (ℋ := ℋ) hrA + +private noncomputable def phiK (K : L ℋ) (T : L (HSOp ℋ)) : ℝ := + Complex.re (inner ℂ (ofOp (star K)) (T (ofOp (star K)))) + +omit [Nontrivial ℋ] in +private lemma phiK_nonneg (K : L ℋ) {T : L (HSOp ℋ)} (hT : 0 ≤ T) : + 0 ≤ phiK (ℋ := ℋ) K T := by + dsimp [phiK] + have hpos : T.IsPositive := (ContinuousLinearMap.nonneg_iff_isPositive T).1 hT + have hnonneg : 0 ≤ Complex.re (inner ℂ (T (ofOp (star K))) (ofOp (star K))) := by + exact ((ContinuousLinearMap.isPositive_iff_complex T).1 hpos (ofOp (star K))).2 + have hre : + Complex.re (inner ℂ (ofOp (star K)) (T (ofOp (star K)))) = + Complex.re (inner ℂ (T (ofOp (star K))) (ofOp (star K))) := by + simpa using + (inner_re_symm (𝕜 := ℂ) (x := ofOp (star K)) (y := T (ofOp (star K)))) + rw [hre] + exact hnonneg + +omit [Nontrivial ℋ] in +private lemma phiK_add (K : L ℋ) (T S : L (HSOp ℋ)) : + phiK (ℋ := ℋ) K (T + S) = phiK (ℋ := ℋ) K T + phiK (ℋ := ℋ) K S := by + simp [phiK, inner_add_right, Complex.add_re] + +omit [Nontrivial ℋ] in +private lemma phiK_smul (K : L ℋ) (r : ℝ) (T : L (HSOp ℋ)) : + phiK (ℋ := ℋ) K (r • T) = r * phiK (ℋ := ℋ) K T := by + rw [phiK] + change Complex.re (inner ℂ (ofOp (star K)) (r • T (ofOp (star K)))) = + r * Complex.re (inner ℂ (ofOp (star K)) (T (ofOp (star K)))) + rw [show inner ℂ (ofOp (star K)) (r • T (ofOp (star K))) = + (r : ℂ) * inner ℂ (ofOp (star K)) (T (ofOp (star K))) by + simpa using inner_smul_right (ofOp (star K)) (T (ofOp (star K))) (r : ℂ)] + simp + +omit [Nontrivial ℋ] in +private lemma phiK_mono (K : L ℋ) {T S : L (HSOp ℋ)} (hTS : T ≤ S) : + phiK (ℋ := ℋ) K T ≤ phiK (ℋ := ℋ) K S := by + have hnonneg : + 0 ≤ S + (-1 : ℝ) • T := by + simpa [sub_eq_add_neg] using (sub_nonneg.mpr hTS) + have hphi_nonneg := phiK_nonneg (ℋ := ℋ) K hnonneg + have hrewrite : + phiK (ℋ := ℋ) K (S + (-1 : ℝ) • T) = + phiK (ℋ := ℋ) K S - phiK (ℋ := ℋ) K T := by + rw [phiK_add, phiK_smul] + ring + linarith [hrewrite ▸ hphi_nonneg] + +omit [CompleteSpace ℋ] [Nontrivial ℋ] in +private lemma leftMulHS_rankOne (A : L ℋ) (x y : ℋ) : + leftMulHS (ℋ := ℋ) A (ofOp (InnerProductSpace.rankOne ℂ x y)) = + ofOp (InnerProductSpace.rankOne ℂ (A x) y) := by + change (A * InnerProductSpace.rankOne ℂ x y) = InnerProductSpace.rankOne ℂ (A x) y + simpa [leftMulHS_apply] using + (InnerProductSpace.comp_rankOne (𝕜 := ℂ) (x := x) (y := y) (f := A)) + +omit [Nontrivial ℋ] in +private lemma rightMulHS_rankOne (B : L ℋ) (x y : ℋ) : + rightMulHS (ℋ := ℋ) B (ofOp (InnerProductSpace.rankOne ℂ x y)) = + ofOp (InnerProductSpace.rankOne ℂ x ((star B) y)) := by + change (InnerProductSpace.rankOne ℂ x y * B) = InnerProductSpace.rankOne ℂ x ((star B) y) + simpa [rightMulHS_apply, ContinuousLinearMap.star_eq_adjoint] using + (InnerProductSpace.rankOne_comp (𝕜 := ℂ) (x := x) (y := y) (f := B)) + +private lemma re_inner_nonneg_of_nonneg + {𝓚 : Type*} [NormedAddCommGroup 𝓚] [InnerProductSpace ℂ 𝓚] + {T : 𝓚 →L[ℂ] 𝓚} (hT : 0 ≤ T) : + ∀ x : 𝓚, 0 ≤ Complex.re (inner ℂ x (T x)) := by + intro x + have hpos : T.IsPositive := (ContinuousLinearMap.nonneg_iff_isPositive T).1 hT + have hnonneg : 0 ≤ Complex.re (inner ℂ (T x) x) := + ((ContinuousLinearMap.isPositive_iff_complex T).1 hpos x).2 + have hre : + Complex.re (inner ℂ x (T x)) = Complex.re (inner ℂ (T x) x) := by + simpa using (inner_re_symm (𝕜 := ℂ) (x := x) (y := T x)) + rw [hre] + exact hnonneg + +private lemma aeval_apply_of_mem_eigenspace_realpoly + {𝓚 : Type*} [NormedAddCommGroup 𝓚] [InnerProductSpace ℂ 𝓚] + {T : 𝓚 →L[ℂ] 𝓚} {r : ℝ} {x : 𝓚} + (hx : x ∈ eigenspace T.toLinearMap (r : ℂ)) (p : ℝ[X]) : + Polynomial.aeval T (p.map (algebraMap ℝ ℂ)) x = + ((p.map (algebraMap ℝ ℂ)).eval (r : ℂ)) • x := by + by_cases hx0 : x = 0 + · simp [hx0] + have hmap : + Polynomial.aeval T (p.map (algebraMap ℝ ℂ)) x = + Polynomial.aeval T.toLinearMap (p.map (algebraMap ℝ ℂ)) x := by + simpa using + congrArg (fun F : 𝓚 →ₗ[ℂ] 𝓚 => F x) + (Polynomial.map_aeval_eq_aeval_map + (R := ℂ) (S := 𝓚 →L[ℂ] 𝓚) (T := ℂ) (U := 𝓚 →ₗ[ℂ] 𝓚) + (φ := RingHom.id ℂ) (ψ := ContinuousLinearMap.toLinearMapRingHom) + (h := by ext z; rfl) (p := p.map (algebraMap ℝ ℂ)) (a := T)) + rw [hmap] + simpa using + (Module.End.aeval_apply_of_hasEigenvector + (f := T.toLinearMap) (p := p.map (algebraMap ℝ ℂ)) (μ := (r : ℂ)) (x := x) ⟨hx, hx0⟩) + +-- The interpolation-based `cfcR`-on-eigenspace lemma is elaboration-heavy. +set_option maxHeartbeats 400000 in +private lemma cfcR_apply_of_mem_eigenspace_real + {𝓚 : Type*} [NormedAddCommGroup 𝓚] [InnerProductSpace ℂ 𝓚] [CompleteSpace 𝓚] + [FiniteDimensional ℂ 𝓚] + [ContinuousFunctionalCalculus ℝ (L 𝓚) IsSelfAdjoint] + (f : ℝ → ℝ) {T : L 𝓚} (hT : IsSelfAdjoint T) {r : ℝ} {x : 𝓚} + (hx : x ∈ eigenspace T.toLinearMap (r : ℂ)) : + cfcR (ℋ := 𝓚) f T x = (f r : ℂ) • x := by + haveI : IsScalarTower ℝ ℂ (L 𝓚) := RestrictScalars.isScalarTower ℝ ℂ (L 𝓚) + classical + by_cases hx0 : x = 0 + · simp [hx0] + have hspecCfin : Set.Finite (spectrum ℂ T) := by + change Set.Finite (spectrum ℂ ((Module.End.toContinuousLinearMap 𝓚) T.toLinearMap)) + simpa using Module.End.finite_spectrum (K := ℂ) (V := 𝓚) T.toLinearMap + have hspecRfin : Set.Finite (spectrum ℝ T) := by + rw [← spectrum.preimage_algebraMap ℂ] + exact hspecCfin.preimage (FaithfulSMul.algebraMap_injective ℝ ℂ).injOn + let s : Finset ℝ := hspecRfin.toFinset + let q : ℝ[X] := Lagrange.interpolate s id fun y ↦ f y + have hq_spec : (spectrum ℝ T).EqOn f q.eval := by + intro y hy + have hy' : y ∈ s := by + simpa [s] using hy + symm + simpa [q] using + (Lagrange.eval_interpolate_at_node + (s := s) (v := id) (r := fun z ↦ f z) (i := y) + (hvs := fun _ _ _ _ h => h) hy') + have hcfc : cfcR (ℋ := 𝓚) f T = cfcR (ℋ := 𝓚) q.eval T := by + simpa [cfcR] using (cfc_congr (a := T) (f := f) (g := q.eval) hq_spec) + have hpoly : cfcR (ℋ := 𝓚) q.eval T = Polynomial.aeval T q := by + simpa [cfcR] using (cfc_polynomial (p := IsSelfAdjoint) (q := q) (a := T) hT) + have hxv : Module.End.HasEigenvector T.toLinearMap (r : ℂ) x := ⟨hx, hx0⟩ + have hr_specC : (r : ℂ) ∈ spectrum ℂ T := + by + change (r : ℂ) ∈ spectrum ℂ ((Module.End.toContinuousLinearMap 𝓚) T.toLinearMap) + simpa using (Module.End.hasEigenvalue_of_hasEigenvector hxv).mem_spectrum + have hr_spec : r ∈ spectrum ℝ T := spectrum.of_algebraMap_mem ℂ hr_specC + calc + cfcR (ℋ := 𝓚) f T x = cfcR (ℋ := 𝓚) q.eval T x := by rw [hcfc] + _ = Polynomial.aeval T q x := by rw [hpoly] + _ = Polynomial.aeval T (q.map (algebraMap ℝ ℂ)) x := by + symm + simp + _ = ((q.map (algebraMap ℝ ℂ)).eval (r : ℂ)) • x := by + simpa using aeval_apply_of_mem_eigenspace_realpoly hx q + _ = (f r : ℂ) • x := by + congr 1 + rw [Polynomial.eval_map_algebraMap] + calc + Polynomial.aeval (algebraMap ℝ ℂ r) q = ((Polynomial.eval r q : ℝ) : ℂ) := by + simpa using + (Polynomial.aeval_algebraMap_apply_eq_algebraMap_eval (A := ℂ) (x := r) (p := q)) + _ = (f r : ℂ) := by + simpa using congrArg (fun t : ℝ => (t : ℂ)) (hq_spec hr_spec).symm + +-- This proof is isolated because the joint eigenspace decomposition is heartbeat-heavy. +set_option maxHeartbeats 800000 in +set_option backward.isDefEq.respectTransparency false in +private lemma hmiddle_leftMul_rightMul + {s : ℝ} {A B : L ℋ} + (hA : A ∈ pdSet (ℋ := ℋ)) (hB : B ∈ pdSet (ℋ := ℋ)) : + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ s) + (cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) * + leftMulHS (ℋ := ℋ) A * + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B)) = + leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B ^ (-s)) := by + rcases hA with ⟨hA_sa, hA_spec⟩ + rcases hB with ⟨hB_sa, hB_spec⟩ + have hA0 : 0 ≤ A := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA_sa)).2 + (by intro x hx; exact (hA_spec hx).le) + have hB0 : 0 ≤ B := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B (ha := hB_sa)).2 + (by intro x hx; exact (hB_spec hx).le) + have hright_negHalf : + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) = + rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) := by + rw [show rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) = + rightMulHS (ℋ := ℋ) (cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) B) by + congr + simpa [cfcR] using + (CFC.rpow_eq_cfc_real (A := L ℋ) (a := B) (y := (-1 : ℝ) / 2) (ha := hB0))] + exact (rightMulHS_cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) B hB_sa + (by + intro x hx + exact (Real.continuousAt_rpow_const x ((-1 : ℝ) / 2) + (Or.inl (ne_of_gt (hB_spec hx)))).continuousWithinAt)).symm + have hBunit : IsUnit B := by + refine spectrum.isUnit_of_zero_notMem (R := ℝ) ?_ + intro h0 + exact (lt_irrefl (0 : ℝ)) (by simpa [Set.Ioi] using hB_spec h0) + have hBnegOne : + B ^ ((-1 : ℝ) / 2) * B ^ ((-1 : ℝ) / 2) = B ^ (-1 : ℝ) := by + calc + B ^ ((-1 : ℝ) / 2) * B ^ ((-1 : ℝ) / 2) + = B ^ (((-1 : ℝ) / 2) + ((-1 : ℝ) / 2)) := by + rw [← CFC.rpow_add hBunit] + _ = B ^ (-1 : ℝ) := by ring_nf + have hmid_prod : + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) * + leftMulHS (ℋ := ℋ) A * + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) = + leftMulHS (ℋ := ℋ) A * rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ)) := by + rw [hright_negHalf] + calc + rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) * + leftMulHS (ℋ := ℋ) A * + rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) = + leftMulHS (ℋ := ℋ) A * + (rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) * + rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2))) := by + rw [← mul_assoc, + (leftMulHS_rightMulHS_commute (ℋ := ℋ) A (B ^ ((-1 : ℝ) / 2))).eq.symm, + mul_assoc] + _ = leftMulHS (ℋ := ℋ) A * rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ)) := by + rw [← rightMulHS_mul (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) (B ^ ((-1 : ℝ) / 2)), hBnegOne] + rw [hmid_prod] + let T0 : HSOp ℋ →ₗ[ℂ] HSOp ℋ := (leftMulHS (ℋ := ℋ) A).toLinearMap + let T1 : HSOp ℋ →ₗ[ℂ] HSOp ℋ := (rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ))).toLinearMap + let lhs : L (HSOp ℋ) := + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ s) + (leftMulHS (ℋ := ℋ) A * rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ))) + let rhs : L (HSOp ℋ) := + leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B ^ (-s)) + let D : L (HSOp ℋ) := lhs - rhs + have hleft_sa : IsSelfAdjoint (leftMulHS (ℋ := ℋ) A) := + IsSelfAdjoint.of_nonneg (leftMulHS_nonneg (ℋ := ℋ) hA0) + have hT0_symm : T0.IsSymmetric := by + simpa [T0] using + (ContinuousLinearMap.isSelfAdjoint_iff_isSymmetric.mp hleft_sa) + have hBinv0 : 0 ≤ B ^ (-1 : ℝ) := by + simp + have hBinv_sa : IsSelfAdjoint (B ^ (-1 : ℝ)) := IsSelfAdjoint.of_nonneg hBinv0 + have hBinv_unit : IsUnit (B ^ (-1 : ℝ)) := by + rcases hBunit with ⟨u, rfl⟩ + simp [CFC.rpow_neg_one_eq_inv u (by simpa using hB0)] + have hright_sa : IsSelfAdjoint (rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ))) := + IsSelfAdjoint.of_nonneg (rightMulHS_nonneg (ℋ := ℋ) hBinv0) + have hT1_symm : T1.IsSymmetric := by + simpa [T1] using + (ContinuousLinearMap.isSelfAdjoint_iff_isSymmetric.mp hright_sa) + have hcomm : Commute T0 T1 := by + show T0 * T1 = T1 * T0 + ext x + simpa [T0, T1] using congrArg (fun F : L (HSOp ℋ) => F x) + (leftMulHS_rightMulHS_commute (ℋ := ℋ) A (B ^ (-1 : ℝ))).eq + have hleft_pow : + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ s) (leftMulHS (ℋ := ℋ) A) = + leftMulHS (ℋ := ℋ) (A ^ s) := by + rw [show leftMulHS (ℋ := ℋ) (A ^ s) = + leftMulHS (ℋ := ℋ) (cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ s) A) by + congr + simpa [cfcR] using + (CFC.rpow_eq_cfc_real (A := L ℋ) (a := A) (y := s) (ha := hA0))] + exact (leftMulHS_cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ s) A hA_sa + (by + intro x hx + exact (Real.continuousAt_rpow_const x s + (Or.inl (ne_of_gt (hA_spec hx)))).continuousWithinAt)).symm + have hright_pow : + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ s) + (rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ))) = + rightMulHS (ℋ := ℋ) (B ^ (-s)) := by + rw [show rightMulHS (ℋ := ℋ) (B ^ (-s)) = + rightMulHS (ℋ := ℋ) (cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ s) (B ^ (-1 : ℝ))) by + congr + calc + B ^ (-s) = (B ^ (-1 : ℝ)) ^ s := by + symm + simpa using (CFC.rpow_rpow B (-1 : ℝ) s (by norm_num) (hBunit.isStrictlyPositive hB0)) + _ = cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ s) (B ^ (-1 : ℝ)) := by + simpa [cfcR] using + (CFC.rpow_eq_cfc_real (A := L ℋ) (a := B ^ (-1 : ℝ)) (y := s) (ha := hBinv0))] + exact (rightMulHS_cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ s) (B ^ (-1 : ℝ)) hBinv_sa + (by + intro x hx + have hx0 : x ≠ 0 := by + intro hx0 + exact spectrum.zero_notMem (R := ℝ) hBinv_unit (by simpa [hx0] using hx) + exact (Real.continuousAt_rpow_const x s (Or.inl hx0)).continuousWithinAt)).symm + have hprod0 : + 0 ≤ leftMulHS (ℋ := ℋ) A * rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ)) := by + exact (leftMulHS_rightMulHS_commute (ℋ := ℋ) A (B ^ (-1 : ℝ))).mul_nonneg + (leftMulHS_nonneg (ℋ := ℋ) hA0) + (rightMulHS_nonneg (ℋ := ℋ) hBinv0) + have hprod_sa : + IsSelfAdjoint + (leftMulHS (ℋ := ℋ) A * rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ))) := + IsSelfAdjoint.of_nonneg hprod0 + have htop : + (⨆ α, ⨆ β, eigenspace T0 α ⊓ eigenspace T1 β) = ⊤ := by + exact LinearMap.IsSymmetric.iSup_iSup_eigenspace_inf_eigenspace_eq_top_of_commute + hT0_symm hT1_symm hcomm + have hjoint_ker : + ∀ α β, + eigenspace T0 α ⊓ eigenspace T1 β ≤ LinearMap.ker D.toLinearMap := by + intro α β x hx + rcases hx with ⟨hx0, hx1⟩ + rw [LinearMap.mem_ker] + by_cases hxzero : x = 0 + · simp [D, hxzero] + have hxv0 : Module.End.HasEigenvector T0 α x := ⟨hx0, hxzero⟩ + have hxv1 : Module.End.HasEigenvector T1 β x := ⟨hx1, hxzero⟩ + have hαeq : α = (α.re : ℂ) := by + exact (RCLike.conj_eq_iff_re.mp + (hT0_symm.conj_eigenvalue_eq_self (Module.End.hasEigenvalue_of_hasEigenvector hxv0)) + ).symm + have hβeq : β = (β.re : ℂ) := by + exact (RCLike.conj_eq_iff_re.mp + (hT1_symm.conj_eigenvalue_eq_self (Module.End.hasEigenvalue_of_hasEigenvector hxv1)) + ).symm + have hx0r : x ∈ eigenspace T0 (α.re : ℂ) := by + rwa [hαeq] at hx0 + have hx1r : x ∈ eigenspace T1 (β.re : ℂ) := by + rwa [hβeq] at hx1 + have hT0_nonneg_re : + ∀ y : HSOp ℋ, 0 ≤ Complex.re (inner ℂ y (T0 y)) := by + intro y + simpa [T0] using + re_inner_nonneg_of_nonneg + (T := leftMulHS (ℋ := ℋ) A) + (leftMulHS_nonneg (ℋ := ℋ) hA0) y + have hT1_nonneg_re : + ∀ y : HSOp ℋ, 0 ≤ Complex.re (inner ℂ y (T1 y)) := by + intro y + simpa [T1] using + re_inner_nonneg_of_nonneg + (T := rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ))) + (rightMulHS_nonneg (ℋ := ℋ) hBinv0) y + have hαnonneg : 0 ≤ α.re := by + exact eigenvalue_nonneg_of_nonneg + (Module.End.hasEigenvalue_of_hasEigenvector ⟨hx0r, hxzero⟩) + hT0_nonneg_re + have hβnonneg : 0 ≤ β.re := by + exact eigenvalue_nonneg_of_nonneg + (Module.End.hasEigenvalue_of_hasEigenvector ⟨hx1r, hxzero⟩) + hT1_nonneg_re + have hxprod : + x ∈ eigenspace + ((leftMulHS (ℋ := ℋ) A * rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ))).toLinearMap) + (((α.re * β.re : ℝ) : ℂ)) := by + rw [Module.End.mem_eigenspace_iff] + have hx0apply : T0 x = (α.re : ℂ) • x := Module.End.mem_eigenspace_iff.mp hx0r + have hx1apply : T1 x = (β.re : ℂ) • x := Module.End.mem_eigenspace_iff.mp hx1r + have hx0apply' : + leftMulHS (ℋ := ℋ) A x = (α.re : ℂ) • x := by + simpa [T0] using hx0apply + have hx1apply' : + rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ)) x = (β.re : ℂ) • x := by + simpa [T1] using hx1apply + show leftMulHS (ℋ := ℋ) A (rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ)) x) = + (((α.re * β.re : ℝ) : ℂ)) • x + rw [hx1apply', ContinuousLinearMap.map_smul, hx0apply'] + rw [smul_smul] + congr 1 + simp [mul_comm] + have hlhsx : + lhs x = ((((α.re * β.re : ℝ) ^ s : ℝ) : ℂ) • x) := by + simpa [lhs] using + cfcR_apply_of_mem_eigenspace_real + (𝓚 := HSOp ℋ) (f := fun t : ℝ ↦ t ^ s) hprod_sa hxprod + have hrhsx : + rhs x = ((((α.re ^ s) * (β.re ^ s) : ℝ) : ℂ) • x) := by + change (leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B ^ (-s))) x = + ((((α.re ^ s) * (β.re ^ s) : ℝ) : ℂ) • x) + have hleftx : + cfcR (ℋ := HSOp ℋ) (fun t : ℝ ↦ t ^ s) (leftMulHS (ℋ := ℋ) A) x = + (((α.re ^ s : ℝ) : ℂ) • x) := by + simpa using + cfcR_apply_of_mem_eigenspace_real + (𝓚 := HSOp ℋ) (f := fun t : ℝ ↦ t ^ s) hleft_sa hx0r + have hrightx : + cfcR (ℋ := HSOp ℋ) (fun t : ℝ ↦ t ^ s) + (rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ))) x = + (((β.re ^ s : ℝ) : ℂ) • x) := by + simpa using + cfcR_apply_of_mem_eigenspace_real + (𝓚 := HSOp ℋ) (f := fun t : ℝ ↦ t ^ s) hright_sa hx1r + rw [← hleft_pow, ← hright_pow, ContinuousLinearMap.mul_def] + show cfcR (ℋ := HSOp ℋ) (fun t : ℝ ↦ t ^ s) (leftMulHS (ℋ := ℋ) A) + (cfcR (ℋ := HSOp ℋ) (fun t : ℝ ↦ t ^ s) + (rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ))) x) = + ((((α.re ^ s) * (β.re ^ s) : ℝ) : ℂ) • x) + rw [hrightx, ContinuousLinearMap.map_smul, hleftx] + rw [smul_smul] + congr 1 + simp [mul_comm] + have hscal : + (((α.re * β.re : ℝ) ^ s : ℝ) : ℂ) = + ((((α.re ^ s) * (β.re ^ s) : ℝ)) : ℂ) := by + exact congrArg (fun t : ℝ => (t : ℂ)) (Real.mul_rpow hαnonneg hβnonneg) + simpa [D] using + sub_eq_zero.mpr (hlhsx.trans (hscal ▸ hrhsx.symm)) + have hker_top : LinearMap.ker D.toLinearMap = ⊤ := by + apply top_unique + rw [← htop] + refine iSup_le ?_ + intro α + refine iSup_le ?_ + intro β + exact hjoint_ker α β + have hDzero : D = 0 := by + ext x + have hx : x ∈ LinearMap.ker D.toLinearMap := by simp [hker_top] + exact LinearMap.mem_ker.mp hx + have hlhs_eq_rhs : lhs = rhs := sub_eq_zero.mp hDzero + simpa [lhs, rhs] using hlhs_eq_rhs + +-- The bridge lemma expands a large `HSOp`-valued generalized perspective term. +set_option maxHeartbeats 800000 in +set_option backward.isDefEq.respectTransparency false in +private lemma phiK_operatorPowerMean_eq_liebTraceMap + {s : ℝ} (K A B : L ℋ) (hA : A ∈ pdSet (ℋ := ℋ)) (hB : B ∈ pdSet (ℋ := ℋ)) : + phiK (ℋ := ℋ) K + (operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A) (rightMulHS (ℋ := ℋ) B)) = + liebTraceMap (ℋ := ℋ) s K A B := by + rcases hA with ⟨hA_sa, hA_spec⟩ + rcases hB with ⟨hB_sa, hB_spec⟩ + have hA0 : 0 ≤ A := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA_sa)).2 + (by intro x hx; exact (hA_spec hx).le) + have hB0 : 0 ≤ B := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B (ha := hB_sa)).2 + (by intro x hx; exact (hB_spec hx).le) + have hright_half : + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) = + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) := by + rw [show rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) = + rightMulHS (ℋ := ℋ) (cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ ((1 : ℝ) / 2)) B) by + congr + simpa [cfcR] using + (CFC.rpow_eq_cfc_real (A := L ℋ) (a := B) (y := (1 : ℝ) / 2) (ha := hB0))] + exact (rightMulHS_cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ ((1 : ℝ) / 2)) B hB_sa + (by + intro x hx + exact (Real.continuousAt_rpow_const x ((1 : ℝ) / 2) + (Or.inr (by positivity))).continuousWithinAt)).symm + have hright_negHalf : + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) = + rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) := by + rw [show rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) = + rightMulHS (ℋ := ℋ) (cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) B) by + congr + simpa [cfcR] using + (CFC.rpow_eq_cfc_real (A := L ℋ) (a := B) (y := (-1 : ℝ) / 2) (ha := hB0))] + exact (rightMulHS_cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) B hB_sa + (by + intro x hx + exact (Real.continuousAt_rpow_const x ((-1 : ℝ) / 2) + (Or.inl (ne_of_gt (hB_spec hx)))).continuousWithinAt)).symm + have hBunit : IsUnit B := by + refine spectrum.isUnit_of_zero_notMem (R := ℝ) ?_ + intro h0 + exact (lt_irrefl (0 : ℝ)) (by simpa [Set.Ioi] using hB_spec h0) + have hBpow : + B ^ ((1 : ℝ) / 2) * B ^ (-s) * B ^ ((1 : ℝ) / 2) = B ^ (1 - s) := by + calc + B ^ ((1 : ℝ) / 2) * B ^ (-s) * B ^ ((1 : ℝ) / 2) + = B ^ (((1 : ℝ) / 2) + (-s)) * B ^ ((1 : ℝ) / 2) := by + rw [← CFC.rpow_add hBunit] + _ = B ^ ((((1 : ℝ) / 2) + (-s)) + ((1 : ℝ) / 2)) := by + rw [← CFC.rpow_add hBunit] + _ = B ^ (1 - s) := by ring_nf + have hBnegOne : + B ^ ((-1 : ℝ) / 2) * B ^ ((-1 : ℝ) / 2) = B ^ (-1 : ℝ) := by + calc + B ^ ((-1 : ℝ) / 2) * B ^ ((-1 : ℝ) / 2) + = B ^ (((-1 : ℝ) / 2) + ((-1 : ℝ) / 2)) := by + rw [← CFC.rpow_add hBunit] + _ = B ^ (-1 : ℝ) := by ring_nf + have hBinvHalf0 : 0 ≤ B ^ ((-1 : ℝ) / 2) := by + simp + have hBinv0 : 0 ≤ B ^ (-1 : ℝ) := by + simp + have hBinv_sa : IsSelfAdjoint (B ^ (-1 : ℝ)) := IsSelfAdjoint.of_nonneg hBinv0 + have hright_invHalf0 : + 0 ≤ rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) := by + exact rightMulHS_nonneg (ℋ := ℋ) hBinvHalf0 + have hmid_nonneg : + 0 ≤ cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) * + leftMulHS (ℋ := ℋ) A * + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) := by + rw [hright_negHalf] + simpa [mul_assoc] using + conjugate_nonneg_of_nonneg (leftMulHS_nonneg (ℋ := ℋ) hA0) hright_invHalf0 + have hmid_prod : + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) * + leftMulHS (ℋ := ℋ) A * + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) = + leftMulHS (ℋ := ℋ) A * rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ)) := by + rw [hright_negHalf] + calc + rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) * + leftMulHS (ℋ := ℋ) A * + rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) + = + leftMulHS (ℋ := ℋ) A * + (rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) * + rightMulHS (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2))) := by + rw [← mul_assoc, + (leftMulHS_rightMulHS_commute (ℋ := ℋ) A (B ^ ((-1 : ℝ) / 2))).eq.symm, + mul_assoc] + _ = leftMulHS (ℋ := ℋ) A * rightMulHS (ℋ := ℋ) (B ^ (-1 : ℝ)) := by + rw [← rightMulHS_mul (ℋ := ℋ) (B ^ ((-1 : ℝ) / 2)) (B ^ ((-1 : ℝ) / 2)), hBnegOne] + have hmiddle : + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ s) + (cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B) * + leftMulHS (ℋ := ℋ) A * + cfcR (ℋ := HSOp ℋ) (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (rightMulHS (ℋ := ℋ) B)) = + leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B ^ (-s)) := by + exact hmiddle_leftMul_rightMul (ℋ := ℋ) (s := s) ⟨hA_sa, hA_spec⟩ ⟨hB_sa, hB_spec⟩ + have happly : + operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A) (rightMulHS (ℋ := ℋ) B) (ofOp (star K)) = + ofOp (A ^ s * star K * B ^ (1 - s)) := by + have hcomm_half : + Commute (leftMulHS (ℋ := ℋ) (A ^ s)) (rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2))) := + leftMulHS_rightMulHS_commute (ℋ := ℋ) (A ^ s) (B ^ ((1 : ℝ) / 2)) + have hright_pow : + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) * + rightMulHS (ℋ := ℋ) (B ^ (-s)) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) = + rightMulHS (ℋ := ℋ) (B ^ (1 - s)) := by + calc + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) * + rightMulHS (ℋ := ℋ) (B ^ (-s)) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) + = + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2) * B ^ (-s) * B ^ ((1 : ℝ) / 2)) := by + simp [mul_assoc] + _ = rightMulHS (ℋ := ℋ) (B ^ (1 - s)) := by rw [hBpow] + have hreorder : + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) * + (leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B ^ (-s))) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) = + leftMulHS (ℋ := ℋ) (A ^ s) * + (rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) * + rightMulHS (ℋ := ℋ) (B ^ (-s)) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2))) := by + calc + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) * + (leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B ^ (-s))) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) + = + ((rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) * + leftMulHS (ℋ := ℋ) (A ^ s)) * + rightMulHS (ℋ := ℋ) (B ^ (-s))) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) := by + simp [mul_assoc] + _ = + ((leftMulHS (ℋ := ℋ) (A ^ s) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2))) * + rightMulHS (ℋ := ℋ) (B ^ (-s))) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) := by + rw [hcomm_half.eq] + _ = + leftMulHS (ℋ := ℋ) (A ^ s) * + (rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) * + rightMulHS (ℋ := ℋ) (B ^ (-s)) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2))) := by + simp [mul_assoc] + calc + operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A) (rightMulHS (ℋ := ℋ) B) (ofOp (star K)) + = + (rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) * + (leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B ^ (-s))) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2))) (ofOp (star K)) := by + rw [OperatorGeometricMean.operatorPowerMean, GeneralizedPerspective, + GeneralizedPerspectiveFunction.hSqrt, GeneralizedPerspectiveFunction.hInvSqrt] + simp only [Real.rpow_one] + rw [hmiddle] + rw [hright_half] + _ = + (leftMulHS (ℋ := ℋ) (A ^ s) * + (rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)) * + rightMulHS (ℋ := ℋ) (B ^ (-s)) * + rightMulHS (ℋ := ℋ) (B ^ ((1 : ℝ) / 2)))) (ofOp (star K)) := by + rw [hreorder] + _ = + (leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B ^ (1 - s))) (ofOp (star K)) := by + rw [hright_pow] + _ = ofOp (A ^ s * star K * B ^ (1 - s)) := by + simp [leftMulHS_apply, rightMulHS_apply, mul_assoc] + calc + phiK (ℋ := ℋ) K + (operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A) (rightMulHS (ℋ := ℋ) B)) + = Complex.re + (inner ℂ (ofOp (star K)) + (ofOp (A ^ s * star K * B ^ (1 - s)))) := by + simp [phiK, happly] + _ = traceRe (ℋ := ℋ) (A ^ s * star K * B ^ (1 - s) * K) := by + rw [traceRe] + set X : L ℋ := A ^ s * star K * B ^ (1 - s) + have htrace := + re_hsInner_eq_traceRe (ℋ := ℋ) (X := star K) (Y := X) + have htrace' : + Complex.re (inner ℂ (ofOp (star K)) (ofOp X)) = + Complex.re (LinearMap.trace ℂ ℋ + ((K * X).toLinearMap)) := by + simpa [X, mul_assoc] using htrace + have hcycle : + Complex.re (LinearMap.trace ℂ ℋ ((K * X).toLinearMap)) = + Complex.re (LinearMap.trace ℂ ℋ ((X * K).toLinearMap)) := by + simpa using + congrArg Complex.re + (LinearMap.trace_mul_comm (R := ℂ) (M := ℋ) K.toLinearMap X.toLinearMap) + simpa [X, mul_assoc] using htrace'.trans hcycle + _ = liebTraceMap (ℋ := ℋ) s K A B := by + rfl + +omit [FiniteDimensional ℂ ℋ] in +/-- Convex combinations preserve `pdSet` (strict positivity). -/ +lemma pdSet_convexCombo {A B : L ℋ} {t : ℝ} + (hA : A ∈ pdSet (ℋ := ℋ)) (hB : B ∈ pdSet (ℋ := ℋ)) + (ht0 : 0 ≤ t) (ht1 : t ≤ 1) : + ((1 - t) • A + t • B) ∈ pdSet (ℋ := ℋ) := by + rcases hA with ⟨hA_sa, hA_spec⟩ + rcases hB with ⟨hB_sa, hB_spec⟩ + set C : L ℋ := (1 - t) • A + t • B + have hC : IsSelfAdjoint C := by + simpa [C] using (IsSelfAdjoint.all (1 - t)).smul hA_sa |>.add ((IsSelfAdjoint.all t).smul hB_sa) + have hApos : ∃ r > 0, algebraMap ℝ (L ℋ) r ≤ A := by + refine (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := A) (ha := hA_sa)).2 ?_ + intro x hx + exact hA_spec hx + have hBpos : ∃ r > 0, algebraMap ℝ (L ℋ) r ≤ B := by + refine (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := B) (ha := hB_sa)).2 ?_ + intro x hx + exact hB_spec hx + rcases hApos with ⟨rA, hrA, hrA_le⟩ + rcases hBpos with ⟨rB, hrB, hrB_le⟩ + set rC : ℝ := (1 - t) * rA + t * rB + have hrC : 0 < rC := by + by_cases h1t : (1 - t) = 0 + · have ht' : t = 1 := by linarith + subst ht' + simpa [rC] using hrB + · have h1t_pos : 0 < 1 - t := lt_of_le_of_ne (sub_nonneg.mpr ht1) (Ne.symm h1t) + simpa [rC] using + add_pos_of_pos_of_nonneg (mul_pos h1t_pos hrA) (mul_nonneg ht0 (le_of_lt hrB)) + have hrC_le : algebraMap ℝ (L ℋ) rC ≤ C := by + have hsum : + (1 - t) • algebraMap ℝ (L ℋ) rA + t • algebraMap ℝ (L ℋ) rB ≤ C := by + simpa [C] using + add_le_add (smul_le_smul_of_nonneg_left hrA_le (sub_nonneg.mpr ht1)) + (smul_le_smul_of_nonneg_left hrB_le ht0) + have hLHS : + (1 - t) • algebraMap ℝ (L ℋ) rA + t • algebraMap ℝ (L ℋ) rB = + algebraMap ℝ (L ℋ) rC := by + simp [rC, Algebra.smul_def] + simpa [hLHS] using hsum + refine ⟨hC, ?_⟩ + intro x hx + simpa [C] using + (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := C) (ha := hC)).1 ⟨rC, hrC, hrC_le⟩ x hx + +omit [Nontrivial ℋ] in +private lemma phiK_leftMul_rightMul_eq_traceRe (K C D : L ℋ) : + phiK (ℋ := ℋ) K + (leftMulHS (ℋ := ℋ) C * rightMulHS (ℋ := ℋ) D) = + traceRe (ℋ := ℋ) (C * star K * D * K) := by + calc + phiK (ℋ := ℋ) K + (leftMulHS (ℋ := ℋ) C * rightMulHS (ℋ := ℋ) D) + = Complex.re + (inner ℂ (ofOp (star K)) + ((leftMulHS (ℋ := ℋ) C * rightMulHS (ℋ := ℋ) D) (ofOp (star K)))) := by + simp [phiK] + _ = Complex.re + (inner ℂ (ofOp (star K)) + (ofOp (C * star K * D))) := by + simp [leftMulHS_apply, rightMulHS_apply, mul_assoc] + _ = traceRe (ℋ := ℋ) (C * star K * D * K) := by + rw [traceRe] + set X : L ℋ := C * star K * D + have htrace := + re_hsInner_eq_traceRe (ℋ := ℋ) (X := star K) (Y := X) + have htrace' : + Complex.re (inner ℂ (ofOp (star K)) (ofOp X)) = + Complex.re (LinearMap.trace ℂ ℋ ((K * X).toLinearMap)) := by + simpa [X, mul_assoc] using htrace + have hcycle : + Complex.re (LinearMap.trace ℂ ℋ ((K * X).toLinearMap)) = + Complex.re (LinearMap.trace ℂ ℋ ((X * K).toLinearMap)) := by + simpa using + congrArg Complex.re + (LinearMap.trace_mul_comm (R := ℂ) (M := ℋ) K.toLinearMap X.toLinearMap) + simpa [X, mul_assoc] using htrace'.trans hcycle + +omit [FiniteDimensional ℂ ℋ] in +set_option maxHeartbeats 400000 in +private lemma pdSet_rpow_of_mem_Icc_zero_one + {p : ℝ} (hp : p ∈ Set.Icc (0 : ℝ) 1) {A : L ℋ} (hA : A ∈ pdSet (ℋ := ℋ)) : + A ^ p ∈ pdSet (ℋ := ℋ) := by + rcases hA with ⟨hA_sa, hA_spec⟩ + have hA0 : 0 ≤ A := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA_sa)).2 + (by intro x hx; exact (hA_spec hx).le) + have hApow0 : 0 ≤ A ^ p := by + simp + have hApow_sa : IsSelfAdjoint (A ^ p) := IsSelfAdjoint.of_nonneg hApow0 + rcases (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := A) (ha := hA_sa)).2 hA_spec with + ⟨r, hr, hrA⟩ + refine ⟨hApow_sa, ?_⟩ + have hr0 : 0 ≤ algebraMap ℝ (L ℋ) r := by + simpa [Algebra.algebraMap_eq_smul_one] using + smul_nonneg hr.le (show (0 : L ℋ) ≤ 1 by simp) + have hmono := + power_Icc_zero_one_operatorMonotoneOn_Ici (ℋ := ℋ) p hp + (A := A) (B := algebraMap ℝ (L ℋ) r) + hA0 hr0 hrA + (by + intro x hx + have hx0 : 0 < x := by simpa [Set.Ioi] using hA_spec hx + exact hx0.le) + (by + intro x hx + exact spectrum_nonneg_of_nonneg hr0 hx) + have hApow : + cfcR (ℋ := ℋ) (fun x : ℝ ↦ x ^ p) A = A ^ p := by + simpa [cfcR, LownerHeinzCore.cfcR] using + (CFC.rpow_eq_cfc_real (A := L ℋ) (a := A) (y := p) (ha := hA0)).symm + have hscalar : + (algebraMap ℝ (L ℋ) r) ^ p = algebraMap ℝ (L ℋ) (r ^ p) := by + rw [CFC.rpow_eq_cfc_real (A := L ℋ) (a := algebraMap ℝ (L ℋ) r) (y := p) (ha := hr0)] + simp + have hbound : algebraMap ℝ (L ℋ) (r ^ p) ≤ A ^ p := by + simpa [hscalar, hApow] using hmono + exact (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := A ^ p) (ha := hApow_sa)).1 + ⟨r ^ p, Real.rpow_pos_of_pos hr p, hbound⟩ + +omit [Nontrivial ℋ] in +set_option maxHeartbeats 400000 in +private lemma liebTraceMap_mono_right + {s : ℝ} (hs : 1 - s ∈ Set.Icc (0 : ℝ) 1) + (K A B₁ B₂ : L ℋ) + (hA : A ∈ pdSet (ℋ := ℋ)) (hB₁ : B₁ ∈ pdSet (ℋ := ℋ)) (hB₂ : B₂ ∈ pdSet (ℋ := ℋ)) + (hB : B₁ ≤ B₂) : + liebTraceMap (ℋ := ℋ) s K A B₁ ≤ liebTraceMap (ℋ := ℋ) s K A B₂ := by + rcases hA with ⟨hA_sa, hA_spec⟩ + rcases hB₁ with ⟨hB₁_sa, hB₁_spec⟩ + rcases hB₂ with ⟨hB₂_sa, hB₂_spec⟩ + have hA0 : 0 ≤ A := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA_sa)).2 + (by intro x hx; exact (hA_spec hx).le) + have hB₁0 : 0 ≤ B₁ := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B₁ (ha := hB₁_sa)).2 + (by intro x hx; exact (hB₁_spec hx).le) + have hB₂0 : 0 ≤ B₂ := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B₂ (ha := hB₂_sa)).2 + (by intro x hx; exact (hB₂_spec hx).le) + have hcfc := + power_Icc_zero_one_operatorMonotoneOn_Ici (ℋ := ℋ) (1 - s) hs + (A := B₂) (B := B₁) hB₂0 hB₁0 hB + (by + intro x hx + have hx0 : 0 < x := by simpa [Set.Ioi] using hB₂_spec hx + exact hx0.le) + (by + intro x hx + have hx0 : 0 < x := by simpa [Set.Ioi] using hB₁_spec hx + exact hx0.le) + have hpow : + B₁ ^ (1 - s) ≤ B₂ ^ (1 - s) := by + simpa [cfcR, LownerHeinzCore.cfcR, + CFC.rpow_eq_cfc_real (A := L ℋ) (a := B₁) (y := 1 - s) (ha := hB₁0), + CFC.rpow_eq_cfc_real (A := L ℋ) (a := B₂) (y := 1 - s) (ha := hB₂0)] using hcfc + have hApow0 : 0 ≤ A ^ s := by + simp + have hdiff0 : 0 ≤ B₂ ^ (1 - s) - B₁ ^ (1 - s) := sub_nonneg.mpr hpow + have hprod0 : + 0 ≤ leftMulHS (ℋ := ℋ) (A ^ s) * + rightMulHS (ℋ := ℋ) (B₂ ^ (1 - s) - B₁ ^ (1 - s)) := by + exact (leftMulHS_rightMulHS_commute (ℋ := ℋ) (A ^ s) (B₂ ^ (1 - s) - B₁ ^ (1 - s))).mul_nonneg + (leftMulHS_nonneg (ℋ := ℋ) hApow0) + (rightMulHS_nonneg (ℋ := ℋ) hdiff0) + have hphi : 0 ≤ + phiK (ℋ := ℋ) K + (leftMulHS (ℋ := ℋ) (A ^ s) * + rightMulHS (ℋ := ℋ) (B₂ ^ (1 - s) - B₁ ^ (1 - s))) := + phiK_nonneg (ℋ := ℋ) K hprod0 + have hsplit : + leftMulHS (ℋ := ℋ) (A ^ s) * + rightMulHS (ℋ := ℋ) (B₂ ^ (1 - s) - B₁ ^ (1 - s)) = + leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B₂ ^ (1 - s)) - + leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B₁ ^ (1 - s)) := by + ext T + show (A ^ s * (toOp T * (B₂ ^ (1 - s) - B₁ ^ (1 - s))) : L ℋ) = + A ^ s * (toOp T * B₂ ^ (1 - s)) - A ^ s * (toOp T * B₁ ^ (1 - s)) + simp [mul_sub] + have hrewrite : + phiK (ℋ := ℋ) K + (leftMulHS (ℋ := ℋ) (A ^ s) * + rightMulHS (ℋ := ℋ) (B₂ ^ (1 - s) - B₁ ^ (1 - s))) = + liebTraceMap (ℋ := ℋ) s K A B₂ - liebTraceMap (ℋ := ℋ) s K A B₁ := by + rw [hsplit, sub_eq_add_neg, phiK_add] + rw [show -(leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B₁ ^ (1 - s))) = + (-1 : ℝ) • (leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B₁ ^ (1 - s))) by simp, + phiK_smul] + simp [phiK_leftMul_rightMul_eq_traceRe, liebTraceMap, mul_assoc, sub_eq_add_neg] + linarith [hrewrite ▸ hphi] + +omit [Nontrivial ℋ] in +set_option maxHeartbeats 400000 in +private lemma liebTraceMap_antitone_right + {s : ℝ} (hs : 1 - s ∈ Set.Icc (-1 : ℝ) 0) + (K A B₁ B₂ : L ℋ) + (hA : A ∈ pdSet (ℋ := ℋ)) (hB₁ : B₁ ∈ pdSet (ℋ := ℋ)) (hB₂ : B₂ ∈ pdSet (ℋ := ℋ)) + (hB : B₁ ≤ B₂) : + liebTraceMap (ℋ := ℋ) s K A B₂ ≤ liebTraceMap (ℋ := ℋ) s K A B₁ := by + rcases hA with ⟨hA_sa, hA_spec⟩ + rcases hB₁ with ⟨hB₁_sa, hB₁_spec⟩ + rcases hB₂ with ⟨hB₂_sa, hB₂_spec⟩ + have hA0 : 0 ≤ A := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA_sa)).2 + (by intro x hx; exact (hA_spec hx).le) + have hcfc := + power_Icc_neg_one_zero_neg_operatorMonotoneOn_Ioi (ℋ := ℋ) (1 - s) hs + (A := B₂) (B := B₁) + (show (0 : L ℋ) ≤ B₂ by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B₂ (ha := hB₂_sa)).2 + (by intro x hx; exact (hB₂_spec hx).le)) + (show (0 : L ℋ) ≤ B₁ by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B₁ (ha := hB₁_sa)).2 + (by intro x hx; exact (hB₁_spec hx).le)) + hB + (by + intro x hx + exact hB₂_spec hx) + (by + intro x hx + exact hB₁_spec hx) + have hpow : + B₂ ^ (1 - s) ≤ B₁ ^ (1 - s) := by + have hnegpow : -(B₁ ^ (1 - s)) ≤ -(B₂ ^ (1 - s)) := by + simpa [cfcR, LownerHeinzCore.cfcR, cfc_neg, + CFC.rpow_eq_cfc_real (A := L ℋ) (a := B₁) (y := 1 - s) + (ha := (show 0 ≤ B₁ by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B₁ (ha := hB₁_sa)).2 + (by intro x hx; exact (hB₁_spec hx).le))), + CFC.rpow_eq_cfc_real (A := L ℋ) (a := B₂) (y := 1 - s) + (ha := (show 0 ≤ B₂ by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B₂ (ha := hB₂_sa)).2 + (by intro x hx; exact (hB₂_spec hx).le)))] using hcfc + simpa using (neg_le_neg_iff.mp hnegpow) + have hApow0 : 0 ≤ A ^ s := by + simp + have hdiff0 : 0 ≤ B₁ ^ (1 - s) - B₂ ^ (1 - s) := sub_nonneg.mpr hpow + have hprod0 : + 0 ≤ leftMulHS (ℋ := ℋ) (A ^ s) * + rightMulHS (ℋ := ℋ) (B₁ ^ (1 - s) - B₂ ^ (1 - s)) := by + exact (leftMulHS_rightMulHS_commute (ℋ := ℋ) (A ^ s) (B₁ ^ (1 - s) - B₂ ^ (1 - s))).mul_nonneg + (leftMulHS_nonneg (ℋ := ℋ) hApow0) + (rightMulHS_nonneg (ℋ := ℋ) hdiff0) + have hphi : 0 ≤ + phiK (ℋ := ℋ) K + (leftMulHS (ℋ := ℋ) (A ^ s) * + rightMulHS (ℋ := ℋ) (B₁ ^ (1 - s) - B₂ ^ (1 - s))) := + phiK_nonneg (ℋ := ℋ) K hprod0 + have hsplit : + leftMulHS (ℋ := ℋ) (A ^ s) * + rightMulHS (ℋ := ℋ) (B₁ ^ (1 - s) - B₂ ^ (1 - s)) = + leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B₁ ^ (1 - s)) - + leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B₂ ^ (1 - s)) := by + ext T + show (A ^ s * (toOp T * (B₁ ^ (1 - s) - B₂ ^ (1 - s))) : L ℋ) = + A ^ s * (toOp T * B₁ ^ (1 - s)) - A ^ s * (toOp T * B₂ ^ (1 - s)) + simp [mul_sub] + have hrewrite : + phiK (ℋ := ℋ) K + (leftMulHS (ℋ := ℋ) (A ^ s) * + rightMulHS (ℋ := ℋ) (B₁ ^ (1 - s) - B₂ ^ (1 - s))) = + liebTraceMap (ℋ := ℋ) s K A B₁ - liebTraceMap (ℋ := ℋ) s K A B₂ := by + rw [hsplit, sub_eq_add_neg, phiK_add] + rw [show -(leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B₂ ^ (1 - s))) = + (-1 : ℝ) • (leftMulHS (ℋ := ℋ) (A ^ s) * rightMulHS (ℋ := ℋ) (B₂ ^ (1 - s))) by simp, + phiK_smul] + simp [phiK_leftMul_rightMul_eq_traceRe, liebTraceMap, mul_assoc, sub_eq_add_neg] + linarith [hrewrite ▸ hphi] + +private lemma phiK_weightedSum_operatorPowerMean_eq + {s θ : ℝ} (K A₁ A₂ B₁ B₂ : L ℋ) + (hA₁ : A₁ ∈ pdSet (ℋ := ℋ)) (hA₂ : A₂ ∈ pdSet (ℋ := ℋ)) + (hB₁ : B₁ ∈ pdSet (ℋ := ℋ)) (hB₂ : B₂ ∈ pdSet (ℋ := ℋ)) : + phiK (ℋ := ℋ) K + ((1 - θ) • operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₁) (rightMulHS (ℋ := ℋ) B₁) + + θ • operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₂) (rightMulHS (ℋ := ℋ) B₂)) = + (1 - θ) • liebTraceMap (ℋ := ℋ) s K A₁ B₁ + + θ • liebTraceMap (ℋ := ℋ) s K A₂ B₂ := by + rw [phiK_add, phiK_smul, phiK_smul] + simpa [smul_eq_mul] using + show (1 - θ) * phiK (ℋ := ℋ) K + (operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₁) (rightMulHS (ℋ := ℋ) B₁)) + + θ * phiK (ℋ := ℋ) K + (operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₂) (rightMulHS (ℋ := ℋ) B₂)) = + (1 - θ) * liebTraceMap (ℋ := ℋ) s K A₁ B₁ + + θ * liebTraceMap (ℋ := ℋ) s K A₂ B₂ by + simp only [phiK_operatorPowerMean_eq_liebTraceMap (ℋ := ℋ) (s := s) K A₁ B₁ hA₁ hB₁, + phiK_operatorPowerMean_eq_liebTraceMap (ℋ := ℋ) (s := s) K A₂ B₂ hA₂ hB₂] + +-- The `HSOp`-valued `operatorPowerMean` terms are large enough that the skeleton itself is expensive. +theorem liebTrace_jointlyConcaveOn_pdSet + {s : ℝ} (hs0 : 0 < s) (hs1 : s < 1) (K : L ℋ) : + JointlyConcaveOn (pdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) + (liebTraceMap (ℋ := ℋ) s K) := by + intro A₁ A₂ B₁ B₂ θ hA₁ hA₂ hB₁ hB₂ hθ0 hθ1 + have hleft_combo : + (1 - θ) • leftMulHS (ℋ := ℋ) A₁ + θ • leftMulHS (ℋ := ℋ) A₂ = + leftMulHS (ℋ := ℋ) ((1 - θ) • A₁ + θ • A₂) := by + ext T + show ((1 - θ) • (A₁ * toOp T) + θ • (A₂ * toOp T) : L ℋ) = + ((1 - θ) • A₁ + θ • A₂) * toOp T + rw [add_mul, smul_mul_assoc, smul_mul_assoc] + have hright_combo : + (1 - θ) • rightMulHS (ℋ := ℋ) B₁ + θ • rightMulHS (ℋ := ℋ) B₂ = + rightMulHS (ℋ := ℋ) ((1 - θ) • B₁ + θ • B₂) := by + ext T + show ((1 - θ) • (toOp T * B₁) + θ • (toOp T * B₂) : L ℋ) = + toOp T * ((1 - θ) • B₁ + θ • B₂) + rw [mul_add, mul_smul_comm, mul_smul_comm] + have hA_combo : + ((1 - θ) • A₁ + θ • A₂) ∈ pdSet (ℋ := ℋ) := by + exact pdSet_convexCombo (ℋ := ℋ) hA₁ hA₂ hθ0 hθ1 + have hB_combo : + ((1 - θ) • B₁ + θ • B₂) ∈ pdSet (ℋ := ℋ) := by + exact pdSet_convexCombo (ℋ := ℋ) hB₁ hB₂ hθ0 hθ1 + letI : Nontrivial (HSOp ℋ) := by + delta HSOp + infer_instance + letI : Nontrivial (L (HSOp ℋ)) := inferInstance + have hconc_hs := + operatorPowerMean_jointlyConcaveOn_pdSet + (ℋ := HSOp ℋ) (α := s) (β := 1) + ⟨le_of_lt hs0, hs1.le⟩ ⟨by norm_num, by norm_num⟩ + (A₁ := leftMulHS (ℋ := ℋ) A₁) (A₂ := leftMulHS (ℋ := ℋ) A₂) + (B₁ := rightMulHS (ℋ := ℋ) B₁) (B₂ := rightMulHS (ℋ := ℋ) B₂) + (θ := θ) + (leftMulHS_pdSet (ℋ := ℋ) hA₁) (leftMulHS_pdSet (ℋ := ℋ) hA₂) + (rightMulHS_pdSet (ℋ := ℋ) hB₁) (rightMulHS_pdSet (ℋ := ℋ) hB₂) + hθ0 hθ1 + have hconc : + (1 - θ) • operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₁) (rightMulHS (ℋ := ℋ) B₁) + + θ • operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₂) (rightMulHS (ℋ := ℋ) B₂) ≤ + operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) ((1 - θ) • A₁ + θ • A₂)) + (rightMulHS (ℋ := ℋ) ((1 - θ) • B₁ + θ • B₂)) := by + simpa [hleft_combo, hright_combo] using hconc_hs + have hphi_mono : + phiK (ℋ := ℋ) K + ((1 - θ) • operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₁) (rightMulHS (ℋ := ℋ) B₁) + + θ • operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₂) (rightMulHS (ℋ := ℋ) B₂)) ≤ + phiK (ℋ := ℋ) K + (operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) ((1 - θ) • A₁ + θ • A₂)) + (rightMulHS (ℋ := ℋ) ((1 - θ) • B₁ + θ • B₂))) := by + exact phiK_mono (ℋ := ℋ) K hconc + rw [phiK_weightedSum_operatorPowerMean_eq (ℋ := ℋ) (s := s) (θ := θ) K A₁ A₂ B₁ B₂ + hA₁ hA₂ hB₁ hB₂] at hphi_mono + rw [phiK_operatorPowerMean_eq_liebTraceMap (ℋ := ℋ) (s := s) K + ((1 - θ) • A₁ + θ • A₂) ((1 - θ) • B₁ + θ • B₂) hA_combo hB_combo] at hphi_mono + simpa [add_comm, add_left_comm, add_assoc] using hphi_mono + +theorem liebTrace_jointlyConvexOn_pdSet + {s : ℝ} (hs1 : 1 ≤ s) (hs2 : s ≤ 2) (K : L ℋ) : + JointlyConvexOn (pdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) + (liebTraceMap (ℋ := ℋ) s K) := by + intro A₁ A₂ B₁ B₂ θ hA₁ hA₂ hB₁ hB₂ hθ0 hθ1 + have hleft_combo : + (1 - θ) • leftMulHS (ℋ := ℋ) A₁ + θ • leftMulHS (ℋ := ℋ) A₂ = + leftMulHS (ℋ := ℋ) ((1 - θ) • A₁ + θ • A₂) := by + ext T + show ((1 - θ) • (A₁ * toOp T) + θ • (A₂ * toOp T) : L ℋ) = + ((1 - θ) • A₁ + θ • A₂) * toOp T + rw [add_mul, smul_mul_assoc, smul_mul_assoc] + have hright_combo : + (1 - θ) • rightMulHS (ℋ := ℋ) B₁ + θ • rightMulHS (ℋ := ℋ) B₂ = + rightMulHS (ℋ := ℋ) ((1 - θ) • B₁ + θ • B₂) := by + ext T + show ((1 - θ) • (toOp T * B₁) + θ • (toOp T * B₂) : L ℋ) = + toOp T * ((1 - θ) • B₁ + θ • B₂) + rw [mul_add, mul_smul_comm, mul_smul_comm] + have hA_combo : + ((1 - θ) • A₁ + θ • A₂) ∈ pdSet (ℋ := ℋ) := by + exact pdSet_convexCombo (ℋ := ℋ) hA₁ hA₂ hθ0 hθ1 + have hB_combo : + ((1 - θ) • B₁ + θ • B₂) ∈ pdSet (ℋ := ℋ) := by + exact pdSet_convexCombo (ℋ := ℋ) hB₁ hB₂ hθ0 hθ1 + letI : Nontrivial (HSOp ℋ) := by + delta HSOp + infer_instance + letI : Nontrivial (L (HSOp ℋ)) := inferInstance + have hconv_hs := + operatorPowerMean_jointlyConvexOn_pdSet + (ℋ := HSOp ℋ) (α := s) (β := 1) + ⟨hs1, hs2⟩ ⟨by norm_num, by norm_num⟩ + (A₁ := leftMulHS (ℋ := ℋ) A₁) (A₂ := leftMulHS (ℋ := ℋ) A₂) + (B₁ := rightMulHS (ℋ := ℋ) B₁) (B₂ := rightMulHS (ℋ := ℋ) B₂) + (θ := θ) + (leftMulHS_pdSet (ℋ := ℋ) hA₁) (leftMulHS_pdSet (ℋ := ℋ) hA₂) + (rightMulHS_pdSet (ℋ := ℋ) hB₁) (rightMulHS_pdSet (ℋ := ℋ) hB₂) + hθ0 hθ1 + have hconv : + operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) ((1 - θ) • A₁ + θ • A₂)) + (rightMulHS (ℋ := ℋ) ((1 - θ) • B₁ + θ • B₂)) ≤ + (1 - θ) • operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₁) (rightMulHS (ℋ := ℋ) B₁) + + θ • operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₂) (rightMulHS (ℋ := ℋ) B₂) := by + simpa [hleft_combo, hright_combo] using hconv_hs + have hphi_mono : + phiK (ℋ := ℋ) K + (operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) ((1 - θ) • A₁ + θ • A₂)) + (rightMulHS (ℋ := ℋ) ((1 - θ) • B₁ + θ • B₂))) ≤ + phiK (ℋ := ℋ) K + ((1 - θ) • operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₁) (rightMulHS (ℋ := ℋ) B₁) + + θ • operatorPowerMean (ℋ := HSOp ℋ) s 1 + (leftMulHS (ℋ := ℋ) A₂) (rightMulHS (ℋ := ℋ) B₂)) := by + exact phiK_mono (ℋ := ℋ) K hconv + rw [phiK_operatorPowerMean_eq_liebTraceMap (ℋ := ℋ) (s := s) K + ((1 - θ) • A₁ + θ • A₂) ((1 - θ) • B₁ + θ • B₂) hA_combo hB_combo] at hphi_mono + rw [phiK_weightedSum_operatorPowerMean_eq (ℋ := ℋ) (s := s) (θ := θ) K A₁ A₂ B₁ B₂ + hA₁ hA₂ hB₁ hB₂] at hphi_mono + simpa [add_comm, add_left_comm, add_assoc] using hphi_mono + +set_option maxHeartbeats 600000 in +theorem liebExtensionTrace_jointlyConcaveOn_pdSet + {p q : ℝ} (hp : 0 < p) (hq : 0 < q) (hpq : p + q ≤ 1) (K : L ℋ) : + JointlyConcaveOn (pdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) + (liebExtensionTraceMap (ℋ := ℋ) q p K) := by + have hq1 : q < 1 := by linarith + let β : ℝ := p / (1 - q) + have h1q : 0 < 1 - q := by linarith + have hβ0 : 0 ≤ β := by + dsimp [β] + positivity + have hβ1 : β ≤ 1 := by + dsimp [β] + field_simp [h1q.ne'] + linarith + have hβ : β ∈ Set.Icc (0 : ℝ) 1 := ⟨hβ0, hβ1⟩ + have hβmul : β * (1 - q) = p := by + dsimp [β] + field_simp [h1q.ne'] + intro A₁ A₂ B₁ B₂ θ hA₁ hA₂ hB₁ hB₂ hθ0 hθ1 + have hA_combo : + ((1 - θ) • A₁ + θ • A₂) ∈ pdSet (ℋ := ℋ) := by + exact pdSet_convexCombo (ℋ := ℋ) hA₁ hA₂ hθ0 hθ1 + have hB_combo : + ((1 - θ) • B₁ + θ • B₂) ∈ pdSet (ℋ := ℋ) := by + exact pdSet_convexCombo (ℋ := ℋ) hB₁ hB₂ hθ0 hθ1 + have hB₁β : B₁ ^ β ∈ pdSet (ℋ := ℋ) := + pdSet_rpow_of_mem_Icc_zero_one (ℋ := ℋ) hβ hB₁ + have hB₂β : B₂ ^ β ∈ pdSet (ℋ := ℋ) := + pdSet_rpow_of_mem_Icc_zero_one (ℋ := ℋ) hβ hB₂ + have hB_comboβ : + (((1 - θ) • B₁ + θ • B₂) ^ β) ∈ pdSet (ℋ := ℋ) := + pdSet_rpow_of_mem_Icc_zero_one (ℋ := ℋ) hβ hB_combo + have hBpow_combo : + ((1 - θ) • (B₁ ^ β) + θ • (B₂ ^ β)) ∈ pdSet (ℋ := ℋ) := by + exact pdSet_convexCombo (ℋ := ℋ) hB₁β hB₂β hθ0 hθ1 + have hB₁_mem := hB₁ + have hB₂_mem := hB₂ + have hB_combo_mem := hB_combo + rcases hB₁ with ⟨hB₁_sa, hB₁_spec⟩ + rcases hB₂ with ⟨hB₂_sa, hB₂_spec⟩ + rcases hB_combo with ⟨hB_combo_sa, hB_combo_spec⟩ + have hB₁0 : 0 ≤ B₁ := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B₁ (ha := hB₁_sa)).2 + (by intro x hx; exact (hB₁_spec hx).le) + have hB₂0 : 0 ≤ B₂ := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B₂ (ha := hB₂_sa)).2 + (by intro x hx; exact (hB₂_spec hx).le) + have hBcombo0 : 0 ≤ ((1 - θ) • B₁ + θ • B₂) := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) ((1 - θ) • B₁ + θ • B₂) + (ha := hB_combo_sa)).2 + (by intro x hx; exact (hB_combo_spec hx).le) + have hpow_conc := + power_Icc_zero_one_operatorConcaveOn_Ici (ℋ := ℋ) β hβ + (A := B₁) (B := B₂) (t := θ) hB₁_sa hB₂_sa hθ0 hθ1 + (by + intro x hx + have hx0 : 0 < x := by simpa [Set.Ioi] using hB₁_spec hx + exact hx0.le) + (by + intro x hx + have hx0 : 0 < x := by simpa [Set.Ioi] using hB₂_spec hx + exact hx0.le) + have hBpow_le : + (1 - θ) • (B₁ ^ β) + θ • (B₂ ^ β) ≤ + ((1 - θ) • B₁ + θ • B₂) ^ β := by + have hBcombo0' : 0 ≤ θ • B₂ + (1 - θ) • B₁ := by + simpa [add_comm, add_left_comm, add_assoc] using hBcombo0 + have hneg : + -(((1 - θ) • B₁ + θ • B₂) ^ β) ≤ + -((1 - θ) • (B₁ ^ β) + θ • (B₂ ^ β)) := by + simpa [cfcR, LownerHeinzCore.cfcR, cfc_neg, smul_neg, neg_add, + add_comm, add_left_comm, add_assoc, + CFC.rpow_eq_cfc_real (A := L ℋ) (a := B₁) (y := β) (ha := hB₁0), + CFC.rpow_eq_cfc_real (A := L ℋ) (a := B₂) (y := β) (ha := hB₂0), + CFC.rpow_eq_cfc_real (A := L ℋ) (a := θ • B₂ + (1 - θ) • B₁) (y := β) (ha := hBcombo0'), + CFC.rpow_eq_cfc_real (A := L ℋ) (a := ((1 - θ) • B₁ + θ • B₂)) (y := β) (ha := hBcombo0)] + using hpow_conc + exact neg_le_neg_iff.mp hneg + have hsmono : 1 - q ∈ Set.Icc (0 : ℝ) 1 := by + constructor <;> linarith + have hmono : + liebTraceMap (ℋ := ℋ) q K + ((1 - θ) • A₁ + θ • A₂) + ((1 - θ) • (B₁ ^ β) + θ • (B₂ ^ β)) ≤ + liebTraceMap (ℋ := ℋ) q K + ((1 - θ) • A₁ + θ • A₂) + (((1 - θ) • B₁ + θ • B₂) ^ β) := by + exact liebTraceMap_mono_right (ℋ := ℋ) (s := q) hsmono K + ((1 - θ) • A₁ + θ • A₂) + ((1 - θ) • (B₁ ^ β) + θ • (B₂ ^ β)) + (((1 - θ) • B₁ + θ • B₂) ^ β) + hA_combo hBpow_combo hB_comboβ hBpow_le + have hconc := + liebTrace_jointlyConcaveOn_pdSet (ℋ := ℋ) (s := q) hq hq1 K + (A₁ := A₁) (A₂ := A₂) (B₁ := B₁ ^ β) (B₂ := B₂ ^ β) + (θ := θ) hA₁ hA₂ hB₁β hB₂β hθ0 hθ1 + have hpow_rewrite : + ∀ {A B : L ℋ}, B ∈ pdSet (ℋ := ℋ) → + liebTraceMap (ℋ := ℋ) q K A (B ^ β) = + liebExtensionTraceMap (ℋ := ℋ) q p K A B := by + intro A B hB + rcases hB with ⟨hB_sa, hB_spec⟩ + have hB0 : 0 ≤ B := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B (ha := hB_sa)).2 + (by intro x hx; exact (hB_spec hx).le) + have hpow : + (B ^ β) ^ (1 - q) = B ^ p := by + calc + (B ^ β) ^ (1 - q) = B ^ (β * (1 - q)) := by + simpa using + (CFC.rpow_rpow_of_exponent_nonneg (A := L ℋ) B β (1 - q) hβ0 (by linarith) hB0) + _ = B ^ p := by rw [hβmul] + simp [liebTraceMap, liebExtensionTraceMap, hpow, mul_assoc] + simpa [hpow_rewrite hB₁_mem, hpow_rewrite hB₂_mem, hpow_rewrite hB_combo_mem] using + (le_trans hconc hmono) + +set_option maxHeartbeats 600000 in +theorem andoTrace_jointlyConvexOn_pdSet + {q r : ℝ} (hq1 : 1 ≤ q) (hq2 : q ≤ 2) (hr0 : 0 ≤ r) (hr1 : r ≤ 1) + (hqr : 1 ≤ q - r) (K : L ℋ) : + JointlyConvexOn (pdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) + (andoTraceMap (ℋ := ℋ) q r K) := by + by_cases hqeq : q = 1 + · have hrz : r = 0 := by linarith + subst hqeq + subst hrz + convert (liebTrace_jointlyConvexOn_pdSet (s := 1) (by norm_num) (by norm_num) K) using 1 + ext A B + simp [andoTraceMap, liebTraceMap] + · have hqgt : 1 < q := lt_of_le_of_ne hq1 (Ne.symm hqeq) + let β : ℝ := r / (q - 1) + have hq1pos : 0 < q - 1 := by linarith + have hβ0 : 0 ≤ β := by + dsimp [β] + positivity + have hβ1 : β ≤ 1 := by + dsimp [β] + field_simp [hq1pos.ne'] + linarith + have hβ : β ∈ Set.Icc (0 : ℝ) 1 := ⟨hβ0, hβ1⟩ + have hβmul : β * (1 - q) = -r := by + dsimp [β] + field_simp [hq1pos.ne'] + ring + intro A₁ A₂ B₁ B₂ θ hA₁ hA₂ hB₁ hB₂ hθ0 hθ1 + have hA_combo : + ((1 - θ) • A₁ + θ • A₂) ∈ pdSet (ℋ := ℋ) := by + exact pdSet_convexCombo (ℋ := ℋ) hA₁ hA₂ hθ0 hθ1 + have hB_combo : + ((1 - θ) • B₁ + θ • B₂) ∈ pdSet (ℋ := ℋ) := by + exact pdSet_convexCombo (ℋ := ℋ) hB₁ hB₂ hθ0 hθ1 + have hB₁β : B₁ ^ β ∈ pdSet (ℋ := ℋ) := + pdSet_rpow_of_mem_Icc_zero_one (ℋ := ℋ) hβ hB₁ + have hB₂β : B₂ ^ β ∈ pdSet (ℋ := ℋ) := + pdSet_rpow_of_mem_Icc_zero_one (ℋ := ℋ) hβ hB₂ + have hB_comboβ : + (((1 - θ) • B₁ + θ • B₂) ^ β) ∈ pdSet (ℋ := ℋ) := + pdSet_rpow_of_mem_Icc_zero_one (ℋ := ℋ) hβ hB_combo + have hBpow_combo : + ((1 - θ) • (B₁ ^ β) + θ • (B₂ ^ β)) ∈ pdSet (ℋ := ℋ) := by + exact pdSet_convexCombo (ℋ := ℋ) hB₁β hB₂β hθ0 hθ1 + have hB₁_mem := hB₁ + have hB₂_mem := hB₂ + have hB_combo_mem := hB_combo + rcases hB₁ with ⟨hB₁_sa, hB₁_spec⟩ + rcases hB₂ with ⟨hB₂_sa, hB₂_spec⟩ + rcases hB_combo with ⟨hB_combo_sa, hB_combo_spec⟩ + have hB₁0 : 0 ≤ B₁ := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B₁ (ha := hB₁_sa)).2 + (by intro x hx; exact (hB₁_spec hx).le) + have hB₂0 : 0 ≤ B₂ := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B₂ (ha := hB₂_sa)).2 + (by intro x hx; exact (hB₂_spec hx).le) + have hBcombo0 : 0 ≤ ((1 - θ) • B₁ + θ • B₂) := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) ((1 - θ) • B₁ + θ • B₂) + (ha := hB_combo_sa)).2 + (by intro x hx; exact (hB_combo_spec hx).le) + have hpow_conc := + power_Icc_zero_one_operatorConcaveOn_Ici (ℋ := ℋ) β hβ + (A := B₁) (B := B₂) (t := θ) hB₁_sa hB₂_sa hθ0 hθ1 + (by + intro x hx + have hx0 : 0 < x := by simpa [Set.Ioi] using hB₁_spec hx + exact hx0.le) + (by + intro x hx + have hx0 : 0 < x := by simpa [Set.Ioi] using hB₂_spec hx + exact hx0.le) + have hBcombo0' : 0 ≤ θ • B₂ + (1 - θ) • B₁ := by + simpa [add_comm, add_left_comm, add_assoc] using hBcombo0 + have hBpow_le : + (1 - θ) • (B₁ ^ β) + θ • (B₂ ^ β) ≤ + ((1 - θ) • B₁ + θ • B₂) ^ β := by + have hneg : + -(((1 - θ) • B₁ + θ • B₂) ^ β) ≤ + -((1 - θ) • (B₁ ^ β) + θ • (B₂ ^ β)) := by + simpa [cfcR, LownerHeinzCore.cfcR, cfc_neg, smul_neg, neg_add, + add_comm, add_left_comm, add_assoc, + CFC.rpow_eq_cfc_real (A := L ℋ) (a := B₁) (y := β) (ha := hB₁0), + CFC.rpow_eq_cfc_real (A := L ℋ) (a := B₂) (y := β) (ha := hB₂0), + CFC.rpow_eq_cfc_real (A := L ℋ) (a := θ • B₂ + (1 - θ) • B₁) (y := β) (ha := hBcombo0'), + CFC.rpow_eq_cfc_real (A := L ℋ) (a := ((1 - θ) • B₁ + θ • B₂)) (y := β) (ha := hBcombo0)] + using hpow_conc + exact neg_le_neg_iff.mp hneg + have hsanti : 1 - q ∈ Set.Icc (-1 : ℝ) 0 := by + constructor <;> linarith + have hmono : + liebTraceMap (ℋ := ℋ) q K + ((1 - θ) • A₁ + θ • A₂) + (((1 - θ) • B₁ + θ • B₂) ^ β) ≤ + liebTraceMap (ℋ := ℋ) q K + ((1 - θ) • A₁ + θ • A₂) + ((1 - θ) • (B₁ ^ β) + θ • (B₂ ^ β)) := by + exact liebTraceMap_antitone_right (ℋ := ℋ) (s := q) hsanti K + ((1 - θ) • A₁ + θ • A₂) + ((1 - θ) • (B₁ ^ β) + θ • (B₂ ^ β)) + (((1 - θ) • B₁ + θ • B₂) ^ β) + hA_combo hBpow_combo hB_comboβ hBpow_le + have hconv := + liebTrace_jointlyConvexOn_pdSet (ℋ := ℋ) (s := q) hq1 hq2 K + (A₁ := A₁) (A₂ := A₂) (B₁ := B₁ ^ β) (B₂ := B₂ ^ β) + (θ := θ) hA₁ hA₂ hB₁β hB₂β hθ0 hθ1 + have hpow_rewrite : + ∀ {A B : L ℋ}, B ∈ pdSet (ℋ := ℋ) → + liebTraceMap (ℋ := ℋ) q K A (B ^ β) = + andoTraceMap (ℋ := ℋ) q r K A B := by + intro A B hB + rcases hB with ⟨hB_sa, hB_spec⟩ + have hB0 : 0 ≤ B := by + exact (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B (ha := hB_sa)).2 + (by intro x hx; exact (hB_spec hx).le) + have hBunit : IsUnit B := by + refine spectrum.isUnit_of_zero_notMem (R := ℝ) ?_ + intro h0 + exact (lt_irrefl (0 : ℝ)) (by simpa [Set.Ioi] using hB_spec h0) + have hpow : + (B ^ β) ^ (1 - q) = B ^ (-r) := by + by_cases hβzero : β = 0 + · have hrz : r = 0 := by + rw [hβzero] at hβmul + linarith + have hBzero : B ^ (0 : ℝ) = (1 : L ℋ) := by + simpa using (CFC.rpow_zero (a := B)) + calc + (B ^ β) ^ (1 - q) = (B ^ (0 : ℝ)) ^ (1 - q) := by simp [hβzero] + _ = (1 : L ℋ) ^ (1 - q) := by rw [hBzero] + _ = (1 : L ℋ) := by simp + _ = B ^ (0 : ℝ) := by rw [hBzero] + _ = B ^ (-r) := by simp [hrz] + · calc + (B ^ β) ^ (1 - q) = B ^ (β * (1 - q)) := by + simpa [mul_comm] using + (CFC.rpow_rpow B β (1 - q) hβzero (hBunit.isStrictlyPositive hB0)) + _ = B ^ (-r) := by rw [hβmul] + simp [liebTraceMap, andoTraceMap, hpow, mul_assoc] + simpa [hpow_rewrite hB₁_mem, hpow_rewrite hB₂_mem, hpow_rewrite hB_combo_mem] using + (le_trans hmono hconv) + +theorem liebCorollaryTrace_jointlyConvexOn_pdSet + {q r : ℝ} (hr1 : 1 < r) (hrq : r ≤ q) (hq2 : q ≤ 2) (K : L ℋ) : + JointlyConvexOn (pdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) + (liebCorollaryTraceMap (ℋ := ℋ) q r K) := by + have hq1 : 1 ≤ q := by linarith + have hr0 : 0 ≤ r - 1 := by linarith + have hr1' : r - 1 ≤ 1 := by linarith + have hqr' : 1 ≤ q - (r - 1) := by linarith + convert + (andoTrace_jointlyConvexOn_pdSet (ℋ := ℋ) (q := q) (r := r - 1) + hq1 hq2 hr0 hr1' hqr' K) using 1 + ext A B + simp [liebCorollaryTraceMap, andoTraceMap] + +end LiebAndoTrace diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LownerHeinzCore.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LownerHeinzCore.lean new file mode 100644 index 000000000..10dc92933 --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LownerHeinzCore.lean @@ -0,0 +1,2406 @@ +/- +Copyright (c) 2026 Hayata Yamasaki. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kei Tsukamoto, Kento Mori, Hayata Yamasaki +-/ + +module + +public import Mathlib.Analysis.CStarAlgebra.ContinuousFunctionalCalculus.Order +public import Mathlib.Analysis.SpecialFunctions.ContinuousFunctionalCalculus.Rpow.IntegralRepresentation +public import Mathlib.Analysis.SpecialFunctions.ContinuousFunctionalCalculus.Rpow.Order +public import Mathlib.LinearAlgebra.Matrix.PosDef + +@[expose] public section + +/-! +## 構造（Core / Wrapper） + +このファイルは Löwner–Heinz まわりの議論を、**一般の C★代数 `𝓐`** 上で再利用できるように +Core として切り出したものです。 + +- `section Pure`：`cfcR` と `OperatorMonotone(On)` / `OperatorConvexOn` などの **定義**（軽い層） +- `section Spectrum`：`NonnegSpectrumClass` などを仮定して、主要定理群を置く **重い層** +- `namespace LownerHeinzCore.Spectral`：`spectralOrder` を **`local instance`** として閉じ込めた wrapper + +`spectralOrder` を Core 本体に混ぜず、wrapper 側で局所化することで、他モジュールへの順序変更が +漏れないようにしています。また `NonnegSpectrumClass` は必要な層で明示し、場当たりの `infer_instance` +散布を避けています。 +-/ + +namespace LownerHeinzCore + +universe u v + +open CFC + +section Pure + +variable {𝓐 : Type u} +variable [CStarAlgebra 𝓐] [PartialOrder 𝓐] [StarOrderedRing 𝓐] +variable [Nontrivial 𝓐] + +noncomputable abbrev cfcR (f : ℝ → ℝ) (A : 𝓐) : 𝓐 := + cfc (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) f A + +/-- Fixed-space operator monotonicity on the ambient algebra `𝓐`. -/ +def OperatorMonotone (f : ℝ → ℝ) : Prop := + ∀ ⦃A B : 𝓐⦄, 0 ≤ A → 0 ≤ B → B ≤ A → cfcR f B ≤ cfcR f A + +/-- Fixed-space operator monotonicity on `s` for the ambient algebra `𝓐`. -/ +def OperatorMonotoneOn (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ ⦃A B : 𝓐⦄, + 0 ≤ A → 0 ≤ B → B ≤ A → + spectrum ℝ A ⊆ s → spectrum ℝ B ⊆ s → + cfcR f B ≤ cfcR f A + +/-- Fixed-space operator antitonicity on the ambient algebra `𝓐`. -/ +def OperatorAntitone (f : ℝ → ℝ) : Prop := + ∀ ⦃A B : 𝓐⦄, 0 ≤ A → 0 ≤ B → B ≤ A → + cfcR f A ≤ cfcR f B + +/-- Fixed-space operator antitonicity on `s` for the ambient algebra `𝓐`. -/ +def OperatorAntitoneOn (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ ⦃A B : 𝓐⦄, + 0 ≤ A → 0 ≤ B → B ≤ A → + spectrum ℝ A ⊆ s → spectrum ℝ B ⊆ s → + cfcR f A ≤ cfcR f B + +/-- Fixed-space operator convexity on the ambient algebra `𝓐`. -/ +def OperatorConvex (f : ℝ → ℝ) : Prop := + ∀ ⦃A B : 𝓐⦄ ⦃t : ℝ⦄, 0 ≤ t → t ≤ 1 → + cfcR f ((1 - t) • A + t • B) + ≤ (1 - t) • cfcR f A + t • cfcR f B + +/-- Fixed-space operator convexity on `s` for the ambient algebra `𝓐`. -/ +def OperatorConvexOn (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ ⦃A B : 𝓐⦄ ⦃t : ℝ⦄, + IsSelfAdjoint A → IsSelfAdjoint B → + 0 ≤ t → t ≤ 1 → + spectrum ℝ A ⊆ s → spectrum ℝ B ⊆ s → + cfcR f ((1 - t) • A + t • B) + ≤ (1 - t) • cfcR f A + t • cfcR f B + +/-- Fixed-space operator concavity on the ambient algebra `𝓐`. -/ +def OperatorConcave (f : ℝ → ℝ) : Prop := + OperatorConvex (𝓐 := 𝓐) (fun x => - f x) + +/-- Fixed-space operator concavity on `s` for the ambient algebra `𝓐`. -/ +def OperatorConcaveOn (s : Set ℝ) (f : ℝ → ℝ) : Prop := + OperatorConvexOn (𝓐 := 𝓐) (s : Set ℝ) (fun x => - f x) + +omit 𝓐 [CStarAlgebra 𝓐] [PartialOrder 𝓐] [StarOrderedRing 𝓐] [Nontrivial 𝓐] in +/-- Uniform operator monotonicity over all ambient algebras in universe `u`. -/ +def OperatorMonotoneAll (f : ℝ → ℝ) : Prop := + ∀ {𝓑 : Type u} [CStarAlgebra 𝓑] [PartialOrder 𝓑] [StarOrderedRing 𝓑] + [ContinuousFunctionalCalculus ℝ 𝓑 IsSelfAdjoint] [Nontrivial 𝓑], + OperatorMonotone (𝓐 := 𝓑) f + +omit 𝓐 [CStarAlgebra 𝓐] [PartialOrder 𝓐] [StarOrderedRing 𝓐] [Nontrivial 𝓐] in +/-- Uniform operator monotonicity on `s` over all ambient algebras in universe `u`. -/ +def OperatorMonotoneOnAll (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ {𝓑 : Type u} [CStarAlgebra 𝓑] [PartialOrder 𝓑] [StarOrderedRing 𝓑] + [ContinuousFunctionalCalculus ℝ 𝓑 IsSelfAdjoint] [Nontrivial 𝓑], + OperatorMonotoneOn (𝓐 := 𝓑) s f + +omit 𝓐 [CStarAlgebra 𝓐] [PartialOrder 𝓐] [StarOrderedRing 𝓐] [Nontrivial 𝓐] in +/-- Uniform operator antitonicity over all ambient algebras in universe `u`. -/ +def OperatorAntitoneAll (f : ℝ → ℝ) : Prop := + ∀ {𝓑 : Type u} [CStarAlgebra 𝓑] [PartialOrder 𝓑] [StarOrderedRing 𝓑] + [ContinuousFunctionalCalculus ℝ 𝓑 IsSelfAdjoint] [Nontrivial 𝓑], + OperatorAntitone (𝓐 := 𝓑) f + +omit 𝓐 [CStarAlgebra 𝓐] [PartialOrder 𝓐] [StarOrderedRing 𝓐] [Nontrivial 𝓐] in +/-- Uniform operator antitonicity on `s` over all ambient algebras in universe `u`. -/ +def OperatorAntitoneOnAll (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ {𝓑 : Type u} [CStarAlgebra 𝓑] [PartialOrder 𝓑] [StarOrderedRing 𝓑] + [ContinuousFunctionalCalculus ℝ 𝓑 IsSelfAdjoint] [Nontrivial 𝓑], + OperatorAntitoneOn (𝓐 := 𝓑) s f + +omit 𝓐 [CStarAlgebra 𝓐] [PartialOrder 𝓐] [StarOrderedRing 𝓐] [Nontrivial 𝓐] in +/-- Uniform operator convexity over all ambient algebras in universe `u`. -/ +def OperatorConvexAll (f : ℝ → ℝ) : Prop := + ∀ {𝓑 : Type u} [CStarAlgebra 𝓑] [PartialOrder 𝓑] [StarOrderedRing 𝓑] + [ContinuousFunctionalCalculus ℝ 𝓑 IsSelfAdjoint] [Nontrivial 𝓑], + OperatorConvex (𝓐 := 𝓑) f + +omit 𝓐 [CStarAlgebra 𝓐] [PartialOrder 𝓐] [StarOrderedRing 𝓐] [Nontrivial 𝓐] in +/-- Uniform operator convexity on `s` over all ambient algebras in universe `u`. -/ +def OperatorConvexOnAll (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ {𝓑 : Type u} [CStarAlgebra 𝓑] [PartialOrder 𝓑] [StarOrderedRing 𝓑] + [ContinuousFunctionalCalculus ℝ 𝓑 IsSelfAdjoint] [Nontrivial 𝓑], + OperatorConvexOn (𝓐 := 𝓑) s f + +omit 𝓐 [CStarAlgebra 𝓐] [PartialOrder 𝓐] [StarOrderedRing 𝓐] [Nontrivial 𝓐] in +/-- Uniform operator concavity over all ambient algebras in universe `u`. -/ +def OperatorConcaveAll (f : ℝ → ℝ) : Prop := + ∀ {𝓑 : Type u} [CStarAlgebra 𝓑] [PartialOrder 𝓑] [StarOrderedRing 𝓑] + [ContinuousFunctionalCalculus ℝ 𝓑 IsSelfAdjoint] [Nontrivial 𝓑], + OperatorConcave (𝓐 := 𝓑) f + +omit 𝓐 [CStarAlgebra 𝓐] [PartialOrder 𝓐] [StarOrderedRing 𝓐] [Nontrivial 𝓐] in +/-- Uniform operator concavity on `s` over all ambient algebras in universe `u`. -/ +def OperatorConcaveOnAll (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ {𝓑 : Type u} [CStarAlgebra 𝓑] [PartialOrder 𝓑] [StarOrderedRing 𝓑] + [ContinuousFunctionalCalculus ℝ 𝓑 IsSelfAdjoint] [Nontrivial 𝓑], + OperatorConcaveOn (𝓐 := 𝓑) s f + +end Pure + +section Spectrum + +variable {𝓐 : Type u} +variable [CStarAlgebra 𝓐] [PartialOrder 𝓐] [StarOrderedRing 𝓐] +variable [Nontrivial 𝓐] +variable [NonnegSpectrumClass ℝ 𝓐] + +omit [Nontrivial (𝓐)] [NonnegSpectrumClass ℝ 𝓐] in +lemma conjugate_isPositive {X T : 𝓐} (hX : 0 ≤ X) (hT : IsSelfAdjoint T) : + 0 ≤ T * X * T := by + simpa using hT.conjugate_nonneg hX + +omit [Nontrivial 𝓐] [NonnegSpectrumClass ℝ 𝓐] in +theorem one_div_operatorAntitoneOn_Ioi : + OperatorAntitoneOn (𝓐 := 𝓐) (Set.Ioi (0 : ℝ)) (fun x : ℝ ↦ 1 / x) := by + dsimp [OperatorAntitoneOn] + intro A B A_nonneg B_nonneg BA As Bs + let f : ℝ → ℝ := fun x ↦ x + have hA_sa : IsSelfAdjoint A := IsSelfAdjoint.of_nonneg A_nonneg + have hB_sa : IsSelfAdjoint B := IsSelfAdjoint.of_nonneg B_nonneg + have hA_ne0 : ∀ x ∈ spectrum ℝ A, f x ≠ 0 := by + intro x hx + exact ne_of_gt (As hx) + have hB_ne0 : ∀ x ∈ spectrum ℝ B, f x ≠ 0 := by + intro x hx + exact ne_of_gt (Bs hx) + let uA : (𝓐)ˣ := + cfcUnits (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) f A hA_ne0 (ha := hA_sa) + let uB : (𝓐)ˣ := + cfcUnits (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) f B hB_ne0 (ha := hB_sa) + have huA_val : (uA : 𝓐) = A := by + simp [uA, cfcUnits, f, cfc_id' (R := ℝ) (a := A) (ha := hA_sa)] + have huB_val : (uB : 𝓐) = B := by + simp [uB, cfcUnits, f, cfc_id' (R := ℝ) (a := B) (ha := hB_sa)] + have huB_nonneg : 0 ≤ (uB : 𝓐) := by + simpa [huB_val] using B_nonneg + have hub_le_hua : (uB : 𝓐) ≤ (uA : 𝓐) := by + simpa [huA_val, huB_val] using BA + have hinv : (↑uA⁻¹ : 𝓐) ≤ (↑uB⁻¹ : 𝓐) := by + simpa using + (CStarAlgebra.inv_le_inv (A := 𝓐) (a := uB) (b := uA) huB_nonneg hub_le_hua) + -- convert the inverse inequality back to the desired `cfcR` inequality + simpa [uA, uB, cfcUnits, cfcR, f, one_div] using hinv + +private lemma spectrum_convexCombo_Ioi {A B : 𝓐} {t : ℝ} + (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + (As : spectrum ℝ A ⊆ Set.Ioi (0 : ℝ)) (Bs : spectrum ℝ B ⊆ Set.Ioi (0 : ℝ)) : + spectrum ℝ ((1 - t) • A + t • B) ⊆ Set.Ioi (0 : ℝ) := by + set C : 𝓐 := (1 - t) • A + t • B + have hC : IsSelfAdjoint C := by + simpa [C] using (IsSelfAdjoint.all (1 - t)).smul hA |>.add ((IsSelfAdjoint.all t).smul hB) + have hApos : ∃ r > 0, algebraMap ℝ (𝓐) r ≤ A := by + refine (CFC.exists_pos_algebraMap_le_iff (A := 𝓐) (a := A) (ha := hA)).2 ?_ + intro x hx + exact As hx + have hBpos : ∃ r > 0, algebraMap ℝ (𝓐) r ≤ B := by + refine (CFC.exists_pos_algebraMap_le_iff (A := 𝓐) (a := B) (ha := hB)).2 ?_ + intro x hx + exact Bs hx + rcases hApos with ⟨rA, hrA, hrA_le⟩ + rcases hBpos with ⟨rB, hrB, hrB_le⟩ + set rC : ℝ := (1 - t) * rA + t * rB + have hrC : 0 < rC := by + by_cases h1t : (1 - t) = 0 + · have ht' : t = 1 := by simpa [sub_eq_zero] using (sub_eq_zero.mp h1t).symm + subst ht' + simpa [rC, h1t] using hrB + · simpa [rC] using add_pos_of_pos_of_nonneg (mul_pos (lt_of_le_of_ne' (sub_nonneg.mpr ht1) (by simpa using h1t)) hrA) (mul_nonneg ht0 (le_of_lt hrB)) + have hrC_le : algebraMap ℝ (𝓐) rC ≤ C := by + have hsum : (1 - t) • algebraMap ℝ (𝓐) rA + t • algebraMap ℝ (𝓐) rB ≤ C := by + simpa [C] using add_le_add (smul_le_smul_of_nonneg_left hrA_le (sub_nonneg.mpr ht1)) (smul_le_smul_of_nonneg_left hrB_le ht0) + have hLHS : + (1 - t) • algebraMap ℝ (𝓐) rA + t • algebraMap ℝ (𝓐) rB = + algebraMap ℝ (𝓐) rC := by + simp [rC, Algebra.smul_def] + simpa [hLHS] using hsum + intro x hx + simpa [C] using (CFC.exists_pos_algebraMap_le_iff (A := 𝓐) (a := C) (ha := hC)).1 ⟨rC, hrC, hrC_le⟩ x hx + +omit [Nontrivial (𝓐)] in +omit [NonnegSpectrumClass ℝ 𝓐] in +private lemma posSemidef_block_one_inv {A : 𝓐} (hA : IsSelfAdjoint A) + (As : spectrum ℝ A ⊆ Set.Ioi (0 : ℝ)) : + Matrix.PosSemidef + (!![A, 1; 1, cfcR (fun x : ℝ ↦ x⁻¹) A] : Matrix (Fin 2) (Fin 2) 𝓐) := by + -- Gram matrix construction using `A^{1/2}` and `A^{-1/2}` + set sqrtA : 𝓐 := cfcR (fun x : ℝ ↦ x ^ ((1 : ℝ) / 2)) A + set invSqrtA : 𝓐 := cfcR (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) A + set v : Fin 2 → 𝓐 := fun i => if i = 0 then sqrtA else invSqrtA + have posV : Matrix.PosSemidef (Matrix.vecMulVec v (star v)) := by + simpa using (Matrix.posSemidef_vecMulVec_self_star (R := 𝓐) v) + have hsqrtA : IsSelfAdjoint sqrtA := by + dsimp [sqrtA, cfcR] + exact cfc_predicate _ _ + have hinvSqrtA : IsSelfAdjoint invSqrtA := by + dsimp [invSqrtA, cfcR] + exact cfc_predicate _ _ + have hcont_sqrt : ContinuousOn (fun x : ℝ ↦ x ^ ((1 : ℝ) / 2)) (spectrum ℝ A) := + fun x hx => (Real.continuousAt_rpow_const x _ (Or.inl (ne_of_gt (As hx)))).continuousWithinAt + have hcont_invSqrt : ContinuousOn (fun x : ℝ ↦ x ^ ((-1 : ℝ) / 2)) (spectrum ℝ A) := + fun x hx => (Real.continuousAt_rpow_const x _ (Or.inl (ne_of_gt (As hx)))).continuousWithinAt + have sqrtA_mul_invSqrtA : sqrtA * invSqrtA = (1 : 𝓐) := by + dsimp [sqrtA, invSqrtA, cfcR] + rw [← cfc_mul _ _ A hcont_sqrt hcont_invSqrt, ← cfc_const_one ℝ A] + apply cfc_congr + intro x hx + dsimp only + rw [← Real.rpow_add (As hx), show ((1 : ℝ) / 2 + (-1) / 2 : ℝ) = 0 from by ring, Real.rpow_zero] + have invSqrtA_mul_sqrtA : invSqrtA * sqrtA = (1 : 𝓐) := by + dsimp [sqrtA, invSqrtA, cfcR] + rw [← cfc_mul _ _ A hcont_invSqrt hcont_sqrt, ← cfc_const_one ℝ A] + apply cfc_congr + intro x hx + dsimp only + rw [← Real.rpow_add (As hx), show ((-1 : ℝ) / 2 + (1 : ℝ) / 2 : ℝ) = 0 from by ring, Real.rpow_zero] + have invSqrtA_mul_invSqrtA : invSqrtA * invSqrtA = cfcR (fun x : ℝ ↦ x ^ (-1 : ℝ)) A := by + dsimp [invSqrtA, cfcR] + rw [← cfc_mul _ _ A hcont_invSqrt hcont_invSqrt] + apply cfc_congr + intro x hx + dsimp only + rw [← Real.rpow_add (As hx), show ((-1 : ℝ) / 2 + (-1 : ℝ) / 2 : ℝ) = -1 from by ring] + have sqrtA_mul_sqrtA : sqrtA * sqrtA = A := by + dsimp [sqrtA, cfcR] + rw [← cfc_mul _ _ A hcont_sqrt hcont_sqrt] + calc + cfcR (fun x : ℝ ↦ x ^ ((1 : ℝ) / 2) * x ^ ((1 : ℝ) / 2)) A = + cfcR (fun x : ℝ ↦ x) A := by + apply cfc_congr + intro x hx + dsimp only + rw [← Real.rpow_add (As hx), show ((1 : ℝ) / 2 + (1 : ℝ) / 2 : ℝ) = 1 from by ring, Real.rpow_one] + _ = A := cfc_id' (R := ℝ) (a := A) (ha := hA) + have invA_eq : cfcR (fun x : ℝ ↦ x ^ (-1 : ℝ)) A = cfcR (fun x : ℝ ↦ x⁻¹) A := by + dsimp [cfcR] + apply cfc_congr + intro x hx + have hxne : x ≠ 0 := ne_of_gt (As hx) + simpa [hxne] using (Real.rpow_neg_one x) + have hEq : Matrix.vecMulVec v (star v) = (!![A, 1; 1, cfcR (fun x : ℝ ↦ x⁻¹) A] : + Matrix (Fin 2) (Fin 2) (𝓐)) := by + ext i j + fin_cases i <;> fin_cases j <;> + simp [Matrix.vecMulVec_apply, v, hsqrtA.star_eq, hinvSqrtA.star_eq, sqrtA_mul_sqrtA, + sqrtA_mul_invSqrtA, invSqrtA_mul_sqrtA, invSqrtA_mul_invSqrtA, invA_eq] + simpa [hEq] using posV + +omit [Nontrivial (𝓐)] in +omit [PartialOrder 𝓐] [StarOrderedRing 𝓐] [NonnegSpectrumClass ℝ 𝓐] in +private lemma schur_conj_eq_diagonal {C D invC : 𝓐} (hInvC_sa : IsSelfAdjoint invC) + (invC_mul_C : invC * C = (1 : 𝓐)) (C_mul_invC : C * invC = (1 : 𝓐)) : + star (!![(1 : 𝓐), -invC; 0, 1] : Matrix (Fin 2) (Fin 2) (𝓐)) + * (!![C, 1; 1, D] : Matrix (Fin 2) (Fin 2) (𝓐)) + * (!![(1 : 𝓐), -invC; 0, 1] : Matrix (Fin 2) (Fin 2) (𝓐)) + = Matrix.diagonal (fun i : Fin 2 => if i = 0 then C else D - invC) := by + set U : Matrix (Fin 2) (Fin 2) (𝓐) := !![(1 : 𝓐), -invC; 0, 1] + have hstarU : star U = !![(1 : 𝓐), 0; -invC, 1] := by + dsimp [U] + ext i j + fin_cases i <;> fin_cases j <;> simp [hInvC_sa.star_eq] + have hP : + star U * (!![C, 1; 1, D] : Matrix (Fin 2) (Fin 2) (𝓐)) = + !![C, 1; -invC * C + 1, -invC + D] := by + simp [hstarU, U] + have hQ : + star U * (!![C, 1; 1, D] : Matrix (Fin 2) (Fin 2) (𝓐)) * U = + !![C, 0; 0, D - invC] := by + have hstep : + star U * (!![C, 1; 1, D] : Matrix (Fin 2) (Fin 2) (𝓐)) * U = + (!![C, 1; -invC * C + 1, -invC + D] : Matrix (Fin 2) (Fin 2) (𝓐)) * U := by + simpa [mul_assoc] using congrArg (fun X => X * U) hP + dsimp [U] at hstep ⊢ + simp [hstep, C_mul_invC, invC_mul_C, sub_eq_add_neg, add_comm] + have hdiag : + (Matrix.diagonal (fun i : Fin 2 => if i = 0 then C else D - invC)) = + (!![C, 0; 0, D - invC] : Matrix (Fin 2) (Fin 2) (𝓐)) := by + ext i j + fin_cases i <;> fin_cases j <;> simp [Matrix.diagonal] + simpa [hdiag] using hQ + +theorem one_div_operatorConvexOn_Ioi : + OperatorConvexOn (𝓐 := 𝓐) (Set.Ioi (0 : ℝ)) (fun x : ℝ ↦ 1 / x) := by + dsimp [OperatorConvexOn] + intro A B t hA hB ht0 ht1 As Bs + -- rewrite `1/x` as `x⁻¹` + simp only [one_div] + set C : 𝓐 := (1 - t) • A + t • B + have hC : IsSelfAdjoint C := by + simpa [C] using (IsSelfAdjoint.all (1 - t)).smul hA |>.add ((IsSelfAdjoint.all t).smul hB) + have specC : spectrum ℝ C ⊆ Set.Ioi (0 : ℝ) := by + simpa [C] using + spectrum_convexCombo_Ioi (A := A) (B := B) (t := t) hA hB ht0 ht1 As Bs + set invA : 𝓐 := cfcR (fun x : ℝ ↦ x⁻¹) A + set invB : 𝓐 := cfcR (fun x : ℝ ↦ x⁻¹) B + set invC : 𝓐 := cfcR (fun x : ℝ ↦ x⁻¹) C + set D : 𝓐 := (1 - t) • invA + t • invB + let M_A : Matrix (Fin 2) (Fin 2) (𝓐) := !![A, 1; 1, invA] + let M_B : Matrix (Fin 2) (Fin 2) (𝓐) := !![B, 1; 1, invB] + let M : Matrix (Fin 2) (Fin 2) (𝓐) := (1 - t) • M_A + t • M_B + have posA : Matrix.PosSemidef M_A := by + simpa [M_A, invA] using posSemidef_block_one_inv (A := A) hA As + have posB : Matrix.PosSemidef M_B := by + simpa [M_B, invB] using posSemidef_block_one_inv (A := B) hB Bs + have posM : Matrix.PosSemidef M := by + simpa [M] using Matrix.PosSemidef.add + (Matrix.PosSemidef.smul (x := M_A) (a := (1 - t)) posA (sub_nonneg.mpr ht1)) + (Matrix.PosSemidef.smul (x := M_B) (a := t) posB ht0) + have hM : M = !![C, 1; 1, D] := by + ext i j + fin_cases i <;> fin_cases j + · simp [M, M_A, M_B, C] + · have h1 : (1 - t) • (1 : 𝓐) + t • (1 : 𝓐) = (1 : 𝓐) := by + calc + (1 - t) • (1 : 𝓐) + t • (1 : 𝓐) = ((1 - t) + t) • (1 : 𝓐) := by + simpa using (add_smul (1 - t) t (1 : 𝓐)).symm + _ = (1 : 𝓐) := by simp [sub_add_cancel] + simp [M, M_A, M_B, h1] + · have h1 : (1 - t) • (1 : 𝓐) + t • (1 : 𝓐) = (1 : 𝓐) := by + calc + (1 - t) • (1 : 𝓐) + t • (1 : 𝓐) = ((1 - t) + t) • (1 : 𝓐) := by + simpa using (add_smul (1 - t) t (1 : 𝓐)).symm + _ = (1 : 𝓐) := by simp [sub_add_cancel] + simp [M, M_A, M_B, h1] + · simp [M, M_A, M_B, D] + let U : Matrix (Fin 2) (Fin 2) (𝓐) := !![(1 : 𝓐), -invC; 0, 1] + have hU : IsUnit U := by + let V : Matrix (Fin 2) (Fin 2) (𝓐) := !![(1 : 𝓐), invC; 0, 1] + refine ⟨⟨U, V, ?_, ?_⟩, rfl⟩ + · dsimp [U, V] + simp [Matrix.one_fin_two] + · dsimp [U, V] + simp [Matrix.one_fin_two] + have hconj : + star U * (!![C, 1; 1, D] : Matrix (Fin 2) (Fin 2) (𝓐)) * U + = Matrix.diagonal (fun i : Fin 2 => if i = 0 then C else D - invC) := by + have hInvC_sa : IsSelfAdjoint invC := by + dsimp [invC, cfcR] + exact cfc_predicate _ _ + have hcont_inv : ContinuousOn (fun x : ℝ ↦ x⁻¹) (spectrum ℝ C) := + fun x hx => (continuousAt_inv₀ (ne_of_gt (specC hx))).continuousWithinAt + have invC_mul_C : invC * C = (1 : 𝓐) := by + dsimp [invC, cfcR] + have hmul : + cfcR (fun x : ℝ ↦ x⁻¹) C * C = + cfcR (fun x : ℝ ↦ x⁻¹ * x) C := by + simpa [cfc_id' (R := ℝ) (a := C) (ha := hC)] using + (cfc_mul (fun x : ℝ ↦ x⁻¹) (fun x : ℝ ↦ x) C hcont_inv continuousOn_id).symm + rw [hmul, ← cfc_const_one ℝ C] + apply cfc_congr + intro x hx + have hxne : x ≠ 0 := ne_of_gt (specC hx) + simp [hxne] + have C_mul_invC : C * invC = (1 : 𝓐) := by + dsimp [invC, cfcR] + have hmul : + C * cfcR (fun x : ℝ ↦ x⁻¹) C = + cfcR (fun x : ℝ ↦ x * x⁻¹) C := by + simpa [cfc_id' (R := ℝ) (a := C) (ha := hC)] using + (cfc_mul (fun x : ℝ ↦ x) (fun x : ℝ ↦ x⁻¹) C continuousOn_id hcont_inv).symm + rw [hmul, ← cfc_const_one ℝ C] + apply cfc_congr + intro x hx + have hxne : x ≠ 0 := ne_of_gt (specC hx) + simp [hxne] + simpa [U] using + schur_conj_eq_diagonal (C := C) (D := D) (invC := invC) + hInvC_sa invC_mul_C C_mul_invC + have posDiag : + Matrix.PosSemidef (Matrix.diagonal (fun i : Fin 2 => if i = 0 then C else D - invC)) := by + have posConj : Matrix.PosSemidef (star U * M * U) := by + simpa [Matrix.star_eq_conjTranspose] using (posM.conjTranspose_mul_mul_same U) + have posConj' : + Matrix.PosSemidef + (star U * (!![C, 1; 1, D] : Matrix (Fin 2) (Fin 2) 𝓐) * U) := by + -- rewrite the middle block matrix as `M` + rw [← hM] + exact posConj + -- rewrite the goal using the computed conjugation + rw [← hconj] + exact posConj' + have hinvC : invC ≤ D := by + have hDinvC : 0 ≤ D - invC := by + simpa using + (Matrix.posSemidef_diagonal_iff (R := 𝓐) + (d := fun i : Fin 2 => if i = 0 then C else D - invC)).1 posDiag (1 : Fin 2) + exact le_of_sub_nonneg hDinvC + exact hinvC + +omit [Nontrivial (𝓐)] [NonnegSpectrumClass ℝ 𝓐] in +theorem one_div_add_t_operatorAntitoneOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorAntitoneOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ 1 / (x + t)) := by + intro t ht + dsimp [OperatorAntitoneOn] + intro A B A_nonneg B_nonneg BA As Bs + let f : ℝ → ℝ := fun x => x + t + have hA_sa : IsSelfAdjoint A := IsSelfAdjoint.of_nonneg A_nonneg + have hB_sa : IsSelfAdjoint B := IsSelfAdjoint.of_nonneg B_nonneg + have hA_ne0 : ∀ x ∈ spectrum ℝ A, f x ≠ 0 := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := by + simpa [Set.Ici] using (As hx) + exact ne_of_gt (add_pos_of_nonneg_of_pos hx0 ht) + have hB_ne0 : ∀ x ∈ spectrum ℝ B, f x ≠ 0 := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := by + simpa [Set.Ici] using (Bs hx) + exact ne_of_gt (add_pos_of_nonneg_of_pos hx0 ht) + let uA : (𝓐)ˣ := + cfcUnits (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) f A hA_ne0 (ha := hA_sa) + let uB : (𝓐)ˣ := + cfcUnits (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) f B hB_ne0 (ha := hB_sa) + have huA_val : (uA : 𝓐) = A + algebraMap ℝ (𝓐) t := by + -- unfold `uA` to a `cfc` statement and use `cfc_add_const` + `cfc_id'` + simp [uA, cfcUnits, f] + simpa [cfc_id' (R := ℝ) (a := A) (ha := hA_sa)] using + (cfc_add_const (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (r := t) + (f := fun x : ℝ ↦ x) (a := A) (ha := hA_sa)) + have huB_val : (uB : 𝓐) = B + algebraMap ℝ (𝓐) t := by + -- unfold `uB` to a `cfc` statement and use `cfc_add_const` + `cfc_id'` + simp [uB, cfcUnits, f] + simpa [cfc_id' (R := ℝ) (a := B) (ha := hB_sa)] using + (cfc_add_const (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (r := t) + (f := fun x : ℝ ↦ x) (a := B) (ha := hB_sa)) + have huB_nonneg : 0 ≤ (uB : 𝓐) := by + -- unfold `uB` and use pointwise nonnegativity on the spectrum + simp only [uB, cfcUnits, f] + refine cfc_nonneg (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (a := B) ?_ + intro x hx + have hx0 : (0 : ℝ) ≤ x := by + simpa [Set.Ici] using (Bs hx) + exact le_of_lt (add_pos_of_nonneg_of_pos hx0 ht) + have hub_le_hua : (uB : 𝓐) ≤ (uA : 𝓐) := by + simpa [huA_val, huB_val, add_assoc, add_left_comm, add_comm] using add_le_add_right BA (algebraMap ℝ (𝓐) t) + have hinv : (↑uA⁻¹ : 𝓐) ≤ (↑uB⁻¹ : 𝓐) := by + simpa using + (CStarAlgebra.inv_le_inv (A := 𝓐) (a := uB) (b := uA) huB_nonneg hub_le_hua) + -- convert the inverse inequality back to the desired `cfcR` inequality + simpa [uA, uB, cfcUnits, cfcR, f, one_div] using hinv + +-- Reduces to `one_div_operatorConvexOn_Ioi` and is also elaboration-heavy. +theorem one_div_add_t_operatorConvexOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorConvexOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ 1 / (x + t)) := by + /- + It follows from one_div_operatorConvexOn_Ioi + -/ + intro t ht + dsimp [OperatorConvexOn] + intro A B θ hA hB hθ0 hθ1 As Bs + -- rewrite `1 / (x + t)` as `(x + t)⁻¹` for `simp`/`cfc` lemmas + simp only [one_div] + -- Reduce to operator convexity of `x ↦ x⁻¹` on `Ioi 0` by shifting by `t`. + set C : 𝓐 := (1 - θ) • A + θ • B + have hC : IsSelfAdjoint C := by + simpa [C] using (IsSelfAdjoint.all (1 - θ)).smul hA |>.add ((IsSelfAdjoint.all θ).smul hB) + set shift : ℝ → ℝ := fun x ↦ x + t + set T : 𝓐 := algebraMap ℝ (𝓐) t + have hT : IsSelfAdjoint T := by + simpa [T] using (IsSelfAdjoint.algebraMap (A := 𝓐) (r := t) + (hr := IsSelfAdjoint.all (t : ℝ))) + have A_nonneg : 0 ≤ A := by + have h0 : 0 ≤ cfcR (fun x : ℝ ↦ x) A := by + dsimp [cfcR] + apply cfc_nonneg + intro x hx + simpa [Set.Ici] using (As hx) + simpa [cfcR, cfc_id' (R := ℝ) (a := A) (ha := hA)] using h0 + have B_nonneg : 0 ≤ B := by + have h0 : 0 ≤ cfcR (fun x : ℝ ↦ x) B := by + dsimp [cfcR] + apply cfc_nonneg + intro x hx + simpa [Set.Ici] using (Bs hx) + simpa [cfcR, cfc_id' (R := ℝ) (a := B) (ha := hB)] using h0 + have C_nonneg : 0 ≤ C := by + simpa [C] using add_nonneg (smul_nonneg (sub_nonneg.mpr hθ1) A_nonneg) (smul_nonneg hθ0 B_nonneg) + have hA_shift : cfcR shift A = A + T := by + dsimp [cfcR, shift, T] + simpa [cfc_id' (R := ℝ) (a := A) (ha := hA)] using + (cfc_add_const (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (r := t) + (f := fun x : ℝ ↦ x) (a := A) (ha := hA)) + have hB_shift : cfcR shift B = B + T := by + dsimp [cfcR, shift, T] + simpa [cfc_id' (R := ℝ) (a := B) (ha := hB)] using + (cfc_add_const (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (r := t) + (f := fun x : ℝ ↦ x) (a := B) (ha := hB)) + have hC_shift : cfcR shift C = C + T := by + dsimp [cfcR, shift, T] + simpa [cfc_id' (R := ℝ) (a := C) (ha := hC)] using + (cfc_add_const (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (r := t) + (f := fun x : ℝ ↦ x) (a := C) (ha := hC)) + set A1 : 𝓐 := A + T + set B1 : 𝓐 := B + T + set C1 : 𝓐 := (1 - θ) • A1 + θ • B1 + have hA1_sa : IsSelfAdjoint A1 := by + subst A1 + exact hA.add hT + have hB1_sa : IsSelfAdjoint B1 := by + subst B1 + exact hB.add hT + have specA1 : spectrum ℝ A1 ⊆ Set.Ioi (0 : ℝ) := by + intro x hx + have hs : spectrum ℝ (cfc shift A) = shift '' spectrum ℝ A := by + simpa [shift] using + (cfc_map_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (a := A) + (f := shift) (ha := hA)) + have hx' : x ∈ shift '' spectrum ℝ A := by + have hx0 : x ∈ spectrum ℝ (cfc shift A) := by + have hval : cfc shift A = A1 := by + simpa [cfcR, shift, A1] using hA_shift + simpa [hval] using hx + simpa [hs] using hx0 + rcases hx' with ⟨y, hy, rfl⟩ + have hy0 : 0 ≤ y := by + simpa [Set.Ici] using (As hy) + simpa [Set.Ioi] using (add_pos_of_nonneg_of_pos hy0 ht) + have specB1 : spectrum ℝ B1 ⊆ Set.Ioi (0 : ℝ) := by + intro x hx + have hs : spectrum ℝ (cfc shift B) = shift '' spectrum ℝ B := by + simpa [shift] using + (cfc_map_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (a := B) + (f := shift) (ha := hB)) + have hx' : x ∈ shift '' spectrum ℝ B := by + have hx0 : x ∈ spectrum ℝ (cfc shift B) := by + have hval : cfc shift B = B1 := by + simpa [cfcR, shift, B1] using hB_shift + simpa [hval] using hx + simpa [hs] using hx0 + rcases hx' with ⟨y, hy, rfl⟩ + have hy0 : 0 ≤ y := by + simpa [Set.Ici] using (Bs hy) + simpa [Set.Ioi] using (add_pos_of_nonneg_of_pos hy0 ht) + have hC1 : C1 = C + T := by + subst A1 B1 C1 + simp [C, add_assoc, add_left_comm, add_comm, smul_add] + have hshift_ne0_A : ∀ x ∈ spectrum ℝ A, shift x ≠ 0 := by + intro x hx + have hx0 : 0 ≤ x := by + simpa [Set.Ici] using (As hx) + exact ne_of_gt (by simpa [shift] using (add_pos_of_nonneg_of_pos hx0 ht)) + have hshift_ne0_B : ∀ x ∈ spectrum ℝ B, shift x ≠ 0 := by + intro x hx + have hx0 : 0 ≤ x := by + simpa [Set.Ici] using (Bs hx) + exact ne_of_gt (by simpa [shift] using (add_pos_of_nonneg_of_pos hx0 ht)) + have hshift_ne0_C : ∀ x ∈ spectrum ℝ C, shift x ≠ 0 := + fun x hx ↦ ne_of_gt (by simpa [shift] using (add_pos_of_nonneg_of_pos (spectrum_nonneg_of_nonneg C_nonneg hx) ht)) + have hA_inv : cfcR (fun x : ℝ ↦ (x + t)⁻¹) A = Ring.inverse A1 := by + have h' : cfc (fun x : ℝ ↦ (shift x)⁻¹) A = Ring.inverse (cfc shift A) := by + simpa [shift] using (cfc_inv (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (f := shift) (a := A) hshift_ne0_A (ha := hA)) + have hval : cfc shift A = A1 := by + simpa [cfcR, shift, A1] using hA_shift + simpa [cfcR, shift, hval] using h' + have hB_inv : cfcR (fun x : ℝ ↦ (x + t)⁻¹) B = Ring.inverse B1 := by + have h' : cfc (fun x : ℝ ↦ (shift x)⁻¹) B = Ring.inverse (cfc shift B) := by + simpa [shift] using (cfc_inv (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (f := shift) (a := B) hshift_ne0_B (ha := hB)) + have hval : cfc shift B = B1 := by + simpa [cfcR, shift, B1] using hB_shift + simpa [cfcR, shift, hval] using h' + have hC_inv : cfcR (fun x : ℝ ↦ (x + t)⁻¹) C = Ring.inverse (C + T) := by + have h' : cfc (fun x : ℝ ↦ (shift x)⁻¹) C = Ring.inverse (cfc shift C) := by + simpa [shift] using (cfc_inv (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (f := shift) (a := C) hshift_ne0_C (ha := hC)) + have hval : cfc shift C = C + T := by + simpa [cfcR, shift] using hC_shift + simpa [cfcR, shift, hval] using h' + have hA1_inv : cfcR (fun x : ℝ ↦ x⁻¹) A1 = Ring.inverse A1 := by + dsimp [cfcR] + simpa [cfc_id' (R := ℝ) (a := A1) (ha := hA1_sa)] using + (cfc_inv (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (f := fun x : ℝ ↦ x) + (a := A1) (fun x hx ↦ ne_of_gt (specA1 hx)) (ha := hA1_sa)) + have hB1_inv : cfcR (fun x : ℝ ↦ x⁻¹) B1 = Ring.inverse B1 := by + dsimp [cfcR] + simpa [cfc_id' (R := ℝ) (a := B1) (ha := hB1_sa)] using + (cfc_inv (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (f := fun x : ℝ ↦ x) + (a := B1) (fun x hx ↦ ne_of_gt (specB1 hx)) (ha := hB1_sa)) + have hA_eq : cfcR (fun x : ℝ ↦ (x + t)⁻¹) A = cfcR (fun x : ℝ ↦ x⁻¹) A1 := by + simp [hA_inv, hA1_inv] + have hB_eq : cfcR (fun x : ℝ ↦ (x + t)⁻¹) B = cfcR (fun x : ℝ ↦ x⁻¹) B1 := by + simp [hB_inv, hB1_inv] + have specC1 : spectrum ℝ C1 ⊆ Set.Ioi (0 : ℝ) := by + intro x hx + have hs : spectrum ℝ (cfc shift C) = shift '' spectrum ℝ C := by + simpa [shift] using + (cfc_map_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (a := C) + (f := shift) (ha := hC)) + have hx' : x ∈ shift '' spectrum ℝ C := by + have hx0 : x ∈ spectrum ℝ (cfc shift C) := by + have hval : cfc shift C = C + T := by + simpa [cfcR, shift] using hC_shift + have hval' : cfc shift C = C1 := by + simpa [hC1] using hval + simpa [hval'] using hx + simpa [hs] using hx0 + rcases hx' with ⟨y, hy, rfl⟩ + have hy0 : 0 ≤ y := spectrum_nonneg_of_nonneg C_nonneg hy + have : 0 < y + t := add_pos_of_nonneg_of_pos hy0 ht + simpa [Set.Ioi] using this + have hC1_ne0 : ∀ x ∈ spectrum ℝ C1, (x : ℝ) ≠ 0 := fun x hx ↦ ne_of_gt (specC1 hx) + have hC1_sa : IsSelfAdjoint C1 := by + simpa [hC1] using (hC.add hT) + have hC1_inv : cfcR (fun x : ℝ ↦ x⁻¹) C1 = Ring.inverse C1 := by + dsimp [cfcR] + simpa [cfc_id' (R := ℝ) (a := C1) (ha := hC1_sa)] using + (cfc_inv (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (f := fun x : ℝ ↦ x) + (a := C1) hC1_ne0 (ha := hC1_sa)) + have hC_eq : cfcR (fun x : ℝ ↦ (x + t)⁻¹) C = cfcR (fun x : ℝ ↦ x⁻¹) C1 := by + calc + cfcR (fun x : ℝ ↦ (x + t)⁻¹) C + = Ring.inverse (C + T) := hC_inv + _ = Ring.inverse C1 := by simp [hC1] + _ = cfcR (fun x : ℝ ↦ x⁻¹) C1 := by simpa using hC1_inv.symm + have hconv : + cfcR (fun x : ℝ ↦ x⁻¹) C1 + ≤ (1 - θ) • cfcR (fun x : ℝ ↦ x⁻¹) A1 + + θ • cfcR (fun x : ℝ ↦ x⁻¹) B1 := by + simpa [one_div] using + (one_div_operatorConvexOn_Ioi (A := A1) (B := B1) (t := θ) + hA1_sa hB1_sa hθ0 hθ1 specA1 specB1) + -- conclude by rewriting everything to the shifted `1/x` convexity statement + simpa [C, hC_eq, hA_eq, hB_eq] using hconv + +omit [Nontrivial (𝓐)] [NonnegSpectrumClass ℝ 𝓐] in +theorem ratio_add_t_operatorMonotoneOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorMonotoneOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ x / (x + t)) := by + intro t ht + dsimp [OperatorMonotoneOn] + intro A B hA0 hB0 hBA hspA hspB + let invfun : ℝ → ℝ := fun x : ℝ ↦ 1 / (x + t) + have hmono_core : + (1 : 𝓐) - t • cfcR invfun B ≤ (1 : 𝓐) - t • cfcR invfun A := by + have h1 : t • cfcR invfun A ≤ t • cfcR invfun B := + smul_le_smul_of_nonneg_left + ((one_div_add_t_operatorAntitoneOn_Ici t ht) hA0 hB0 hBA hspA hspB) (le_of_lt ht) + exact sub_le_sub_left h1 (1 : 𝓐) + have hrepr (T : 𝓐) (hT0 : 0 ≤ T) (hspT : spectrum ℝ T ⊆ Set.Ici (0 : ℝ)) : + cfcR (fun x : ℝ ↦ x / (x + t)) T = (1 : 𝓐) - t • cfcR invfun T := by + have hT_sa : IsSelfAdjoint T := IsSelfAdjoint.of_nonneg hT0 + have hEqT : + (spectrum ℝ T).EqOn (fun x : ℝ ↦ x / (x + t)) (fun x : ℝ ↦ 1 - t * invfun x) := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := by + simpa [Set.Ici] using (hspT hx) + simp [invfun] + field_simp [ne_of_gt (add_pos_of_nonneg_of_pos hx0 ht)] + ring + have hT_ne0 : ∀ x ∈ spectrum ℝ T, x + t ≠ 0 := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := by + simpa [Set.Ici] using (hspT hx) + exact ne_of_gt (add_pos_of_nonneg_of_pos hx0 ht) + have hT_cont : ContinuousOn invfun (spectrum ℝ T) := by + simpa [invfun, one_div] using (continuousOn_id.add continuousOn_const).inv₀ hT_ne0 + dsimp [cfcR] + have hcongr : + cfcR (fun x : ℝ ↦ x / (x + t)) T = + cfcR (fun x : ℝ ↦ 1 - t * invfun x) T := + cfc_congr hEqT + have hsub : + cfcR (fun x : ℝ ↦ 1 - t * invfun x) T = + cfcR (fun _ : ℝ ↦ (1 : ℝ)) T - + cfcR (fun x : ℝ ↦ t * invfun x) T := by + simpa using + (cfc_sub (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (f := fun _ : ℝ ↦ (1 : ℝ)) (g := fun x : ℝ ↦ t * invfun x) (a := T) + (hf := continuousOn_const) (hg := continuousOn_const.mul hT_cont)) + have hone : + cfcR (fun _ : ℝ ↦ (1 : ℝ)) T = (1 : 𝓐) := by + simpa using + (cfc_const_one (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (a := T) (ha := hT_sa)) + have hmul : + cfcR (fun x : ℝ ↦ t * invfun x) T = + t • cfcR invfun T := by + simpa using + (cfc_const_mul (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (r := t) (f := invfun) (a := T) + (hf := hT_cont)) + calc + cfcR (fun x : ℝ ↦ x / (x + t)) T = + cfcR (fun x : ℝ ↦ 1 - t * invfun x) T := hcongr + _ = + cfcR (fun _ : ℝ ↦ (1 : ℝ)) T - + cfcR (fun x : ℝ ↦ t * invfun x) T := hsub + _ = (1 : 𝓐) - t • cfcR invfun T := by + rw [hone, hmul] + calc + cfcR (fun x : ℝ ↦ x / (x + t)) B + = (1 : 𝓐) - t • cfcR invfun B := by + simpa using hrepr B hB0 hspB + _ ≤ (1 : 𝓐) - t • cfcR invfun A := hmono_core + _ = cfcR (fun x : ℝ ↦ x / (x + t)) A := by + simpa using (hrepr A hA0 hspA).symm + +theorem ratio_add_t_operatorConcaveOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorConcaveOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ x / (x + t)) := by + intro t ht + dsimp [OperatorConcaveOn, OperatorConvexOn] + intro A B u hA hB hu0 hu1 As Bs + have hu0' : 0 ≤ (1 - u) := sub_nonneg.mpr hu1 + -- main input: operator convexity of `x ↦ 1 / (x + t)` on `Set.Ici 0` + have hconv_inv : + cfcR (fun x : ℝ ↦ 1 / (x + t)) ((1 - u) • A + u • B) + ≤ (1 - u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + u • cfcR (fun x : ℝ ↦ 1 / (x + t)) B := by + simpa using (one_div_add_t_operatorConvexOn_Ici t ht) (A := A) + (B := B) (t := u) hA hB hu0 hu1 As Bs + -- rewrite `-(x/(x+t))` as `(-1) + t/(x+t)` under functional calculus + have hcalc (T : 𝓐) (hT : IsSelfAdjoint T) (Ts : spectrum ℝ T ⊆ Set.Ici (0 : ℝ)) : + cfcR (fun x : ℝ ↦ - (x / (x + t))) T + = algebraMap ℝ (𝓐) (-1 : ℝ) + + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) T := by + let invfun : ℝ → ℝ := fun x ↦ 1 / (x + t) + have hne0 : ∀ x ∈ spectrum ℝ T, x + t ≠ 0 := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := by + simpa [Set.Ici] using (Ts hx) + exact ne_of_gt (add_pos_of_nonneg_of_pos hx0 ht) + have hcont : ContinuousOn invfun (spectrum ℝ T) := by + simpa [invfun, one_div] using (continuousOn_id.add continuousOn_const).inv₀ hne0 + dsimp [cfcR] + have hcongr : + cfcR (fun x : ℝ ↦ - (x / (x + t))) T + = cfcR + (fun x : ℝ ↦ (-1 : ℝ) + t * invfun x) T := by + apply cfc_congr + intro x hx + have hx0 : (0 : ℝ) ≤ x := by + simpa [Set.Ici] using (Ts hx) + have : + - (x / (x + t)) = (-1 : ℝ) + t * (1 / (x + t)) := by + field_simp [ne_of_gt (add_pos_of_nonneg_of_pos hx0 ht)] + ring_nf + simpa [invfun] using this + calc + cfcR (fun x : ℝ ↦ - (x / (x + t))) T + = cfcR + (fun x : ℝ ↦ (-1 : ℝ) + t * invfun x) T := hcongr + _ = algebraMap ℝ (𝓐) (-1 : ℝ) + + cfcR (fun x : ℝ ↦ t * invfun x) T := by + simpa using + (cfc_const_add (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (r := (-1 : ℝ)) + (f := fun x : ℝ ↦ t * invfun x) (a := T) + (hf := continuousOn_const.mul hcont) (ha := hT)) + _ = algebraMap ℝ (𝓐) (-1 : ℝ) + + t • cfcR invfun T := by + simp [cfc_const_mul (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) t invfun T + (hf := hcont)] + _ = algebraMap ℝ (𝓐) (-1 : ℝ) + + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) T := by + simp [invfun] + set AB : 𝓐 := (1 - u) • A + u • B + have hAB : IsSelfAdjoint AB := by + dsimp [AB] + simpa using + (IsSelfAdjoint.smul (by simp [IsSelfAdjoint]) hA).add + (IsSelfAdjoint.smul (by simp [IsSelfAdjoint]) hB) + -- apply operator convexity of `-(x/(x+t))` + have hL : + cfcR (fun x : ℝ ↦ - (x / (x + t))) AB + ≤ (1 - u) • cfcR (fun x : ℝ ↦ - (x / (x + t))) A + + u • cfcR (fun x : ℝ ↦ - (x / (x + t))) B := by + -- expand both sides using `hcalc`, then use `hconv_inv` + -- (filled in the next step) + set C : 𝓐 := algebraMap ℝ (𝓐) (-1 : ℝ) + have nonneg_of_spectrum_subset_Ici0 {T : 𝓐} (hT : IsSelfAdjoint T) + (Ts : spectrum ℝ T ⊆ Set.Ici (0 : ℝ)) : 0 ≤ T := by + have h' : algebraMap ℝ (𝓐) (0 : ℝ) ≤ T := + (algebraMap_le_iff_le_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (r := (0 : ℝ)) (a := T) (ha := hT)).2 (by + intro x hx + simpa [Set.Ici] using (Ts hx)) + simpa using h' + have hA0 : 0 ≤ A := + nonneg_of_spectrum_subset_Ici0 (T := A) hA As + have hB0 : 0 ≤ B := + nonneg_of_spectrum_subset_Ici0 (T := B) hB Bs + have hAB0 : 0 ≤ AB := by + dsimp [AB] + exact add_nonneg (smul_nonneg hu0' hA0) (smul_nonneg hu0 hB0) + have ABs : spectrum ℝ AB ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := + spectrum_nonneg_of_nonneg (𝕜 := ℝ) (A := 𝓐) (a := AB) hAB0 hx + simpa [Set.Ici] using hx0 + have hscale : + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) AB + ≤ (t * (1 - u)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + (t * u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) B := by + have hconv_inv_AB : + cfcR (fun x : ℝ ↦ 1 / (x + t)) AB + ≤ (1 - u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + u • cfcR (fun x : ℝ ↦ 1 / (x + t)) B := by + simpa [AB] using hconv_inv + have hscale0 : + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) AB + ≤ t • + ((1 - u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + u • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := + smul_le_smul_of_nonneg_left hconv_inv_AB (le_of_lt ht) + calc + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) AB + ≤ t • + ((1 - u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + u • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := hscale0 + _ = + (t * (1 - u)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + (t * u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) B := by + simp [smul_add, smul_smul] + have hconst : (1 - u) • C + u • C = C := by + simpa [add_smul, sub_add_cancel] using (add_smul (1 - u) u C).symm + have hmain : + C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) AB + ≤ (1 - u) • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) A) + + u • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := by + have h' : + C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) AB + ≤ C + + ((t * (1 - u)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + (t * u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := by + exact add_le_add_right hscale C + have hR : + C + + ((t * (1 - u)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + (t * u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) + = + (1 - u) • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) A) + + u • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := by + have hR' : + (1 - u) • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) A) + + u • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) + = + ((1 - u) • C + u • C) + + ((t * (1 - u)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + (t * u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := by + calc + (1 - u) • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) A) + + u • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) + = + (1 - u) • C + + (1 - u) • (t • cfcR (fun x : ℝ ↦ 1 / (x + t)) A) + + (u • C + u • (t • cfcR (fun x : ℝ ↦ 1 / (x + t)) B)) := by + simp [smul_add, add_assoc, add_left_comm, add_comm] + _ = + (1 - u) • C + + (t * (1 - u)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + (u • C + (t * u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := by + simp [smul_smul, mul_comm, add_assoc, add_left_comm, add_comm] + _ = + ((1 - u) • C + u • C) + + ((t * (1 - u)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + (t * u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := by + abel + calc + C + + ((t * (1 - u)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + (t * u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) + = + ((1 - u) • C + u • C) + + ((t * (1 - u)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + (t * u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := by + simp [hconst, add_comm] + _ = + (1 - u) • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) A) + + u • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := by + simpa using hR'.symm + calc + C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) AB + ≤ + C + + ((t * (1 - u)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) A + + (t * u) • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := h' + _ = + (1 - u) • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) A) + + u • (C + t • cfcR (fun x : ℝ ↦ 1 / (x + t)) B) := hR + dsimp [C] at hmain + rw [hcalc AB hAB ABs, hcalc A hA As, hcalc B hB Bs] + exact hmain + simpa [AB] using hL + +omit [Nontrivial (𝓐)] in +theorem power_Icc_zero_one_operatorMonotoneOn_Ici : ∀ p ∈ Set.Icc (0 : ℝ) 1, + OperatorMonotoneOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x ↦ x ^ p) := by + intro p hp + dsimp [OperatorMonotoneOn] + intro A B hA0 hB0 hBA hspA hspB + have hA : cfcR (fun x : ℝ ↦ x ^ p) A = A ^ p := by + simpa [cfcR] using + (CFC.rpow_eq_cfc_real (A := 𝓐) (a := A) (y := p) (ha := hA0)).symm + have hB : cfcR (fun x : ℝ ↦ x ^ p) B = B ^ p := by + simpa [cfcR] using + (CFC.rpow_eq_cfc_real (A := 𝓐) (a := B) (y := p) (ha := hB0)).symm + simpa [hA, hB] using (CFC.rpow_le_rpow (A := 𝓐) hp hBA) + +omit [Nontrivial (𝓐)] in +omit [StarOrderedRing 𝓐] in +private lemma cfcₙ_rpowIntegrand₀₁_eq_smul_cfcR_ratio {q : NNReal} (hq : q ∈ Set.Ioo (0 : NNReal) 1) + {t : ℝ} (htpos : 0 < t) (X : 𝓐) (hX0 : 0 ≤ X) : + cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) X = + (t ^ ((q : ℝ) - 1)) • cfcR (fun x : ℝ => x / (x + t)) X := by + have hq_real : ((q : ℝ) : ℝ) ∈ Set.Ioo (0 : ℝ) 1 := ⟨(NNReal.coe_pos).2 hq.1, (NNReal.coe_lt_coe).2 hq.2⟩ + let ratio : ℝ → ℝ := fun x => x / (x + t) + let r : ℝ := t ^ ((q : ℝ) - 1) + have hcont_ratio : ContinuousOn ratio (spectrum ℝ X) := + continuousOn_id.div (continuousOn_id.add continuousOn_const) (fun x hx ↦ ne_of_gt (add_pos_of_nonneg_of_pos (spectrum_nonneg_of_nonneg hX0 hx) htpos)) + have hcfcₙ : cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) X = + cfcR (Real.rpowIntegrand₀₁ (q : ℝ) t) X := by + have hqs : quasispectrum ℝ X ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := quasispectrum_nonneg_of_nonneg X hX0 x hx + simpa [Set.Ici] using hx0 + have hf : ContinuousOn (Real.rpowIntegrand₀₁ (q : ℝ) t) (quasispectrum ℝ X) := + (Real.continuousOn_rpowIntegrand₀₁_Ici hq_real htpos).mono hqs + simpa using + (cfcₙ_eq_cfc (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (f := Real.rpowIntegrand₀₁ (q : ℝ) t) (a := X) (hf := hf) (hf0 := by simp)) + have hEq : + (spectrum ℝ X).EqOn (Real.rpowIntegrand₀₁ (q : ℝ) t) (fun x : ℝ ↦ r * ratio x) := by + intro x hx + simp [r, ratio, Real.rpowIntegrand₀₁_eq_pow_div hq_real (le_of_lt htpos) (spectrum_nonneg_of_nonneg hX0 hx), + add_comm, mul_div_assoc] + have hcfc_congr : + cfcR (Real.rpowIntegrand₀₁ (q : ℝ) t) X = + cfcR (fun x : ℝ ↦ r * ratio x) X := + cfc_congr hEq + have hcfc_mul : + cfcR (fun x : ℝ ↦ r * ratio x) X = + r • cfcR ratio X := by + simpa using + (cfc_const_mul (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (r := r) (f := ratio) (a := X) + (hf := hcont_ratio)) + have hmain : + cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) X = r • cfcR ratio X := by + calc + cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) X = + cfcR (Real.rpowIntegrand₀₁ (q : ℝ) t) X := by + simpa using hcfcₙ + _ = cfcR (fun x : ℝ ↦ r * ratio x) X := hcfc_congr + _ = r • cfcR ratio X := hcfc_mul + _ = r • cfcR ratio X := by simp [cfcR] + simpa [r, ratio] using hmain + +private lemma cfcR_ratio_weighted_le {t : ℝ} (htpos : 0 < t) {A B : 𝓐} (hA0 : 0 ≤ A) (hB0 : 0 ≤ B) + {a b : ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) : + a • cfcR (fun x : ℝ => x / (x + t)) A + b • cfcR (fun x : ℝ => x / (x + t)) B + ≤ cfcR (fun x : ℝ => x / (x + t)) (a • A + b • B) := by + have ha1 : a = 1 - b := by linarith [hab] + have hb1 : b ≤ 1 := by linarith [ha, hab] + have hspec (X : 𝓐) (hX0 : 0 ≤ X) : spectrum ℝ X ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := spectrum_nonneg_of_nonneg hX0 hx + simpa [Set.Ici] using hx0 + have hOp := ratio_add_t_operatorConcaveOn_Ici (𝓐 := 𝓐) t htpos + have hneg := + (by + dsimp [OperatorConcaveOn, OperatorConvexOn] at hOp + have := hOp (A := A) (B := B) (t := b) (IsSelfAdjoint.of_nonneg hA0) (IsSelfAdjoint.of_nonneg hB0) + hb hb1 (hspec A hA0) (hspec B hB0) + exact this) + have hneg' : + cfcR (fun x : ℝ ↦ - (x / (x + t))) ((1 - b) • A + b • B) + ≤ (1 - b) • cfcR (fun x : ℝ ↦ - (x / (x + t))) A + + b • cfcR (fun x : ℝ ↦ - (x / (x + t))) B := hneg + have hneg'' : + -cfcR (fun x : ℝ => x / (x + t)) ((1 - b) • A + b • B) + ≤ -((1 - b) • cfcR (fun x : ℝ => x / (x + t)) A + b • cfcR (fun x : ℝ => x / (x + t)) B) := by + have h' : + -cfcR (fun x : ℝ => x / (x + t)) ((1 - b) • A + b • B) + ≤ -(b • cfcR (fun x : ℝ => x / (x + t)) B + (1 - b) • cfcR (fun x : ℝ => x / (x + t)) A) := by + simpa [cfcR, cfc_neg, smul_neg, neg_add] using hneg' + simpa [add_comm, add_left_comm, add_assoc] using h' + simpa [ha1, add_comm, add_left_comm, add_assoc] using neg_le_neg_iff.mp hneg'' + +private lemma concaveOn_cfcₙ_rpowIntegrand₀₁ {q : NNReal} (hq : q ∈ Set.Ioo (0 : NNReal) 1) + {t : ℝ} (htpos : 0 < t) : + ConcaveOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 => cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) A) := by + have hq_real : ((q : ℝ) : ℝ) ∈ Set.Ioo (0 : ℝ) 1 := by + refine ⟨?_, ?_⟩ + · exact (NNReal.coe_pos).2 hq.1 + · exact (NNReal.coe_lt_coe).2 hq.2 + refine ⟨convex_Ici (𝕜 := ℝ) (0 : 𝓐), ?_⟩ + intro A hA B hB a b ha hb hab + have hA0 : 0 ≤ A := by simpa [Set.Ici] using hA + have hB0 : 0 ≤ B := by simpa [Set.Ici] using hB + have hAB0 : 0 ≤ a • A + b • B := add_nonneg (smul_nonneg ha hA0) (smul_nonneg hb hB0) + let ratio : ℝ → ℝ := fun x => x / (x + t) + let r : ℝ := t ^ ((q : ℝ) - 1) + have hr_nonneg : 0 ≤ r := Real.rpow_nonneg (le_of_lt htpos) _ + have hrepr (X : 𝓐) (hX0 : 0 ≤ X) : + cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) X = r • cfcR ratio X := by + simpa [r, ratio] using cfcₙ_rpowIntegrand₀₁_eq_smul_cfcR_ratio (q := q) hq htpos X hX0 + have hratio : + a • cfcR ratio A + b • cfcR ratio B ≤ cfcR ratio (a • A + b • B) := by + -- use the separate lemma to keep heartbeats per-declaration small + -- (`ratio` is a local abbreviation here) + simpa [ratio] using cfcR_ratio_weighted_le (t := t) htpos (A := A) (B := B) hA0 hB0 ha hb hab + have hscaled : r • (a • cfcR ratio A + b • cfcR ratio B) ≤ r • cfcR ratio (a • A + b • B) := + smul_le_smul_of_nonneg_left hratio hr_nonneg + have hL : + a • cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) A + b • cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) B = + r • (a • cfcR ratio A + b • cfcR ratio B) := by + simp [hrepr A hA0, hrepr B hB0, smul_add, smul_smul, mul_comm] + have hR : + cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) (a • A + b • B) = r • cfcR ratio (a • A + b • B) := by + simp [hrepr (a • A + b • B) hAB0] + calc + a • cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) A + b • cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) B + = r • (a • cfcR ratio A + b • cfcR ratio B) := hL + _ ≤ r • cfcR ratio (a • A + b • B) := hscaled + _ = cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) (a • A + b • B) := hR.symm + +private lemma concaveOn_nnrpow_Ioo {q : NNReal} (hq : q ∈ Set.Ioo (0 : NNReal) 1) : + ConcaveOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 ↦ A ^ q) := by + -- integral representation for `a ↦ a ^ q` + obtain ⟨μ, hμ⟩ := + CFC.exists_measure_nnrpow_eq_integral_cfcₙ_rpowIntegrand₀₁ (A := 𝓐) hq + let ν : MeasureTheory.Measure ℝ := μ.restrict (Set.Ioi (0 : ℝ)) + let F : ℝ → 𝓐 → 𝓐 := fun t A => cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) A + have hF_int : ∀ A ∈ Set.Ici (0 : 𝓐), MeasureTheory.Integrable (fun t => F t A) ν := by + intro A hA + simpa [F, ν, MeasureTheory.IntegrableOn] using (hμ A hA).1 + have hF_conc : + ∀ᵐ t ∂ν, ConcaveOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 => F t A) := by + filter_upwards [MeasureTheory.ae_restrict_mem measurableSet_Ioi] with t ht + simpa [F] using (concaveOn_cfcₙ_rpowIntegrand₀₁ (q := q) hq ht) + have hconc_int : + ConcaveOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 ↦ ∫ t, F t A ∂ν) := + MeasureTheory.integral_concaveOn_of_integrand_ae + (μ := ν) (s := Set.Ici (0 : 𝓐)) (f := fun t A => F t A) + (convex_Ici (𝕜 := ℝ) (0 : 𝓐)) hF_conc hF_int + -- identify the integral with `A ^ q` on `Ici 0` + refine hconc_int.congr ?_ + intro A hA + -- `A ^ q` is the set integral of the integrand on `Ioi 0` + have hEq : A ^ q = ∫ t, F t A ∂ν := by + simpa [F, ν] using (hμ A hA).2 + simp [hEq] + +private lemma concaveOn_rpow_Ioo {p : ℝ} (hp : p ∈ Set.Ioo (0 : ℝ) 1) : + ConcaveOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 ↦ A ^ p) := by + -- reduce to the `ℝ≥0` exponent case + let q : NNReal := ⟨p, le_of_lt hp.1⟩ + have hq0 : (0 : NNReal) < q := by + have : (0 : ℝ) < (q : ℝ) := by + simpa [q] using hp.1 + exact (NNReal.coe_pos).1 this + have hq1 : q < (1 : NNReal) := by + have : (q : ℝ) < (1 : ℝ) := by + simpa [q] using hp.2 + exact (NNReal.coe_lt_coe).1 (by simpa using this) + have hq : q ∈ Set.Ioo (0 : NNReal) 1 := ⟨hq0, hq1⟩ + -- main lemma: concavity for `a ↦ a ^ q` + have hconc : ConcaveOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 ↦ A ^ q) := + concaveOn_nnrpow_Ioo hq + -- transport concavity from `A ^ q` to `A ^ p` + refine hconc.congr ?_ + intro A hA + -- `A ^ q = A ^ (q : ℝ)`, and `(q : ℝ) = p` + simpa [q] using (CFC.nnrpow_eq_rpow (A := 𝓐) (a := A) (x := q) hq0) + +theorem power_Icc_zero_one_operatorConcaveOn_Ici : ∀ p ∈ Set.Icc (0 : ℝ) 1, + OperatorConcaveOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x ↦ x ^ p) := by + intro p hp + by_cases hp0 : p = 0 + · subst hp0 + dsimp [OperatorConcaveOn, OperatorConvexOn] + intro A B u hA hB hu0 hu1 As Bs + have hC : IsSelfAdjoint ((1 - u) • A + u • B) := by + simpa using (IsSelfAdjoint.all (1 - u)).smul hA |>.add ((IsSelfAdjoint.all u).smul hB) + have hfun : (fun x : ℝ ↦ - (x ^ (0 : ℝ))) = (fun _ : ℝ ↦ (-1 : ℝ)) := by + funext x + simp + have hconst (T : 𝓐) (hT : IsSelfAdjoint T) : + cfcR (fun _ : ℝ ↦ (-1 : ℝ)) T = (-1 : 𝓐) := by + simpa [cfcR] using + (cfc_const (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (-1 : ℝ) T hT) + rw [hfun] + rw [hconst _ hC, hconst _ hA, hconst _ hB] + have hR : (1 - u) • (-1 : 𝓐) + u • (-1 : 𝓐) = (-1 : 𝓐) := by + calc + (1 - u) • (-1 : 𝓐) + u • (-1 : 𝓐) = ((1 - u) + u) • (-1 : 𝓐) := by + simpa [add_smul] using (add_smul (1 - u) u (-1 : 𝓐)).symm + _ = (1 : ℝ) • (-1 : 𝓐) := by simp + _ = (-1 : 𝓐) := by simp + simp + by_cases hp1 : p = 1 + · subst hp1 + dsimp [OperatorConcaveOn, OperatorConvexOn] + intro A B u hA hB hu0 hu1 As Bs + have hC : IsSelfAdjoint ((1 - u) • A + u • B) := by + simpa using (IsSelfAdjoint.all (1 - u)).smul hA |>.add ((IsSelfAdjoint.all u).smul hB) + have hfun : (fun x : ℝ ↦ - (x ^ (1 : ℝ))) = (fun x : ℝ ↦ -x) := by + funext x + simp + have hneg (T : 𝓐) (hT : IsSelfAdjoint T) : + cfcR (fun x : ℝ ↦ -x) T = -T := by + simpa [cfcR] using (cfc_neg_id (R := ℝ) (p := IsSelfAdjoint) (a := T) hT) + rw [hfun] + rw [hneg _ hC, hneg _ hA, hneg _ hB] + -- both sides are `-((1-u)•A + u•B)` + simp [add_comm, sub_eq_add_neg] + have hp01 : p ∈ Set.Ioo (0 : ℝ) 1 := by + refine ⟨?_, ?_⟩ + · have : 0 ≤ p := hp.1 + exact lt_of_le_of_ne this (Ne.symm hp0) + · have : p ≤ 1 := hp.2 + exact lt_of_le_of_ne this hp1 + dsimp [OperatorConcaveOn, OperatorConvexOn] + intro A B u hA hB hu0 hu1 As Bs + have hA0 : 0 ≤ A := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA)).2 ?_ + intro x hx + have : x ∈ Set.Ici (0 : ℝ) := As hx + simpa [Set.Ici] using this + have hB0 : 0 ≤ B := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B (ha := hB)).2 ?_ + intro x hx + have : x ∈ Set.Ici (0 : ℝ) := Bs hx + simpa [Set.Ici] using this + have hu0' : 0 ≤ (1 - u) := sub_nonneg.mpr hu1 + have hC0 : 0 ≤ (1 - u) • A + u • B := + add_nonneg (smul_nonneg hu0' hA0) (smul_nonneg hu0 hB0) + set C : 𝓐 := (1 - u) • A + u • B + have hC_mem : C ∈ Set.Ici (0 : 𝓐) := by + simpa [C, Set.Ici] using hC0 + have hA_mem : A ∈ Set.Ici (0 : 𝓐) := by simpa [Set.Ici] using hA0 + have hB_mem : B ∈ Set.Ici (0 : 𝓐) := by simpa [Set.Ici] using hB0 + have hconcC : (1 - u) • (A ^ p) + u • (B ^ p) ≤ C ^ p := by + have hab : (1 - u) + u = (1 : ℝ) := by ring + simpa [C] using (concaveOn_rpow_Ioo hp01).2 hA_mem hB_mem hu0' hu0 hab + have hcalc (T : 𝓐) (hT0 : 0 ≤ T) : + cfcR (fun x : ℝ ↦ x ^ p) T = T ^ p := by + simpa [cfcR] using + (CFC.rpow_eq_cfc_real (A := 𝓐) (a := T) (y := p) (ha := hT0)).symm + have hconcC' : + (1 - u) • cfcR (fun x : ℝ ↦ x ^ p) A + u • cfcR (fun x : ℝ ↦ x ^ p) B + ≤ cfcR (fun x : ℝ ↦ x ^ p) C := by + simpa [hcalc A hA0, hcalc B hB0, hcalc C hC0, C] using hconcC + -- convert concavity into convexity of `x ↦ -x^p` + simpa [cfcR, cfc_neg, smul_neg, neg_add, add_assoc, add_left_comm, add_comm] using neg_le_neg hconcC' + +private lemma sq_mul_div_add (x t : ℝ) (hxt : x + t ≠ 0) : + (x * x) / (x + t) = x - t + (t * t) / (x + t) := by + field_simp [hxt] + ring + +private lemma convexOn_cfcR_one_div_add_t (t : ℝ) (htpos : 0 < t) : + ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun X : 𝓐 ↦ cfcR (fun x : ℝ ↦ 1 / (x + t)) X) := by + have hs : Convex ℝ (Set.Ici (0 : 𝓐)) := convex_Ici (𝕜 := ℝ) (0 : 𝓐) + refine ⟨hs, ?_⟩ + intro A hA B hB a b ha hb hab + have ha1 : a = 1 - b := by linarith [hab] + have hb1 : b ≤ 1 := by linarith [ha, hab] + have hA0 : 0 ≤ A := by simpa [Set.Ici] using hA + have hB0 : 0 ≤ B := by simpa [Set.Ici] using hB + have hspec (X : 𝓐) (hX0 : 0 ≤ X) : spectrum ℝ X ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := spectrum_nonneg_of_nonneg hX0 hx + simpa [Set.Ici] using hx0 + have hOp := one_div_add_t_operatorConvexOn_Ici (𝓐 := 𝓐) t htpos + dsimp [OperatorConvexOn] at hOp + simpa [one_div, ha1] using + hOp (A := A) (B := B) (t := b) (IsSelfAdjoint.of_nonneg hA0) (IsSelfAdjoint.of_nonneg hB0) hb hb1 (hspec A hA0) (hspec B hB0) + +omit [Nontrivial (𝓐)] in +private lemma G_eqOn_rpowIntegrand₀₁_mul {q : NNReal} (hq_real : (q : ℝ) ∈ Set.Ioo (0 : ℝ) 1) + (t : ℝ) (htpos : 0 < t) : + (Set.Ici (0 : 𝓐)).EqOn + (fun X : 𝓐 ↦ cfcₙ (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) X) + (fun X : 𝓐 ↦ (t ^ ((q : ℝ) - 1)) • + (X - algebraMap ℝ (𝓐) t + (t ^ (2 : ℕ)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) X)) := by + intro X hX + have hX0 : 0 ≤ X := by simpa [Set.Ici] using hX + have hX_sa : IsSelfAdjoint X := IsSelfAdjoint.of_nonneg hX0 + have hqs : quasispectrum ℝ X ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := quasispectrum_nonneg_of_nonneg X hX0 x hx + simpa [Set.Ici] using hx0 + have hf_int : ContinuousOn (Real.rpowIntegrand₀₁ (q : ℝ) t) (quasispectrum ℝ X) := + (Real.continuousOn_rpowIntegrand₀₁_Ici hq_real htpos).mono hqs + have hf : + ContinuousOn (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) (quasispectrum ℝ X) := + continuousOn_id.mul hf_int + have hcfcₙ : + cfcₙ (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) X = + cfcR + (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) X := by + simpa using + (cfcₙ_eq_cfc (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (f := fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) (a := X) + (hf := hf) (hf0 := by simp)) + have hEq : + (spectrum ℝ X).EqOn (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) + (fun x : ℝ ↦ (t ^ ((q : ℝ) - 1)) * (x - t + (t ^ (2 : ℕ)) / (x + t))) := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := spectrum_nonneg_of_nonneg hX0 hx + have ht0 : (0 : ℝ) ≤ t := le_of_lt htpos + have hxt : x + t ≠ 0 := ne_of_gt (add_pos_of_nonneg_of_pos hx0 htpos) + have hdiv : (x * x) / (x + t) = x - t + (t * t) / (x + t) := sq_mul_div_add x t hxt + have hrepr0 : + x * Real.rpowIntegrand₀₁ (q : ℝ) t x = (t ^ ((q : ℝ) - 1)) * ((x * x) / (x + t)) := by + rw [Real.rpowIntegrand₀₁_eq_pow_div hq_real ht0 hx0] + rw [mul_div_assoc'] + have hnum : x * (t ^ ((q : ℝ) - 1) * x) = t ^ ((q : ℝ) - 1) * (x * x) := by ring + rw [hnum, mul_div_assoc] + simp [add_comm] + simp [hrepr0, hdiv, pow_two, mul_comm] + have hcfc_congr : + cfcR + (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) X + = + cfcR + (fun x : ℝ ↦ (t ^ ((q : ℝ) - 1)) * (x - t + (t ^ (2 : ℕ)) / (x + t))) X := + cfc_congr hEq + have hne : ∀ x ∈ spectrum ℝ X, x + t ≠ 0 := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := spectrum_nonneg_of_nonneg hX0 hx + exact ne_of_gt (add_pos_of_nonneg_of_pos hx0 htpos) + have hcont_one_div : ContinuousOn (fun x : ℝ ↦ 1 / (x + t)) (spectrum ℝ X) := by + have hden : ContinuousOn (fun x : ℝ ↦ x + t) (spectrum ℝ X) := + continuousOn_id.add continuousOn_const + exact continuousOn_const.div hden hne + have hcont_inner : + ContinuousOn (fun x : ℝ ↦ x - t + (t ^ (2 : ℕ)) / (x + t)) (spectrum ℝ X) := by + have hden : ContinuousOn (fun x : ℝ ↦ x + t) (spectrum ℝ X) := + continuousOn_id.add continuousOn_const + have hdiv : ContinuousOn (fun x : ℝ ↦ (t ^ (2 : ℕ)) / (x + t)) (spectrum ℝ X) := + continuousOn_const.div hden hne + have hsub : ContinuousOn (fun x : ℝ ↦ x - t) (spectrum ℝ X) := + continuousOn_id.sub continuousOn_const + exact hsub.add hdiv + have hcfc_scale : + cfcR + (fun x : ℝ ↦ (t ^ ((q : ℝ) - 1)) * (x - t + (t ^ (2 : ℕ)) / (x + t))) X + = + (t ^ ((q : ℝ) - 1)) • cfcR + (fun x : ℝ ↦ x - t + (t ^ (2 : ℕ)) / (x + t)) X := by + simpa using + (cfc_const_mul (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (r := (t ^ ((q : ℝ) - 1))) + (f := fun x : ℝ ↦ x - t + (t ^ (2 : ℕ)) / (x + t)) (a := X) + (hf := hcont_inner)) + have hcfc_inner : + cfcR + (fun x : ℝ ↦ x - t + (t ^ (2 : ℕ)) / (x + t)) X + = + X - algebraMap ℝ (𝓐) t + (t ^ (2 : ℕ)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) X := by + have hconst : + cfcR (fun _ : ℝ ↦ t) X = + algebraMap ℝ (𝓐) t := by + simpa using (cfc_const (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (r := t) (a := X) hX_sa) + have hid : + cfcR (fun x : ℝ ↦ x) X = X := by + simpa using (cfc_id' (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (a := X) (ha := hX_sa)) + have hpow : + cfcR + (fun x : ℝ ↦ (t ^ (2 : ℕ)) / (x + t)) X + = + (t ^ (2 : ℕ)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) X := by + have : + cfcR + (fun x : ℝ ↦ (t ^ (2 : ℕ)) / (x + t)) X + = + cfcR + (fun x : ℝ ↦ (t ^ (2 : ℕ)) * (1 / (x + t))) X := by + refine cfc_congr ?_ + intro x hx + simp [div_eq_mul_inv, mul_comm] + rw [this] + simpa [cfcR] using + (cfc_const_mul (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (r := (t ^ (2 : ℕ))) (f := fun x : ℝ ↦ 1 / (x + t)) (a := X) (hf := hcont_one_div)) + calc + cfcR + (fun x : ℝ ↦ x - t + (t ^ (2 : ℕ)) / (x + t)) X + = + cfcR (fun x : ℝ ↦ x - t) X + + cfcR (fun x : ℝ ↦ (t ^ (2 : ℕ)) / (x + t)) X := by + simpa using + (cfc_add (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (f := fun x : ℝ ↦ x - t) (g := fun x : ℝ ↦ (t ^ (2 : ℕ)) / (x + t)) (a := X)) + _ = + (cfcR (fun x : ℝ ↦ x) X + - cfcR (fun _ : ℝ ↦ t) X) + + (t ^ (2 : ℕ)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) X := by + simpa [hpow] using + (congrArg (fun z => z + cfcR + (fun x : ℝ ↦ (t ^ (2 : ℕ)) / (x + t)) X) + (cfc_sub (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (f := fun x : ℝ ↦ x) (g := fun _ : ℝ ↦ t) (a := X))) + _ = X - algebraMap ℝ (𝓐) t + (t ^ (2 : ℕ)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) X := by + simp [hid, hconst, sub_eq_add_neg, add_comm] + -- finish + calc + cfcₙ (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) X + = + cfcR + (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) X := hcfcₙ + _ = + cfcR + (fun x : ℝ ↦ (t ^ ((q : ℝ) - 1)) * (x - t + (t ^ (2 : ℕ)) / (x + t))) X := hcfc_congr + _ = + (t ^ ((q : ℝ) - 1)) • cfcR + (fun x : ℝ ↦ x - t + (t ^ (2 : ℕ)) / (x + t)) X := hcfc_scale + _ = (t ^ ((q : ℝ) - 1)) • + (X - algebraMap ℝ (𝓐) t + (t ^ (2 : ℕ)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) X) := by + simp [hcfc_inner, smul_add, smul_smul, mul_comm] + +private lemma convexOn_G_rpowIntegrand₀₁_mul {q : NNReal} (hq_real : (q : ℝ) ∈ Set.Ioo (0 : ℝ) 1) + (t : ℝ) (htpos : 0 < t) : + ConvexOn ℝ (Set.Ici (0 : 𝓐)) + (fun X : 𝓐 ↦ cfcₙ (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) X) := by + -- use `EqOn` to replace the integrand by a structured convex expression + let r : ℝ := t ^ ((q : ℝ) - 1) + have hr_nonneg : 0 ≤ r := + Real.rpow_nonneg (le_of_lt htpos) _ + have hs : Convex ℝ (Set.Ici (0 : 𝓐)) := convex_Ici (𝕜 := ℝ) (0 : 𝓐) + have h_aff : ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun X : 𝓐 ↦ X - algebraMap ℝ (𝓐) t) := by + have hid : ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun X : 𝓐 ↦ X) := by + simpa using (convexOn_id (𝕜 := ℝ) (s := Set.Ici (0 : 𝓐)) hs) + have hconst : ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun _ : 𝓐 ↦ -algebraMap ℝ (𝓐) t) := + convexOn_const (-algebraMap ℝ (𝓐) t) hs + simpa [sub_eq_add_neg] using hid.add hconst + have h_one_div : ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun X : 𝓐 ↦ cfcR (fun x : ℝ ↦ 1 / (x + t)) X) := + convexOn_cfcR_one_div_add_t t htpos + have h_inner : ConvexOn ℝ (Set.Ici (0 : 𝓐)) + (fun X : 𝓐 ↦ X - algebraMap ℝ 𝓐 t + (t ^ (2 : ℕ)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) X) := by + have hterm : + ConvexOn ℝ (Set.Ici (0 : 𝓐)) + (fun X : 𝓐 ↦ (t ^ (2 : ℕ)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) X) := + (h_one_div.smul (sq_nonneg t)) + exact h_aff.add hterm + have h_rhs : + ConvexOn ℝ (Set.Ici (0 : 𝓐)) + (fun X : 𝓐 ↦ r • + (X - algebraMap ℝ (𝓐) t + (t ^ (2 : ℕ)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) X)) := + h_inner.smul hr_nonneg + -- transfer convexity back to the `cfcₙ` expression + refine h_rhs.congr ?_ + intro X hX + have : (fun X : 𝓐 ↦ cfcₙ (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) X) X + = + (fun X : 𝓐 ↦ r • + (X - algebraMap ℝ (𝓐) t + (t ^ (2 : ℕ)) • cfcR (fun x : ℝ ↦ 1 / (x + t)) X)) X := by + simpa [r] using G_eqOn_rpowIntegrand₀₁_mul hq_real t htpos hX + simpa using this.symm + +omit [Nontrivial (𝓐)] in +private lemma ae_cfcₙ_mul_id_rpowIntegrand₀₁_restrict_Ioi {q : NNReal} (hq_real : (q : ℝ) ∈ Set.Ioo (0 : ℝ) 1) + (μ : MeasureTheory.Measure ℝ) (A : 𝓐) (hA0 : 0 ≤ A) : + ∀ᵐ t ∂(μ.restrict (Set.Ioi (0 : ℝ))), + cfcₙ (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) A = + A * cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) A := by + filter_upwards [MeasureTheory.ae_restrict_mem measurableSet_Ioi] with t ht + have hqs : quasispectrum ℝ A ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : (0 : ℝ) ≤ x := quasispectrum_nonneg_of_nonneg A hA0 x hx + simpa [Set.Ici] using hx0 + have hg : ContinuousOn (Real.rpowIntegrand₀₁ (q : ℝ) t) (quasispectrum ℝ A) := + (Real.continuousOn_rpowIntegrand₀₁_Ici hq_real ht).mono hqs + have hG_mul : + cfcₙ (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) A + = + cfcₙ (fun x : ℝ ↦ x) A * cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) A := by + simpa using + (cfcₙ_mul (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (f := fun x : ℝ ↦ x) (g := Real.rpowIntegrand₀₁ (q : ℝ) t) (a := A) + (hf := continuousOn_id) (hf0 := by simp) (hg := hg) (hg0 := by simp)) + have hA_id : cfcₙ (fun x : ℝ ↦ x) A = A := by + simpa using (cfcₙ_id' (R := ℝ) (a := A) (ha := IsSelfAdjoint.of_nonneg hA0)) + simp [hA_id, hG_mul] + +private lemma convexOn_nnrpow_Ioo_one_add {q : NNReal} (hq : q ∈ Set.Ioo (0 : NNReal) 1) : + ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 ↦ A ^ ((1 : NNReal) + q)) := by + -- real exponent in `(0,1)` + have hq_real : (q : ℝ) ∈ Set.Ioo (0 : ℝ) 1 := by + refine ⟨?_, ?_⟩ + · exact (NNReal.coe_pos).2 hq.1 + · exact (NNReal.coe_lt_coe).2 hq.2 + -- integral representation for `a ↦ a ^ q` + obtain ⟨μ, hμ⟩ := + CFC.exists_measure_nnrpow_eq_integral_cfcₙ_rpowIntegrand₀₁ (A := 𝓐) hq + let ν : MeasureTheory.Measure ℝ := μ.restrict (Set.Ioi (0 : ℝ)) + let F0 : ℝ → 𝓐 → 𝓐 := fun t A => cfcₙ (Real.rpowIntegrand₀₁ (q : ℝ) t) A + let G : ℝ → 𝓐 → 𝓐 := fun t A => + cfcₙ (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) A + have hF0_int : ∀ A ∈ Set.Ici (0 : 𝓐), MeasureTheory.Integrable (fun t => F0 t A) ν := by + intro A hA + simpa [F0, ν, MeasureTheory.IntegrableOn] using (hμ A hA).1 + have hG_int : ∀ A ∈ Set.Ici (0 : 𝓐), MeasureTheory.Integrable (fun t => G t A) ν := by + intro A hA + have hA0 : 0 ≤ A := by simpa [Set.Ici] using hA + have hAF : MeasureTheory.Integrable (fun t => A * F0 t A) ν := by + -- left multiplication by a constant is a continuous linear map + have hF : MeasureTheory.Integrable (fun t => F0 t A) ν := hF0_int A hA + simpa [ContinuousLinearMap.mul_apply'] using + (ContinuousLinearMap.mul ℝ (𝓐) A).integrable_comp hF + have hG_mul_ae : ∀ᵐ t ∂ν, G t A = A * F0 t A := by + simpa [ν, G, F0] using + ae_cfcₙ_mul_id_rpowIntegrand₀₁_restrict_Ioi (q := q) hq_real μ A hA0 + exact hAF.congr (hG_mul_ae.mono fun _ ht => ht.symm) + have hG_conv : + ∀ᵐ t ∂ν, ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 => G t A) := by + filter_upwards [MeasureTheory.ae_restrict_mem measurableSet_Ioi] with t ht + have hconv : + ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun X : 𝓐 ↦ cfcₙ (fun x : ℝ ↦ x * Real.rpowIntegrand₀₁ (q : ℝ) t x) X) := + convexOn_G_rpowIntegrand₀₁_mul hq_real t ht + simpa [G] using hconv + have hconv_int : + ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 ↦ ∫ t, G t A ∂ν) := + MeasureTheory.integral_convexOn_of_integrand_ae + (μ := ν) (s := Set.Ici (0 : 𝓐)) (f := fun t A => G t A) + (convex_Ici (𝕜 := ℝ) (0 : 𝓐)) hG_conv hG_int + -- identify the integral with `A ^ (1 + q)` on `Ici 0` + refine hconv_int.congr ?_ + intro A hA + have hA0 : 0 ≤ A := by simpa [Set.Ici] using hA + have hq0 : (0 : NNReal) < q := hq.1 + have hpow : + A ^ ((1 : NNReal) + q) = A * (A ^ q) := by + have h1 : A ^ ((1 : NNReal) + q) = A ^ (1 : NNReal) * A ^ q := by + simpa [add_comm, add_left_comm, add_assoc] using + (CFC.nnrpow_add (A := 𝓐) (a := A) (x := (1 : NNReal)) (y := q) zero_lt_one hq0) + simpa [CFC.nnrpow_one (A := 𝓐) A hA0] using h1 + have hEq_q : A ^ q = ∫ t, F0 t A ∂ν := by + simpa [F0, ν] using (hμ A hA).2 + have hEq_mul : + A * (∫ t, F0 t A ∂ν) = ∫ t, A * F0 t A ∂ν := by + have h : + (∫ t, (ContinuousLinearMap.mul ℝ (𝓐) A) (F0 t A) ∂ν) + = + (ContinuousLinearMap.mul ℝ (𝓐) A) (∫ t, F0 t A ∂ν) := + (ContinuousLinearMap.mul ℝ (𝓐) A).integral_comp_comm (μ := ν) (φ_int := hF0_int A hA) + exact h.symm + have hEq : + A ^ ((1 : NNReal) + q) = ∫ t, G t A ∂ν := by + calc + A ^ ((1 : NNReal) + q) = A * (A ^ q) := hpow + _ = A * (∫ t, F0 t A ∂ν) := by simp [hEq_q] + _ = ∫ t, A * F0 t A ∂ν := hEq_mul + _ = ∫ t, G t A ∂ν := by + have hG_mul_ae : ∀ᵐ t ∂ν, A * F0 t A = G t A := by + have h' : ∀ᵐ t ∂ν, G t A = A * F0 t A := by + simpa [ν, G, F0] using + ae_cfcₙ_mul_id_rpowIntegrand₀₁_restrict_Ioi (q := q) hq_real μ A hA0 + exact h'.mono (fun _ ht => ht.symm) + simpa using (MeasureTheory.integral_congr_ae hG_mul_ae) + simp [hEq] + +private lemma convexOn_rpow_Ioo_one_two {p : ℝ} (hp : p ∈ Set.Ioo (1 : ℝ) 2) : + ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 ↦ A ^ p) := by + -- reduce to the `ℝ≥0` exponent case with `p = 1 + q`, `q ∈ (0,1)` + let q : NNReal := ⟨p - 1, sub_nonneg.mpr (le_of_lt hp.1)⟩ + have hq0 : (0 : NNReal) < q := by + have : (0 : ℝ) < (q : ℝ) := by + simpa [q] using (sub_pos.mpr hp.1) + exact (NNReal.coe_pos).1 this + have hq1 : q < (1 : NNReal) := by + have : (q : ℝ) < (1 : ℝ) := by + have : p - 1 < (1 : ℝ) := by linarith [hp.2] + simpa [q] using this + exact (NNReal.coe_lt_coe).1 (by simpa using this) + have hq : q ∈ Set.Ioo (0 : NNReal) 1 := ⟨hq0, hq1⟩ + have hconv : + ConvexOn ℝ (Set.Ici (0 : 𝓐)) (fun A : 𝓐 ↦ A ^ ((1 : NNReal) + q)) := + convexOn_nnrpow_Ioo_one_add hq + refine hconv.congr ?_ + intro A hA + have hA0 : 0 ≤ A := by simpa [Set.Ici] using hA + have hq0' : (0 : NNReal) < (1 : NNReal) + q := + add_pos_of_pos_of_nonneg zero_lt_one (le_of_lt hq0) + -- `A ^ (1 + q) = A ^ p` + have hEq : + A ^ ((1 : NNReal) + q) = A ^ (((1 : NNReal) + q : NNReal) : ℝ) := by + simpa using (CFC.nnrpow_eq_rpow (A := 𝓐) (a := A) (x := (1 : NNReal) + q) hq0') + -- simplify the real exponent `(1 + q : ℝ)` into `p` + have hreal : (((1 : NNReal) + q : NNReal) : ℝ) = p := by + have : (1 : ℝ) + (p - 1) = p := by ring + simp [q, this] + simp [hEq, hreal] + +omit [Nontrivial (𝓐)] in +omit [PartialOrder 𝓐] [StarOrderedRing 𝓐] [NonnegSpectrumClass ℝ 𝓐] in +private lemma cfcR_mul_self (T : 𝓐) (hT : IsSelfAdjoint T) : + cfcR (fun x : ℝ ↦ x * x) T = T * T := by + dsimp [cfcR] + calc + cfcR (fun x : ℝ ↦ x * x) T = + cfcR (fun x : ℝ ↦ x) T * cfcR (fun x : ℝ ↦ x) T := by + simpa using + (cfc_mul (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) + (f := fun x : ℝ ↦ x) (g := fun x : ℝ ↦ x) (a := T)) + _ = T * T := by + simp [cfc_id' (R := ℝ) (a := T) (ha := hT)] + +omit [Nontrivial (𝓐)] in +omit [PartialOrder 𝓐] [StarOrderedRing 𝓐] [NonnegSpectrumClass ℝ 𝓐] in +private lemma sub_mul_sub (A B : 𝓐) : + (A - B) * (A - B) = A * A - A * B - B * A + B * B := by + calc + (A - B) * (A - B) = (A * A - B * A) - (A * B - B * B) := by + simp [mul_sub, sub_mul] + _ = A * A - A * B - B * A + B * B := by + abel + +omit [Nontrivial (𝓐)] in +omit [PartialOrder 𝓐] [StarOrderedRing 𝓐] [NonnegSpectrumClass ℝ 𝓐] in +private lemma smul_sub_mul_sub (α : ℝ) (A B : 𝓐) : + α • (A * A - A * B - B * A + B * B) = + α • (A * A) - α • (A * B) - α • (B * A) + α • (B * B) := by + rw [smul_add, smul_sub, smul_sub] + +omit [Nontrivial (𝓐)] in +omit [PartialOrder 𝓐] [StarOrderedRing 𝓐] [NonnegSpectrumClass ℝ 𝓐] in +private lemma square_convexity_diff_rhs (A B : 𝓐) (u : ℝ) : + (u * (1 - u)) • ((A - B) * (A - B)) = + (u * (1 - u)) • (A * A) - (u * (1 - u)) • (A * B) - (u * (1 - u)) • (B * A) + + (u * (1 - u)) • (B * B) := by + let α : ℝ := u * (1 - u) + have hsmul : α • ((A - B) * (A - B)) = α • (A * A - A * B - B * A + B * B) := by + rw [sub_mul_sub A B] + have hα : + α • (A * A) - α • (A * B) - α • (B * A) + α • (B * B) + = + (u * (1 - u)) • (A * A) - (u * (1 - u)) • (A * B) - (u * (1 - u)) • (B * A) + + (u * (1 - u)) • (B * B) := by + simp [α] + calc + (u * (1 - u)) • ((A - B) * (A - B)) = α • ((A - B) * (A - B)) := by simp [α] + _ = α • (A * A - A * B - B * A + B * B) := hsmul + _ = α • (A * A) - α • (A * B) - α • (B * A) + α • (B * B) := + smul_sub_mul_sub (α := α) A B + _ = (u * (1 - u)) • (A * A) - (u * (1 - u)) • (A * B) - (u * (1 - u)) • (B * A) + + (u * (1 - u)) • (B * B) := by + simp [hα] + +omit [Nontrivial (𝓐)] in +omit [PartialOrder 𝓐] [StarOrderedRing 𝓐] [NonnegSpectrumClass ℝ 𝓐] in +private lemma square_convexity_diff_hL (A B : 𝓐) (u : ℝ) : + (1 - u) • (A * A) + u • (B * B) - + (((1 - u) * (1 - u)) • (A * A) + ((1 - u) * u) • (A * B) + + (u * (1 - u)) • (B * A) + (u * u) • (B * B)) = + (u * (1 - u)) • (A * A) - (u * (1 - u)) • (A * B) - (u * (1 - u)) • (B * A) + + (u * (1 - u)) • (B * B) := by + let α : ℝ := u * (1 - u) + have hα1 : (1 - u) - (1 - u) * (1 - u) = α := by + simp [α] + ring + have hα2 : u - u * u = α := by + simp [α] + ring + have hα3 : (1 - u) * u = α := by + simp [α] + ring + have hAA : (1 - u) • (A * A) - ((1 - u) * (1 - u)) • (A * A) = α • (A * A) := by + have : (1 - u) • (A * A) - ((1 - u) * (1 - u)) • (A * A) = + ((1 - u) - (1 - u) * (1 - u)) • (A * A) := by + simpa using (sub_smul (1 - u) ((1 - u) * (1 - u)) (A * A)).symm + simp [this, hα1] + have hBB : u • (B * B) - (u * u) • (B * B) = α • (B * B) := by + have : u • (B * B) - (u * u) • (B * B) = (u - u * u) • (B * B) := by + simpa using (sub_smul u (u * u) (B * B)).symm + simp [this, hα2] + have hAB : ((1 - u) * u) • (A * B) = α • (A * B) := by simp [hα3] + have hBA : (u * (1 - u)) • (B * A) = α • (B * A) := by rfl + have hL : + (1 - u) • (A * A) + u • (B * B) - + (((1 - u) * (1 - u)) • (A * A) + ((1 - u) * u) • (A * B) + + (u * (1 - u)) • (B * A) + (u * u) • (B * B)) = + α • (A * A) - α • (A * B) - α • (B * A) + α • (B * B) := by + have hL0 : + (1 - u) • (A * A) + u • (B * B) - + (((1 - u) * (1 - u)) • (A * A) + ((1 - u) * u) • (A * B) + + (u * (1 - u)) • (B * A) + (u * u) • (B * B)) = + ((1 - u) • (A * A) - ((1 - u) * (1 - u)) • (A * A) + + (u • (B * B) - (u * u) • (B * B))) + - ((1 - u) * u) • (A * B) - (u * (1 - u)) • (B * A) := by + abel + have hL1 : + ((1 - u) • (A * A) - ((1 - u) * (1 - u)) • (A * A) + + (u • (B * B) - (u * u) • (B * B))) + - ((1 - u) * u) • (A * B) - (u * (1 - u)) • (B * A) + = α • (A * A) - α • (A * B) - α • (B * A) + α • (B * B) := by + simp_rw [hAA, hBB, hAB, hBA] + abel + simpa [hL0] using hL1 + simpa [α] using hL + +-- This lemma is purely algebraic, so we drop analytical/finite-dimensional assumptions here. +omit [Nontrivial (𝓐)] in +omit [PartialOrder 𝓐] [StarOrderedRing 𝓐] [NonnegSpectrumClass ℝ 𝓐] in +private lemma square_convexity_diff_hCC_sum (A B : 𝓐) (u : ℝ) : + ((1 - u) • A) * ((1 - u) • A) + + ((1 - u) • A) * (u • B) + + (u • B) * ((1 - u) • A) + + (u • B) * (u • B) = + ((1 - u) * (1 - u)) • (A * A) + ((1 - u) * u) • (A * B) + + (u * (1 - u)) • (B * A) + (u * u) • (B * B) := by + have hAA' : + ((1 - u) • A) * ((1 - u) • A) = ((1 - u) * (1 - u)) • (A * A) := by + calc + ((1 - u) • A) * ((1 - u) • A) = (1 - u) • (A * ((1 - u) • A)) := by + exact Algebra.smul_mul_assoc (R := ℝ) (A := 𝓐) (1 - u) A ((1 - u) • A) + _ = (1 - u) • ((1 - u) • (A * A)) := by + rw [Algebra.mul_smul_comm] + _ = ((1 - u) * (1 - u)) • (A * A) := by + simp [smul_smul] + have hAB' : + ((1 - u) • A) * (u • B) = ((1 - u) * u) • (A * B) := by + calc + ((1 - u) • A) * (u • B) = (1 - u) • (A * (u • B)) := by + exact Algebra.smul_mul_assoc (R := ℝ) (A := 𝓐) (1 - u) A (u • B) + _ = (1 - u) • (u • (A * B)) := by + rw [Algebra.mul_smul_comm] + _ = ((1 - u) * u) • (A * B) := by + simp [smul_smul] + have hBA' : + (u • B) * ((1 - u) • A) = (u * (1 - u)) • (B * A) := by + calc + (u • B) * ((1 - u) • A) = u • (B * ((1 - u) • A)) := by + exact Algebra.smul_mul_assoc (R := ℝ) (A := 𝓐) u B ((1 - u) • A) + _ = u • ((1 - u) • (B * A)) := by + simp [Algebra.mul_smul_comm] + _ = (u * (1 - u)) • (B * A) := by + simpa using (smul_smul u (1 - u) (B * A)) + have hBB' : + (u • B) * (u • B) = (u * u) • (B * B) := by + calc + (u • B) * (u • B) = u • (B * (u • B)) := by + exact Algebra.smul_mul_assoc (R := ℝ) (A := 𝓐) u B (u • B) + _ = u • (u • (B * B)) := by + simp [Algebra.mul_smul_comm] + _ = (u * u) • (B * B) := by + simp [smul_smul] + rw [hAA', hAB', hBA', hBB'] + +omit [Nontrivial (𝓐)] in +omit [PartialOrder 𝓐] [StarOrderedRing 𝓐] [NonnegSpectrumClass ℝ 𝓐] in +private lemma square_convexity_diff_hCC (A B : 𝓐) (u : ℝ) : + ((1 - u) • A + u • B) * ((1 - u) • A + u • B) = + ((1 - u) * (1 - u)) • (A * A) + ((1 - u) * u) • (A * B) + + (u * (1 - u)) • (B * A) + (u * u) • (B * B) := by + have hexpand : + ((1 - u) • A + u • B) * ((1 - u) • A + u • B) = + ((1 - u) • A) * ((1 - u) • A) + + ((1 - u) • A) * (u • B) + + (u • B) * ((1 - u) • A) + + (u • B) * (u • B) := by + set X : 𝓐 := (1 - u) • A + set Y : 𝓐 := u • B + have hXY : (1 - u) • A + u • B = X + Y := by simp [X, Y] + calc + ((1 - u) • A + u • B) * ((1 - u) • A + u • B) = (X + Y) * (X + Y) := by + simp [hXY] + _ = X * (X + Y) + Y * (X + Y) := by + simp [add_mul] + _ = (X * X + X * Y) + (Y * X + Y * Y) := by + simp [mul_add, add_assoc] + _ = X * X + X * Y + Y * X + Y * Y := by + abel + _ = ((1 - u) • A) * ((1 - u) • A) + + ((1 - u) • A) * (u • B) + + (u • B) * ((1 - u) • A) + + (u • B) * (u • B) := by + simp [X, Y] + exact hexpand.trans (square_convexity_diff_hCC_sum A B u) + +omit [PartialOrder 𝓐] [StarOrderedRing 𝓐] [NonnegSpectrumClass ℝ 𝓐] [Nontrivial (𝓐)] in +private lemma square_convexity_diff (A B : 𝓐) (u : ℝ) : + (1 - u) • (A * A) + u • (B * B) + - ((1 - u) • A + u • B) * ((1 - u) • A + u • B) + = + (u * (1 - u)) • ((A - B) * (A - B)) := by + rw [square_convexity_diff_hCC A B u] + have hL' : + (1 - u) • (A * A) + u • (B * B) - + (((1 - u) * (1 - u)) • (A * A) + ((1 - u) * u) • (A * B) + + (u * (1 - u)) • (B * A) + (u * u) • (B * B)) = + (u * (1 - u)) • (A * A) - (u * (1 - u)) • (A * B) - (u * (1 - u)) • (B * A) + + (u * (1 - u)) • (B * B) := + square_convexity_diff_hL A B u + have hR : + (u * (1 - u)) • ((A - B) * (A - B)) = + (u * (1 - u)) • (A * A) - (u * (1 - u)) • (A * B) - (u * (1 - u)) • (B * A) + + (u * (1 - u)) • (B * B) := + square_convexity_diff_rhs A B u + exact hL'.trans hR.symm + +omit [Nontrivial (𝓐)] in +private lemma operatorConvexOn_pow_two_Ici : + OperatorConvexOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ x ^ (2 : ℝ)) := by + dsimp [OperatorConvexOn] + intro A B u hA hB hu0 hu1 As Bs + have hA0 : 0 ≤ A := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA)).2 ?_ + intro x hx + have : x ∈ Set.Ici (0 : ℝ) := As hx + simpa [Set.Ici] using this + have hB0 : 0 ≤ B := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B (ha := hB)).2 ?_ + intro x hx + have : x ∈ Set.Ici (0 : ℝ) := Bs hx + simpa [Set.Ici] using this + have hu0' : 0 ≤ (1 - u) := sub_nonneg.mpr hu1 + set C : 𝓐 := (1 - u) • A + u • B + have hC0 : 0 ≤ C := + add_nonneg (smul_nonneg hu0' hA0) (smul_nonneg hu0 hB0) + have hsq : 0 ≤ (A - B) * (A - B) := by + have h1 : (0 : 𝓐) ≤ (1 : 𝓐) := (zero_le_one : (0 : 𝓐) ≤ 1) + have hT : IsSelfAdjoint (A - B) := by simpa using hA.sub hB + simpa [mul_assoc] using conjugate_isPositive (X := (1 : 𝓐)) (T := (A - B)) h1 hT + have hub : 0 ≤ u * (1 - u) := mul_nonneg hu0 hu0' + have hdiff : + (1 - u) • (A * A) + u • (B * B) - C * C + = (u * (1 - u)) • ((A - B) * (A - B)) := by + simpa [C] using (square_convexity_diff A B u) + have hnonneg : 0 ≤ (1 - u) • (A * A) + u • (B * B) - C * C := by + have hscale : 0 ≤ (u * (1 - u)) • ((A - B) * (A - B)) := smul_nonneg hub hsq + simpa [hdiff] using hscale + have hmain : C * C ≤ (1 - u) • (A * A) + u • (B * B) := + (sub_nonneg).1 hnonneg + have hC : IsSelfAdjoint C := by + simpa [C] using (IsSelfAdjoint.all (1 - u)).smul hA |>.add ((IsSelfAdjoint.all u).smul hB) + -- rewrite the goal via `cfcR (x ↦ x^2) T = T*T` + have hfun : (fun x : ℝ ↦ x ^ (2 : ℝ)) = (fun x : ℝ ↦ x * x) := by + funext x + simp [pow_two] + rw [hfun] + simpa [C, cfcR_mul_self C hC, cfcR_mul_self A hA, cfcR_mul_self B hB] using hmain + +theorem power_Icc_one_two_operatorConvexOn_Ici : ∀ p ∈ Set.Icc (1 : ℝ) 2, + OperatorConvexOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x ↦ x ^ p) := by + intro p hp + by_cases hp1 : p = 1 + · subst hp1 + dsimp [OperatorConvexOn] + intro A B u hA hB hu0 hu1 As Bs + have hC : IsSelfAdjoint ((1 - u) • A + u • B) := by + simpa using (IsSelfAdjoint.all (1 - u)).smul hA |>.add ((IsSelfAdjoint.all u).smul hB) + have hfun : (fun x : ℝ ↦ x ^ (1 : ℝ)) = (fun x : ℝ ↦ x) := by + funext x + simp + rw [hfun] + simp [cfcR, cfc_id' (R := ℝ) (a := ((1 - u) • A + u • B)) (ha := hC), + cfc_id' (R := ℝ) (a := A) (ha := hA), cfc_id' (R := ℝ) (a := B) (ha := hB)] + by_cases hp2 : p = 2 + · subst hp2 + simpa using operatorConvexOn_pow_two_Ici + have hp12 : p ∈ Set.Ioo (1 : ℝ) 2 := by + refine ⟨?_, ?_⟩ + · have : 1 ≤ p := hp.1 + exact lt_of_le_of_ne this (Ne.symm hp1) + · have : p ≤ 2 := hp.2 + exact lt_of_le_of_ne this hp2 + dsimp [OperatorConvexOn] + intro A B u hA hB hu0 hu1 As Bs + have hA0 : 0 ≤ A := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) A (ha := hA)).2 ?_ + intro x hx + have : x ∈ Set.Ici (0 : ℝ) := As hx + simpa [Set.Ici] using this + have hB0 : 0 ≤ B := by + refine (StarOrderedRing.nonneg_iff_spectrum_nonneg (R := ℝ) B (ha := hB)).2 ?_ + intro x hx + have : x ∈ Set.Ici (0 : ℝ) := Bs hx + simpa [Set.Ici] using this + have hu0' : 0 ≤ (1 - u) := sub_nonneg.mpr hu1 + set C : 𝓐 := (1 - u) • A + u • B + have hC0 : 0 ≤ C := + add_nonneg (smul_nonneg hu0' hA0) (smul_nonneg hu0 hB0) + have hC_mem : C ∈ Set.Ici (0 : 𝓐) := by + simpa [C, Set.Ici] using hC0 + have hA_mem : A ∈ Set.Ici (0 : 𝓐) := by simpa [Set.Ici] using hA0 + have hB_mem : B ∈ Set.Ici (0 : 𝓐) := by simpa [Set.Ici] using hB0 + have hab : (1 - u) + u = (1 : ℝ) := by ring + have hconvC : (C ^ p) ≤ (1 - u) • (A ^ p) + u • (B ^ p) := by + simpa [C] using + (convexOn_rpow_Ioo_one_two hp12).2 hA_mem hB_mem hu0' hu0 hab + have hcalc (T : 𝓐) (hT0 : 0 ≤ T) : + cfcR (fun x : ℝ ↦ x ^ p) T = T ^ p := by + simpa [cfcR] using + (CFC.rpow_eq_cfc_real (A := 𝓐) (a := T) (y := p) (ha := hT0)).symm + -- rewrite the convexity inequality through `cfcR` + simpa [hcalc A hA0, hcalc B hB0, hcalc C hC0, C] using hconvC + +-- Paper statement (Löwner–Heinz): for `p ∈ [-1,0]`, `f(t) = -t^p` is operator monotone and concave +-- on `(0,∞)`. +omit [Nontrivial 𝓐] in +theorem power_Icc_neg_one_zero_neg_operatorMonotoneOn_Ioi : ∀ p ∈ Set.Icc (-1 : ℝ) 0, + OperatorMonotoneOn (𝓐 := 𝓐) (Set.Ioi (0 : ℝ)) (fun x ↦ -(x ^ p)) := by + intro p hp + dsimp [OperatorMonotoneOn] + intro A B hA0 hB0 hBA hspA hspB + let q : ℝ := -p + have hq : q ∈ Set.Icc (0 : ℝ) 1 := by + constructor + · dsimp [q] + exact neg_nonneg.mpr hp.2 + · dsimp [q] + simpa using (neg_le_neg hp.1) + have hBAq : cfcR (fun x : ℝ ↦ x ^ q) B ≤ cfcR (fun x : ℝ ↦ x ^ q) A := by + have hspA' : spectrum ℝ A ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspA hx + simpa [Set.Ici] using (le_of_lt hx0) + have hspB' : spectrum ℝ B ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspB hx + simpa [Set.Ici] using (le_of_lt hx0) + exact (power_Icc_zero_one_operatorMonotoneOn_Ici q hq (A := A) (B := B) hA0 hB0 hBA hspA' hspB') + let Aq : 𝓐 := cfcR (fun x : ℝ ↦ x ^ q) A + let Bq : 𝓐 := cfcR (fun x : ℝ ↦ x ^ q) B + have hAq0 : 0 ≤ Aq := by + dsimp [Aq, cfcR] + refine cfc_nonneg ?_ + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspA hx + exact le_of_lt (Real.rpow_pos_of_pos hx0 _) + have hBq0 : 0 ≤ Bq := by + dsimp [Bq, cfcR] + refine cfc_nonneg ?_ + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspB hx + exact le_of_lt (Real.rpow_pos_of_pos hx0 _) + have hspAq : spectrum ℝ Aq ⊆ Set.Ioi (0 : ℝ) := by + have hA_sa : IsSelfAdjoint A := IsSelfAdjoint.of_nonneg hA0 + have hcontA : ContinuousOn (fun x : ℝ ↦ x ^ q) (spectrum ℝ A) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspA hx + exact (Real.continuousAt_rpow_const x q (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hspec : + spectrum ℝ Aq = (fun x : ℝ ↦ x ^ q) '' spectrum ℝ A := by + dsimp [Aq, cfcR] + simpa using + (cfc_map_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (f := fun x : ℝ ↦ x ^ q) + (a := A) (ha := hA_sa) (hf := hcontA)) + intro y hy + have hy' : y ∈ (fun x : ℝ ↦ x ^ q) '' spectrum ℝ A := by simpa [hspec] using hy + rcases hy' with ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspA hx + simpa [Set.Ioi] using (Real.rpow_pos_of_pos hx0 q) + have hspBq : spectrum ℝ Bq ⊆ Set.Ioi (0 : ℝ) := by + have hB_sa : IsSelfAdjoint B := IsSelfAdjoint.of_nonneg hB0 + have hcontB : ContinuousOn (fun x : ℝ ↦ x ^ q) (spectrum ℝ B) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspB hx + exact (Real.continuousAt_rpow_const x q (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hspec : + spectrum ℝ Bq = (fun x : ℝ ↦ x ^ q) '' spectrum ℝ B := by + dsimp [Bq, cfcR] + simpa using + (cfc_map_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (f := fun x : ℝ ↦ x ^ q) + (a := B) (ha := hB_sa) (hf := hcontB)) + intro y hy + have hy' : y ∈ (fun x : ℝ ↦ x ^ q) '' spectrum ℝ B := by simpa [hspec] using hy + rcases hy' with ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspB hx + simpa [Set.Ioi] using (Real.rpow_pos_of_pos hx0 q) + have h_inv : + cfcR (fun x : ℝ ↦ 1 / x) Aq ≤ cfcR (fun x : ℝ ↦ 1 / x) Bq := by + have hanti := one_div_operatorAntitoneOn_Ioi (𝓐 := 𝓐) + dsimp [OperatorAntitoneOn] at hanti + have hBAq' : Bq ≤ Aq := by simpa [Aq, Bq] using hBAq + exact hanti (A := Aq) (B := Bq) hAq0 hBq0 hBAq' hspAq hspBq + have hcompA : + cfcR (fun x : ℝ ↦ 1 / x) Aq = cfcR (fun x : ℝ ↦ x ^ p) A := by + have hA_sa : IsSelfAdjoint A := IsSelfAdjoint.of_nonneg hA0 + have hcontA : ContinuousOn (fun x : ℝ ↦ x ^ q) (spectrum ℝ A) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspA hx + exact (Real.continuousAt_rpow_const x q (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hs : (fun x : ℝ ↦ x ^ q) '' spectrum ℝ A ⊆ ({0}ᶜ : Set ℝ) := by + rintro y ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspA hx + simpa [Set.mem_compl_singleton_iff] using (ne_of_gt (Real.rpow_pos_of_pos hx0 q)) + have hg : ContinuousOn (fun y : ℝ ↦ 1 / y) ((fun x : ℝ ↦ x ^ q) '' spectrum ℝ A) := by + have hg' : ContinuousOn (fun y : ℝ ↦ y⁻¹) ({0}ᶜ : Set ℝ) := continuousOn_inv₀ + simpa [one_div] using (hg'.mono hs) + have hcomp : + cfcR (fun y : ℝ ↦ 1 / y) (cfcR (fun x : ℝ ↦ x ^ q) A) = + cfcR (fun x : ℝ ↦ 1 / (x ^ q)) A := by + dsimp [cfcR] + simpa [Function.comp] using + (cfc_comp' (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (g := fun y : ℝ ↦ 1 / y) + (f := fun x : ℝ ↦ x ^ q) (a := A) (hg := hg) (hf := hcontA) (ha := hA_sa)).symm + have hL : + cfcR (fun x : ℝ ↦ 1 / x) Aq = + cfcR (fun y : ℝ ↦ y⁻¹) (cfcR (fun x : ℝ ↦ x ^ q) A) := by + simp [Aq, one_div] + rw [hL] + have hcomp' : + cfcR (fun y : ℝ ↦ y⁻¹) (cfcR (fun x : ℝ ↦ x ^ q) A) = + cfcR (fun x : ℝ ↦ (x ^ q)⁻¹) A := by + simpa [one_div] using hcomp + rw [hcomp'] + dsimp [cfcR] + apply cfc_congr + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspA hx + calc + (x ^ q)⁻¹ = x ^ (-q) := by simpa using (Real.rpow_neg (le_of_lt hx0) q).symm + _ = x ^ p := by simp [q] + have hcompB : + cfcR (fun x : ℝ ↦ 1 / x) Bq = cfcR (fun x : ℝ ↦ x ^ p) B := by + have hB_sa : IsSelfAdjoint B := IsSelfAdjoint.of_nonneg hB0 + have hcontB : ContinuousOn (fun x : ℝ ↦ x ^ q) (spectrum ℝ B) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspB hx + exact (Real.continuousAt_rpow_const x q (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hs : (fun x : ℝ ↦ x ^ q) '' spectrum ℝ B ⊆ ({0}ᶜ : Set ℝ) := by + rintro y ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspB hx + simpa [Set.mem_compl_singleton_iff] using (ne_of_gt (Real.rpow_pos_of_pos hx0 q)) + have hg : ContinuousOn (fun y : ℝ ↦ 1 / y) ((fun x : ℝ ↦ x ^ q) '' spectrum ℝ B) := by + have hg' : ContinuousOn (fun y : ℝ ↦ y⁻¹) ({0}ᶜ : Set ℝ) := continuousOn_inv₀ + simpa [one_div] using (hg'.mono hs) + have hcomp : + cfcR (fun y : ℝ ↦ 1 / y) (cfcR (fun x : ℝ ↦ x ^ q) B) = + cfcR (fun x : ℝ ↦ 1 / (x ^ q)) B := by + dsimp [cfcR] + simpa [Function.comp] using + (cfc_comp' (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (g := fun y : ℝ ↦ 1 / y) + (f := fun x : ℝ ↦ x ^ q) (a := B) (hg := hg) (hf := hcontB) (ha := hB_sa)).symm + have hL : + cfcR (fun x : ℝ ↦ 1 / x) Bq = + cfcR (fun y : ℝ ↦ y⁻¹) (cfcR (fun x : ℝ ↦ x ^ q) B) := by + simp [Bq, one_div] + rw [hL] + have hcomp' : + cfcR (fun y : ℝ ↦ y⁻¹) (cfcR (fun x : ℝ ↦ x ^ q) B) = + cfcR (fun x : ℝ ↦ (x ^ q)⁻¹) B := by + simpa [one_div] using hcomp + rw [hcomp'] + dsimp [cfcR] + apply cfc_congr + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using hspB hx + calc + (x ^ q)⁻¹ = x ^ (-q) := by simpa using (Real.rpow_neg (le_of_lt hx0) q).symm + _ = x ^ p := by simp [q] + have hanti : cfcR (fun x : ℝ ↦ x ^ p) A ≤ cfcR (fun x : ℝ ↦ x ^ p) B := by + calc + cfcR (fun x : ℝ ↦ x ^ p) A = + cfcR (fun x : ℝ ↦ 1 / x) Aq := by + simpa using hcompA.symm + _ ≤ cfcR (fun x : ℝ ↦ 1 / x) Bq := h_inv + _ = cfcR (fun x : ℝ ↦ x ^ p) B := by + simpa using hcompB + have hneg : -cfcR (fun x : ℝ ↦ x ^ p) B ≤ -cfcR (fun x : ℝ ↦ x ^ p) A := + neg_le_neg hanti + have hnegA : + cfcR (fun x : ℝ ↦ -(x ^ p)) A = -cfcR (fun x : ℝ ↦ x ^ p) A := by + simp [cfcR, cfc_neg] + have hnegB : + cfcR (fun x : ℝ ↦ -(x ^ p)) B = -cfcR (fun x : ℝ ↦ x ^ p) B := by + simp [cfcR, cfc_neg] + simpa [hnegA, hnegB] using hneg + +theorem power_Icc_neg_one_zero_neg_operatorConcaveOn_Ioi : ∀ p ∈ Set.Icc (-1 : ℝ) 0, + OperatorConcaveOn (𝓐 := 𝓐) (Set.Ioi (0 : ℝ)) (fun x ↦ -(x ^ p)) := by + intro p hp + -- `OperatorConcaveOn` for `-(x^p)` is `OperatorConvexOn` for `x^p`. + dsimp [OperatorConcaveOn, OperatorConvexOn] + intro A B t hA hB ht0 ht1 As Bs + -- main parameters + let r : ℝ := -p + have hr : r ∈ Set.Icc (0 : ℝ) 1 := by + constructor + · dsimp [r] + exact neg_nonneg.mpr hp.2 + · dsimp [r] + simpa using (neg_le_neg hp.1) + -- convex combination + set C : 𝓐 := (1 - t) • A + t • B + have hC : IsSelfAdjoint C := by + simpa [C] using (IsSelfAdjoint.all (1 - t)).smul hA |>.add ((IsSelfAdjoint.all t).smul hB) + have Cs : spectrum ℝ C ⊆ Set.Ioi (0 : ℝ) := by + simpa [C] using + spectrum_convexCombo_Ioi (A := A) (B := B) (t := t) hA hB ht0 ht1 As Bs + -- r-th powers + let Ar : 𝓐 := cfcR (fun x : ℝ ↦ x ^ r) A + let Br : 𝓐 := cfcR (fun x : ℝ ↦ x ^ r) B + let Cr : 𝓐 := cfcR (fun x : ℝ ↦ x ^ r) C + let Dr : 𝓐 := (1 - t) • Ar + t • Br + have h_conc : Dr ≤ Cr := by + have As0 : spectrum ℝ A ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using As hx + simpa [Set.Ici] using (le_of_lt hx0) + have Bs0 : spectrum ℝ B ⊆ Set.Ici (0 : ℝ) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Bs hx + simpa [Set.Ici] using (le_of_lt hx0) + have hconc := power_Icc_zero_one_operatorConcaveOn_Ici (𝓐 := 𝓐) r hr + dsimp [OperatorConcaveOn, OperatorConvexOn] at hconc + have h1 : + (-Cr) ≤ (1 - t) • (-Ar) + t • (-Br) := by + simpa [C, Ar, Br, Cr, cfcR, cfc_neg] using + hconc (A := A) (B := B) (t := t) hA hB ht0 ht1 As0 Bs0 + have h2 : (1 - t) • (-Ar) + t • (-Br) = -Dr := by + simp [Dr, smul_neg, add_comm] + have h3 : (-Cr) ≤ (-Dr) := by + calc + (-Cr) ≤ (1 - t) • (-Ar) + t • (-Br) := h1 + _ = (-Dr) := h2 + simpa [Dr, add_comm, add_left_comm, add_assoc] using (neg_le_neg_iff).1 h3 + -- invert and use antitonicity/convexity of `x ↦ 1/x` + have h_inv1 : + cfcR (fun x : ℝ ↦ 1 / x) Cr ≤ cfcR (fun x : ℝ ↦ 1 / x) Dr := by + have hCr0 : 0 ≤ Cr := by + dsimp [Cr, cfcR] + refine cfc_nonneg ?_ + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Cs hx + exact le_of_lt (Real.rpow_pos_of_pos hx0 r) + have hAr0 : 0 ≤ Ar := by + dsimp [Ar, cfcR] + refine cfc_nonneg ?_ + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using As hx + exact le_of_lt (Real.rpow_pos_of_pos hx0 r) + have hBr0 : 0 ≤ Br := by + dsimp [Br, cfcR] + refine cfc_nonneg ?_ + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Bs hx + exact le_of_lt (Real.rpow_pos_of_pos hx0 r) + have hDr0 : 0 ≤ Dr := by + dsimp [Dr] + exact add_nonneg (smul_nonneg (sub_nonneg.mpr ht1) hAr0) (smul_nonneg ht0 hBr0) + have hCr_sa : IsSelfAdjoint Cr := by + dsimp [Cr, cfcR] + exact cfc_predicate _ _ + have hAr_sa : IsSelfAdjoint Ar := by + dsimp [Ar, cfcR] + exact cfc_predicate _ _ + have hBr_sa : IsSelfAdjoint Br := by + dsimp [Br, cfcR] + exact cfc_predicate _ _ + have hspCr : spectrum ℝ Cr ⊆ Set.Ioi (0 : ℝ) := by + have hcontC : ContinuousOn (fun x : ℝ ↦ x ^ r) (spectrum ℝ C) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Cs hx + exact (Real.continuousAt_rpow_const x r (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hspec : + spectrum ℝ Cr = (fun x : ℝ ↦ x ^ r) '' spectrum ℝ C := by + dsimp [Cr, cfcR] + simpa using + (cfc_map_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (f := fun x : ℝ ↦ x ^ r) + (a := C) (ha := hC) (hf := hcontC)) + intro y hy + have hy' : y ∈ (fun x : ℝ ↦ x ^ r) '' spectrum ℝ C := by simpa [hspec] using hy + rcases hy' with ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Cs hx + simpa [Set.Ioi] using (Real.rpow_pos_of_pos hx0 r) + have hspAr : spectrum ℝ Ar ⊆ Set.Ioi (0 : ℝ) := by + have hcontA : ContinuousOn (fun x : ℝ ↦ x ^ r) (spectrum ℝ A) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using As hx + exact (Real.continuousAt_rpow_const x r (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hspec : + spectrum ℝ Ar = (fun x : ℝ ↦ x ^ r) '' spectrum ℝ A := by + dsimp [Ar, cfcR] + simpa using + (cfc_map_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (f := fun x : ℝ ↦ x ^ r) + (a := A) (ha := hA) (hf := hcontA)) + intro y hy + have hy' : y ∈ (fun x : ℝ ↦ x ^ r) '' spectrum ℝ A := by simpa [hspec] using hy + rcases hy' with ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using As hx + simpa [Set.Ioi] using (Real.rpow_pos_of_pos hx0 r) + have hspBr : spectrum ℝ Br ⊆ Set.Ioi (0 : ℝ) := by + have hcontB : ContinuousOn (fun x : ℝ ↦ x ^ r) (spectrum ℝ B) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Bs hx + exact (Real.continuousAt_rpow_const x r (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hspec : + spectrum ℝ Br = (fun x : ℝ ↦ x ^ r) '' spectrum ℝ B := by + dsimp [Br, cfcR] + simpa using + (cfc_map_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (f := fun x : ℝ ↦ x ^ r) + (a := B) (ha := hB) (hf := hcontB)) + intro y hy + have hy' : y ∈ (fun x : ℝ ↦ x ^ r) '' spectrum ℝ B := by simpa [hspec] using hy + rcases hy' with ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Bs hx + simpa [Set.Ioi] using (Real.rpow_pos_of_pos hx0 r) + have hspDr : spectrum ℝ Dr ⊆ Set.Ioi (0 : ℝ) := by + simpa [Dr] using + spectrum_convexCombo_Ioi (A := Ar) (B := Br) (t := t) hAr_sa hBr_sa ht0 ht1 hspAr hspBr + have hanti := one_div_operatorAntitoneOn_Ioi (𝓐 := 𝓐) + dsimp [OperatorAntitoneOn] at hanti + exact hanti (A := Cr) (B := Dr) hCr0 hDr0 h_conc hspCr hspDr + have h_inv2 : + cfcR (fun x : ℝ ↦ 1 / x) Dr + ≤ (1 - t) • cfcR (fun x : ℝ ↦ 1 / x) Ar + + t • cfcR (fun x : ℝ ↦ 1 / x) Br := by + have hAr_sa : IsSelfAdjoint Ar := by + dsimp [Ar, cfcR] + exact cfc_predicate _ _ + have hBr_sa : IsSelfAdjoint Br := by + dsimp [Br, cfcR] + exact cfc_predicate _ _ + have hspAr : spectrum ℝ Ar ⊆ Set.Ioi (0 : ℝ) := by + have hcontA : ContinuousOn (fun x : ℝ ↦ x ^ r) (spectrum ℝ A) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using As hx + exact (Real.continuousAt_rpow_const x r (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hspec : + spectrum ℝ Ar = (fun x : ℝ ↦ x ^ r) '' spectrum ℝ A := by + dsimp [Ar, cfcR] + simpa using + (cfc_map_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (f := fun x : ℝ ↦ x ^ r) + (a := A) (ha := hA) (hf := hcontA)) + intro y hy + have hy' : y ∈ (fun x : ℝ ↦ x ^ r) '' spectrum ℝ A := by simpa [hspec] using hy + rcases hy' with ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using As hx + simpa [Set.Ioi] using (Real.rpow_pos_of_pos hx0 r) + have hspBr : spectrum ℝ Br ⊆ Set.Ioi (0 : ℝ) := by + have hcontB : ContinuousOn (fun x : ℝ ↦ x ^ r) (spectrum ℝ B) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Bs hx + exact (Real.continuousAt_rpow_const x r (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hspec : + spectrum ℝ Br = (fun x : ℝ ↦ x ^ r) '' spectrum ℝ B := by + dsimp [Br, cfcR] + simpa using + (cfc_map_spectrum (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (f := fun x : ℝ ↦ x ^ r) + (a := B) (ha := hB) (hf := hcontB)) + intro y hy + have hy' : y ∈ (fun x : ℝ ↦ x ^ r) '' spectrum ℝ B := by simpa [hspec] using hy + rcases hy' with ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Bs hx + simpa [Set.Ioi] using (Real.rpow_pos_of_pos hx0 r) + have hconv := one_div_operatorConvexOn_Ioi (𝓐 := 𝓐) + dsimp [OperatorConvexOn] at hconv + simpa [Dr] using + hconv (A := Ar) (B := Br) (t := t) hAr_sa hBr_sa ht0 ht1 hspAr hspBr + -- rewrite `1/(X^r)` into `X^p` + have hcompA : + cfcR (fun x : ℝ ↦ 1 / x) Ar = cfcR (fun x : ℝ ↦ x ^ p) A := by + have hcontA : ContinuousOn (fun x : ℝ ↦ x ^ r) (spectrum ℝ A) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using As hx + exact (Real.continuousAt_rpow_const x r (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hs : (fun x : ℝ ↦ x ^ r) '' spectrum ℝ A ⊆ ({0}ᶜ : Set ℝ) := by + rintro y ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using As hx + simpa [Set.mem_compl_singleton_iff] using (ne_of_gt (Real.rpow_pos_of_pos hx0 r)) + have hg : ContinuousOn (fun y : ℝ ↦ 1 / y) ((fun x : ℝ ↦ x ^ r) '' spectrum ℝ A) := by + have hg' : ContinuousOn (fun y : ℝ ↦ y⁻¹) ({0}ᶜ : Set ℝ) := continuousOn_inv₀ + simpa [one_div] using (hg'.mono hs) + have hcomp : + cfcR (fun y : ℝ ↦ 1 / y) (cfcR (fun x : ℝ ↦ x ^ r) A) = + cfcR (fun x : ℝ ↦ 1 / (x ^ r)) A := by + dsimp [cfcR] + simpa [Function.comp] using + (cfc_comp' (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (g := fun y : ℝ ↦ 1 / y) + (f := fun x : ℝ ↦ x ^ r) (a := A) (hg := hg) (hf := hcontA) (ha := hA)).symm + have hL : + cfcR (fun x : ℝ ↦ 1 / x) Ar = + cfcR (fun y : ℝ ↦ y⁻¹) (cfcR (fun x : ℝ ↦ x ^ r) A) := by + simp [Ar, one_div] + rw [hL] + have hcomp' : + cfcR (fun y : ℝ ↦ y⁻¹) (cfcR (fun x : ℝ ↦ x ^ r) A) = + cfcR (fun x : ℝ ↦ (x ^ r)⁻¹) A := by + simpa [one_div] using hcomp + rw [hcomp'] + dsimp [cfcR] + apply cfc_congr + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using As hx + calc + (x ^ r)⁻¹ = x ^ (-r) := by + simpa using (Real.rpow_neg (le_of_lt hx0) r).symm + _ = x ^ p := by simp [r] + have hcompB : + cfcR (fun x : ℝ ↦ 1 / x) Br = cfcR (fun x : ℝ ↦ x ^ p) B := by + have hcontB : ContinuousOn (fun x : ℝ ↦ x ^ r) (spectrum ℝ B) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Bs hx + exact (Real.continuousAt_rpow_const x r (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hs : (fun x : ℝ ↦ x ^ r) '' spectrum ℝ B ⊆ ({0}ᶜ : Set ℝ) := by + rintro y ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Bs hx + simpa [Set.mem_compl_singleton_iff] using (ne_of_gt (Real.rpow_pos_of_pos hx0 r)) + have hg : ContinuousOn (fun y : ℝ ↦ 1 / y) ((fun x : ℝ ↦ x ^ r) '' spectrum ℝ B) := by + have hg' : ContinuousOn (fun y : ℝ ↦ y⁻¹) ({0}ᶜ : Set ℝ) := continuousOn_inv₀ + simpa [one_div] using (hg'.mono hs) + have hcomp : + cfcR (fun y : ℝ ↦ 1 / y) (cfcR (fun x : ℝ ↦ x ^ r) B) = + cfcR (fun x : ℝ ↦ 1 / (x ^ r)) B := by + dsimp [cfcR] + simpa [Function.comp] using + (cfc_comp' (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (g := fun y : ℝ ↦ 1 / y) + (f := fun x : ℝ ↦ x ^ r) (a := B) (hg := hg) (hf := hcontB) (ha := hB)).symm + have hL : + cfcR (fun x : ℝ ↦ 1 / x) Br = + cfcR (fun y : ℝ ↦ y⁻¹) (cfcR (fun x : ℝ ↦ x ^ r) B) := by + simp [Br, one_div] + rw [hL] + have hcomp' : + cfcR (fun y : ℝ ↦ y⁻¹) (cfcR (fun x : ℝ ↦ x ^ r) B) = + cfcR (fun x : ℝ ↦ (x ^ r)⁻¹) B := by + simpa [one_div] using hcomp + rw [hcomp'] + dsimp [cfcR] + apply cfc_congr + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Bs hx + calc + (x ^ r)⁻¹ = x ^ (-r) := by + simpa using (Real.rpow_neg (le_of_lt hx0) r).symm + _ = x ^ p := by simp [r] + have hcompC : + cfcR (fun x : ℝ ↦ 1 / x) Cr = cfcR (fun x : ℝ ↦ x ^ p) C := by + have hcontC : ContinuousOn (fun x : ℝ ↦ x ^ r) (spectrum ℝ C) := by + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Cs hx + exact (Real.continuousAt_rpow_const x r (Or.inl (ne_of_gt hx0))).continuousWithinAt + have hs : (fun x : ℝ ↦ x ^ r) '' spectrum ℝ C ⊆ ({0}ᶜ : Set ℝ) := by + rintro y ⟨x, hx, rfl⟩ + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Cs hx + simpa [Set.mem_compl_singleton_iff] using (ne_of_gt (Real.rpow_pos_of_pos hx0 r)) + have hg : ContinuousOn (fun y : ℝ ↦ 1 / y) ((fun x : ℝ ↦ x ^ r) '' spectrum ℝ C) := by + have hg' : ContinuousOn (fun y : ℝ ↦ y⁻¹) ({0}ᶜ : Set ℝ) := continuousOn_inv₀ + simpa [one_div] using (hg'.mono hs) + have hcomp : + cfcR (fun y : ℝ ↦ 1 / y) (cfcR (fun x : ℝ ↦ x ^ r) C) = + cfcR (fun x : ℝ ↦ 1 / (x ^ r)) C := by + dsimp [cfcR] + simpa [Function.comp] using + (cfc_comp' (R := ℝ) (A := 𝓐) (p := IsSelfAdjoint) (g := fun y : ℝ ↦ 1 / y) + (f := fun x : ℝ ↦ x ^ r) (a := C) (hg := hg) (hf := hcontC) (ha := hC)).symm + have hL : + cfcR (fun x : ℝ ↦ 1 / x) Cr = + cfcR (fun y : ℝ ↦ y⁻¹) (cfcR (fun x : ℝ ↦ x ^ r) C) := by + simp [Cr, one_div] + rw [hL] + have hcomp' : + cfcR (fun y : ℝ ↦ y⁻¹) (cfcR (fun x : ℝ ↦ x ^ r) C) = + cfcR (fun x : ℝ ↦ (x ^ r)⁻¹) C := by + simpa [one_div] using hcomp + rw [hcomp'] + dsimp [cfcR] + apply cfc_congr + intro x hx + have hx0 : (0 : ℝ) < x := by simpa [Set.Ioi] using Cs hx + calc + (x ^ r)⁻¹ = x ^ (-r) := by + simpa using (Real.rpow_neg (le_of_lt hx0) r).symm + _ = x ^ p := by simp [r] + -- finish + have hmain : + cfcR (fun x : ℝ ↦ x ^ p) C + ≤ (1 - t) • cfcR (fun x : ℝ ↦ x ^ p) A + + t • cfcR (fun x : ℝ ↦ x ^ p) B := by + have hchain : + cfcR (fun x : ℝ ↦ 1 / x) Cr + ≤ (1 - t) • cfcR (fun x : ℝ ↦ 1 / x) Ar + + t • cfcR (fun x : ℝ ↦ 1 / x) Br := + le_trans h_inv1 h_inv2 + -- convert via `hcomp*` + have hcompA' : cfcR (fun x : ℝ ↦ x⁻¹) Ar = cfcR (fun x : ℝ ↦ x ^ p) A := by + simpa [one_div] using hcompA + have hcompB' : cfcR (fun x : ℝ ↦ x⁻¹) Br = cfcR (fun x : ℝ ↦ x ^ p) B := by + simpa [one_div] using hcompB + have hcompC' : cfcR (fun x : ℝ ↦ x⁻¹) Cr = cfcR (fun x : ℝ ↦ x ^ p) C := by + simpa [one_div] using hcompC + have hchain' : + cfcR (fun x : ℝ ↦ x⁻¹) Cr + ≤ (1 - t) • cfcR (fun x : ℝ ↦ x⁻¹) Ar + + t • cfcR (fun x : ℝ ↦ x⁻¹) Br := by + simpa [one_div] using hchain + simpa [hcompA', hcompB', hcompC'] using hchain' + simpa [C] using hmain + +end Spectrum + +namespace Spectral + +variable {𝓐 : Type u} [CStarAlgebra 𝓐] +variable [Nontrivial 𝓐] + +section + +-- Confine `spectralOrder` to this wrapper namespace. +-- We use local instances so the order change does not leak outside. +noncomputable local instance : PartialOrder 𝓐 := CStarAlgebra.spectralOrder 𝓐 +noncomputable local instance : StarOrderedRing 𝓐 := CStarAlgebra.spectralOrderedRing 𝓐 +noncomputable local instance : NonnegSpectrumClass ℝ 𝓐 := inferInstance + +-- Wrappers: expose the main theorems under spectral order without duplicating proofs. + +omit [Nontrivial 𝓐] in +theorem one_div_operatorAntitoneOn_Ioi : + OperatorAntitoneOn (𝓐 := 𝓐) (Set.Ioi (0 : ℝ)) (fun x : ℝ ↦ 1 / x) := by + simpa using (LownerHeinzCore.one_div_operatorAntitoneOn_Ioi (𝓐 := 𝓐)) + +theorem one_div_operatorConvexOn_Ioi : + OperatorConvexOn (𝓐 := 𝓐) (Set.Ioi (0 : ℝ)) (fun x : ℝ ↦ 1 / x) := by + simpa using (LownerHeinzCore.one_div_operatorConvexOn_Ioi (𝓐 := 𝓐)) + +omit [Nontrivial 𝓐] in +theorem one_div_add_t_operatorAntitoneOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorAntitoneOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ 1 / (x + t)) := by + intro t ht + simpa using (LownerHeinzCore.one_div_add_t_operatorAntitoneOn_Ici (𝓐 := 𝓐) t ht) + +theorem one_div_add_t_operatorConvexOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorConvexOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ 1 / (x + t)) := by + intro t ht + simpa using (LownerHeinzCore.one_div_add_t_operatorConvexOn_Ici (𝓐 := 𝓐) t ht) + +omit [Nontrivial 𝓐] in +theorem ratio_add_t_operatorMonotoneOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorMonotoneOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ x / (x + t)) := by + intro t ht + simpa using (LownerHeinzCore.ratio_add_t_operatorMonotoneOn_Ici (𝓐 := 𝓐) t ht) + +theorem ratio_add_t_operatorConcaveOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorConcaveOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ x / (x + t)) := by + intro t ht + simpa using (LownerHeinzCore.ratio_add_t_operatorConcaveOn_Ici (𝓐 := 𝓐) t ht) + +omit [Nontrivial 𝓐] in +theorem power_Icc_zero_one_operatorMonotoneOn_Ici : ∀ p ∈ Set.Icc (0 : ℝ) 1, + OperatorMonotoneOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x ↦ x ^ p) := by + intro p hp + simpa using (LownerHeinzCore.power_Icc_zero_one_operatorMonotoneOn_Ici (𝓐 := 𝓐) p hp) + +theorem power_Icc_zero_one_operatorConcaveOn_Ici : ∀ p ∈ Set.Icc (0 : ℝ) 1, + OperatorConcaveOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x ↦ x ^ p) := by + intro p hp + simpa using (LownerHeinzCore.power_Icc_zero_one_operatorConcaveOn_Ici (𝓐 := 𝓐) p hp) + +theorem power_Icc_one_two_operatorConvexOn_Ici : ∀ p ∈ Set.Icc (1 : ℝ) 2, + OperatorConvexOn (𝓐 := 𝓐) (Set.Ici (0 : ℝ)) (fun x ↦ x ^ p) := by + intro p hp + simpa using (LownerHeinzCore.power_Icc_one_two_operatorConvexOn_Ici (𝓐 := 𝓐) p hp) + +omit [Nontrivial 𝓐] in +theorem power_Icc_neg_one_zero_neg_operatorMonotoneOn_Ioi : ∀ p ∈ Set.Icc (-1 : ℝ) 0, + OperatorMonotoneOn (𝓐 := 𝓐) (Set.Ioi (0 : ℝ)) (fun x ↦ -(x ^ p)) := by + intro p hp + simpa using (LownerHeinzCore.power_Icc_neg_one_zero_neg_operatorMonotoneOn_Ioi (𝓐 := 𝓐) p hp) + +theorem power_Icc_neg_one_zero_neg_operatorConcaveOn_Ioi : ∀ p ∈ Set.Icc (-1 : ℝ) 0, + OperatorConcaveOn (𝓐 := 𝓐) (Set.Ioi (0 : ℝ)) (fun x ↦ -(x ^ p)) := by + intro p hp + simpa using (LownerHeinzCore.power_Icc_neg_one_zero_neg_operatorConcaveOn_Ioi (𝓐 := 𝓐) p hp) + +end + +end Spectral + +end LownerHeinzCore diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LownerHeinzTheorem.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LownerHeinzTheorem.lean new file mode 100644 index 000000000..43e74f28f --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LownerHeinzTheorem.lean @@ -0,0 +1,279 @@ +/- +Copyright (c) 2026 Hayata Yamasaki. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kei Tsukamoto, Kento Mori, Hayata Yamasaki +-/ +module + +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.LownerHeinzCore + +public import Mathlib.Analysis.CStarAlgebra.ContinuousLinearMap +public import Mathlib.Analysis.Convex.Continuous +public import Mathlib.Analysis.InnerProductSpace.StarOrder + +@[expose] public section + +/-! +## Wrapper（`B(ℋ)`） + +このファイルは `LownerHeinzCore` の結果を、`L ℋ := ℋ →L[ℂ] ℋ`（有界線形作用素）に +**特殊化して再公開する薄い wrapper** です。 + +- 証明は `simpa using` による Core の特殊化のみ（重複証明は書かない） +- `B(ℋ)` 側では既存の Loewner order の ecosystem を尊重し、`spectralOrder` は導入しません + （`spectralOrder` が必要な場合は `LownerHeinzCore.Spectral` を利用） +-/ + +namespace LownerHeinzTheorem + +universe u v + +open CFC + +abbrev L (ℋ : Type u) [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] : Type u := + ℋ →L[ℂ] ℋ + +variable {ℋ : Type u} [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] +variable [Nontrivial ℋ] + +noncomputable instance instNontrivialL : Nontrivial (L ℋ) := inferInstance + +set_option synthInstance.maxHeartbeats 40000 in +noncomputable local instance : NonnegSpectrumClass ℝ (L ℋ) := inferInstance + +set_option synthInstance.maxHeartbeats 80000 in +noncomputable instance instCFCRealSelfAdjoint : + ContinuousFunctionalCalculus ℝ (L ℋ) IsSelfAdjoint := inferInstance + +noncomputable abbrev cfcR (f : ℝ → ℝ) (A : L ℋ) : L ℋ := + LownerHeinzCore.cfcR (𝓐 := L ℋ) f A + +/-- Fixed-space operator monotonicity on the Hilbert space `ℋ`. -/ +def OperatorMonotone (f : ℝ → ℝ) : Prop := + LownerHeinzCore.OperatorMonotone (𝓐 := L ℋ) f + +/-- Fixed-space operator monotonicity on `s` for the Hilbert space `ℋ`. -/ +def OperatorMonotoneOn (s : Set ℝ) (f : ℝ → ℝ) : Prop := + LownerHeinzCore.OperatorMonotoneOn (𝓐 := L ℋ) s f + +/-- Fixed-space operator antitonicity on the Hilbert space `ℋ`. -/ +def OperatorAntitone (f : ℝ → ℝ) : Prop := + LownerHeinzCore.OperatorAntitone (𝓐 := L ℋ) f + +/-- Fixed-space operator antitonicity on `s` for the Hilbert space `ℋ`. -/ +def OperatorAntitoneOn (s : Set ℝ) (f : ℝ → ℝ) : Prop := + LownerHeinzCore.OperatorAntitoneOn (𝓐 := L ℋ) s f + +/-- Fixed-space operator convexity on the Hilbert space `ℋ`. -/ +def OperatorConvex (f : ℝ → ℝ) : Prop := + LownerHeinzCore.OperatorConvex (𝓐 := L ℋ) f + +/-- Fixed-space operator convexity on `s` for the Hilbert space `ℋ`. -/ +def OperatorConvexOn (s : Set ℝ) (f : ℝ → ℝ) : Prop := + LownerHeinzCore.OperatorConvexOn (𝓐 := L ℋ) s f + +/-- Fixed-space operator concavity on the Hilbert space `ℋ`. -/ +def OperatorConcave (f : ℝ → ℝ) : Prop := + LownerHeinzCore.OperatorConcave (𝓐 := L ℋ) f + +/-- Fixed-space operator concavity on `s` for the Hilbert space `ℋ`. -/ +def OperatorConcaveOn (s : Set ℝ) (f : ℝ → ℝ) : Prop := + LownerHeinzCore.OperatorConcaveOn (𝓐 := L ℋ) s f + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] [Nontrivial ℋ] in +/-- Uniform operator monotonicity over all Hilbert spaces in universe `u`. -/ +def OperatorMonotoneAll (f : ℝ → ℝ) : Prop := + ∀ {K : Type u} + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + [Nontrivial K], + OperatorMonotone (ℋ := K) f + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] [Nontrivial ℋ] in +/-- Uniform operator monotonicity on `s` over all Hilbert spaces in universe `u`. -/ +def OperatorMonotoneOnAll (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ {K : Type u} + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + [Nontrivial K], + OperatorMonotoneOn (ℋ := K) s f + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] [Nontrivial ℋ] in +/-- Uniform operator antitonicity over all Hilbert spaces in universe `u`. -/ +def OperatorAntitoneAll (f : ℝ → ℝ) : Prop := + ∀ {K : Type u} + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + [Nontrivial K], + OperatorAntitone (ℋ := K) f + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] [Nontrivial ℋ] in +/-- Uniform operator antitonicity on `s` over all Hilbert spaces in universe `u`. -/ +def OperatorAntitoneOnAll (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ {K : Type u} + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + [Nontrivial K], + OperatorAntitoneOn (ℋ := K) s f + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] [Nontrivial ℋ] in +/-- Uniform operator convexity over all Hilbert spaces in universe `u`. -/ +def OperatorConvexAll (f : ℝ → ℝ) : Prop := + ∀ {K : Type u} + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + [Nontrivial K], + OperatorConvex (ℋ := K) f + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] [Nontrivial ℋ] in +/-- Uniform operator convexity on `s` over all Hilbert spaces in universe `u`. -/ +def OperatorConvexOnAll (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ {K : Type u} + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + [Nontrivial K], + OperatorConvexOn (ℋ := K) s f + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] [Nontrivial ℋ] in +/-- Uniform operator concavity over all Hilbert spaces in universe `u`. -/ +def OperatorConcaveAll (f : ℝ → ℝ) : Prop := + ∀ {K : Type u} + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + [Nontrivial K], + OperatorConcave (ℋ := K) f + +omit ℋ [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] [Nontrivial ℋ] in +/-- Uniform operator concavity on `s` over all Hilbert spaces in universe `u`. -/ +def OperatorConcaveOnAll (s : Set ℝ) (f : ℝ → ℝ) : Prop := + ∀ {K : Type u} + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + [Nontrivial K], + OperatorConcaveOn (ℋ := K) s f + +theorem operatorConvex_convexOn_univ {f : ℝ → ℝ} (hf : OperatorConvex (ℋ := ℋ) f) : + ConvexOn ℝ Set.univ f := by + refine ⟨convex_univ, ?_⟩ + intro x _ y _ a b ha hb hab + have hb1 : b ≤ 1 := by + linarith + have halg_combo (u v r s : ℝ) : + u • (algebraMap ℝ (L ℋ) r) + v • (algebraMap ℝ (L ℋ) s) = + algebraMap ℝ (L ℋ) (u * r + v * s) := by + calc + u • (algebraMap ℝ (L ℋ) r) + v • (algebraMap ℝ (L ℋ) s) = + (algebraMap ℝ (L ℋ) u) * (algebraMap ℝ (L ℋ) r) + + (algebraMap ℝ (L ℋ) v) * (algebraMap ℝ (L ℋ) s) := by + rw [Algebra.smul_def, Algebra.smul_def] + _ = algebraMap ℝ (L ℋ) (u * r) + algebraMap ℝ (L ℋ) (v * s) := by + simp + _ = algebraMap ℝ (L ℋ) (u * r + v * s) := by + simp + have hop : + cfcR (ℋ := ℋ) f + ((1 - b) • (algebraMap ℝ (L ℋ) x) + b • (algebraMap ℝ (L ℋ) y)) ≤ + (1 - b) • cfcR (ℋ := ℋ) f (algebraMap ℝ (L ℋ) x) + + b • cfcR (ℋ := ℋ) f (algebraMap ℝ (L ℋ) y) := + hf (A := algebraMap ℝ (L ℋ) x) (B := algebraMap ℝ (L ℋ) y) (t := b) hb hb1 + have hx : + cfcR (ℋ := ℋ) f (algebraMap ℝ (L ℋ) x) = algebraMap ℝ (L ℋ) (f x) := by + simp [cfcR, LownerHeinzCore.cfcR] + have hy : + cfcR (ℋ := ℋ) f (algebraMap ℝ (L ℋ) y) = algebraMap ℝ (L ℋ) (f y) := by + simp [cfcR, LownerHeinzCore.cfcR] + have hxy : + cfcR (ℋ := ℋ) f (algebraMap ℝ (L ℋ) ((1 - b) * x + b * y)) = + algebraMap ℝ (L ℋ) (f ((1 - b) * x + b * y)) := by + simpa [cfcR, LownerHeinzCore.cfcR] using + cfc_algebraMap (A := L ℋ) (((1 - b) * x + b * y)) f + rw [halg_combo (u := 1 - b) (v := b) (r := x) (s := y), hxy, hx, hy, + halg_combo (u := 1 - b) (v := b) (r := f x) (s := f y)] at hop + have hscalar : + algebraMap ℝ (L ℋ) (f ((1 - b) * x + b * y)) ≤ + algebraMap ℝ (L ℋ) ((1 - b) * f x + b * f y) := by + simpa [Algebra.smul_def] using hop + have hspec_le : + ∀ z ∈ spectrum ℝ (algebraMap ℝ (L ℋ) (f ((1 - b) * x + b * y))), + z ≤ (1 - b) * f x + b * f y := by + simpa using + (le_algebraMap_iff_spectrum_le + (R := ℝ) (A := L ℋ) + (a := algebraMap ℝ (L ℋ) (f ((1 - b) * x + b * y))) + (r := (1 - b) * f x + b * f y) + (ha := cfc_predicate_algebraMap (A := L ℋ) (f ((1 - b) * x + b * y)))).1 hscalar + have ha' : a = 1 - b := by + linarith + have hscalar' : f ((1 - b) * x + b * y) ≤ (1 - b) * f x + b * f y := by + obtain ⟨z, hz⟩ := + ContinuousFunctionalCalculus.spectrum_nonempty (R := ℝ) + (algebraMap ℝ (L ℋ) (f ((1 - b) * x + b * y))) + (cfc_predicate_algebraMap (A := L ℋ) (f ((1 - b) * x + b * y))) + have hz_eq : z = f ((1 - b) * x + b * y) := by + have hz_single := + CFC.spectrum_algebraMap_subset (R := ℝ) (A := L ℋ) (f ((1 - b) * x + b * y)) hz + simpa using hz_single + simpa [hz_eq] using hspec_le z hz + simpa [smul_eq_mul, ha'] using hscalar' + +theorem operatorConvex_continuousOn_univ {f : ℝ → ℝ} (hf : OperatorConvex (ℋ := ℋ) f) : + ContinuousOn f Set.univ := + ConvexOn.continuousOn isOpen_univ (operatorConvex_convexOn_univ (ℋ := ℋ) hf) + +theorem operatorConvex_continuousOn_spectrum_union {f : ℝ → ℝ} + (hf : OperatorConvex (ℋ := ℋ) f) (A B : L ℋ) : + ContinuousOn f (spectrum ℝ A ∪ spectrum ℝ B) := + (operatorConvex_continuousOn_univ (ℋ := ℋ) hf).mono (by intro x hx; simp) + + +omit [Nontrivial ℋ] in +theorem one_div_operatorAntitoneOn_Ioi : + OperatorAntitoneOn (ℋ := ℋ) (Set.Ioi (0 : ℝ)) (fun x : ℝ ↦ 1 / x) := by + simpa using (LownerHeinzCore.one_div_operatorAntitoneOn_Ioi (𝓐 := L ℋ)) + +theorem one_div_operatorConvexOn_Ioi : + OperatorConvexOn (ℋ := ℋ) (Set.Ioi (0 : ℝ)) (fun x : ℝ ↦ 1 / x) := by + simpa using (LownerHeinzCore.one_div_operatorConvexOn_Ioi (𝓐 := L ℋ)) + +omit [Nontrivial ℋ] in +theorem one_div_add_t_operatorAntitoneOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorAntitoneOn (ℋ := ℋ) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ 1 / (x + t)) := by + intro t ht + simpa using (LownerHeinzCore.one_div_add_t_operatorAntitoneOn_Ici (𝓐 := L ℋ) t ht) + +theorem one_div_add_t_operatorConvexOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorConvexOn (ℋ := ℋ) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ 1 / (x + t)) := by + intro t ht + simpa using (LownerHeinzCore.one_div_add_t_operatorConvexOn_Ici (𝓐 := L ℋ) t ht) + +omit [Nontrivial ℋ] in +theorem ratio_add_t_operatorMonotoneOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorMonotoneOn (ℋ := ℋ) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ x / (x + t)) := by + intro t ht + simpa using (LownerHeinzCore.ratio_add_t_operatorMonotoneOn_Ici (𝓐 := L ℋ) t ht) + +theorem ratio_add_t_operatorConcaveOn_Ici : ∀ (t : ℝ), 0 < t → + OperatorConcaveOn (ℋ := ℋ) (Set.Ici (0 : ℝ)) (fun x : ℝ ↦ x / (x + t)) := by + intro t ht + simpa using (LownerHeinzCore.ratio_add_t_operatorConcaveOn_Ici (𝓐 := L ℋ) t ht) + +omit [Nontrivial ℋ] in +theorem power_Icc_zero_one_operatorMonotoneOn_Ici : ∀ p ∈ Set.Icc (0 : ℝ) 1, + OperatorMonotoneOn (ℋ := ℋ) (Set.Ici (0 : ℝ)) (fun x ↦ x ^ p) := by + intro p hp + simpa using (LownerHeinzCore.power_Icc_zero_one_operatorMonotoneOn_Ici (𝓐 := L ℋ) p hp) + +theorem power_Icc_zero_one_operatorConcaveOn_Ici : ∀ p ∈ Set.Icc (0 : ℝ) 1, + OperatorConcaveOn (ℋ := ℋ) (Set.Ici (0 : ℝ)) (fun x ↦ x ^ p) := by + intro p hp + simpa using (LownerHeinzCore.power_Icc_zero_one_operatorConcaveOn_Ici (𝓐 := L ℋ) p hp) + +theorem power_Icc_one_two_operatorConvexOn_Ici : ∀ p ∈ Set.Icc (1 : ℝ) 2, + OperatorConvexOn (ℋ := ℋ) (Set.Ici (0 : ℝ)) (fun x ↦ x ^ p) := by + intro p hp + simpa using (LownerHeinzCore.power_Icc_one_two_operatorConvexOn_Ici (𝓐 := L ℋ) p hp) + +omit [Nontrivial ℋ] in +theorem power_Icc_neg_one_zero_neg_operatorMonotoneOn_Ioi : ∀ p ∈ Set.Icc (-1 : ℝ) 0, + OperatorMonotoneOn (ℋ := ℋ) (Set.Ioi (0 : ℝ)) (fun x ↦ -(x ^ p)) := by + intro p hp + simpa using (LownerHeinzCore.power_Icc_neg_one_zero_neg_operatorMonotoneOn_Ioi (𝓐 := L ℋ) p hp) + +theorem power_Icc_neg_one_zero_neg_operatorConcaveOn_Ioi : ∀ p ∈ Set.Icc (-1 : ℝ) 0, + OperatorConcaveOn (ℋ := ℋ) (Set.Ioi (0 : ℝ)) (fun x ↦ -(x ^ p)) := by + intro p hp + simpa using (LownerHeinzCore.power_Icc_neg_one_zero_neg_operatorConcaveOn_Ioi (𝓐 := L ℋ) p hp) + +end LownerHeinzTheorem diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/OperatorGeometricMean.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/OperatorGeometricMean.lean new file mode 100644 index 000000000..cf15c94a6 --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/OperatorGeometricMean.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Hayata Yamasaki. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kei Tsukamoto, Kento Mori, Hayata Yamasaki +-/ +module + +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.GeneralizedPerspectiveFunction + +@[expose] public section + +namespace OperatorGeometricMean + +universe u + +open LownerHeinzTheorem +open GeneralizedPerspectiveFunction + +variable {ℋ : Type u} +variable [NormedAddCommGroup ℋ] [InnerProductSpace ℂ ℋ] [CompleteSpace ℋ] +variable [Nontrivial ℋ] + +/-- The operator `(α, β)`-power mean, realized as a generalized perspective. -/ +noncomputable def operatorPowerMean (α β : ℝ) (A B : L ℋ) : L ℋ := + GeneralizedPerspective (fun x : ℝ ↦ x ^ α) (fun x : ℝ ↦ x ^ β) A B + +private lemma rpow_continuousOn_Ici (p : ℝ) (hp : 0 ≤ p) : + ContinuousOn (fun x : ℝ ↦ x ^ p) (Set.Ici (0 : ℝ)) := by + intro x hx + exact (Real.continuousAt_rpow_const x p (Or.inr hp)).continuousWithinAt + +omit [Nontrivial ℋ] in +private lemma operatorConcaveOn_Ioi_of_Ici {f : ℝ → ℝ} + (h : OperatorConcaveOn (ℋ := ℋ) (Set.Ici (0 : ℝ)) f) : + OperatorConcaveOn (ℋ := ℋ) (Set.Ioi (0 : ℝ)) f := by + intro A B t hA hB ht0 ht1 hAs hBs + exact h hA hB ht0 ht1 (Set.Subset.trans hAs Set.Ioi_subset_Ici_self) + (Set.Subset.trans hBs Set.Ioi_subset_Ici_self) + +omit [Nontrivial ℋ] in +private lemma pdSet_subset_psdSet : pdSet (ℋ := ℋ) ⊆ psdSet (ℋ := ℋ) := by + intro A hA + rcases hA with ⟨hA_sa, hA_spec⟩ + exact ⟨hA_sa, Set.Subset.trans hA_spec Set.Ioi_subset_Ici_self⟩ + +private lemma rpow_pos_on_Ioi (p : ℝ) : + ∀ x ∈ Set.Ioi (0 : ℝ), 0 < x ^ p := by + intro x hx + exact Real.rpow_pos_of_pos hx p + +/-- +Theorem 1.1, concave range: the operator `(α, β)`-power mean is jointly concave on +strictly positive operators for `0 ≤ α, β ≤ 1`. +-/ +theorem operatorPowerMean_jointlyConcaveOn_pdSet + {α β : ℝ} + (hα : α ∈ Set.Icc (0 : ℝ) 1) + (hβ : β ∈ Set.Icc (0 : ℝ) 1) : + JointlyConcaveOn (pdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) + (operatorPowerMean (ℋ := ℋ) α β) := by + intro A₁ A₂ B₁ B₂ θ hA₁ hA₂ hB₁ hB₂ hθ0 hθ1 + have hconc := + theorem_2_6_forward_jointlyConcaveOn_psd_pd_Ici + (ℋ := ℋ) + (f := fun x : ℝ ↦ x ^ α) + (h := fun x : ℝ ↦ x ^ β) + (hfconc := by + intro K _ _ _ _ + exact power_Icc_zero_one_operatorConcaveOn_Ici (ℋ := K) α hα) + (hfcont := rpow_continuousOn_Ici α hα.1) + (hf0 := by + exact Real.rpow_nonneg (show (0 : ℝ) ≤ 0 by simp) α) + (hconc := by + exact operatorConcaveOn_Ioi_of_Ici (ℋ := ℋ) + (power_Icc_zero_one_operatorConcaveOn_Ici (ℋ := ℋ) β hβ)) + (hcont := by + intro x hx + exact (Real.continuousAt_rpow_const x β (Or.inl (ne_of_gt hx))).continuousWithinAt) + (hpos := rpow_pos_on_Ioi β) + simpa [operatorPowerMean] using + hconc (A₁ := A₁) (A₂ := A₂) (B₁ := B₁) (B₂ := B₂) (θ := θ) + (pdSet_subset_psdSet (ℋ := ℋ) hA₁) (pdSet_subset_psdSet (ℋ := ℋ) hA₂) + hB₁ hB₂ hθ0 hθ1 + +/-- +Theorem 1.1, convex range: the operator `(α, β)`-power mean is jointly convex on +strictly positive operators for `1 ≤ α ≤ 2` and `0 ≤ β ≤ 1`. +-/ +theorem operatorPowerMean_jointlyConvexOn_pdSet + {α β : ℝ} + (hα : α ∈ Set.Icc (1 : ℝ) 2) + (hβ : β ∈ Set.Icc (0 : ℝ) 1) : + JointlyConvexOn (pdSet (ℋ := ℋ)) (pdSet (ℋ := ℋ)) + (operatorPowerMean (ℋ := ℋ) α β) := by + intro A₁ A₂ B₁ B₂ θ hA₁ hA₂ hB₁ hB₂ hθ0 hθ1 + have hconv := + theorem_2_5_forward_jointlyConvexOn_psd_pd_Ici + (ℋ := ℋ) + (f := fun x : ℝ ↦ x ^ α) + (h := fun x : ℝ ↦ x ^ β) + (hf := by + refine ⟨?_, ?_, ?_⟩ + · intro K _ _ _ _ + exact power_Icc_one_two_operatorConvexOn_Ici (ℋ := K) α hα + · exact rpow_continuousOn_Ici α (by linarith [hα.1]) + · have hα0 : α ≠ 0 := by linarith [hα.1] + simp [Real.zero_rpow hα0] + ) + (hconc := by + exact operatorConcaveOn_Ioi_of_Ici (ℋ := ℋ) + (power_Icc_zero_one_operatorConcaveOn_Ici (ℋ := ℋ) β hβ)) + (hcont := by + intro x hx + exact (Real.continuousAt_rpow_const x β (Or.inl (ne_of_gt hx))).continuousWithinAt) + (hpos := rpow_pos_on_Ioi β) + simpa [operatorPowerMean] using + hconv (A₁ := A₁) (A₂ := A₂) (B₁ := B₁) (B₂ := B₂) (θ := θ) + (pdSet_subset_psdSet (ℋ := ℋ) hA₁) (pdSet_subset_psdSet (ℋ := ℋ) hA₂) + hB₁ hB₂ hθ0 hθ1 + +end OperatorGeometricMean diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/PORTING_NOTES.txt b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/PORTING_NOTES.txt new file mode 100644 index 000000000..62b177160 --- /dev/null +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/PORTING_NOTES.txt @@ -0,0 +1,27 @@ +When porting the code from https://github.com/Hayata-Yamasaki-Group/lean-quantum to Lean-QuamtumInfo, +besides moving the code to a different directory (and thus editing the imports at the tops of +files), a few changes were made: + * Some of the `Nontrivial` and `CompleteSpace` instance variables were moved around or `omit`ted, in + or to prevent the linter warnings about unneeded variables. This was done in: + - BlockDiagonal.lean + - GeneralizedPerspectiveFunction.lean + - HilbertSchmidtOperatorSpace.lean + - JensenOperatorInequality.lean + - JensenOperatorInequalityIImpIV.lean + - JensenOperatorInequalityIVtoV.lean + - LiebAndoTrace.Lean + * Code was moved to the "module system", adding `module`/`public import`/`@[expose]` to the start + of each file. + * Some whitespace was modified to make lines fit without the longLine linter complaining. + +The project this code is graciously borrowed from is the work of the following: + +Kazumi Kasaura (OMRON SINIC X, RIKEN) +Kei Tsukamoto (The University of Tokyo) +Kento Mori (MOLSIS) +Lisa Mizuno (The University of Tokyo) +Takahiro Namatame (Kyoto University) +Yuta Oriike (CyberAgent) +Masaya Taniguchi (RIKEN) +Sho Sonoda (RIKEN, CyberAgent) +Hayata Yamasaki (The University of Tokyo) diff --git a/QuantumInfo/ForMathlib/HermitianMat.lean b/QuantumInfo/ForMathlib/HermitianMat.lean index 9fd607a07..8c322e822 100644 --- a/QuantumInfo/ForMathlib/HermitianMat.lean +++ b/QuantumInfo/ForMathlib/HermitianMat.lean @@ -8,8 +8,10 @@ module public import QuantumInfo.ForMathlib.HermitianMat.Basic public import QuantumInfo.ForMathlib.HermitianMat.CFC public import QuantumInfo.ForMathlib.HermitianMat.Inner +public import QuantumInfo.ForMathlib.HermitianMat.LiebConcavity public import QuantumInfo.ForMathlib.HermitianMat.LogExp public import QuantumInfo.ForMathlib.HermitianMat.Order +public import QuantumInfo.ForMathlib.HermitianMat.Peierls public import QuantumInfo.ForMathlib.HermitianMat.Proj public import QuantumInfo.ForMathlib.HermitianMat.Rpow public import QuantumInfo.ForMathlib.HermitianMat.Reindex diff --git a/QuantumInfo/ForMathlib/HermitianMat/LiebConcavity.lean b/QuantumInfo/ForMathlib/HermitianMat/LiebConcavity.lean new file mode 100644 index 000000000..cd7e3b81a --- /dev/null +++ b/QuantumInfo/ForMathlib/HermitianMat/LiebConcavity.lean @@ -0,0 +1,528 @@ +/- +Copyright (c) 2026 Alex Meiburg. All rights reserved. +Released under MIT license as described in the file LICENSE. +Authors: Alex Meiburg +-/ +module + +public import QuantumInfo.ForMathlib.HermitianMat.Rpow +public import QuantumInfo.ForMathlib.HermitianMat.Schatten +public import QuantumInfo.ForMathlib.HayataGroup.TraceInequality.LiebAndoTrace +public import Mathlib + +@[expose] public section + +/-! ## Main result for DPI + +We derive the concavity of the trace functional `σ ↦ Tr[(σ^s H σ^s)^p]` from +the Lieb–Ando trace inequalities proved in `LiebAndoTrace.lean`. +-/ + +variable {d : Type*} [Fintype d] [DecidableEq d] + +namespace HermitianMatBridge + +/- Bridge lemmas: HermitianMat ↔ L (EuclideanSpace ℂ d) + +We use `Matrix.toEuclideanCLM` (a `≃⋆ₐ[ℂ]`) to bridge between `Matrix d d ℂ` +and bounded operators on `EuclideanSpace ℂ d`. This allows us to apply +the Lieb–Ando trace inequalities proved in `LiebAndoTrace.lean` to +`HermitianMat` trace functionals. +-/ + +open LiebAndoTrace GeneralizedPerspectiveFunction + +/-- Abbreviation for the star algebra isomorphism. -/ +noncomputable abbrev Φ : Matrix d d ℂ ≃⋆ₐ[ℂ] (EuclideanSpace ℂ d →L[ℂ] EuclideanSpace ℂ d) := + Matrix.toEuclideanCLM (n := d) (𝕜 := ℂ) + +/-- `Φ` is continuous (as a linear map between finite-dimensional spaces). -/ +lemma Φ_continuous : Continuous (⇑Φ : Matrix d d ℂ → _) := + (Φ (d := d)).toAlgEquiv.toLinearEquiv.toLinearMap.continuous_of_finiteDimensional + +/-- `Φ` maps Hermitian matrices to self-adjoint operators. -/ +lemma Φ_isSelfAdjoint (A : HermitianMat d ℂ) : + IsSelfAdjoint (Φ A.mat) := by + rw [isSelfAdjoint_iff, ← map_star (Φ (d := d))] + congr 1; exact A.conjTranspose_mat + +/- +`Φ` preserves nonneg: PSD HermitianMat maps to nonneg operators. +-/ +lemma Φ_nonneg (A : HermitianMat d ℂ) (hA : 0 ≤ A) : + (0 : EuclideanSpace ℂ d →L[ℂ] EuclideanSpace ℂ d) ≤ Φ A.mat := by + refine' { .. } + · convert Φ_isSelfAdjoint A using 1 + simp [IsSelfAdjoint, LinearMap.IsSymmetric] + simp [ContinuousLinearMap.ext_iff, ContinuousLinearMap.star_eq_adjoint] + grind only [IsSelfAdjoint.adjoint_eq, Φ_isSelfAdjoint, ContinuousLinearMap.adjoint_inner_left] + · intro x + have h_inner : ∀ x : EuclideanSpace ℂ d, 0 ≤ Complex.re (inner ℂ x (Φ A.mat x)) := by + intro x + have h_inner : 0 ≤ Complex.re (∑ i, ∑ j, star (x i) * A.mat i j * x j) := by + have := hA.2 + specialize this (Finsupp.equivFunOnFinite.symm x.ofLp); simp_all [Finsupp.sum_fintype] + simp_all [Complex.le_def] + convert h_inner using 1 + simp [inner, mul_comm] + simp [Matrix.mulVec, dotProduct, mul_comm, Finset.sum_add_distrib] + simp [mul_add, mul_sub, Finset.mul_sum _ _ _, Finset.sum_add_distrib, Finset.sum_sub_distrib] + simp [mul_left_comm] + ring + convert h_inner x using 1 + simp [ContinuousLinearMap.reApplyInnerSelf] + rw [← inner_conj_symm, Complex.conj_re] + +open ComplexOrder in +/-- `Φ` maps PosDef HermitianMat to pdSet. -/ +lemma Φ_mem_pdSet [Nonempty d] (A : HermitianMat d ℂ) (hA : A.mat.PosDef) : + Φ A.mat ∈ pdSet (ℋ := EuclideanSpace ℂ d) := by + have h_spectrum : spectrum ℝ (Φ A.mat) = spectrum ℝ A.mat := by + ext x + simp [spectrum.mem_iff] + rw [show (algebraMap ℝ _) x = Φ (algebraMap ℝ _ x) from ?_, + show (algebraMap ℝ (Matrix d d ℂ)) x = x • 1 from ?_] + · simp [← map_sub, -map_smul] + · simp [Algebra.smul_def] + · ext + simp [Φ] + simp [Algebra.algebraMap_eq_smul_one, Matrix.mulVec, dotProduct] + simp [Matrix.one_apply, Finset.sum_ite_eq] + rfl + refine' ⟨ Φ_isSelfAdjoint A, h_spectrum.symm ▸ _ ⟩ + exact HermitianMat.Matrix.PosDef.spectrum_subset_Ioi hA + +set_option backward.isDefEq.respectTransparency false in +/-- `Φ` commutes with CFC for Hermitian matrices. -/ +lemma Φ_cfc (A : HermitianMat d ℂ) (f : ℝ → ℝ) : + Φ (cfc f A.mat) = cfc f (Φ A.mat) := by + exact StarAlgHomClass.map_cfc Φ f A.mat (hφ := Φ_continuous) + (ha := A.H.isSelfAdjoint) + +set_option backward.isDefEq.respectTransparency false in +/-- `Φ` commutes with rpow for PSD matrices. -/ +lemma Φ_rpow (A : HermitianMat d ℂ) (hA : 0 ≤ A) (r : ℝ) : + Φ (A ^ r).mat = (Φ A.mat) ^ r := by + rw [HermitianMat.rpow_eq_cfc, HermitianMat.mat_cfc] + rw [Φ_cfc, CFC.rpow_eq_cfc_real (ha := Φ_nonneg A hA)] + +set_option maxHeartbeats 800000 in +/-- General trace bridge: the operator trace of Φ(M) equals the matrix trace of M, +for any matrix M (not just Hermitian). -/ +lemma trace_Φ_eq (M : Matrix d d ℂ) : + (LinearMap.trace ℂ (EuclideanSpace ℂ d)) (Φ M).toLinearMap = M.trace := by + rw [LinearMap.trace_eq_matrix_trace ℂ (EuclideanSpace.basisFun d ℂ).toBasis] + congr 1 + ext i j + simp [Φ, Matrix.toEuclideanCLM, EuclideanSpace.basisFun] + +/-- `traceRe(Φ(M)) = re(Tr[M])` for any matrix M. -/ +lemma traceRe_Φ_general (M : Matrix d d ℂ) : + traceRe (Φ M) = Complex.re M.trace := by + simp [traceRe, trace_Φ_eq] + +end HermitianMatBridge + +namespace HermitianMat + +open LiebAndoTrace GeneralizedPerspectiveFunction ComplexOrder + +set_option maxHeartbeats 400000 in +/-- The PSD cone is convex. -/ +private lemma psd_convex : Convex ℝ {σ : HermitianMat d ℂ | 0 ≤ σ} := by + intro σ₁ hσ₁ σ₂ hσ₂ a b ha hb _ + simp only [Set.mem_setOf_eq] at * + exact add_nonneg (smul_nonneg ha hσ₁) (smul_nonneg hb hσ₂) + +/-- The trace of rpow applied to a congruence is continuous in the base matrix. -/ +private lemma trace_conj_rpow_continuous {s p : ℝ} (hs : 0 ≤ s) (hp : 0 ≤ p) + (H : HermitianMat d ℂ) : + Continuous (fun σ : HermitianMat d ℂ ↦ + ((H.conj (σ ^ s).mat) ^ p).trace) := by + have h_rpow_cont : Continuous (fun σ : HermitianMat d ℂ => σ ^ s) := + rpow_const_continuous hs + have h_conj_cont : Continuous (fun σ : HermitianMat d ℂ => (σ ^ s).mat) := + Continuous.subtype_val h_rpow_cont + have h_trace_cont : Continuous (fun σ : HermitianMat d ℂ => σ.trace) := by + simp [HermitianMat.trace]; fun_prop + have h_comp_cont : Continuous (fun σ : Matrix d d ℂ => ((conj σ H) ^ p).trace) := by + have h_conj_cont : Continuous (fun σ : Matrix d d ℂ => conj σ H) := + continuous_conj H + exact h_trace_cont.comp (rpow_const_continuous hp |>.comp h_conj_cont) + exact h_comp_cont.comp h_conj_cont + +/-! ### Density and continuity lemmas for PD/PSD extension -/ + +private lemma psd_add_eps_posdef [Nonempty d] (σ : HermitianMat d ℂ) (hσ : 0 ≤ σ) + (ε : ℝ) (hε : 0 < ε) : (σ + ε • (1 : HermitianMat d ℂ)).mat.PosDef := by + refine' ⟨ _, _ ⟩ + · exact H (σ + ε • 1) + · intro x hx_ne_zero + have h_pos : 0 < ∑ i, ∑ j, star (x i) * (σ.mat i j + ε * (if i = j then 1 else 0)) * x j := by + have h_pos : 0 ≤ ∑ i, ∑ j, star (x i) * σ i j * x j := by + have := hσ.2 + simpa [Finsupp.sum_fintype, Finset.sum_mul _ _ _] using this x + simp_all [mul_add, add_mul, Finset.sum_add_distrib] + refine' add_pos_of_nonneg_of_pos h_pos _ + simp_all [mul_comm, mul_left_comm, Complex.mul_conj, Complex.normSq_eq_norm_sq] + contrapose! hx_ne_zero + ext i + simp only [Finsupp.coe_zero, Pi.zero_apply] + exact not_not.mp fun hi => hx_ne_zero <| lt_of_lt_of_le (by positivity) <| + Finset.single_le_sum (fun i _ => by positivity) <| Finset.mem_univ i + simp [Finsupp.sum] + convert h_pos using 1 + rw [Finset.sum_subset (Finset.subset_univ x.support)] + · refine Finset.sum_congr rfl fun i hi => ?_ + exact Finset.sum_subset (Finset.subset_univ _) fun j hj₁ hj₂ => by aesop + · aesop + +/-- σ + εI → σ as ε → 0+. -/ +private lemma tendsto_add_eps (σ : HermitianMat d ℂ) : + Filter.Tendsto (fun ε : ℝ ↦ σ + ε • (1 : HermitianMat d ℂ)) + (nhdsWithin 0 (Set.Ioi 0)) (nhds σ) := by + exact tendsto_nhdsWithin_of_tendsto_nhds + (Continuous.tendsto' (by continuity) _ _ (by simp)) + +/-! ### Helper lemmas for the core concavity proof -/ + +set_option maxHeartbeats 800000 in +/-- **AB/BA trace identity for rpow**: `Tr[(C^*C)^p] = Tr[(CC^*)^p]` for any square C. -/ +private lemma trace_rpow_conjTranspose_mul_comm [Nonempty d] + (C : Matrix d d ℂ) (p : ℝ) : + let M₁ : HermitianMat d ℂ := ⟨_, Matrix.isHermitian_conjTranspose_mul_self C⟩ + let M₂ : HermitianMat d ℂ := ⟨_, Matrix.isHermitian_mul_conjTranspose_self C⟩ + (M₁ ^ p).trace = (M₂ ^ p).trace := by + intro M₁ M₂ + rw [trace_rpow_eq_sum M₁ p, trace_rpow_eq_sum M₂ p] + have hcharpoly : M₁.mat.charpoly = M₂.mat.charpoly := + Matrix.charpoly_mul_comm C.conjTranspose C + rw [M₁.H.charpoly_eq, M₂.H.charpoly_eq] at hcharpoly + have hmultiset : Finset.univ.val.map (fun i => (M₁.H.eigenvalues i : ℂ)) = + Finset.univ.val.map (fun i => (M₂.H.eigenvalues i : ℂ)) := by + have h1 := Polynomial.roots_multiset_prod_X_sub_C + (Finset.univ.val.map (fun i => (M₁.H.eigenvalues i : ℂ))) + have h2 := Polynomial.roots_multiset_prod_X_sub_C + (Finset.univ.val.map (fun i => (M₂.H.eigenvalues i : ℂ))) + simp only [Multiset.map_map] at h1 h2 + rw [← h1, ← h2]; congr 1 + have hmap : Finset.univ.val.map (fun i => M₁.H.eigenvalues i ^ p) = + Finset.univ.val.map (fun i => M₂.H.eigenvalues i ^ p) := by + have := congr_arg (Multiset.map (fun x : ℂ => x.re ^ p)) hmultiset + simp [Multiset.map_map, Function.comp, Complex.ofReal_re] at this + exact this + simpa using congr_arg Multiset.sum hmap + +/-! ### Core concavity on positive definite matrices -/ + +section VariationalAndBridge +open InnerProductSpace + +/- +Variational lower bound from trace Young inequality: + `Tr[X^p] ≥ p · ⟪X, Z^r⟫ - (p-1) · Tr[Z]` where r = (p-1)/p. + Proof: Young says ⟪X, Z^r⟫ ≤ Tr[X^p]/p + Tr[Z]/q (with q=p/(p-1)), + so p·⟪X, Z^r⟫ ≤ Tr[X^p] + (p-1)·Tr[Z]. +-/ +private lemma variational_lower_bound + (X Z : HermitianMat d ℂ) (hX : 0 ≤ X) (hZ : 0 ≤ Z) + {p : ℝ} (hp : 1 < p) : + p * ⟪X, Z ^ ((p-1)/p)⟫_ℝ - (p - 1) * Z.trace ≤ (X ^ p).trace := by + have := @HermitianMat.trace_young d _ _ X (Z ^ ((p - 1) / p)) hX (?_) p (p / (p - 1)) hp ?_ + · -- Using the fact that $Z$ is positive semi-definite, we can simplify the expression. + have hZ_pow : ((Z ^ ((p - 1) / p)) ^ (p / (p - 1))) = Z := by + rw [← HermitianMat.rpow_mul] + · field_simp + rw [div_self (by linarith), HermitianMat.rpow_one] + · exact hZ + simp_all + field_simp at this + exact this + · exact rpow_nonneg hZ + · grind + +/- +At the optimizer Z = X^p, the variational bound is tight. +-/ +private lemma variational_eq_optimizer + (X : HermitianMat d ℂ) (hX : 0 ≤ X) + {p : ℝ} (hp : 1 < p) : + p * ⟪X, (X ^ p) ^ ((p-1)/p)⟫_ℝ - (p - 1) * (X ^ p).trace = (X ^ p).trace := by + -- (X ^ p) ^ ((p - 1) / p) = X ^ (p * ((p - 1) / p)) = X ^ (p - 1) + have h_exp : (X ^ p) ^ ((p - 1) / p) = X ^ (p - 1) := by + rw [← rpow_mul hX, mul_div_cancel₀ _ (by positivity)] + have h_inner : ⟪X, X ^ (p - 1)⟫_ℝ = (X ^ p).trace := by + have h_inner : ⟪X, X ^ (p - 1)⟫_ℝ = (X * (X ^ (p - 1)).mat).trace.re := by + exact Real.ext_cauchy rfl + convert h_inner using 1 + have h_exp : (X ^ p).mat = X.mat * (X ^ (p - 1)).mat := by + convert mat_rpow_add hX _ + rotate_left + rotate_left + exacts [1, by linarith, by ring, by simp] + exact h_exp ▸ rfl + rw [h_exp, h_inner]; ring + +/- +Joint concavity of the Lieb extension trace map on HermitianMat. + This bridges `liebExtensionTrace_jointlyConcaveOn_pdSet` to HermitianMat. +-/ +set_option maxHeartbeats 1600000 in +set_option backward.isDefEq.respectTransparency false in +private lemma liebExtension_bridge [Nonempty d] + {q r : ℝ} (hq : 0 < q) (hr : 0 < r) (hqr : q + r ≤ 1) + (K : HermitianMat d ℂ) + (σ₁ σ₂ Z₁ Z₂ : HermitianMat d ℂ) + (hσ₁ : σ₁.mat.PosDef) (hσ₂ : σ₂.mat.PosDef) + (hZ₁ : Z₁.mat.PosDef) (hZ₂ : Z₂.mat.PosDef) + (θ : ℝ) (hθ₀ : 0 ≤ θ) (hθ₁ : θ ≤ 1) : + (1 - θ) * ⟪(σ₁ ^ q).conj K, Z₁ ^ r⟫_ℝ + θ * ⟪(σ₂ ^ q).conj K, Z₂ ^ r⟫_ℝ ≤ + ⟪(((1 - θ) • σ₁ + θ • σ₂) ^ q).conj K, ((1 - θ) • Z₁ + θ • Z₂) ^ r⟫_ℝ := by + open HermitianMatBridge GeneralizedPerspectiveFunction in + -- Rewrite the inequality using the joint concavity result. + have h_joint_concave := + LiebAndoTrace.liebExtensionTrace_jointlyConcaveOn_pdSet hr hq (by linarith) (Φ K.mat) + have h_rewrite : ∀ σ Z : HermitianMat d ℂ, 0 ≤ σ → 0 ≤ Z → + ⟪(σ ^ q).conj K, Z ^ r⟫_ℝ = liebExtensionTraceMap q r (Φ K.mat) (Φ σ.mat) (Φ Z.mat) := by + intros σ Z hσ hZ + have h_inner : ⟪(σ ^ q).conj K, Z ^ r⟫_ℝ = ((σ ^ q).mat * K * (Z ^ r).mat * K).trace.re := by + rw [inner_eq_re_trace] + simp [Matrix.mul_assoc, Matrix.trace_mul_comm K.mat] + convert h_inner using 1 + rw [← traceRe_Φ_general] + simp [liebExtensionTraceMap, Φ_rpow, hσ, hZ] + rw [show star (Φ K.mat) = Φ K.mat from ?_] + have h_rewrite : IsSelfAdjoint (Φ K.mat) := by + exact Φ_isSelfAdjoint K + exact h_rewrite + convert h_joint_concave (Φ_mem_pdSet σ₁ hσ₁) (Φ_mem_pdSet σ₂ hσ₂) + (Φ_mem_pdSet Z₁ hZ₁) (Φ_mem_pdSet Z₂ hZ₂) hθ₀ hθ₁ using 1 + · rw [h_rewrite σ₁ Z₁ (by + constructor + · simp [Matrix.IsHermitian] + · intro x; have := hσ₁.2 + simp_all + exact if hx : x = 0 then by simp [hx] else le_of_lt (this hx)) + (by finiteness), h_rewrite σ₂ Z₂ (by finiteness) (by finiteness)] + norm_num [Algebra.smul_def] + · convert h_rewrite ((1 - θ) • σ₁ + θ • σ₂) ((1 - θ) • Z₁ + θ • Z₂) _ _ using 1 + · congr! 2 + · ext; simp [Φ] + simp [Matrix.mulVec, dotProduct, Finset.mul_sum, mul_assoc] + · ext; simp [Φ] + simp [Matrix.mulVec, dotProduct, Finset.mul_sum] + simp only [mul_assoc] + · nontriviality + have h_pos_def : ∀ (A : HermitianMat d ℂ), A.mat.PosDef → 0 ≤ A := by + intro A hA + have := hA.2 + constructor + · simp [Matrix.IsHermitian] + · intro x; by_cases hx : x = 0 <;> simp_all [Matrix.PosDef] + exact le_of_lt (hA.2 hx) + positivity [sub_nonneg.2 hθ₁] + · have : 0 ≤ 1 - θ := by linarith + positivity + +/- +**AB/BA rewrite**: `Tr[(H.conj (σ^s))^p] = Tr[((σ^{2s}).conj (H^{1/2}))^p]` for PSD σ, H. +-/ +private lemma trace_conj_rpow_eq_conj_sqrt [Nonempty d] + (σ H : HermitianMat d ℂ) (hσ : 0 ≤ σ) (hH : 0 ≤ H) (s p : ℝ) (hs : 0 < s) : + ((H.conj (σ ^ s).mat) ^ p).trace = + (((σ ^ (2 * s)).conj (H ^ (1/2 : ℝ)).mat) ^ p).trace := by + norm_num [conj_apply_mat, Matrix.mul_assoc] + have h_exp : (σ ^ (2 * s)).mat = (σ ^ s).mat * (σ ^ s).mat := by + convert mat_rpow_add hσ _ using 1 <;> ring_nf + positivity + have h_exp' : (H ^ (1 / 2 : ℝ)).mat * (H ^ (1 / 2 : ℝ)).mat = H.mat := by + apply HermitianMat.pow_half_mul hH + -- Apply the lemma that states the equality of the traces of the conjugates. + have := trace_rpow_conjTranspose_mul_comm ((σ ^ s).mat * (H ^ (1 / 2 : ℝ)).mat) p + convert this.symm using 3 <;> simp [mul_assoc] + · ext; simp [← mul_assoc] + simp [conj_apply] + simp_all [mul_assoc] + · ext; simp [← mul_assoc] + simp [conj, h_exp] + simp [mul_assoc] + +/- +Extension of liebExtension_bridge from PD to PSD Z inputs via continuity. +-/ +private lemma liebExtension_bridge_psd [Nonempty d] + {q r : ℝ} (hq : 0 < q) (hr : 0 < r) (hqr : q + r ≤ 1) + (K σ₁ σ₂ Z₁ Z₂ : HermitianMat d ℂ) + (hσ₁ : σ₁.mat.PosDef) (hσ₂ : σ₂.mat.PosDef) + (hZ₁ : 0 ≤ Z₁) (hZ₂ : 0 ≤ Z₂) + (θ : ℝ) (hθ₀ : 0 ≤ θ) (hθ₁ : θ ≤ 1) : + (1 - θ) * ⟪(σ₁ ^ q).conj K, Z₁ ^ r⟫_ℝ + θ * ⟪(σ₂ ^ q).conj K, Z₂ ^ r⟫_ℝ ≤ + ⟪(((1 - θ) • σ₁ + θ • σ₂) ^ q).conj K, ((1 - θ) • Z₁ + θ • Z₂) ^ r⟫_ℝ := by + open scoped Topology in + have h_cont : ∀ (ε : ℝ), 0 < ε → (1 - θ) * ⟪(σ₁ ^ q).conj K, (Z₁ + ε • 1) ^ r⟫_ℝ + + θ * ⟪(σ₂ ^ q).conj K, (Z₂ + ε • 1) ^ r⟫_ℝ ≤ ⟪(((1 - θ) • σ₁ + θ • σ₂) ^ q).conj K, + ((1 - θ) • (Z₁ + ε • 1) + θ • (Z₂ + ε • 1)) ^ r⟫_ℝ := by + intro ε hε_pos + exact liebExtension_bridge hq hr hqr K σ₁ σ₂ (Z₁ + ε • 1) (Z₂ + ε • 1) hσ₁ hσ₂ + (psd_add_eps_posdef Z₁ hZ₁ ε hε_pos) (psd_add_eps_posdef Z₂ hZ₂ ε hε_pos) θ hθ₀ hθ₁ + -- Apply the continuity results to take the limit as ε approaches 0. + have h_lim : + Filter.Tendsto (fun ε : ℝ ↦ ⟪(σ₁ ^ q).conj K, (Z₁ + ε • 1) ^ r⟫_ℝ) (𝓝[>] 0) + (𝓝 ⟪(σ₁ ^ q).conj K, Z₁ ^ r⟫_ℝ) ∧ + Filter.Tendsto (fun ε : ℝ ↦ ⟪(σ₂ ^ q).conj K, (Z₂ + ε • 1) ^ r⟫_ℝ) (𝓝[>] 0) + (𝓝 ⟪(σ₂ ^ q).conj K, Z₂ ^ r⟫_ℝ) := by + constructor <;> refine' Filter.Tendsto.mono_left _ nhdsWithin_le_nhds + · have h_cont : Continuous (fun ε : ℝ => (Z₁ + ε • 1) ^ r) := by + have h_cont : Continuous (fun ε : ℝ => (Z₁ + ε • 1)) := by + fun_prop + exact (HermitianMat.rpow_const_continuous (show 0 ≤ r by positivity)).comp h_cont + convert Filter.Tendsto.inner tendsto_const_nhds (h_cont.tendsto 0) using 2 + norm_num + · have h_inner_cont : Continuous (fun ε : ℝ => (Z₂ + ε • 1) ^ r) := by + have h_cont : Continuous (fun ε : HermitianMat d ℂ => ε ^ r) := by + apply_rules [HermitianMat.rpow_const_continuous] + positivity + fun_prop (disch := solve_by_elim) + convert Filter.Tendsto.inner tendsto_const_nhds (h_inner_cont.tendsto 0) using 2; simp + refine le_of_tendsto_of_tendsto + ((tendsto_const_nhds.mul h_lim.1).add (tendsto_const_nhds.mul h_lim.2)) ?_ + (Filter.eventually_of_mem self_mem_nhdsWithin h_cont) + refine Filter.Tendsto.inner tendsto_const_nhds ?_ + refine (rpow_const_continuous (by positivity) |> Continuous.continuousAt |> fun h => + h.tendsto.comp (show Filter.Tendsto (fun ε : ℝ => (1 - θ) • (Z₁ + ε • 1) + θ • (Z₂ + ε • 1)) + (nhdsWithin 0 (Set.Ioi 0)) (nhds ((1 - θ) • Z₁ + θ • Z₂)) from ?_)) + refine' tendsto_nhdsWithin_of_tendsto_nhds _ + refine' Continuous.tendsto' _ _ _ _ <;> norm_num + fun_prop + +set_option maxHeartbeats 1600000 in +/-- Core concavity inequality on positive definite matrices. -/ +private lemma trace_conj_rpow_concave_pd [Nonempty d] {α : ℝ} (hα : 1 < α) + (H : HermitianMat d ℂ) (hH : 0 ≤ H) + (σ₁ σ₂ : HermitianMat d ℂ) (hσ₁ : σ₁.mat.PosDef) (hσ₂ : σ₂.mat.PosDef) + (a b : ℝ) (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) : + let s := (α - 1) / (2 * α) + let p := α / (α - 1) + a * ((H.conj (σ₁ ^ s).mat) ^ p).trace + b * ((H.conj (σ₂ ^ s).mat) ^ p).trace ≤ + ((H.conj ((a • σ₁ + b • σ₂) ^ s).mat) ^ p).trace := by + intro s p + -- Key derived parameters + have hα_pos : 0 < α := by linarith + have hαm1_pos : 0 < α - 1 := by linarith + have hα_ne : α ≠ 0 := ne_of_gt hα_pos + have hαm1_ne : α - 1 ≠ 0 := ne_of_gt hαm1_pos + have hs_pos : 0 < s := by show 0 < (α - 1) / (2 * α); positivity + have hp_gt1 : 1 < p := by + show 1 < α / (α - 1); rw [lt_div_iff₀ hαm1_pos]; linarith + have hp_pos : 0 < p := by linarith + -- The exponents for the bridge + set q := (α - 1) / α with q_def + set r := 1 / α with r_def + have hq_pos : 0 < q := by simp only [q_def]; positivity + have hr_pos : 0 < r := by simp only [r_def]; positivity + have hqr : q + r ≤ 1 := by + simp only [q_def, r_def]; rw [← add_div, sub_add_cancel, div_self hα_ne] + have h2s_eq_q : 2 * s = q := by + show 2 * ((α - 1) / (2 * α)) = (α - 1) / α; field_simp + have hr_eq : r = (p - 1) / p := by + show 1 / α = (α / (α - 1) - 1) / (α / (α - 1)); field_simp; ring + -- K = H^{1/2} + set K := H ^ (1/2 : ℝ) with K_def + have hK : 0 ≤ K := rpow_nonneg hH + -- PSD facts for σ_i + have hσ₁_psd : 0 ≤ σ₁ := HermitianMat.zero_le_iff.mpr hσ₁.posSemidef + have hσ₂_psd : 0 ≤ σ₂ := HermitianMat.zero_le_iff.mpr hσ₂.posSemidef + have hσ_mix_psd : 0 ≤ a • σ₁ + b • σ₂ := + add_nonneg (smul_nonneg ha hσ₁_psd) (smul_nonneg hb hσ₂_psd) + -- X_i = (σ_i ^ q).conj K + set X₁ := (σ₁ ^ q).conj K.mat with X₁_def + set X₂ := (σ₂ ^ q).conj K.mat with X₂_def + set X_mix := ((a • σ₁ + b • σ₂) ^ q).conj K.mat with X_mix_def + have hX₁ : 0 ≤ X₁ := conj_nonneg _ (rpow_nonneg hσ₁_psd) + have hX₂ : 0 ≤ X₂ := conj_nonneg _ (rpow_nonneg hσ₂_psd) + have hX_mix : 0 ≤ X_mix := conj_nonneg _ (rpow_nonneg hσ_mix_psd) + -- Z_i = X_i ^ p + set Z₁ := X₁ ^ p with Z₁_def + set Z₂ := X₂ ^ p with Z₂_def + have hZ₁ : 0 ≤ Z₁ := rpow_nonneg hX₁ + have hZ₂ : 0 ≤ Z₂ := rpow_nonneg hX₂ + have hZ_mix : 0 ≤ a • Z₁ + b • Z₂ := + add_nonneg (smul_nonneg ha hZ₁) (smul_nonneg hb hZ₂) + -- Step 1: Rewrite using AB/BA identity + have rewrite₁ : ((H.conj (σ₁ ^ s).mat) ^ p).trace = (Z₁).trace := by + rw [trace_conj_rpow_eq_conj_sqrt σ₁ H hσ₁_psd hH s p hs_pos, h2s_eq_q] + have rewrite₂ : ((H.conj (σ₂ ^ s).mat) ^ p).trace = (Z₂).trace := by + rw [trace_conj_rpow_eq_conj_sqrt σ₂ H hσ₂_psd hH s p hs_pos, h2s_eq_q] + have rewrite_mix : ((H.conj ((a • σ₁ + b • σ₂) ^ s).mat) ^ p).trace = (X_mix ^ p).trace := by + rw [trace_conj_rpow_eq_conj_sqrt (a • σ₁ + b • σ₂) H hσ_mix_psd hH s p hs_pos, h2s_eq_q] + rw [rewrite₁, rewrite₂, rewrite_mix] + -- Step 2a: Use variational_eq_optimizer + have var_opt₁ := variational_eq_optimizer X₁ hX₁ hp_gt1 + have var_opt₂ := variational_eq_optimizer X₂ hX₂ hp_gt1 + rw [← hr_eq] at var_opt₁ var_opt₂ + -- Step 2b: Rewrite LHS + rw [show Z₁.trace = p * ⟪X₁, Z₁ ^ r⟫_ℝ - (p - 1) * Z₁.trace from var_opt₁.symm, + show Z₂.trace = p * ⟪X₂, Z₂ ^ r⟫_ℝ - (p - 1) * Z₂.trace from var_opt₂.symm] + -- Goal: a*(p*⟪X₁,Z₁^r⟫-(p-1)*Z₁.trace) + b*(p*⟪X₂,Z₂^r⟫-(p-1)*Z₂.trace) ≤ (X_mix^p).trace + -- Step 2c-f: Chain inequality + calc a * (p * ⟪X₁, Z₁ ^ r⟫_ℝ - (p - 1) * Z₁.trace) + + b * (p * ⟪X₂, Z₂ ^ r⟫_ℝ - (p - 1) * Z₂.trace) + = p * (a * ⟪X₁, Z₁ ^ r⟫_ℝ + b * ⟪X₂, Z₂ ^ r⟫_ℝ) - + (p - 1) * (a * Z₁.trace + b * Z₂.trace) := by ring + _ ≤ p * ⟪X_mix, (a • Z₁ + b • Z₂) ^ r⟫_ℝ - + (p - 1) * (a • Z₁ + b • Z₂).trace := by + have bridge := liebExtension_bridge_psd hq_pos hr_pos hqr K + σ₁ σ₂ Z₁ Z₂ hσ₁ hσ₂ hZ₁ hZ₂ b hb (by linarith) + rw [show (1 : ℝ) - b = a from by linarith] at bridge + have trace_lin : (a • Z₁ + b • Z₂).trace = a * Z₁.trace + b * Z₂.trace := by + rw [trace_add, trace_smul, trace_smul] + rw [trace_lin] + linarith [mul_le_mul_of_nonneg_left bridge hp_pos.le] + _ ≤ (X_mix ^ p).trace := by + rw [hr_eq] + exact variational_lower_bound X_mix (a • Z₁ + b • Z₂) hX_mix hZ_mix hp_gt1 + +end VariationalAndBridge + +/- +**Concavity of the trace functional for DPI**: For `α > 1`, `H ≥ 0`, the map + `σ ↦ Tr[(σ^s H σ^s)^p]` is concave on PSD matrices, + where `s = (α-1)/(2α)` and `p = α/(α-1)`. +-/ +theorem trace_conj_rpow_concave {α : ℝ} (hα : 1 < α) + (H : HermitianMat d ℂ) (hH : 0 ≤ H) : + ConcaveOn ℝ {σ : HermitianMat d ℂ | 0 ≤ σ} + (fun σ ↦ ((H.conj (σ ^ ((α - 1) / (2 * α))).mat) ^ (α / (α - 1))).trace) := by + refine' ⟨psd_convex, fun σ₁ hσ₁ σ₂ hσ₂ a b ha hb hab => _⟩ + by_cases hd : Nonempty d + · simp only [Set.mem_setOf_eq, smul_eq_mul] at * + open scoped Topology in + refine' le_of_tendsto_of_tendsto (b := 𝓝[>] (0 : ℝ)) + (f := fun ε ↦ a * ((H.conj ((σ₁ + ε • 1) ^ ((α - 1) / (2 * α))).mat) ^ (α / (α - 1))).trace + + b * ((H.conj ((σ₂ + ε • 1) ^ ((α - 1) / (2 * α))).mat) ^ (α / (α - 1))).trace) + (g := fun ε ↦ ((H.conj ((a • (σ₁ + ε • 1) + b • (σ₂ + ε • 1)) ^ ((α - 1) / (2 * α))).mat) ^ + (α / (α - 1))).trace) + ?_ ?_ _ + · have hcont : Continuous (fun σ : HermitianMat d ℂ ↦ ((H.conj (σ ^ ((α - 1) / (2 * α))).mat) ^ + (α / (α - 1))).trace) := + trace_conj_rpow_continuous + (div_nonneg (sub_nonneg.2 hα.le) (by positivity)) + (div_nonneg (by positivity) (by linarith)) H + exact Filter.Tendsto.add (tendsto_const_nhds.mul (hcont.continuousAt.tendsto.comp + (tendsto_add_eps _))) (tendsto_const_nhds.mul (hcont.continuousAt.tendsto.comp + (tendsto_add_eps _))) |> fun h => h.trans (by simp) + · have hcont : Continuous (fun σ : HermitianMat d ℂ ↦ ((H.conj (σ ^ ((α - 1) / (2 * α))).mat) ^ + (α / (α - 1))).trace) := + trace_conj_rpow_continuous (div_nonneg (sub_nonneg.2 hα.le) (by positivity)) + (div_nonneg (by positivity) (by linarith)) H + refine hcont.continuousAt.tendsto.comp (show Filter.Tendsto + (fun ε ↦ a • (σ₁ + ε • 1) + b • (σ₂ + ε • 1)) (𝓝[>] 0) (𝓝 (a • σ₁ + b • σ₂)) from ?_) + apply tendsto_nhdsWithin_of_tendsto_nhds + exact Continuous.tendsto' (by fun_prop) _ _ (by simp) + · filter_upwards [self_mem_nhdsWithin] with ε hε + refine trace_conj_rpow_concave_pd hα H hH (σ₁ + ε • 1) (σ₂ + ε • 1) ?_ ?_ a b ha hb hab + · exact psd_add_eps_posdef σ₁ hσ₁ ε hε + · exact psd_add_eps_posdef σ₂ hσ₂ ε hε + · simp_all [HermitianMat.trace] + +end HermitianMat diff --git a/QuantumInfo/ForMathlib/HermitianMat/Peierls.lean b/QuantumInfo/ForMathlib/HermitianMat/Peierls.lean new file mode 100644 index 000000000..4ae68c983 --- /dev/null +++ b/QuantumInfo/ForMathlib/HermitianMat/Peierls.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Alex Meiburg. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Alex Meiburg +-/ +module + +public import QuantumInfo.ForMathlib.HermitianMat.Sqrt +public import QuantumInfo.ForMathlib.HermitianMat.LiebConcavity + +@[expose] public section + +noncomputable section + +variable {d : Type*} +variable [Fintype d] [DecidableEq d] +variable {𝕜 : Type*} [RCLike 𝕜] + +open HermitianMat +open scoped InnerProductSpace RealInnerProductSpace Topology + +namespace HermitianMat + +/-- +The trace of cfc(g, A) is invariant under unitary conjugation of A. +Follows from `cfc_conj_unitary` and `trace_conj_unitary`. +-/ +lemma trace_cfc_conj_unitary (A : HermitianMat d ℂ) (g : ℝ → ℝ) (U : 𝐔[d]) : + ((A.conj U.val).cfc g).trace = (A.cfc g).trace := by + rw [cfc_conj_unitary, trace_conj_unitary] + +/-- +Peierls inequality: for a convex function g, the sum of g applied to the +diagonal entries of a Hermitian matrix is at most the trace of g(A). +This follows from Jensen's inequality applied to the spectral decomposition. +-/ +theorem peierls_inequality (A : HermitianMat d ℂ) (g : ℝ → ℝ) (hg : ConvexOn ℝ Set.univ g) : + ∑ i, g ((A.mat i i).re) ≤ (A.cfc g).trace := by + -- By the properties of the trace and the convexity of $g$, we have: + have h_trace_le : ∑ i, g ((A.mat i i).re) ≤ ∑ j, g (A.H.eigenvalues j) * + ∑ i, ‖(A.H.eigenvectorUnitary.val i j)‖^2 := by + -- By the spectral theorem, we can write A as ∑_i λ_i u_i u_i^*, + -- where λ_i are the eigenvalues and u_i are the corresponding eigenvectors. + have h_spectral : ∀ i, (A.mat i i).re = ∑ j, A.H.eigenvalues j * + ‖(A.H.eigenvectorUnitary.val i j)‖^2 := by + intro i + have h_sum : (A.mat i i).re = ∑ j, (A.H.eigenvectorBasis j i) * + star (A.H.eigenvectorBasis j i) * A.H.eigenvalues j := by + have this := congr_fun (congr_fun A.H.spectral_theorem i) i + simp_all [Matrix.mul_apply, Matrix.diagonal] + simp [Complex.ext_iff, mul_comm, mul_left_comm] + exact Finset.sum_congr rfl fun _ _ => by ring + simp_all [Complex.ext_iff, mul_comm] + simp [Complex.normSq, Complex.sq_norm] + have h_jensen : ∀ i, g ((A.mat i i).re) ≤ ∑ j, ‖(A.H.eigenvectorUnitary.val i j)‖^2 * + g (A.H.eigenvalues j) := by + intro i + have h_convex_comb : ∑ j, ‖(A.H.eigenvectorUnitary.val i j)‖^2 = 1 := by + have := congr_fun (congr_fun A.H.eigenvectorUnitary.2.2 i) i + simp_all [Matrix.mul_apply, Complex.mul_conj, Complex.normSq_eq_norm_sq] + exact_mod_cast this + convert hg.map_sum_le _ _ _ <;> simp_all [mul_comm] + convert Finset.sum_le_sum fun i _ => h_jensen i using 1 + rw [Finset.sum_comm, Finset.sum_congr rfl]; intros; rw [Finset.mul_sum]; ac_rfl + have h_unitary : ∀ (j : d), ∑ i, ‖(A.H.eigenvectorUnitary.val i j)‖^2 = 1 := by + exact fun j => Matrix.unitaryGroup_row_norm (H A).eigenvectorUnitary j + simp_all [trace_cfc_eq] + +theorem peierls_inequality_ici (A : HermitianMat d ℂ) (g : ℝ → ℝ) (hg : ConvexOn ℝ (Set.Ici 0) g) + (hA : 0 ≤ A) : + ∑ i, g ((A.mat i i).re) ≤ (A.cfc g).trace := by + -- By the properties of the trace and the convexity of $g$, we have: + have h_trace_le : ∑ i, g ((A.mat i i).re) ≤ ∑ j, g (A.H.eigenvalues j) * + ∑ i, ‖(A.H.eigenvectorUnitary.val i j)‖^2 := by + -- By the spectral theorem, we can write A as ∑_i λ_i u_i u_i^*, + -- where λ_i are the eigenvalues and u_i are the corresponding eigenvectors. + have h_spectral : ∀ i, (A.mat i i).re = ∑ j, A.H.eigenvalues j * + ‖(A.H.eigenvectorUnitary.val i j)‖^2 := by + intro i + have h_sum : (A.mat i i).re = ∑ j, (A.H.eigenvectorBasis j i) * + star (A.H.eigenvectorBasis j i) * A.H.eigenvalues j := by + have := A.H.spectral_theorem + replace this := congr_fun (congr_fun this i) i; simp_all [Matrix.mul_apply, Matrix.diagonal] + simp [Complex.ext_iff, mul_comm, mul_left_comm] + exact Finset.sum_congr rfl fun _ _ => by ring + simp_all [Complex.ext_iff, mul_comm] + simp [Complex.normSq, Complex.sq_norm] + have h_jensen : ∀ i, g ((A.mat i i).re) ≤ ∑ j, ‖(A.H.eigenvectorUnitary.val i j)‖^2 * + g (A.H.eigenvalues j) := by + intro i + have h_convex_comb : ∑ j, ‖(A.H.eigenvectorUnitary.val i j)‖^2 = 1 := by + replace this := congr_fun (congr_fun A.H.eigenvectorUnitary.2.2 i) i + simp_all [Matrix.mul_apply, Complex.mul_conj, Complex.normSq_eq_norm_sq] + exact_mod_cast this + convert hg.map_sum_le _ _ _ + · simp_all [mul_comm] + · simp + · simpa + · simp + intro i + exact A.eigenvalues_nonneg hA i + convert Finset.sum_le_sum fun i _ => h_jensen i using 1 + rw [Finset.sum_comm, Finset.sum_congr rfl]; intros; rw [Finset.mul_sum]; ac_rfl + have h_unitary : ∀ (j : d), ∑ i, ‖(A.H.eigenvectorUnitary.val i j)‖^2 = 1 := by + exact fun j => Matrix.unitaryGroup_row_norm (H A).eigenvectorUnitary j + simp_all [trace_cfc_eq] + +/-- +Joint convexity of the trace functional: for a convex function g, +the map A ↦ tr(g(A)) is convex on the space of Hermitian matrices. +-/ +theorem trace_function_convex_univ (g : ℝ → ℝ) (hg : ConvexOn ℝ Set.univ g) : + ConvexOn ℝ Set.univ (fun A : HermitianMat d ℂ => (A.cfc g).trace) := by + refine ⟨convex_univ, ?_⟩ + intro A _ B _ a b ha hb hab + -- Let $C = aA + bB$. + set C : HermitianMat d ℂ := a • A + b • B + -- By the properties of the trace and the convexity of $g$, we have: + have h_trace : (C.cfc g).trace = ∑ i, g (C.H.eigenvalues i) := by + exact trace_cfc_eq C g + have h_sum : ∑ i, g (C.H.eigenvalues i) ≤ + a * ∑ i, g ((A.conj (star C.H.eigenvectorUnitary.val)).mat i i).re + + b * ∑ i, g ((B.conj (star C.H.eigenvectorUnitary.val)).mat i i |> Complex.re) := by + have h_sum : ∀ i, g (C.H.eigenvalues i) ≤ + a * g ((A.conj (star C.H.eigenvectorUnitary.val)).mat i i).re + + b * g ((B.conj (star C.H.eigenvectorUnitary.val)).mat i i).re := by + intro i + have h_eigenvalue : C.H.eigenvalues i = + a * ((A.conj (star C.H.eigenvectorUnitary.val)).mat i i).re + + b * ((B.conj (star C.H.eigenvectorUnitary.val)).mat i i).re := by + have h_eigenvalue : (C.conj (star C.H.eigenvectorUnitary.val)).mat i i = + a * (A.conj (star C.H.eigenvectorUnitary.val)).mat i i + + b * (B.conj (star C.H.eigenvectorUnitary.val)).mat i i := by + simp +zetaDelta at * + simp [conj] + exact Complex.ext rfl rfl + have h_eigenvalue : (C.conj (star C.H.eigenvectorUnitary.val)) = + (diagonal ℂ C.H.eigenvalues).conj 1 := by + convert congr_arg (conj (star C.H.eigenvectorUnitary.val) ·) (eq_conj_diagonal C) using 1 + simp [conj_conj] + simp_all [conj] + convert congr_arg Complex.re ‹ (diagonal ℂ _) i i = _ › using 1 + · exact Eq.symm (by erw [show (diagonal ℂ _ : HermitianMat d ℂ) i i = + (C.H.eigenvalues i : ℂ) by exact if_pos rfl]; norm_cast) + · norm_num [Complex.ext_iff] + rw [h_eigenvalue] + exact hg.2 trivial trivial ha hb hab + simpa only [Finset.mul_sum, Finset.sum_add_distrib] using Finset.sum_le_sum fun i _ => h_sum i + have hAtr : ∑ i, g ((A.conj (star C.H.eigenvectorUnitary.val)).mat i i).re ≤ (A.cfc g).trace := by + convert peierls_inequality _ _ hg using 1 + convert trace_cfc_conj_unitary _ _ _ using 1 + rotate_right + exact C.H.eigenvectorUnitary + simp [conj_conj] + have hBtr : ∑ i, g ((B.conj (star C.H.eigenvectorUnitary.val)).mat i i).re ≤ (B.cfc g).trace := by + convert peierls_inequality _ _ hg using 1 + convert trace_cfc_conj_unitary _ _ _ + rotate_right + exact C.H.eigenvectorUnitary + simp [conj_conj] + simpa only [h_trace] using h_sum.trans + (add_le_add (mul_le_mul_of_nonneg_left hAtr ha) (mul_le_mul_of_nonneg_left hBtr hb)) + +open ComplexOrder in +/-- +Convexity of trace functions: if `g` is convex on `ℝ₊`, then `A ↦ Tr[g(A)]` is +convex on PSD matrices. -/ +theorem trace_function_convex_ici {g : ℝ → ℝ} (hg : ConvexOn ℝ (Set.Ici 0) g) : + ConvexOn ℝ {A : HermitianMat d ℂ | 0 ≤ A} (fun A => (A.cfc g).trace) := by + refine ⟨convex_Ici 0, ?_⟩ + intro A hA B hB a b ha hb hab + -- Let $C = aA + bB$. + set C : HermitianMat d ℂ := a • A + b • B + -- By the properties of the trace and the convexity of $g$, we have: + have h_trace : (C.cfc g).trace = ∑ i, g (C.H.eigenvalues i) := by + exact trace_cfc_eq C g + have h_sum : ∑ i, g (C.H.eigenvalues i) ≤ + a * ∑ i, g ((A.conj (star C.H.eigenvectorUnitary.val)).mat i i).re + + b * ∑ i, g ((B.conj (star C.H.eigenvectorUnitary.val)).mat i i).re := by + have h_sum : ∀ i, g (C.H.eigenvalues i) ≤ + a * g ((A.conj (star C.H.eigenvectorUnitary.val)).mat i i).re + + b * g ((B.conj (star C.H.eigenvectorUnitary.val)).mat i i).re := by + intro i + have h_eigenvalue : C.H.eigenvalues i = + a * ((A.conj (star C.H.eigenvectorUnitary.val)).mat i i).re + + b * ((B.conj (star C.H.eigenvectorUnitary.val)).mat i i).re := by + have h_eigenvalue : (C.conj (star C.H.eigenvectorUnitary.val)).mat i i = + a * (A.conj (star C.H.eigenvectorUnitary.val)).mat i i + + b * (B.conj (star C.H.eigenvectorUnitary.val)).mat i i := by + simp +zetaDelta only [mat_add, mat_smul, map_add, mat_apply] + simp only [conj, AddMonoidHom.coe_mk, ZeroHom.coe_mk, mat_smul, Algebra.mul_smul_comm, + Algebra.smul_mul_assoc] + rfl + have h_eig2 : (C.conj (star C.H.eigenvectorUnitary.val)) = + (diagonal ℂ C.H.eigenvalues).conj 1 := by + convert congr_arg (conj (star C.H.eigenvectorUnitary.val) ·) (eq_conj_diagonal C) using 1 + simp [conj_conj] + simp_all [conj] + convert congr_arg Complex.re h_eigenvalue using 1 + · exact Eq.symm (by erw [show (diagonal ℂ _ : HermitianMat d ℂ) i i = + (C.H.eigenvalues i : ℂ) by exact if_pos rfl]; norm_cast) + · norm_num [Complex.ext_iff] + rw [h_eigenvalue] + refine hg.2 ?_ ?_ ha hb hab + · simp + exact (Complex.le_def.mp (((zero_le_iff.mp (conj_nonneg _ hA)).diag_nonneg (i := i)))).1 + · simp + exact (Complex.le_def.mp (((zero_le_iff.mp (conj_nonneg _ hB)).diag_nonneg (i := i)))).1 + simpa only [Finset.mul_sum, Finset.sum_add_distrib] using Finset.sum_le_sum fun i _ => h_sum i + -- With convexity of g, we have ∑_i g(A_ii) ≤ Tr(g(A)) and ∑_i g(B_ii) ≤ Tr(g(B)) + have hAtr : ∑ i, g ((A.conj (star C.H.eigenvectorUnitary.val)).mat i i).re ≤ (A.cfc g).trace := by + have hA' : 0 ≤ A.conj (star C.H.eigenvectorUnitary.val) := A.conj_nonneg _ hA + calc ∑ i, g ((A.conj (star C.H.eigenvectorUnitary.val)).mat i i |> Complex.re) + ≤ ((A.conj (star C.H.eigenvectorUnitary.val)).cfc g).trace := + peierls_inequality_ici _ _ hg hA' + _ = (A.cfc g).trace := + trace_cfc_conj_unitary A g ⟨star C.H.eigenvectorUnitary.val, by + rw [Matrix.mem_unitaryGroup_iff, star_star]; exact C.H.eigenvectorUnitary.prop.1⟩ + have hBtr : ∑ i, g ((B.conj (star C.H.eigenvectorUnitary.val)).mat i i).re ≤ (B.cfc g).trace := by + have hB' : 0 ≤ B.conj (star C.H.eigenvectorUnitary.val) := B.conj_nonneg _ hB + calc ∑ i, g ((B.conj (star C.H.eigenvectorUnitary.val)).mat i i |> Complex.re) + ≤ ((B.conj (star C.H.eigenvectorUnitary.val)).cfc g).trace := + peierls_inequality_ici _ _ hg hB' + _ = (B.cfc g).trace := + trace_cfc_conj_unitary B g ⟨star C.H.eigenvectorUnitary.val, by + rw [Matrix.mem_unitaryGroup_iff, star_star]; exact C.H.eigenvectorUnitary.prop.1⟩ + simpa only [h_trace] using h_sum.trans + (add_le_add (mul_le_mul_of_nonneg_left hAtr ha) (mul_le_mul_of_nonneg_left hBtr hb)) + +-- /-- Strict convexity of trace functions: if `g` is strictly convex on `ℝ₊`, then +-- `A ↦ Tr[g(A)]` is strictly convex on PSD matrices. -/ +-- theorem trace_function_strictConvex {g : ℝ → ℝ} (hg : StrictConvexOn ℝ (Set.Ici 0) g) +-- (hg_cont : Continuous g) : +-- StrictConvexOn ℝ {A : HermitianMat d ℂ | 0 ≤ A} +-- (fun A => (A.cfc g).trace) := by +-- not needed right now diff --git a/QuantumInfo/ForMathlib/HermitianMat/Schatten.lean b/QuantumInfo/ForMathlib/HermitianMat/Schatten.lean index c3661e072..21a372903 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Schatten.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Schatten.lean @@ -189,12 +189,24 @@ lemma schattenNorm_half_mul_rpow_eq_trace_conj rw [ Matrix.conjTranspose_conjTranspose ]; exact congrArg Complex.re (congrArg Matrix.trace (congrArg (cfc fun x => x ^ α) h_conj)); · have h_eigenvalues_nonneg : ∀ i, 0 ≤ (Matrix.isHermitian_mul_conjTranspose_self ((A ^ (1 / 2 : ℝ)).mat * B.mat).conjTranspose).eigenvalues i := by - intro i; exact (by - have := Matrix.eigenvalues_conjTranspose_mul_self_nonneg ( ( A ^ ( 1 / 2 : ℝ ) ).mat * B.mat ) i; aesop;); - simp_all [ Matrix.trace, Matrix.IsHermitian.cfc ]; - simp_all [ Matrix.mul_apply, Matrix.diagonal ]; + intro i + simpa only [one_div, HermitianMat.conjTranspose_mat, HermitianMat.conj_apply_mat, + Matrix.conjTranspose_mul] using + ((A ^ (1 / 2 : ℝ)).mat * B.mat).eigenvalues_conjTranspose_mul_self_nonneg i + simp only [Matrix.trace, Matrix.IsHermitian.cfc, one_div, Matrix.conjTranspose_mul, + HermitianMat.conjTranspose_mat, Complex.coe_algebraMap, Unitary.conjStarAlgAut_apply, + Matrix.diag_apply, Complex.re_sum, ge_iff_le] + simp only [one_div, Matrix.conjTranspose_mul, HermitianMat.conjTranspose_mat, + HermitianMat.conj_apply_mat, HermitianMat.conjTranspose_mat] at h_eigenvalues_nonneg h_conj + simp_all only + simp only [Matrix.diagonal, Function.comp_apply, one_div, Matrix.conjTranspose_mul, + HermitianMat.conjTranspose_mat, Matrix.mul_apply, Matrix.IsHermitian.eigenvectorUnitary_apply, + Matrix.of_apply, mul_ite, mul_zero, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, + Matrix.star_apply, RCLike.star_def, Complex.re_sum, Complex.mul_re, Complex.ofReal_re, + Complex.ofReal_im, sub_zero, Complex.conj_re, Complex.mul_im, zero_add, Complex.conj_im, + mul_neg, sub_neg_eq_add, h_conj] refine' Finset.sum_nonneg fun i _ => Finset.sum_nonneg fun j _ => _; - field_simp; + field_simp exact mul_nonneg ( Real.rpow_nonneg ( h_eigenvalues_nonneg j ) _ ) (by positivity) /-! diff --git a/QuantumInfo/ForMathlib/HermitianMat/Unitary.lean b/QuantumInfo/ForMathlib/HermitianMat/Unitary.lean index 4420370c6..f9fb08384 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Unitary.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Unitary.lean @@ -76,3 +76,41 @@ lemma unitary_col_sum_norm_sq (C : Matrix d d ℂ) (hC : C.conjTranspose * C = 1 exact_mod_cast hC end Matrix + +namespace HermitianMat + +variable {𝕜 : Type*} [RCLike 𝕜] {n : Type*} [Fintype n] [DecidableEq n] +variable (A B : HermitianMat n 𝕜) (U : Matrix.unitaryGroup n 𝕜) + +@[simp] +theorem trace_conj_unitary : (conj U.val A).trace = A.trace := by + simp [Matrix.trace_mul_cycle, conj, ← Matrix.star_eq_conjTranspose, trace] + +@[simp] +theorem le_conj_unitary : A.conj U.val ≤ B.conj U ↔ A ≤ B := by + rw [← sub_nonneg, ← sub_nonneg (b := A), ← map_sub] + constructor + · intro h + simpa [HermitianMat.conj_conj] using conj_nonneg (star U).val h + · exact fun h ↦ conj_nonneg U.val h + +open RealInnerProductSpace in +@[simp] +theorem inner_conj_unitary : ⟪A.conj U.val, B.conj U.val⟫ = ⟪A, B⟫ := by + dsimp [conj] + simp only [inner_eq_re_trace, mat_mk] + rw [← mul_assoc, ← mul_assoc, mul_assoc _ _ U.val] + rw [Matrix.trace_mul_cycle, ← mul_assoc, ← mul_assoc _ _ A.mat] + simp [← Matrix.star_eq_conjTranspose] + +/-- +The eigenvalues of a Hermitian matrix conjugated by a unitary matrix are the same +as the eigenvalues of the original matrix. +-/ +@[simp] +theorem eigenvalues_conj : (A.conj U.val).H.eigenvalues = A.H.eigenvalues := by + rw [Matrix.IsHermitian.eigenvalues_eq_eigenvalues_iff] + change (U.val * A.mat * star U.val).charpoly = _ + rw [Matrix.charpoly_mul_comm, ← mul_assoc, U.2.1, one_mul] + +end HermitianMat diff --git a/QuantumInfo/ForMathlib/Lieb.lean b/QuantumInfo/ForMathlib/Lieb.lean deleted file mode 100644 index 1db6602ba..000000000 --- a/QuantumInfo/ForMathlib/Lieb.lean +++ /dev/null @@ -1,25 +0,0 @@ -/- -Copyright (c) 2025 Alex Meiburg. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Alex Meiburg --/ -module - -public import QuantumInfo.ForMathlib.HermitianMat - -/-! Lieb's Inequality .. todo -/ - -@[expose] public section - -variable {m n : Type*} [Fintype m] [Fintype n] {q r : ℝ} - -noncomputable section -open ComplexOrder -open Classical -open RealInnerProductSpace - -theorem LiebConcavity (K : Matrix n m ℂ) (hq : 0 ≤ q) (hr : 0 ≤ r) (hqr : q + r ≤ 1) : - let F : (HermitianMat m ℂ × HermitianMat n ℂ) → ℝ := - fun (x,y) ↦ ⟪(x ^ q).conj K, y ^ r⟫; - ConcaveOn ℝ .univ F := by - sorry