diff --git a/LeanPool/FBLOrderContinuity.lean b/LeanPool/FBLOrderContinuity.lean new file mode 100644 index 0000000000..6a3750bdc2 --- /dev/null +++ b/LeanPool/FBLOrderContinuity.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + + + +module + +public import LeanPool.FBLOrderContinuity.Parameters + +/-! +# Order continuity of induced homomorphisms between free Banach lattices + +Source: arxiv:2611.00451, url:https://github.com/pedrotradacete/FBLOrderContinuousLH/tree/ee3cde5070125ff2356b7144ff7a940a8dff2a54 +Authors: Raúl E. Pariente-Martín, Pedro Tradacete, David Muñoz-Lahoz +Status: verified +Main declarations: `FBLOrderContinuousLH.intro_infty`, `FBLOrderContinuousLH.intro_poe`, + `FBLOrderContinuousLH.cross_parameter_inclusion` +Tags: banach-lattices, free-banach-lattices, order-continuity, operator-extensions +MSC: 46B42, 46A40, 47B60 +-/ + +/-! +## Attribution and dependency scope + +The main formalization is preserved from +`pedrotradacete/FBLOrderContinuousLH` at +`ee3cde5070125ff2356b7144ff7a940a8dff2a54` (Apache-2.0). +The completed proof commit is `167b82ad69724d2ddb2a701fc932e52d445faecc`, +dated October 30, 2026, 22:05:46 UTC. The accompanying manuscript, +[arXiv:2611.00451](https://arxiv.org/abs/2611.00451), was submitted on +October 30 at 23:06:06 UTC. Its declaration on AI use credits GPT-6 Astra +and GPT-6 Sol for the Lean formalization, under the authors’ mathematical +direction; this import records AI provenance for the implementation. + +David Muñoz-Lahoz’s BanLat at +`33c4b73fce845c4295614326193d4e52111be762` supplies the additional +free-lattice, duality, quotient, AM-space representation and functional-calculus +prerequisites, also under Apache-2.0. The existing BanLat core in +`LeanPool.OrderClosures` is reused. The added subtype, weak-convergence and finite-product +modules restore the interfaces needed by this dependency closure without +copying that core. The original mathematical namespaces and theorem statements +are retained. The main paper’s acknowledgments credit Timur Oikhberg for +discussions and a simplification of Lemma 4.11. +-/ diff --git a/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Basic.lean b/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Basic.lean new file mode 100644 index 0000000000..9770782b13 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Basic.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Substructures.Ideal +public import Mathlib.Order.Filter.AtTopBot.Basic + + + +/-! +# AM-spaces + +This file introduces AM-spaces and AM-spaces with unit. An `AMSpace` is a +Banach lattice whose norm satisfies the AM-axiom on disjoint elements. An +`AMSpaceWithUnit` is an AM-space equipped with a strong order unit whose gauge +norm agrees with the original norm. + +The main structural result is that every principal ideal, equipped with its +gauge norm, is an AM-space with unit; conversely, in an AM-space with unit, +the unit generates the whole space as a principal ideal. +-/ + +@[expose] public section + +/-! ### AM-spaces -/ + +/-- An **AM-space** is a Banach lattice whose norm satisfies the AM-axiom on +disjoint elements: if `x ⊓ y = 0`, then `‖x + y‖ = max ‖x‖ ‖y‖`. The +positivity of `x` and `y` is automatic from `x ⊓ y = 0`. -/ +class AMSpace (X : Type*) [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] extends BanachLattice X where + norm_add_eq_max_of_inf_eq_zero {x y : X} (hxy : x ⊓ y = 0) : + ‖x + y‖ = max ‖x‖ ‖y‖ + +namespace AMSpace + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [AMSpace X] + +/-- For disjoint elements in an AM-space, the norm of the supremum is the +maximum of the norms. -/ +theorem norm_sup_eq_max_of_inf_eq_zero {x y : X} (hxy : x ⊓ y = 0) : + ‖x ⊔ y‖ = max ‖x‖ ‖y‖ := by + have hx : 0 ≤ x := by + rw [← hxy] + exact inf_le_left + have hy : 0 ≤ y := by + rw [← hxy] + exact inf_le_right + have hadd : x + y = x ⊔ y := by + calc + x + y = x + (y - x)⁺ := by + rw [← sub_inf_eq_posPart y x, inf_comm, hxy, sub_zero] + _ = x ⊔ y := (sup_eq_add_posPart x y).symm + rw [← hadd] + exact AMSpace.norm_add_eq_max_of_inf_eq_zero hxy + +end AMSpace + +/-! ### AM-spaces with unit -/ + +/-- An **AM-space with unit** is an AM-space equipped with a strong order unit +whose gauge norm agrees with the original norm. -/ +class AMSpaceWithUnit (X : Type*) [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] extends AMSpace X where + /-- The distinguished strong order unit. -/ + unit : X + strongOrderUnit_unit : StrongOrderUnit unit + norm_eq_gaugeNorm : ∀ x : X, ‖x‖ = OrderIdeal.gaugeNorm unit x + +namespace AMSpaceWithUnit + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [AMSpaceWithUnit X] + +/-- The distinguished unit of an AM-space with unit is non-negative. -/ +theorem unit_nonneg : 0 ≤ (AMSpaceWithUnit.unit : X) := + AMSpaceWithUnit.strongOrderUnit_unit.1 + +/-- In an AM-space with unit, the distinguished unit is a strong order unit. -/ +theorem strongOrderUnit_unit' : StrongOrderUnit (AMSpaceWithUnit.unit : X) := + AMSpaceWithUnit.strongOrderUnit_unit + +/-- In an AM-space with unit, the principal ideal generated by the unit is the +whole space. -/ +theorem principal_unit_eq_top : OrderIdeal.principal (AMSpaceWithUnit.unit : X) = ⊤ := + (OrderIdeal.strongOrderUnit_iff_principal_eq_top.mp + AMSpaceWithUnit.strongOrderUnit_unit).2 + +end AMSpaceWithUnit + +/-! ### Principal ideals -/ + +namespace OrderIdeal + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +theorem principal_strongOrderUnit [IsVLArchimedean X] {e : X} (he : 0 ≤ e) : + letI : NormedAddCommGroup ↥(principal e) := principalNormedAddCommGroup e + letI : Lattice ↥(principal e) := instLatticePrincipal e + letI : IsOrderedAddMonoid ↥(principal e) := instIsOrderedAddMonoidPrincipal e + letI : NormedVectorLattice ↥(principal e) := principalNormedVectorLattice e + StrongOrderUnit (⟨e, self_mem_principal e⟩ : ↥(principal e)) := by + let : NormedAddCommGroup ↥(principal e) := principalNormedAddCommGroup e + let : Lattice ↥(principal e) := instLatticePrincipal e + let : IsOrderedAddMonoid ↥(principal e) := instIsOrderedAddMonoidPrincipal e + let : NormedVectorLattice ↥(principal e) := principalNormedVectorLattice e + refine ⟨he, ?_⟩ + intro x + obtain ⟨c, hc, hcx⟩ := mem_principal.mp x.2 + refine ⟨c, hc, ?_⟩ + change |(x : X)| ≤ c • e + rwa [abs_of_nonneg he] at hcx + +theorem principal_norm_eq_gaugeNorm_unit [IsVLArchimedean X] {e : X} : + letI : NormedAddCommGroup ↥(principal e) := principalNormedAddCommGroup e + letI : Lattice ↥(principal e) := instLatticePrincipal e + letI : IsOrderedAddMonoid ↥(principal e) := instIsOrderedAddMonoidPrincipal e + letI : NormedVectorLattice ↥(principal e) := principalNormedVectorLattice e + ∀ x : ↥(principal e), + ‖x‖ = gaugeNorm (⟨e, self_mem_principal e⟩ : ↥(principal e)) x := by + let : NormedAddCommGroup ↥(principal e) := principalNormedAddCommGroup e + let : Lattice ↥(principal e) := instLatticePrincipal e + let : IsOrderedAddMonoid ↥(principal e) := instIsOrderedAddMonoidPrincipal e + let : NormedVectorLattice ↥(principal e) := principalNormedVectorLattice e + intro x + change gaugeNorm e (x : X) = gaugeNorm (⟨e, self_mem_principal e⟩ : ↥(principal e)) x + rfl + +theorem principal_norm_add_eq_max_of_inf_eq_zero [IsVLArchimedean X] + {e : X} (he : 0 ≤ e) : + letI : NormedAddCommGroup ↥(principal e) := principalNormedAddCommGroup e + letI : Lattice ↥(principal e) := instLatticePrincipal e + letI : IsOrderedAddMonoid ↥(principal e) := instIsOrderedAddMonoidPrincipal e + letI : NormedVectorLattice ↥(principal e) := principalNormedVectorLattice e + ∀ {x y : ↥(principal e)}, x ⊓ y = 0 → ‖x + y‖ = max ‖x‖ ‖y‖ := by + let : NormedAddCommGroup ↥(principal e) := principalNormedAddCommGroup e + let : Lattice ↥(principal e) := instLatticePrincipal e + let : IsOrderedAddMonoid ↥(principal e) := instIsOrderedAddMonoidPrincipal e + let : NormedVectorLattice ↥(principal e) := principalNormedVectorLattice e + intro x y hxy + have hx : 0 ≤ x := by rw [← hxy]; exact inf_le_left + have hy : 0 ≤ y := by rw [← hxy]; exact inf_le_right + have hsum_nonneg : 0 ≤ x + y := add_nonneg hx hy + have hsup : x + y = x ⊔ y := + add_eq_sup_of_isVLDisjoint_of_nonneg hx hy (isVLDisjoint_of_inf_eq_zero hxy) + apply le_antisymm + · let M : ℝ := max ‖x‖ ‖y‖ + have hM_nonneg : 0 ≤ M := le_max_of_le_left (norm_nonneg x) + have hx_bound : (x : X) ≤ M • e := by + have hx_abs : |(x : X)| ≤ ‖x‖ • |e| := by + change |(x : X)| ≤ gaugeNorm e (x : X) • |e| + exact abs_le_gaugeNorm_smul_abs e x.2 + calc (x : X) ≤ |(x : X)| := le_abs_self _ + _ ≤ ‖x‖ • |e| := hx_abs + _ ≤ M • |e| := smul_le_smul_of_nonneg_right (le_max_left _ _) (abs_nonneg e) + _ = M • e := by rw [abs_of_nonneg he] + have hy_bound : (y : X) ≤ M • e := by + have hy_abs : |(y : X)| ≤ ‖y‖ • |e| := by + change |(y : X)| ≤ gaugeNorm e (y : X) • |e| + exact abs_le_gaugeNorm_smul_abs e y.2 + calc (y : X) ≤ |(y : X)| := le_abs_self _ + _ ≤ ‖y‖ • |e| := hy_abs + _ ≤ M • |e| := smul_le_smul_of_nonneg_right (le_max_right _ _) (abs_nonneg e) + _ = M • e := by rw [abs_of_nonneg he] + have hsum_bound : ((x + y : ↥(principal e)) : X) ≤ M • e := by + have hsup_val : (x : X) + (y : X) = (x : X) ⊔ (y : X) := by + have hsup_sub : + ((x + y : ↥(principal e)) : X) = ((x ⊔ y : ↥(principal e)) : X) := + congrArg Subtype.val hsup + change (x : X) + (y : X) = (x : X) ⊔ (y : X) at hsup_sub + exact hsup_sub + change (x : X) + (y : X) ≤ M • e + rw [hsup_val] + exact sup_le hx_bound hy_bound + change gaugeNorm e ((x + y : ↥(principal e)) : X) ≤ M + exact gaugeNorm_le_of_abs_le e hM_nonneg (by + rw [abs_of_nonneg (show 0 ≤ ((x + y : ↥(principal e)) : X) from hsum_nonneg), + abs_of_nonneg he] + exact hsum_bound) + · refine max_le ?_ ?_ + · apply norm_le_norm_of_abs_le_abs + rw [abs_of_nonneg hx, abs_of_nonneg hsum_nonneg] + exact le_add_of_nonneg_right hy + · apply norm_le_norm_of_abs_le_abs + rw [abs_of_nonneg hy, abs_of_nonneg hsum_nonneg] + exact le_add_of_nonneg_left hx + +/-- In an Archimedean vector lattice, a complete principal ideal, +equipped with its gauge norm and inherited vector lattice structure, is an +AM-space with unit. -/ +@[reducible] +noncomputable def principalAMSpaceWithUnit [IsVLArchimedean X] {e : X} (he : 0 ≤ e) + (hcomplete : + letI : NormedAddCommGroup ↥(principal e) := principalNormedAddCommGroup e + CompleteSpace ↥(principal e)) : + @AMSpaceWithUnit ↥(principal e) + (principalNormedAddCommGroup e) + (instLatticePrincipal e) + (instIsOrderedAddMonoidPrincipal e) := by + letI : NormedAddCommGroup ↥(principal e) := principalNormedAddCommGroup e + letI : Lattice ↥(principal e) := instLatticePrincipal e + letI : IsOrderedAddMonoid ↥(principal e) := instIsOrderedAddMonoidPrincipal e + letI : NormedVectorLattice ↥(principal e) := principalNormedVectorLattice e + letI : CompleteSpace ↥(principal e) := hcomplete + letI : BanachLattice ↥(principal e) := { } + refine { (inferInstance : BanachLattice ↥(principal e)) with + unit := ⟨e, self_mem_principal e⟩ + strongOrderUnit_unit := principal_strongOrderUnit he + norm_eq_gaugeNorm := principal_norm_eq_gaugeNorm_unit + norm_add_eq_max_of_inf_eq_zero := principal_norm_add_eq_max_of_inf_eq_zero he } + +end OrderIdeal diff --git a/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Characters.lean b/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Characters.lean new file mode 100644 index 0000000000..d93996bef3 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Characters.lean @@ -0,0 +1,887 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import Mathlib.Algebra.Order.Group.Pointwise.CompleteLattice +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.FBLOrderContinuity.BanLat.AMSpace.Maximal +public import LeanPool.OrderClosures.BanLat.Operators.Hom +public import LeanPool.FBLOrderContinuity.BanLat.RieszDec +public import Mathlib.Topology.ContinuousMap.Compact + + + +/-! +# Characters of AM-spaces with unit + +This file introduces the character space of an AM-space with unit and records +its basic order, norm, and topological properties. +-/ + +@[expose] public section + +namespace AMSpaceWithUnit + +variable (X : Type*) [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [AMSpaceWithUnit X] + +/-- A **lattice character** of an AM-space with unit is a real-valued vector +lattice homomorphism that maps the distinguished unit to `1`. -/ +structure LatticeCharacter extends VecLatHom X ℝ where + /-- A lattice character maps the distinguished unit to `1`. -/ + map_unit : toVecLatHom (AMSpaceWithUnit.unit : X) = 1 + +namespace LatticeCharacter + +variable {X} + +/-- The canonical `FunLike` instance, making `LatticeCharacter X` a type of +functions `X → ℝ`. -/ +noncomputable instance instFunLike : FunLike (LatticeCharacter X) X ℝ where + coe φ := fun x => φ.toVecLatHom x + coe_injective := by + intro φ ψ h + cases φ + cases ψ + congr + exact DFunLike.coe_injective h + +@[simp] theorem coe_mk (f : VecLatHom X ℝ) + (hf : f (AMSpaceWithUnit.unit : X) = 1) (x : X) : + (mk f hf : X → ℝ) x = f x := rfl + +@[simp] theorem map_unit_apply (φ : LatticeCharacter X) : + φ (AMSpaceWithUnit.unit : X) = 1 := + φ.map_unit + +/-- A lattice character preserves suprema. -/ +theorem map_sup (φ : LatticeCharacter X) (x y : X) : + φ (x ⊔ y) = max (φ x) (φ y) := + φ.toVecLatHom.toLatticeHom.map_sup' x y + +/-- A lattice character preserves infima. -/ +theorem map_inf (φ : LatticeCharacter X) (x y : X) : + φ (x ⊓ y) = min (φ x) (φ y) := + φ.toVecLatHom.toLatticeHom.map_inf' x y + +/-- A lattice character is monotone. -/ +theorem monotone (φ : LatticeCharacter X) : Monotone (φ : X → ℝ) := + φ.toVecLatHom.monotone + +/-- A lattice character sends positive elements to non-negative reals. -/ +theorem nonneg_apply (φ : LatticeCharacter X) {x : X} (hx : 0 ≤ x) : + 0 ≤ φ x := + φ.toVecLatHom.map_nonneg hx + +theorem abs_le_norm_smul_unit (x : X) : + |x| ≤ ‖x‖ • (AMSpaceWithUnit.unit : X) := by + have hx : x ∈ OrderIdeal.principal (AMSpaceWithUnit.unit : X) := by + rw [principal_unit_eq_top (X := X)] + exact OrderIdeal.mem_top + have h := OrderIdeal.abs_le_gaugeNorm_smul_abs (AMSpaceWithUnit.unit : X) hx + rw [← AMSpaceWithUnit.norm_eq_gaugeNorm, abs_of_nonneg (unit_nonneg (X := X))] at h + exact h + +/-- The fundamental norm bound for a lattice character: `|φ x| ≤ ‖x‖`. -/ +theorem abs_apply_le_norm (φ : LatticeCharacter X) (x : X) : + |φ x| ≤ ‖x‖ := by + have h1 : |(φ x : ℝ)| = φ.toVecLatHom |x| := (φ.toVecLatHom.map_abs x).symm + have h2 : φ.toVecLatHom (‖x‖ • (AMSpaceWithUnit.unit : X)) = ‖x‖ := by + rw [map_smul, φ.map_unit, smul_eq_mul, mul_one] + rw [h1, ← h2] + exact φ.toVecLatHom.monotone (abs_le_norm_smul_unit x) + +/-- A lattice character is a continuous functional. -/ +theorem continuous (φ : LatticeCharacter X) : Continuous (φ : X → ℝ) := by + have h : Continuous (φ.toVecLatHom.toLinearMap : X → ℝ) := + AddMonoidHomClass.continuous_of_bound φ.toVecLatHom.toLinearMap 1 fun x => by + rw [Real.norm_eq_abs, one_mul] + exact abs_apply_le_norm φ x + exact h + +variable (X) + +/-- The character space is topologised as a subspace of `X → ℝ` with the +product topology. -/ +noncomputable instance instTopologicalSpace : TopologicalSpace (LatticeCharacter X) := + TopologicalSpace.induced (fun φ : LatticeCharacter X => (φ : X → ℝ)) + Pi.topologicalSpace + +/-- For each `x : X`, the evaluation map `φ ↦ φ x` is continuous. -/ +theorem continuous_eval (x : X) : + Continuous (fun φ : LatticeCharacter X => φ x) := + (continuous_apply x).comp continuous_induced_dom + +/-- The character space is Hausdorff. -/ +instance instT2Space : T2Space (LatticeCharacter X) := + T2Space.of_injective_continuous (f := fun φ : LatticeCharacter X => (φ : X → ℝ)) + DFunLike.coe_injective continuous_induced_dom + +theorem range_coe_eq_inter : + Set.range (fun φ : LatticeCharacter X => (φ : X → ℝ)) = + (⋂ p : X × X, {g : X → ℝ | g (p.1 + p.2) = g p.1 + g p.2}) ∩ + (⋂ p : ℝ × X, {g : X → ℝ | g (p.1 • p.2) = p.1 * g p.2}) ∩ + (⋂ p : X × X, {g : X → ℝ | g (p.1 ⊔ p.2) = max (g p.1) (g p.2)}) ∩ + (⋂ p : X × X, {g : X → ℝ | g (p.1 ⊓ p.2) = min (g p.1) (g p.2)}) ∩ + {g : X → ℝ | g (AMSpaceWithUnit.unit : X) = 1} := by + ext g + simp only [Set.mem_range, Set.mem_inter_iff, Set.mem_iInter, Set.mem_ofPred_eq, + Prod.forall] + constructor + · rintro ⟨φ, rfl⟩ + refine ⟨⟨⟨⟨?_, ?_⟩, ?_⟩, ?_⟩, ?_⟩ + · exact fun x y => map_add φ.toVecLatHom x y + · exact fun c x => map_smul φ.toVecLatHom c x + · exact LatticeCharacter.map_sup φ + · exact LatticeCharacter.map_inf φ + · exact φ.map_unit + · rintro ⟨⟨⟨⟨hadd, hsmul⟩, hsup⟩, hinf⟩, hunit⟩ + refine ⟨⟨⟨⟨⟨g, hadd⟩, hsmul⟩, hsup, hinf⟩, hunit⟩, rfl⟩ + +/-- The character space is compact in the product topology. -/ +instance instCompactSpace : CompactSpace (LatticeCharacter X) := by + let ι : LatticeCharacter X → (X → ℝ) := fun φ x => φ x + have hι : Topology.IsInducing ι := ⟨rfl⟩ + refine ⟨?_⟩ + rw [Topology.IsInducing.isCompact_iff hι, Set.image_univ] + set K : Set (X → ℝ) := Set.pi Set.univ (fun x => Set.Icc (-‖x‖) ‖x‖) with hK_def + have hK_compact : IsCompact K := isCompact_univ_pi (fun _ => isCompact_Icc) + have hrange_sub : Set.range ι ⊆ K := by + rintro g ⟨φ, rfl⟩ x _ + simp only [Set.mem_Icc] + exact abs_le.mp (φ.abs_apply_le_norm x) + have hrange_closed : IsClosed (Set.range ι) := by + have heq : (Set.range ι) = + Set.range (fun φ : LatticeCharacter X => (φ : X → ℝ)) := rfl + rw [heq, range_coe_eq_inter] + refine IsClosed.inter (IsClosed.inter (IsClosed.inter (IsClosed.inter ?_ ?_) ?_) ?_) ?_ + · exact isClosed_iInter fun p => isClosed_eq (continuous_apply (p.1 + p.2)) + ((continuous_apply p.1).add (continuous_apply p.2)) + · exact isClosed_iInter fun p => isClosed_eq (continuous_apply (p.1 • p.2)) + (continuous_const.mul (continuous_apply p.2)) + · exact isClosed_iInter fun p => isClosed_eq (continuous_apply (p.1 ⊔ p.2)) + ((continuous_apply p.1).max (continuous_apply p.2)) + · exact isClosed_iInter fun p => isClosed_eq (continuous_apply (p.1 ⊓ p.2)) + ((continuous_apply p.1).min (continuous_apply p.2)) + · exact isClosed_eq (continuous_apply (AMSpaceWithUnit.unit : X)) continuous_const + exact hK_compact.of_isClosed_subset hrange_closed hrange_sub + +/-! ### Characters from maximal ideals -/ + +variable {X} + +/-- The ideal obtained by adjoining one generator to an order ideal. -/ +noncomputable def addPrincipal (M : OrderIdeal X) (y : X) : OrderIdeal X := + OrderIdeal.ofSolid (M.toSubmodule + (OrderIdeal.principal y).toSubmodule) <| by + intro a b hab habs + obtain ⟨m, hm_mem, u, hu_mem, rfl⟩ := Submodule.mem_sup.mp hab + have habs' : |b| ≤ |m| + |u| := habs.trans (abs_add_le m u) + have hm_abs_mem : |m| ∈ M := M.abs_mem hm_mem + have hu_abs_mem : |u| ∈ OrderIdeal.principal y := + (OrderIdeal.principal y).abs_mem hu_mem + have hpos_le : b⁺ ≤ |m| + |u| := + sup_le ((le_abs_self b).trans habs') (add_nonneg (abs_nonneg m) (abs_nonneg u)) + have hneg_le : b⁻ ≤ |m| + |u| := + sup_le ((neg_le_abs b).trans habs') (add_nonneg (abs_nonneg m) (abs_nonneg u)) + obtain ⟨p₁, p₂, hp₁_nn, hp₁_le, hp₂_nn, hp₂_le, hp_eq⟩ := + riesz_decomposition (b⁺) |m| |u| (posPart_nonneg b) + (abs_nonneg m) (abs_nonneg u) hpos_le + obtain ⟨n₁, n₂, hn₁_nn, hn₁_le, hn₂_nn, hn₂_le, hn_eq⟩ := + riesz_decomposition (b⁻) |m| |u| (negPart_nonneg b) + (abs_nonneg m) (abs_nonneg u) hneg_le + have hp₁_M : p₁ ∈ M := M.solid hm_abs_mem hp₁_nn hp₁_le + have hp₂_I : p₂ ∈ OrderIdeal.principal y := + (OrderIdeal.principal y).solid hu_abs_mem hp₂_nn hp₂_le + have hn₁_M : n₁ ∈ M := M.solid hm_abs_mem hn₁_nn hn₁_le + have hn₂_I : n₂ ∈ OrderIdeal.principal y := + (OrderIdeal.principal y).solid hu_abs_mem hn₂_nn hn₂_le + have hb_eq : b = (p₁ - n₁) + (p₂ - n₂) := by + have hp := posPart_sub_negPart b + rw [hp_eq, hn_eq] at hp + rw [← hp] + abel + rw [hb_eq] + exact Submodule.add_mem _ + (Submodule.sub_mem _ (Submodule.mem_sup_left hp₁_M) + (Submodule.mem_sup_left hn₁_M)) + (Submodule.sub_mem _ (Submodule.mem_sup_right hp₂_I) + (Submodule.mem_sup_right hn₂_I)) + +theorem addPrincipal_le (M : OrderIdeal X) (y : X) : + M ≤ addPrincipal M y := by + intro x hx + change x ∈ M.toSubmodule + (OrderIdeal.principal y).toSubmodule + exact Submodule.mem_sup_left hx + +theorem self_mem_addPrincipal (M : OrderIdeal X) (y : X) : + y ∈ addPrincipal M y := by + change y ∈ M.toSubmodule + (OrderIdeal.principal y).toSubmodule + exact Submodule.mem_sup_right (OrderIdeal.self_mem_principal y) + +theorem mem_of_disjoint_notMem (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) + {y z : X} (hy_nn : 0 ≤ y) (hz_nn : 0 ≤ z) (hdisj : y ⊓ z = 0) + (hy_notin : y ∉ M) : z ∈ M := by + have hM_lt : M ≤ addPrincipal M y := addPrincipal_le M y + have hM_ne_addP : M ≠ addPrincipal M y := by + intro heq + apply hy_notin + rw [heq] + exact self_mem_addPrincipal M y + have htop : addPrincipal M y = ⊤ := by + by_contra hne + exact hM_ne_addP (hmax _ hM_lt hne).symm + have hz_in : z ∈ (addPrincipal M y).toSubmodule := by + rw [htop] + exact Submodule.mem_top + have hz_in' : z ∈ M.toSubmodule + (OrderIdeal.principal y).toSubmodule := hz_in + obtain ⟨m, hm, u, hu, hzmu⟩ := Submodule.mem_sup.mp hz_in' + obtain ⟨c, hc, hu_bound⟩ := hu + have hz_abs : z ≤ |m| + |u| := by + calc + z = m + u := hzmu.symm + _ ≤ |m| + |u| := add_le_add (le_abs_self m) (le_abs_self u) + obtain ⟨z₁, z₂, hz₁_nn, hz₁_le_m, hz₂_nn, hz₂_le_u, hz₁₂⟩ := + riesz_decomposition z |m| |u| hz_nn (abs_nonneg m) (abs_nonneg u) hz_abs + have hz₁_M : z₁ ∈ M := M.solid (M.abs_mem hm) hz₁_nn hz₁_le_m + have hy_z₂ : y ⊓ z₂ = 0 := by + apply le_antisymm + · have : z₂ ≤ z := le_trans (le_add_of_nonneg_left hz₁_nn) hz₁₂.symm.le + calc + y ⊓ z₂ ≤ y ⊓ z := inf_le_inf le_rfl this + _ = 0 := hdisj + · exact le_inf hy_nn hz₂_nn + have hz₂_le_cy : z₂ ≤ c • y := by + have h1 : z₂ ≤ c • |y| := hz₂_le_u.trans hu_bound + rwa [abs_of_nonneg hy_nn] at h1 + have hz₂_disj_cy : (c • y) ⊓ z₂ = 0 := + inf_eq_zero_of_isVLDisjoint (smul_nonneg hc hy_nn) hz₂_nn + ((isVLDisjoint_of_inf_eq_zero hy_z₂).smul_left c) + have hz₂_zero : z₂ = 0 := by + have h := inf_eq_left.mpr hz₂_le_cy + rw [inf_comm] at hz₂_disj_cy + rw [hz₂_disj_cy] at h + exact h.symm + rw [hz₁₂, hz₂_zero, add_zero] + exact hz₁_M + +theorem smul_unit_notMem_of_proper (M : OrderIdeal X) (hMne : M ≠ ⊤) + {c : ℝ} (hc : 0 < c) : + c • (AMSpaceWithUnit.unit : X) ∉ M := by + intro h + apply hMne + rw [top_iff_unit_mem] + have heq : (1 / c) • (c • (AMSpaceWithUnit.unit : X)) = + AMSpaceWithUnit.unit := by + rw [smul_smul, one_div, inv_mul_cancel₀ (ne_of_gt hc), one_smul] + rw [← heq] + exact M.toSubmodule.smul_mem _ h + +theorem nonneg_le_smul_unit_notMem (M : OrderIdeal X) (hMne : M ≠ ⊤) + {c : ℝ} (hc : 0 < c) {y : X} + (hy : c • (AMSpaceWithUnit.unit : X) ≤ y) (hyM : y ∈ M) : False := by + apply smul_unit_notMem_of_proper M hMne hc + have h_pos : 0 ≤ c • (AMSpaceWithUnit.unit : X) := + smul_nonneg hc.le (unit_nonneg (X := X)) + exact M.solid hyM h_pos hy + +/-- Scalar multiples of the unit lying below `x` modulo the ideal. -/ +def charSetA (M : OrderIdeal X) (x : X) : Set ℝ := + {c : ℝ | (c • AMSpaceWithUnit.unit - x)⁺ ∈ M} + +/-- Scalar multiples of the unit lying above `x` modulo the ideal. -/ +def charSetB (M : OrderIdeal X) (x : X) : Set ℝ := + {c : ℝ | (x - c • AMSpaceWithUnit.unit)⁺ ∈ M} + +theorem mem_charSetA {M : OrderIdeal X} {x : X} {c : ℝ} : + c ∈ charSetA M x ↔ (c • AMSpaceWithUnit.unit - x)⁺ ∈ M := Iff.rfl + +theorem mem_charSetB {M : OrderIdeal X} {x : X} {c : ℝ} : + c ∈ charSetB M x ↔ (x - c • AMSpaceWithUnit.unit)⁺ ∈ M := Iff.rfl + +theorem neg_norm_smul_unit_le (x : X) : + -((‖x‖ : ℝ) • AMSpaceWithUnit.unit) ≤ x := + neg_le.mp (abs_le'.mp (abs_le_norm_smul_unit x)).2 + +theorem le_norm_smul_unit (x : X) : + x ≤ (‖x‖ : ℝ) • AMSpaceWithUnit.unit := + (abs_le'.mp (abs_le_norm_smul_unit x)).1 + +theorem neg_norm_mem_charSetA (M : OrderIdeal X) (x : X) : + -‖x‖ ∈ charSetA M x := by + rw [mem_charSetA] + have hle : (-‖x‖ : ℝ) • AMSpaceWithUnit.unit - x ≤ 0 := by + rw [neg_smul, sub_nonpos] + exact neg_norm_smul_unit_le x + rw [posPart_eq_zero.mpr hle] + exact M.toSubmodule.zero_mem + +theorem norm_mem_charSetB (M : OrderIdeal X) (x : X) : + ‖x‖ ∈ charSetB M x := by + rw [mem_charSetB] + have hle : x - (‖x‖ : ℝ) • AMSpaceWithUnit.unit ≤ 0 := + sub_nonpos.mpr (le_norm_smul_unit x) + rw [posPart_eq_zero.mpr hle] + exact M.toSubmodule.zero_mem + +theorem charSetA_nonempty (M : OrderIdeal X) (x : X) : + (charSetA M x).Nonempty := + ⟨-‖x‖, neg_norm_mem_charSetA M x⟩ + +theorem charSetB_nonempty (M : OrderIdeal X) (x : X) : + (charSetB M x).Nonempty := + ⟨‖x‖, norm_mem_charSetB M x⟩ + +theorem charSetA_downwardClosed (M : OrderIdeal X) (x : X) + {c d : ℝ} (hc : c ∈ charSetA M x) (hdc : d ≤ c) : d ∈ charSetA M x := by + rw [mem_charSetA] at hc ⊢ + apply M.solid hc (posPart_nonneg _) + apply sup_le_sup_right + exact sub_le_sub_right + (smul_le_smul_of_nonneg_right hdc (unit_nonneg (X := X))) _ + +theorem charSetB_upwardClosed (M : OrderIdeal X) (x : X) + {c d : ℝ} (hc : c ∈ charSetB M x) (hcd : c ≤ d) : d ∈ charSetB M x := by + rw [mem_charSetB] at hc ⊢ + apply M.solid hc (posPart_nonneg _) + apply sup_le_sup_right + exact sub_le_sub_left + (smul_le_smul_of_nonneg_right hcd (unit_nonneg (X := X))) _ + +theorem charSetA_bddAbove (M : OrderIdeal X) (hMne : M ≠ ⊤) (x : X) : + BddAbove (charSetA M x) := by + refine ⟨‖x‖, fun c hc => ?_⟩ + by_contra hlt + push Not at hlt + have hxle := le_norm_smul_unit x + have h1 : (c - ‖x‖) • (AMSpaceWithUnit.unit : X) ≤ + c • AMSpaceWithUnit.unit - x := by + rw [sub_smul] + exact sub_le_sub_left hxle (c • AMSpaceWithUnit.unit) + have hpos : 0 < c - ‖x‖ := sub_pos.mpr hlt + have h2 : (c - ‖x‖) • (AMSpaceWithUnit.unit : X) ≤ + (c • AMSpaceWithUnit.unit - x)⁺ := + h1.trans (le_posPart _) + exact nonneg_le_smul_unit_notMem M hMne hpos h2 hc + +theorem charSetB_bddBelow (M : OrderIdeal X) (hMne : M ≠ ⊤) (x : X) : + BddBelow (charSetB M x) := by + refine ⟨-‖x‖, fun c hc => ?_⟩ + by_contra hlt + push Not at hlt + have hxle := neg_norm_smul_unit_le x + have h1 : (-‖x‖ - c) • (AMSpaceWithUnit.unit : X) ≤ + x - c • AMSpaceWithUnit.unit := by + rw [sub_smul, neg_smul] + have : -(‖x‖ • (AMSpaceWithUnit.unit : X)) - + c • AMSpaceWithUnit.unit ≤ x - c • AMSpaceWithUnit.unit := + sub_le_sub_right hxle (c • AMSpaceWithUnit.unit) + exact this + have hpos : 0 < -‖x‖ - c := by linarith + have h2 : (-‖x‖ - c) • (AMSpaceWithUnit.unit : X) ≤ + (x - c • AMSpaceWithUnit.unit)⁺ := + h1.trans (le_posPart _) + exact nonneg_le_smul_unit_notMem M hMne hpos h2 hc + +theorem charSetA_union_charSetB (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) + (x : X) (c : ℝ) : + c ∈ charSetA M x ∨ c ∈ charSetB M x := by + set y := (c • (AMSpaceWithUnit.unit : X) - x)⁺ with hy_def + set z := (x - c • (AMSpaceWithUnit.unit : X))⁺ with hz_def + have hyz : y ⊓ z = 0 := by + have heq : (x - c • (AMSpaceWithUnit.unit : X))⁺ = + (c • AMSpaceWithUnit.unit - x)⁻ := by + rw [show (x - c • (AMSpaceWithUnit.unit : X)) = + -(c • AMSpaceWithUnit.unit - x) from by abel, + show ((-(c • (AMSpaceWithUnit.unit : X) - x))⁺ : X) = + (c • AMSpaceWithUnit.unit - x)⁻ from rfl] + rw [hy_def, hz_def, heq] + exact posPart_inf_negPart_eq_zero _ + have hy_nn : 0 ≤ y := posPart_nonneg _ + have hz_nn : 0 ≤ z := posPart_nonneg _ + by_cases hy : y ∈ M + · left + exact hy + · right + rw [mem_charSetB] + exact mem_of_disjoint_notMem M hmax hy_nn hz_nn hyz hy + +theorem charSetA_charSetB_unique (M : OrderIdeal X) (hMne : M ≠ ⊤) + (x : X) {c : ℝ} (hcA : c ∈ charSetA M x) (hcB : c ∈ charSetB M x) + {d : ℝ} (hdA : d ∈ charSetA M x) (hdB : d ∈ charSetB M x) : c = d := by + rw [mem_charSetA] at hcA hdA + rw [mem_charSetB] at hcB hdB + have hc_neg_in : (c • (AMSpaceWithUnit.unit : X) - x)⁻ ∈ M := by + have h : (c • (AMSpaceWithUnit.unit : X) - x)⁻ = + (x - c • AMSpaceWithUnit.unit)⁺ := by + rw [show x - c • (AMSpaceWithUnit.unit : X) = + -(c • AMSpaceWithUnit.unit - x) from by abel, + show ((-(c • (AMSpaceWithUnit.unit : X) - x))⁺ : X) = + (c • AMSpaceWithUnit.unit - x)⁻ from rfl] + rw [h] + exact hcB + have hd_neg_in : (d • (AMSpaceWithUnit.unit : X) - x)⁻ ∈ M := by + have h : (d • (AMSpaceWithUnit.unit : X) - x)⁻ = + (x - d • AMSpaceWithUnit.unit)⁺ := by + rw [show x - d • (AMSpaceWithUnit.unit : X) = + -(d • AMSpaceWithUnit.unit - x) from by abel, + show ((-(d • (AMSpaceWithUnit.unit : X) - x))⁺ : X) = + (d • AMSpaceWithUnit.unit - x)⁻ from rfl] + rw [h] + exact hdB + have hc_in : c • (AMSpaceWithUnit.unit : X) - x ∈ M := by + have h := M.toSubmodule.sub_mem hcA hc_neg_in + rwa [posPart_sub_negPart] at h + have hd_in : d • (AMSpaceWithUnit.unit : X) - x ∈ M := by + have h := M.toSubmodule.sub_mem hdA hd_neg_in + rwa [posPart_sub_negPart] at h + have hcd_in : (c - d) • (AMSpaceWithUnit.unit : X) ∈ M := by + have h := M.toSubmodule.sub_mem hc_in hd_in + have heq : + (c • (AMSpaceWithUnit.unit : X) - x) - + (d • AMSpaceWithUnit.unit - x) = + (c - d) • AMSpaceWithUnit.unit := by + rw [sub_smul] + abel + rwa [heq] at h + by_contra hne + have hne' : c - d ≠ 0 := sub_ne_zero.mpr hne + rcases lt_or_gt_of_ne hne' with hlt | hgt + · have h_neg : -((c - d) • (AMSpaceWithUnit.unit : X)) ∈ M := + M.toSubmodule.neg_mem hcd_in + rw [← neg_smul] at h_neg + exact smul_unit_notMem_of_proper M hMne (neg_pos.mpr hlt) h_neg + · exact smul_unit_notMem_of_proper M hMne hgt hcd_in + +theorem charSetA_le_charSetB (M : OrderIdeal X) (hMne : M ≠ ⊤) (x : X) + {a : ℝ} (ha : a ∈ charSetA M x) {b : ℝ} (hb : b ∈ charSetB M x) : a ≤ b := by + by_contra hlt + push Not at hlt + have hbA : b ∈ charSetA M x := charSetA_downwardClosed M x ha hlt.le + have haB : a ∈ charSetB M x := charSetB_upwardClosed M x hb hlt.le + exact absurd (charSetA_charSetB_unique M hMne x hbA hb ha haB) (ne_of_gt hlt).symm + +theorem inf_charSetB_le_sup_charSetA (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) (x : X) : + sInf (charSetB M x) ≤ sSup (charSetA M x) := by + by_contra hgt + push Not at hgt + obtain ⟨c, hc1, hc2⟩ := exists_between hgt + have hcA : c ∉ charSetA M x := fun h => + not_lt.mpr (le_csSup (charSetA_bddAbove M hMne x) h) hc1 + have hcB : c ∉ charSetB M x := fun h => + not_lt.mpr (csInf_le (charSetB_bddBelow M hMne x) h) hc2 + rcases charSetA_union_charSetB M hmax x c with h | h + · exact hcA h + · exact hcB h + +theorem sup_charSetA_eq_inf_charSetB (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) (x : X) : + sSup (charSetA M x) = sInf (charSetB M x) := by + apply le_antisymm + · apply csSup_le (charSetA_nonempty M x) + intro a ha + apply le_csInf (charSetB_nonempty M x) + intro b hb + exact charSetA_le_charSetB M hMne x ha hb + · exact inf_charSetB_le_sup_charSetA M hmax hMne x + +/-- The scalar value of `x` determined by the lower cut modulo the ideal. -/ +noncomputable def charValue (M : OrderIdeal X) (x : X) : ℝ := + sSup (charSetA M x) + +theorem charValue_eq_inf_charSetB (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) (x : X) : + charValue M x = sInf (charSetB M x) := + sup_charSetA_eq_inf_charSetB M hmax hMne x + +theorem charValue_zero (M : OrderIdeal X) (hmax : ∀ J : OrderIdeal X, + M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) : + charValue M (0 : X) = 0 := by + apply le_antisymm + · rw [charValue_eq_inf_charSetB M hmax hMne] + apply csInf_le (charSetB_bddBelow M hMne 0) + rw [mem_charSetB] + have : (0 - (0 : ℝ) • (AMSpaceWithUnit.unit : X))⁺ = 0 := by + rw [zero_smul, sub_zero, posPart_eq_zero.mpr le_rfl] + rw [this] + exact M.toSubmodule.zero_mem + · apply le_csSup (charSetA_bddAbove M hMne 0) + rw [mem_charSetA] + have : ((0 : ℝ) • (AMSpaceWithUnit.unit : X) - 0)⁺ = 0 := by + rw [zero_smul, sub_zero, posPart_eq_zero.mpr le_rfl] + rw [this] + exact M.toSubmodule.zero_mem + +theorem charValue_unit (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) : + charValue M (AMSpaceWithUnit.unit : X) = 1 := by + apply le_antisymm + · rw [charValue_eq_inf_charSetB M hmax hMne] + apply csInf_le (charSetB_bddBelow M hMne AMSpaceWithUnit.unit) + rw [mem_charSetB] + have : ((AMSpaceWithUnit.unit : X) - (1 : ℝ) • AMSpaceWithUnit.unit)⁺ = 0 := by + rw [one_smul, sub_self, posPart_eq_zero.mpr le_rfl] + rw [this] + exact M.toSubmodule.zero_mem + · apply le_csSup (charSetA_bddAbove M hMne AMSpaceWithUnit.unit) + rw [mem_charSetA] + have : ((1 : ℝ) • (AMSpaceWithUnit.unit : X) - AMSpaceWithUnit.unit)⁺ = 0 := by + rw [one_smul, sub_self, posPart_eq_zero.mpr le_rfl] + rw [this] + exact M.toSubmodule.zero_mem + +theorem charValue_add_le_aux (M : OrderIdeal X) (x y : X) + {c₁ : ℝ} (hc₁ : c₁ ∈ charSetA M x) {c₂ : ℝ} (hc₂ : c₂ ∈ charSetA M y) : + c₁ + c₂ ∈ charSetA M (x + y) := by + rw [mem_charSetA] at hc₁ hc₂ ⊢ + have h1 : ((c₁ + c₂) • (AMSpaceWithUnit.unit : X) - (x + y))⁺ ≤ + (c₁ • AMSpaceWithUnit.unit - x)⁺ + (c₂ • AMSpaceWithUnit.unit - y)⁺ := by + have hsum : (c₁ + c₂) • (AMSpaceWithUnit.unit : X) - (x + y) = + (c₁ • AMSpaceWithUnit.unit - x) + (c₂ • AMSpaceWithUnit.unit - y) := by + rw [add_smul] + abel + rw [hsum] + exact posPart_add_le _ _ + exact M.solid (M.toSubmodule.add_mem hc₁ hc₂) (posPart_nonneg _) h1 + +theorem charValue_add_le_aux' (M : OrderIdeal X) (x y : X) + {c₁ : ℝ} (hc₁ : c₁ ∈ charSetB M x) {c₂ : ℝ} (hc₂ : c₂ ∈ charSetB M y) : + c₁ + c₂ ∈ charSetB M (x + y) := by + rw [mem_charSetB] at hc₁ hc₂ ⊢ + have h1 : ((x + y) - (c₁ + c₂) • (AMSpaceWithUnit.unit : X))⁺ ≤ + (x - c₁ • AMSpaceWithUnit.unit)⁺ + (y - c₂ • AMSpaceWithUnit.unit)⁺ := by + have hsum : (x + y) - (c₁ + c₂) • (AMSpaceWithUnit.unit : X) = + (x - c₁ • AMSpaceWithUnit.unit) + (y - c₂ • AMSpaceWithUnit.unit) := by + rw [add_smul] + abel + rw [hsum] + exact posPart_add_le _ _ + exact M.solid (M.toSubmodule.add_mem hc₁ hc₂) (posPart_nonneg _) h1 + +section CharValueOps + +open scoped Pointwise + +theorem charSetA_add_subset (M : OrderIdeal X) (x y : X) : + (charSetA M x + charSetA M y : Set ℝ) ⊆ charSetA M (x + y) := by + rintro _ ⟨a, ha, b, hb, rfl⟩ + exact charValue_add_le_aux M x y ha hb + +theorem charSetB_add_subset (M : OrderIdeal X) (x y : X) : + (charSetB M x + charSetB M y : Set ℝ) ⊆ charSetB M (x + y) := by + rintro _ ⟨a, ha, b, hb, rfl⟩ + exact charValue_add_le_aux' M x y ha hb + +theorem charValue_add (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) (x y : X) : + charValue M (x + y) = charValue M x + charValue M y := by + apply le_antisymm + · rw [charValue_eq_inf_charSetB M hmax hMne x, + charValue_eq_inf_charSetB M hmax hMne y, + charValue_eq_inf_charSetB M hmax hMne (x + y)] + have hsub : (charSetB M x + charSetB M y : Set ℝ) ⊆ charSetB M (x + y) := + charSetB_add_subset M x y + have hinf_sum : sInf (charSetB M x + charSetB M y) = + sInf (charSetB M x) + sInf (charSetB M y) := + csInf_add (charSetB_nonempty M x) (charSetB_bddBelow M hMne x) + (charSetB_nonempty M y) (charSetB_bddBelow M hMne y) + rw [← hinf_sum] + apply csInf_le_csInf (charSetB_bddBelow M hMne (x + y)) + ((charSetB_nonempty M x).add (charSetB_nonempty M y)) + exact hsub + · have hsub : (charSetA M x + charSetA M y : Set ℝ) ⊆ charSetA M (x + y) := + charSetA_add_subset M x y + have hsup_sum : sSup (charSetA M x + charSetA M y) = + sSup (charSetA M x) + sSup (charSetA M y) := + csSup_add (charSetA_nonempty M x) (charSetA_bddAbove M hMne x) + (charSetA_nonempty M y) (charSetA_bddAbove M hMne y) + change charValue M x + charValue M y ≤ charValue M (x + y) + unfold charValue + rw [← hsup_sum] + apply csSup_le_csSup (charSetA_bddAbove M hMne (x + y)) + ((charSetA_nonempty M x).add (charSetA_nonempty M y)) + exact hsub + +theorem charSetA_neg_eq (M : OrderIdeal X) (x : X) : + charSetA M (-x) = -charSetB M x := by + ext c + simp only [charSetA, charSetB, Set.mem_ofPred_eq, Set.mem_neg] + constructor + · intro hc + have : (c • (AMSpaceWithUnit.unit : X) - -x) = + (x - (-c) • AMSpaceWithUnit.unit) := by + rw [neg_smul] + abel + rw [this] at hc + exact hc + · intro hc + have : (x - (-c) • (AMSpaceWithUnit.unit : X)) = + (c • AMSpaceWithUnit.unit - -x) := by + rw [neg_smul] + abel + rw [this] at hc + exact hc + +theorem charValue_neg (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) (x : X) : + charValue M (-x) = -charValue M x := by + unfold charValue + rw [charSetA_neg_eq M x] + rw [csSup_neg (charSetB_nonempty M x) (charSetB_bddBelow M hMne x)] + rw [← sup_charSetA_eq_inf_charSetB M hmax hMne x] + +theorem charSetA_smul_pos (M : OrderIdeal X) {c : ℝ} (hc : 0 < c) (x : X) : + charSetA M (c • x) = c • charSetA M x := by + ext d + simp only [charSetA, Set.mem_ofPred_eq, Set.mem_smul_set] + constructor + · intro hd + refine ⟨d / c, ?_, ?_⟩ + · have h1 : c • ((d / c) • (AMSpaceWithUnit.unit : X) - x) = + d • AMSpaceWithUnit.unit - c • x := by + rw [smul_sub, smul_smul, mul_div_cancel₀ _ (ne_of_gt hc)] + have h2 : (c • ((d / c) • (AMSpaceWithUnit.unit : X) - x))⁺ ∈ M := by + rw [h1] + exact hd + have h3 : c • ((d / c) • (AMSpaceWithUnit.unit : X) - x)⁺ = + (c • ((d / c) • AMSpaceWithUnit.unit - x))⁺ := by + rw [posPart_def, posPart_def, nonneg_smul_sup, smul_zero] + exact hc.le + rw [← h3] at h2 + have h4 : (c⁻¹ : ℝ) • c • + ((d / c) • (AMSpaceWithUnit.unit : X) - x)⁺ ∈ M := + M.toSubmodule.smul_mem _ h2 + rwa [smul_smul, inv_mul_cancel₀ (ne_of_gt hc), one_smul] at h4 + · rw [smul_eq_mul] + field_simp + · rintro ⟨d', hd', rfl⟩ + show ((c • d') • (AMSpaceWithUnit.unit : X) - c • x)⁺ ∈ M + have h1 : (c • d') • (AMSpaceWithUnit.unit : X) - c • x = + c • (d' • AMSpaceWithUnit.unit - x) := by + rw [smul_sub, smul_eq_mul, mul_smul] + rw [h1] + have h2 : (c • (d' • (AMSpaceWithUnit.unit : X) - x))⁺ = + c • (d' • AMSpaceWithUnit.unit - x)⁺ := by + rw [posPart_def, posPart_def, nonneg_smul_sup, smul_zero] + exact hc.le + rw [h2] + exact M.toSubmodule.smul_mem _ hd' + +theorem charValue_smul_pos (M : OrderIdeal X) {c : ℝ} (hc : 0 < c) (x : X) : + charValue M (c • x) = c * charValue M x := by + unfold charValue + rw [charSetA_smul_pos M hc x, Real.sSup_smul_of_nonneg hc.le, smul_eq_mul] + +theorem charValue_smul (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) + (c : ℝ) (x : X) : + charValue M (c • x) = c * charValue M x := by + rcases lt_trichotomy c 0 with hlt | heq | hgt + · rw [show (c • x : X) = -((-c) • x) from by rw [neg_smul, neg_neg]] + rw [charValue_neg M hmax hMne, charValue_smul_pos M (neg_pos.mpr hlt)] + ring + · subst heq + simp [charValue_zero M hmax hMne] + · exact charValue_smul_pos M hgt x + +theorem charValue_nonneg (M : OrderIdeal X) (hMne : M ≠ ⊤) {x : X} + (hx : 0 ≤ x) : 0 ≤ charValue M x := by + apply le_csSup (charSetA_bddAbove M hMne x) + rw [mem_charSetA] + have h : (0 : X) = ((0 : ℝ) • AMSpaceWithUnit.unit - x)⁺ := by + rw [zero_smul, zero_sub, posPart_def, ← negPart_def] + exact (negPart_eq_zero.mpr hx).symm + rw [← h] + exact M.toSubmodule.zero_mem + +theorem charValue_eq_zero_of_mem (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) + {x : X} (hx : x ∈ M) : charValue M x = 0 := by + have hposPart : x⁺ ∈ M := by + rw [posPart_def] + exact M.sup_mem hx M.toSubmodule.zero_mem + have hnegPart : x⁻ ∈ M := by + rw [negPart_def] + exact M.sup_mem (M.toSubmodule.neg_mem hx) M.toSubmodule.zero_mem + apply le_antisymm + · rw [charValue_eq_inf_charSetB M hmax hMne] + apply csInf_le (charSetB_bddBelow M hMne x) + rw [mem_charSetB, zero_smul, sub_zero] + exact hposPart + · apply le_csSup (charSetA_bddAbove M hMne x) + rw [mem_charSetA, zero_smul, zero_sub] + have h : (-x)⁺ = x⁻ := by rw [posPart_def, ← negPart_def] + rw [h] + exact hnegPart + +theorem charValue_disjoint (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) + {x y : X} (hxy : x ⊓ y = 0) : + charValue M x ⊓ charValue M y = 0 := by + have hx_nn : 0 ≤ x := by + rw [← hxy] + exact inf_le_left + have hy_nn : 0 ≤ y := by + rw [← hxy] + exact inf_le_right + have hx_in_or_y_in : x ∈ M ∨ y ∈ M := by + by_cases hx : x ∈ M + · left + exact hx + · right + exact mem_of_disjoint_notMem M hmax hx_nn hy_nn hxy hx + rcases hx_in_or_y_in with hx | hy + · rw [charValue_eq_zero_of_mem M hmax hMne hx] + exact min_eq_left (charValue_nonneg M hMne hy_nn) + · rw [charValue_eq_zero_of_mem M hmax hMne hy] + exact min_eq_right (charValue_nonneg M hMne hx_nn) + +end CharValueOps + +/-- The real lattice character associated with a maximal proper ideal. -/ +noncomputable def vecLatHomOfMaximal (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) : + VecLatHom X ℝ := + IsVecLatHom.mk' (charValue M) + (IsVecLatHom.of_disjoint + ⟨charValue_add M hmax hMne, fun c x => by + rw [charValue_smul M hmax hMne] + rfl⟩ + (fun _ _ hxy => charValue_disjoint M hmax hMne hxy)) + +/-- The lattice character arising from a maximal proper ideal. -/ +noncomputable def ofMaximalIdeal (M : OrderIdeal X) + (hmax : ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M) (hMne : M ≠ ⊤) : + LatticeCharacter X where + toVecLatHom := vecLatHomOfMaximal M hmax hMne + map_unit := charValue_unit M hmax hMne + +variable (X) + +theorem unit_ne_zero [Nontrivial X] : + (AMSpaceWithUnit.unit : X) ≠ 0 := by + intro hunit + obtain ⟨x, hx⟩ := exists_ne (0 : X) + obtain ⟨c, hc, hle⟩ := (strongOrderUnit_unit' (X := X)).2 x + rw [hunit, smul_zero] at hle + exact hx ((abs_eq_zero_iff_zero x).mp (le_antisymm hle (abs_nonneg x))) + +theorem exists_character [Nontrivial X] : Nonempty (LatticeCharacter X) := by + classical + let zeroIdeal : OrderIdeal X := OrderIdeal.ofSolid ⊥ <| by + intro x y hx hxy + rw [Submodule.mem_bot] at hx ⊢ + rw [hx, abs_zero] at hxy + exact (abs_eq_zero_iff_zero y).mp (le_antisymm hxy (abs_nonneg y)) + have hZero_ne : zeroIdeal ≠ ⊤ := by + rw [ne_eq, top_iff_unit_mem] + change (AMSpaceWithUnit.unit : X) ∉ (⊥ : Submodule ℝ X) + rw [Submodule.mem_bot] + exact unit_ne_zero X + obtain ⟨M, _, hMne, hMmax⟩ := exists_le_maximal zeroIdeal hZero_ne + exact ⟨ofMaximalIdeal M hMmax hMne⟩ + +theorem principal_norm_smul_unit_sub_ne_top [Nontrivial X] {x : X} + (hx_nonneg : 0 ≤ x) (hx_ne : x ≠ 0) : + OrderIdeal.principal ((‖x‖ : ℝ) • AMSpaceWithUnit.unit - x) ≠ ⊤ := by + classical + rw [ne_eq, top_iff_unit_mem] + intro hunit + rw [OrderIdeal.mem_principal] at hunit + obtain ⟨c, hc_nonneg, hc_le⟩ := hunit + have ha_nonneg : 0 ≤ (‖x‖ : ℝ) • (AMSpaceWithUnit.unit : X) - x := + sub_nonneg.mpr (le_norm_smul_unit x) + rw [abs_of_nonneg (unit_nonneg (X := X)), abs_of_nonneg ha_nonneg] at hc_le + rcases eq_or_lt_of_le hc_nonneg with hc_zero | hc_pos + · rw [← hc_zero, zero_smul] at hc_le + exact unit_ne_zero X (le_antisymm hc_le (unit_nonneg (X := X))) + · have hinv_pos : 0 < 1 / c := one_div_pos.mpr hc_pos + have hscaled : (1 / c) • (AMSpaceWithUnit.unit : X) ≤ + (‖x‖ : ℝ) • AMSpaceWithUnit.unit - x := by + have h := smul_le_smul_of_nonneg_left hc_le hinv_pos.le + rw [smul_smul, one_div, inv_mul_cancel₀ (ne_of_gt hc_pos), one_smul] at h + simpa [one_div] using h + have hx_le : x ≤ (‖x‖ - 1 / c : ℝ) • (AMSpaceWithUnit.unit : X) := by + have h := add_le_add_left hscaled x + have hright : ((‖x‖ : ℝ) • AMSpaceWithUnit.unit - x) + x = + (‖x‖ : ℝ) • AMSpaceWithUnit.unit := by abel + rw [hright] at h + have h' := sub_le_sub_right h ((1 / c) • (AMSpaceWithUnit.unit : X)) + have hleft' : (1 / c) • (AMSpaceWithUnit.unit : X) + x - + (1 / c) • AMSpaceWithUnit.unit = x := by abel + have hright' : (‖x‖ : ℝ) • (AMSpaceWithUnit.unit : X) - + (1 / c) • (AMSpaceWithUnit.unit : X) = + (‖x‖ - 1 / c : ℝ) • (AMSpaceWithUnit.unit : X) := by + rw [sub_smul] + rwa [hleft', hright'] at h' + have hcoeff_nonneg : 0 ≤ ‖x‖ - 1 / c := by + by_contra hneg + push Not at hneg + have hsmul_nonpos : (‖x‖ - 1 / c : ℝ) • (AMSpaceWithUnit.unit : X) ≤ 0 := + smul_nonpos_of_nonpos_of_nonneg hneg.le (unit_nonneg (X := X)) + have hx_zero : x = 0 := le_antisymm (hx_le.trans hsmul_nonpos) hx_nonneg + exact hx_ne hx_zero + have hnorm_le : ‖x‖ ≤ ‖x‖ - 1 / c := by + calc + ‖x‖ = OrderIdeal.gaugeNorm (AMSpaceWithUnit.unit : X) x := + AMSpaceWithUnit.norm_eq_gaugeNorm x + _ ≤ ‖x‖ - 1 / c := by + apply OrderIdeal.gaugeNorm_le_of_abs_le _ hcoeff_nonneg + rwa [abs_of_nonneg hx_nonneg, abs_of_nonneg (unit_nonneg (X := X))] + linarith [hinv_pos] + +/-- Every positive element of a non-trivial AM-space with unit attains its norm +at a lattice character. -/ +theorem exists_apply_eq_norm_of_nonneg [Nontrivial X] {x : X} (hx : 0 ≤ x) : + ∃ φ : LatticeCharacter X, φ x = ‖x‖ := by + by_cases hx_zero : x = 0 + · obtain ⟨φ⟩ := exists_character X + refine ⟨φ, ?_⟩ + rw [hx_zero] + change φ.toVecLatHom 0 = ‖(0 : X)‖ + rw [map_zero, norm_zero] + · let a : X := (‖x‖ : ℝ) • AMSpaceWithUnit.unit - x + have hproper : OrderIdeal.principal a ≠ ⊤ := by + dsimp [a] + exact principal_norm_smul_unit_sub_ne_top (X := X) hx hx_zero + obtain ⟨M, haM, hMne, hMmax⟩ := exists_le_maximal (OrderIdeal.principal a) hproper + let φ := ofMaximalIdeal M hMmax hMne + refine ⟨φ, ?_⟩ + have ha_mem : a ∈ M := haM (OrderIdeal.self_mem_principal a) + have hφa : charValue M a = 0 := + charValue_eq_zero_of_mem M hMmax hMne ha_mem + have hφ_apply : ∀ y : X, φ y = charValue M y := fun _ => rfl + have hlinear : charValue M a = ‖x‖ - charValue M x := by + dsimp [a] + rw [show ((‖x‖ : ℝ) • AMSpaceWithUnit.unit - x : X) = + (‖x‖ : ℝ) • AMSpaceWithUnit.unit + (-x) from sub_eq_add_neg _ _, + charValue_add M hMmax hMne, + charValue_smul M hMmax hMne, + charValue_unit M hMmax hMne, + show (-x : X) = (-1 : ℝ) • x from by rw [neg_smul, one_smul], + charValue_smul M hMmax hMne] + ring + rw [hφ_apply x] + linarith + +/-- Every element of a non-trivial AM-space with unit attains its norm in +absolute value at a lattice character. -/ +theorem exists_abs_apply_eq_norm [Nontrivial X] (x : X) : + ∃ φ : LatticeCharacter X, |φ x| = ‖x‖ := by + obtain ⟨φ, hφ⟩ := exists_apply_eq_norm_of_nonneg (X := X) (x := |x|) (abs_nonneg x) + refine ⟨φ, ?_⟩ + rw [show |φ x| = φ |x| from (φ.toVecLatHom.map_abs x).symm, hφ, norm_abs_eq_norm] + +end LatticeCharacter + +end AMSpaceWithUnit diff --git a/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Kakutani.lean b/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Kakutani.lean new file mode 100644 index 0000000000..f8fceced6b --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Kakutani.lean @@ -0,0 +1,235 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.FBLOrderContinuity.BanLat.AMSpace.Characters +public import LeanPool.FBLOrderContinuity.BanLat.Convergences.Uniform +public import LeanPool.OrderClosures.BanLat.Examples.CofK.Basic +public import Mathlib.Topology.ContinuousMap.StoneWeierstrass + + + +/-! +# Kakutani's representation theorem for AM-spaces with unit + +This file proves the Bohnenblust--Kakutani--Krein representation theorem: +every non-trivial AM-space with unit is Banach-lattice isomorphic to the space +of continuous real-valued functions on its compact character space. +-/ + +@[expose] public section + +namespace AMSpaceWithUnit + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [AMSpaceWithUnit X] + +/-- The **Gelfand transform** sends an element `x : X` to the continuous +function `φ ↦ φ x` on the character space. -/ +noncomputable def gelfand (x : X) : C(LatticeCharacter X, ℝ) where + toFun φ := φ x + continuous_toFun := LatticeCharacter.continuous_eval X x + +@[simp] theorem gelfand_apply (x : X) (φ : LatticeCharacter X) : + gelfand x φ = φ x := rfl + +@[simp] theorem gelfand_unit : + gelfand (AMSpaceWithUnit.unit : X) = 1 := by + ext φ + exact φ.map_unit + +/-- The Gelfand transform is a vector lattice homomorphism. -/ +theorem gelfand_isVecLatHom : + IsVecLatHom (gelfand : X → C(LatticeCharacter X, ℝ)) where + map_add x y := by + ext φ + exact map_add φ.toVecLatHom x y + map_smul r x := by + ext φ + exact map_smul φ.toVecLatHom r x + map_sup' x y := by + ext φ + change φ (x ⊔ y) = max (φ x) (φ y) + exact LatticeCharacter.map_sup φ x y + map_inf' x y := by + ext φ + change φ (x ⊓ y) = min (φ x) (φ y) + exact LatticeCharacter.map_inf φ x y + +/-- The Gelfand transform preserves norms. -/ +theorem norm_gelfand [Nontrivial X] (x : X) : + ‖(gelfand x : C(LatticeCharacter X, ℝ))‖ = ‖x‖ := by + have : Nonempty (LatticeCharacter X) := by + obtain ⟨φ, _⟩ := LatticeCharacter.exists_abs_apply_eq_norm (X := X) x + exact ⟨φ⟩ + apply le_antisymm + · rw [ContinuousMap.norm_eq_iSup_norm] + apply ciSup_le + intro φ + rw [gelfand_apply, Real.norm_eq_abs] + exact φ.abs_apply_le_norm x + · obtain ⟨φ, hφ⟩ := LatticeCharacter.exists_abs_apply_eq_norm (X := X) x + calc + ‖x‖ = |φ x| := hφ.symm + _ = ‖gelfand x φ‖ := by simp [gelfand_apply, Real.norm_eq_abs] + _ ≤ ‖(gelfand x : C(LatticeCharacter X, ℝ))‖ := + ContinuousMap.norm_coe_le_norm _ _ + +/-- The Gelfand transform is an isometry. -/ +theorem gelfand_isometry [Nontrivial X] : + Isometry (gelfand : X → C(LatticeCharacter X, ℝ)) := by + refine Isometry.of_dist_eq fun x y => ?_ + rw [dist_eq_norm, dist_eq_norm] + have h1 : gelfand x - gelfand y = gelfand (x - y) := by + have h2 : gelfand (x - y) + gelfand y = gelfand x := by + rw [← gelfand_isVecLatHom.map_add, sub_add_cancel] + rw [← h2] + abel + rw [h1, norm_gelfand] + +/-- The Gelfand transform is surjective. -/ +theorem gelfand_surjective [Nontrivial X] : + Function.Surjective (gelfand : X → C(LatticeCharacter X, ℝ)) := by + set L : Set C(LatticeCharacter X, ℝ) := Set.range gelfand with hL_def + have hL_inf : ∀ f ∈ L, ∀ g ∈ L, f ⊓ g ∈ L := by + rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ + exact ⟨x ⊓ y, gelfand_isVecLatHom.map_inf' x y⟩ + have hL_sup : ∀ f ∈ L, ∀ g ∈ L, f ⊔ g ∈ L := by + rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ + exact ⟨x ⊔ y, gelfand_isVecLatHom.map_sup' x y⟩ + have hL_ne : L.Nonempty := ⟨gelfand 0, 0, rfl⟩ + have hL_sep : L.SeparatesPointsStrongly := by + intro v φ ψ + by_cases hφψ : φ = ψ + · subst hφψ + refine ⟨gelfand ((v φ) • AMSpaceWithUnit.unit), ⟨(v φ) • AMSpaceWithUnit.unit, rfl⟩, + ?_, ?_⟩ + · change φ ((v φ) • AMSpaceWithUnit.unit) = v φ + have h1 : φ ((v φ) • (AMSpaceWithUnit.unit : X)) = + (v φ) * φ (AMSpaceWithUnit.unit : X) := map_smul φ.toVecLatHom _ _ + rw [h1, φ.map_unit_apply, mul_one] + · change φ ((v φ) • AMSpaceWithUnit.unit) = v φ + have h1 : φ ((v φ) • (AMSpaceWithUnit.unit : X)) = + (v φ) * φ (AMSpaceWithUnit.unit : X) := map_smul φ.toVecLatHom _ _ + rw [h1, φ.map_unit_apply, mul_one] + · have hex : ∃ x : X, φ x ≠ ψ x := by + by_contra h + push Not at h + apply hφψ + exact DFunLike.ext _ _ h + obtain ⟨x, hx⟩ := hex + set d := φ x - ψ x with hd_def + have hd_ne : d ≠ 0 := sub_ne_zero.mpr hx + set α := (v φ - v ψ) / d with hα_def + set β := v φ - α * φ x with hβ_def + refine ⟨gelfand (α • x + β • AMSpaceWithUnit.unit), + ⟨α • x + β • AMSpaceWithUnit.unit, rfl⟩, ?_, ?_⟩ + · change φ (α • x + β • AMSpaceWithUnit.unit) = v φ + have h1 : φ (α • x + β • (AMSpaceWithUnit.unit : X)) = + α * φ x + β * φ (AMSpaceWithUnit.unit : X) := by + rw [show φ (α • x + β • (AMSpaceWithUnit.unit : X)) = + φ (α • x) + φ (β • AMSpaceWithUnit.unit) from map_add φ.toVecLatHom _ _] + rw [show φ (α • x) = α * φ x from map_smul φ.toVecLatHom _ _] + rw [show φ (β • (AMSpaceWithUnit.unit : X)) = + β * φ (AMSpaceWithUnit.unit : X) from map_smul φ.toVecLatHom _ _] + rw [h1, φ.map_unit_apply, mul_one, hβ_def] + ring + · change ψ (α • x + β • AMSpaceWithUnit.unit) = v ψ + have h1 : ψ (α • x + β • (AMSpaceWithUnit.unit : X)) = + α * ψ x + β * ψ (AMSpaceWithUnit.unit : X) := by + rw [show ψ (α • x + β • (AMSpaceWithUnit.unit : X)) = + ψ (α • x) + ψ (β • AMSpaceWithUnit.unit) from map_add ψ.toVecLatHom _ _] + rw [show ψ (α • x) = α * ψ x from map_smul ψ.toVecLatHom _ _] + rw [show ψ (β • (AMSpaceWithUnit.unit : X)) = + β * ψ (AMSpaceWithUnit.unit : X) from map_smul ψ.toVecLatHom _ _] + rw [h1, ψ.map_unit_apply, mul_one] + have key : α * (φ x - ψ x) = v φ - v ψ := by + rw [hα_def, ← hd_def] + field_simp + rw [hβ_def] + linarith [key] + have hL_closure : closure L = Set.univ := + ContinuousMap.sublattice_closure_eq_top L hL_ne hL_inf hL_sup hL_sep + have hL_closed : IsClosed L := (gelfand_isometry (X := X)).isClosedEmbedding.isClosed_range + rw [hL_closed.closure_eq] at hL_closure + intro f + exact (Set.eq_univ_iff_forall.mp hL_closure f) + +variable (X) + +/-- The Gelfand transform as a real-linear map. -/ +noncomputable def gelfandLinear : + X →ₗ[ℝ] C(LatticeCharacter X, ℝ) where + toFun := gelfand + map_add' := gelfand_isVecLatHom.map_add + map_smul' := gelfand_isVecLatHom.map_smul + +/-- The Gelfand transform as a real-linear isometry. -/ +noncomputable def gelfandLinearIsometry [Nontrivial X] : + X →ₗᵢ[ℝ] C(LatticeCharacter X, ℝ) where + toLinearMap := gelfandLinear (X := X) + norm_map' := norm_gelfand + +/-- **Kakutani's representation theorem** for non-trivial AM-spaces with unit. -/ +noncomputable def kakutaniEquiv [Nontrivial X] : + BanachLatEquiv X C(LatticeCharacter X, ℝ) where + toLinearIsometryEquiv := + LinearIsometryEquiv.ofSurjective (gelfandLinearIsometry (X := X)) + (gelfand_surjective (X := X)) + map_sup' := fun a b => gelfand_isVecLatHom.map_sup' a b + map_inf' := fun a b => gelfand_isVecLatHom.map_inf' a b + +@[simp] theorem kakutaniEquiv_apply [Nontrivial X] (x : X) (φ : LatticeCharacter X) : + kakutaniEquiv X x φ = φ x := by + rfl + +/-- Under the Kakutani isomorphism, the unit corresponds to the constant +function `1`. -/ +theorem kakutaniEquiv_unit [Nontrivial X] : + kakutaniEquiv X (AMSpaceWithUnit.unit : X) = 1 := by + ext φ + rw [kakutaniEquiv_apply] + exact φ.map_unit + +end AMSpaceWithUnit + +namespace OrderIdeal + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +/-- In a uniformly complete vector lattice, every nonzero positive principal +ideal, equipped with its gauge norm and inherited vector lattice structure, is +lattice isometric to continuous functions on a compact space. -/ +noncomputable def principalKakutaniEquiv + [IsUniformlyCompleteVectorLattice X] {e : X} (he : 0 < e) : + letI := principalNormedAddCommGroup e + letI : Lattice ↥(principal e) := instLatticePrincipal e + letI : IsOrderedAddMonoid ↥(principal e) := instIsOrderedAddMonoidPrincipal e + letI : AMSpaceWithUnit ↥(principal e) := + principalAMSpaceWithUnit he.le + (IsUniformlyCompleteVectorLattice.complete_principal e he) + BanachLatEquiv ↥(principal e) + C(AMSpaceWithUnit.LatticeCharacter ↥(principal e), ℝ) := by + letI := principalNormedAddCommGroup e + letI : Lattice ↥(principal e) := instLatticePrincipal e + letI : IsOrderedAddMonoid ↥(principal e) := instIsOrderedAddMonoidPrincipal e + letI : AMSpaceWithUnit ↥(principal e) := + principalAMSpaceWithUnit he.le + (IsUniformlyCompleteVectorLattice.complete_principal e he) + haveI : Nontrivial ↥(principal e) := by + refine ⟨⟨0, ⟨e, self_mem_principal e⟩, ?_⟩⟩ + intro h + exact (ne_of_gt he) (by simpa using (congrArg Subtype.val h).symm) + exact AMSpaceWithUnit.kakutaniEquiv ↥(principal e) + +end OrderIdeal diff --git a/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Maximal.lean b/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Maximal.lean new file mode 100644 index 0000000000..537e0d5901 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/AMSpace/Maximal.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.AMSpace.Basic +public import Mathlib.Order.Zorn + + + +/-! +# Maximal ideals in AM-spaces with unit + +This file proves that every proper order ideal in an AM-space with unit is +contained in a maximal proper order ideal. +-/ + +@[expose] public section + +namespace AMSpaceWithUnit + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [AMSpaceWithUnit X] + +/-- An ideal in an AM-space with unit is the whole space iff it contains the +distinguished unit. -/ +theorem top_iff_unit_mem (I : OrderIdeal X) : + I = ⊤ ↔ (AMSpaceWithUnit.unit : X) ∈ I := by + constructor + · intro h + rw [h] + exact OrderIdeal.mem_top + · intro hunit + have hprincipal_le : OrderIdeal.principal (AMSpaceWithUnit.unit : X) ≤ I := by + intro x hx + rw [OrderIdeal.mem_principal] at hx + obtain ⟨c, hc, hxle⟩ := hx + have hcunit : c • (AMSpaceWithUnit.unit : X) ∈ I := + I.toSubmodule.smul_mem c hunit + have hxle' : |x| ≤ c • (AMSpaceWithUnit.unit : X) := by + simpa [abs_of_nonneg (unit_nonneg (X := X))] using hxle + exact I.mem_of_abs_mem (I.solid hcunit (abs_nonneg x) hxle') + exact le_antisymm le_top (by + rw [← principal_unit_eq_top (X := X)] + exact hprincipal_le) + +private theorem directedOn_toSubmodule_of_chain {c : Set (OrderIdeal X)} + (hchain : IsChain (· ≤ ·) c) : + DirectedOn (· ≤ ·) ((fun J : OrderIdeal X => J.toSubmodule) '' c) := by + rintro _ ⟨J₁, hJ₁, rfl⟩ _ ⟨J₂, hJ₂, rfl⟩ + by_cases heq : J₁ = J₂ + · exact ⟨J₁.toSubmodule, ⟨J₁, hJ₁, rfl⟩, le_refl _, heq ▸ le_refl _⟩ + · rcases hchain hJ₁ hJ₂ heq with h | h + · exact ⟨J₂.toSubmodule, ⟨J₂, hJ₂, rfl⟩, fun _ hx => h hx, le_refl _⟩ + · exact ⟨J₁.toSubmodule, ⟨J₁, hJ₁, rfl⟩, le_refl _, fun _ hx => h hx⟩ + +/-- **Every proper order ideal is contained in a maximal proper order ideal.** +This is the usual Zorn lemma argument applied to the poset of proper order +ideals containing the given ideal. -/ +theorem exists_le_maximal (I : OrderIdeal X) (hI : I ≠ ⊤) : + ∃ M : OrderIdeal X, I ≤ M ∧ M ≠ ⊤ ∧ + ∀ J : OrderIdeal X, M ≤ J → J ≠ ⊤ → J = M := by + classical + set S : Set (OrderIdeal X) := {J | I ≤ J ∧ J ≠ ⊤} with hS_def + have hIS : I ∈ S := ⟨le_refl _, hI⟩ + have hzorn : ∀ c ⊆ S, IsChain (· ≤ ·) c → ∀ y ∈ c, + ∃ ub ∈ S, ∀ z ∈ c, z ≤ ub := by + intro c hcS hchain y hyc + set SM : Set (Submodule ℝ X) := + (fun J : OrderIdeal X => J.toSubmodule) '' c with hSM_def + have hSMne : SM.Nonempty := ⟨y.toSubmodule, y, hyc, rfl⟩ + have hdir : DirectedOn (· ≤ ·) SM := directedOn_toSubmodule_of_chain hchain + refine ⟨OrderIdeal.ofSolid (sSup SM) ?_, ⟨?_, ?_⟩, ?_⟩ + · intro x w hx hxw + rw [Submodule.mem_sSup_of_directed hSMne hdir] at hx + obtain ⟨_, ⟨J, hJ, rfl⟩, hxJ⟩ := hx + rw [Submodule.mem_sSup_of_directed hSMne hdir] + exact ⟨J.toSubmodule, ⟨J, hJ, rfl⟩, J.mem_of_abs_le_abs hxJ hxw⟩ + · change I.toSubmodule ≤ sSup SM + exact le_trans (fun _ hx => (hcS hyc).1 hx) (le_sSup ⟨y, hyc, rfl⟩) + · intro hU_top + have hmem : (AMSpaceWithUnit.unit : X) ∈ sSup SM := by + have : (AMSpaceWithUnit.unit : X) ∈ (⊤ : OrderIdeal X) := OrderIdeal.mem_top + rw [← hU_top] at this + exact this + rw [Submodule.mem_sSup_of_directed hSMne hdir] at hmem + obtain ⟨_, ⟨J, hJ, rfl⟩, heJ⟩ := hmem + exact (hcS hJ).2 ((top_iff_unit_mem J).mpr heJ) + · intro J hJ + change J.toSubmodule ≤ sSup SM + exact le_sSup ⟨J, hJ, rfl⟩ + obtain ⟨M, hIM, hMax⟩ := zorn_le_nonempty₀ S hzorn I hIS + refine ⟨M, hIM, hMax.prop.2, ?_⟩ + intro J hMJ hJne + have hJS : J ∈ S := ⟨le_trans hIM hMJ, hJne⟩ + exact hMax.eq_of_ge hJS hMJ + +end AMSpaceWithUnit diff --git a/LeanPool/FBLOrderContinuity/BanLat/Convergences/Uniform.lean b/LeanPool/FBLOrderContinuity/BanLat/Convergences/Uniform.lean new file mode 100644 index 0000000000..d0725603f6 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Convergences/Uniform.lean @@ -0,0 +1,362 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Substructures.Ideal +public import LeanPool.OrderClosures.BanLat.OrderComplete + + + +/-! +# Uniform completeness + +This file introduces uniformly complete vector lattices. The definition is +given in terms of completeness of principal ideals for their gauge norms, and +the basic permanence facts relate uniform completeness to σ-order completeness +and Banach lattice completeness. +-/ + +@[expose] public section + +/-- A vector lattice is **uniformly complete** if it is Archimedean and every +principal ideal generated by a non-zero positive element is complete for its +gauge norm. The omitted zero principal ideal is trivial. -/ +class IsUniformlyCompleteVectorLattice (X : Type*) [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] : Prop extends IsVLArchimedean X where + complete_principal : + ∀ (e : X) (_he : 0 < e), + letI : IsVLArchimedean X := toIsVLArchimedean + letI := OrderIdeal.principalNormedAddCommGroup e + CompleteSpace ↥(OrderIdeal.principalSubmodule e) + +private theorem abs_sub_le_of_gauge_le {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] [IsVLArchimedean X] + {e x y : X} (he : 0 ≤ e) (hx : x ∈ OrderIdeal.principal e) + (hy : y ∈ OrderIdeal.principal e) {c : ℝ} + (hxy : OrderIdeal.gaugeNorm e (x - y) ≤ c) : + |x - y| ≤ c • e := by + calc |x - y| + ≤ OrderIdeal.gaugeNorm e (x - y) • |e| := + OrderIdeal.abs_le_gaugeNorm_smul_abs e ((OrderIdeal.principal e).toSubmodule.sub_mem hx hy) + _ ≤ c • |e| := smul_le_smul_of_nonneg_right hxy (abs_nonneg e) + _ = c • e := by rw [abs_of_nonneg he] + +private theorem norm_coe_le_norm_generator_mul_gauge {X : Type*} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [BanachLattice X] {e : X} (x : ↥(OrderIdeal.principalSubmodule e)) : + ‖(x : X)‖ ≤ ‖e‖ * OrderIdeal.gaugeNorm e (x : X) := by + have hnonneg : 0 ≤ OrderIdeal.gaugeNorm e (x : X) := + OrderIdeal.gaugeNorm_nonneg e (x : X) + calc ‖(x : X)‖ + ≤ ‖OrderIdeal.gaugeNorm e (x : X) • |e|‖ := by + apply norm_le_norm_of_abs_le_abs + rw [abs_of_nonneg (smul_nonneg hnonneg (abs_nonneg e))] + exact OrderIdeal.abs_le_gaugeNorm_smul_abs e x.2 + _ = ‖OrderIdeal.gaugeNorm e (x : X)‖ * ‖|e|‖ := norm_smul _ _ + _ = ‖e‖ * OrderIdeal.gaugeNorm e (x : X) := by + rw [Real.norm_of_nonneg hnonneg, norm_abs_eq_norm, mul_comm] + +private theorem norm_principal_eq_gauge {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] [IsVLArchimedean X] + {e : X} (x : ↥(OrderIdeal.principalSubmodule e)) : + letI := OrderIdeal.principalNormedAddCommGroup e + ‖x‖ = OrderIdeal.gaugeNorm e (x : X) := by + let := OrderIdeal.principalNormedAddCommGroup e + rfl + +private theorem dist_principal_eq_gauge {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] [IsVLArchimedean X] + {e : X} (x y : ↥(OrderIdeal.principalSubmodule e)) : + letI := OrderIdeal.principalNormedAddCommGroup e + letI : PseudoMetricSpace ↥(OrderIdeal.principalSubmodule e) := + @SeminormedAddCommGroup.toPseudoMetricSpace _ + (@NormedAddCommGroup.toSeminormedAddCommGroup _ + (OrderIdeal.principalNormedAddCommGroup e)) + dist x y = OrderIdeal.gaugeNorm e ((x : X) - (y : X)) := by + let := OrderIdeal.principalNormedAddCommGroup e + let : PseudoMetricSpace ↥(OrderIdeal.principalSubmodule e) := + @SeminormedAddCommGroup.toPseudoMetricSpace _ + (@NormedAddCommGroup.toSeminormedAddCommGroup _ + (OrderIdeal.principalNormedAddCommGroup e)) + calc + dist x y = ‖x - y‖ := @dist_eq_norm _ + (@NormedAddCommGroup.toSeminormedAddCommGroup _ + (OrderIdeal.principalNormedAddCommGroup e)) x y + _ = OrderIdeal.gaugeNorm e ((x : X) - (y : X)) := norm_principal_eq_gauge (x - y) + +private theorem completeSpace_principal_of_banachLattice {X : Type*} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [BanachLattice X] (e : X) (he : 0 < e) : + @CompleteSpace ↥(OrderIdeal.principalSubmodule e) + (@PseudoMetricSpace.toUniformSpace _ + (@SeminormedAddCommGroup.toPseudoMetricSpace _ + (@NormedAddCommGroup.toSeminormedAddCommGroup _ + (OrderIdeal.principalNormedAddCommGroup e)))) := by + let := OrderIdeal.principalNormedAddCommGroup e + let Y := ↥(OrderIdeal.principalSubmodule e) + let : PseudoMetricSpace Y := + @SeminormedAddCommGroup.toPseudoMetricSpace Y + (@NormedAddCommGroup.toSeminormedAddCommGroup Y + (OrderIdeal.principalNormedAddCommGroup e)) + refine Metric.complete_of_cauchySeq_tendsto (α := Y) fun u hu => ?_ + have hnorme_pos : 0 < ‖e‖ := norm_pos_iff.mpr (ne_of_gt he) + have hu_ambient : CauchySeq (fun n => (u n : X)) := by + rw [Metric.cauchySeq_iff] at hu ⊢ + intro ε hε + obtain ⟨N, hN⟩ := hu (ε / ‖e‖) (div_pos hε hnorme_pos) + refine ⟨N, fun n hn m hm => ?_⟩ + have hdist := hN n hn m hm + have hdist_gauge : OrderIdeal.gaugeNorm e ((u n : X) - (u m : X)) < ε / ‖e‖ := by + have heq : dist (u n) (u m) = + OrderIdeal.gaugeNorm e ((u n : X) - (u m : X)) := by + simpa only using (dist_principal_eq_gauge (u n) (u m)) + rw [heq] at hdist + exact hdist + rw [dist_eq_norm] + have hle : ‖(u n : X) - (u m : X)‖ ≤ + ‖e‖ * OrderIdeal.gaugeNorm e ((u n : X) - (u m : X)) := by + exact norm_coe_le_norm_generator_mul_gauge (e := e) (u n - u m) + have hmul : ‖e‖ * OrderIdeal.gaugeNorm e ((u n : X) - (u m : X)) < + ‖e‖ * (ε / ‖e‖) := + mul_lt_mul_of_pos_left hdist_gauge hnorme_pos + have htarget : ‖e‖ * (ε / ‖e‖) = ε := by + field_simp [ne_of_gt hnorme_pos] + exact hle.trans_lt (by rwa [htarget] at hmul) + obtain ⟨x, hx_tend⟩ := cauchySeq_tendsto_of_complete hu_ambient + have hx_mem : x ∈ OrderIdeal.principalSubmodule e := by + rw [Metric.cauchySeq_iff] at hu + obtain ⟨N, hN⟩ := hu 1 zero_lt_one + have htail : ∀ᶠ n in Filter.atTop, + |(u n : X) - (u N : X)| ≤ (1 : ℝ) • e := by + filter_upwards [Filter.eventually_atTop.mpr ⟨N, fun n hn => hn⟩] with n hn + have hdist := hN n hn N le_rfl + exact abs_sub_le_of_gauge_le he.le (u n).2 (u N).2 (le_of_lt (by + have heq : dist (u n) (u N) = + OrderIdeal.gaugeNorm e ((u n : X) - (u N : X)) := by + simpa only using (dist_principal_eq_gauge (u n) (u N)) + rw [heq] at hdist + exact hdist)) + have hlim : + |x - (u N : X)| ≤ (1 : ℝ) • e := by + have hdiff_tend : + Filter.Tendsto (fun n => (u n : X) - (u N : X)) Filter.atTop + (nhds (x - (u N : X))) := + hx_tend.sub tendsto_const_nhds + have habs_tend : + Filter.Tendsto (fun n => |(u n : X) - (u N : X)|) Filter.atTop + (nhds |x - (u N : X)|) := + (NormedVectorLattice.lipschitzWith_abs.continuous.tendsto _).comp hdiff_tend + exact le_of_tendsto_of_tendsto habs_tend tendsto_const_nhds (by + filter_upwards [htail] with n hn + simpa [show x - (u N : X) = x - (u N : X) from rfl] using hn) + have hdiff_mem : x - (u N : X) ∈ OrderIdeal.principal e := + ⟨1, zero_le_one, by simpa [abs_of_nonneg he.le] using hlim⟩ + have hadd_mem : + (x - (u N : X)) + (u N : X) ∈ OrderIdeal.principalSubmodule e := + (OrderIdeal.principal e).toSubmodule.add_mem hdiff_mem (u N).2 + simpa using hadd_mem + refine ⟨⟨x, hx_mem⟩, ?_⟩ + rw [Metric.tendsto_atTop] + intro ε hε + rw [Metric.cauchySeq_iff] at hu + obtain ⟨N, hN⟩ := hu (ε / 2) (by linarith) + refine ⟨N, fun n hn => ?_⟩ + have horder : |x - (u n : X)| ≤ (ε / 2) • e := by + have htail : ∀ᶠ m in Filter.atTop, + |(u m : X) - (u n : X)| ≤ (ε / 2) • e := by + filter_upwards [Filter.eventually_atTop.mpr ⟨N, fun m hm => hm⟩] with m hm + have hdist := hN m hm n hn + exact abs_sub_le_of_gauge_le he.le (u m).2 (u n).2 (le_of_lt (by + have heq : dist (u m) (u n) = + OrderIdeal.gaugeNorm e ((u m : X) - (u n : X)) := by + simpa only using (dist_principal_eq_gauge (u m) (u n)) + rw [heq] at hdist + exact hdist)) + have hdiff_tend : + Filter.Tendsto (fun m => (u m : X) - (u n : X)) Filter.atTop + (nhds (x - (u n : X))) := + hx_tend.sub tendsto_const_nhds + have habs_tend : + Filter.Tendsto (fun m => |(u m : X) - (u n : X)|) Filter.atTop + (nhds |x - (u n : X)|) := + (NormedVectorLattice.lipschitzWith_abs.continuous.tendsto _).comp hdiff_tend + exact le_of_tendsto_of_tendsto habs_tend tendsto_const_nhds htail + have hgauge : OrderIdeal.gaugeNorm e ((u n : X) - x) ≤ ε / 2 := by + rw [show (u n : X) - x = -(x - (u n : X)) by abel, OrderIdeal.gaugeNorm_neg] + exact OrderIdeal.gaugeNorm_le_of_abs_le e (by linarith) (by + simpa [abs_of_nonneg he.le] using horder) + have hgauge_lt : OrderIdeal.gaugeNorm e ((u n : X) - x) < ε := by + linarith + have heq : dist (u n) ⟨x, hx_mem⟩ = + OrderIdeal.gaugeNorm e ((u n : X) - x) := by + simpa only using (dist_principal_eq_gauge (u n) ⟨x, hx_mem⟩) + rw [heq] + exact hgauge_lt + +private theorem completeSpace_principal_of_sigmaConditionallyCompleteLattice {X : Type*} + [AddCommGroup X] [SigmaConditionallyCompleteLattice X] + [IsOrderedAddMonoid X] [VectorLattice X] (e : X) (he : 0 < e) : + letI : IsVLArchimedean X := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + @CompleteSpace ↥(OrderIdeal.principalSubmodule e) + (@PseudoMetricSpace.toUniformSpace _ + (@SeminormedAddCommGroup.toPseudoMetricSpace _ + (@NormedAddCommGroup.toSeminormedAddCommGroup _ + (OrderIdeal.principalNormedAddCommGroup e)))) := by + let : IsVLArchimedean X := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + let := OrderIdeal.principalNormedAddCommGroup e + let Y := ↥(OrderIdeal.principalSubmodule e) + let : PseudoMetricSpace Y := + @SeminormedAddCommGroup.toPseudoMetricSpace Y + (@NormedAddCommGroup.toSeminormedAddCommGroup Y + (OrderIdeal.principalNormedAddCommGroup e)) + let b : ℕ → ℝ := fun n => (1 / 2 : ℝ) ^ n + let r : ℕ → ℝ := fun n => 2 * b n + have hb_pos : ∀ n, 0 < b n := fun n => pow_pos (by norm_num) n + have hb_nonneg : ∀ n, 0 ≤ b n := fun n => (hb_pos n).le + have hr_nonneg : ∀ n, 0 ≤ r n := fun n => mul_nonneg (by norm_num) (hb_nonneg n) + have hr_succ : ∀ n, r n = b n + r (n + 1) := by + intro n + dsimp [r, b] + rw [pow_succ] + ring + refine Metric.complete_of_convergent_controlled_sequences (α := Y) b hb_pos fun u hu => ?_ + let v : ℕ → X := fun n => (u n : X) - r n • e + let w : ℕ → X := fun n => (u n : X) + r n • e + have hstep_abs : ∀ n, |(u n : X) - (u (n + 1) : X)| ≤ b n • e := by + intro n + have hdist := hu n n (n + 1) le_rfl (Nat.le_succ n) + exact abs_sub_le_of_gauge_le he.le (u n).2 (u (n + 1)).2 (le_of_lt (by + have heq : dist (u n) (u (n + 1)) = + OrderIdeal.gaugeNorm e ((u n : X) - (u (n + 1) : X)) := by + simpa only using (dist_principal_eq_gauge (u n) (u (n + 1))) + rw [heq] at hdist + exact hdist)) + have hv_mono : Monotone v := by + refine monotone_nat_of_le_succ fun n => ?_ + have hdiff : (u n : X) - (u (n + 1) : X) ≤ b n • e := + (le_abs_self _).trans (hstep_abs n) + have hu_le : (u n : X) ≤ b n • e + (u (n + 1) : X) := + sub_le_iff_le_add.mp hdiff + calc v n + ≤ (b n • e + (u (n + 1) : X)) - r n • e := sub_le_sub_right hu_le _ + _ = v (n + 1) := by + dsimp [v] + rw [hr_succ n, add_smul] + abel + have hw_anti : Antitone w := by + refine antitone_nat_of_succ_le fun n => ?_ + have hdiff : (u (n + 1) : X) - (u n : X) ≤ b n • e := by + calc (u (n + 1) : X) - (u n : X) + = -((u n : X) - (u (n + 1) : X)) := by abel + _ ≤ |(u n : X) - (u (n + 1) : X)| := neg_le_abs _ + _ ≤ b n • e := hstep_abs n + have hu_le : (u (n + 1) : X) ≤ b n • e + (u n : X) := + sub_le_iff_le_add.mp hdiff + calc w (n + 1) + = (u (n + 1) : X) + r (n + 1) • e := rfl + _ ≤ (b n • e + (u n : X)) + r (n + 1) • e := + add_le_add hu_le le_rfl + _ = w n := by + dsimp [w] + rw [hr_succ n, add_smul] + abel + have hv_le_w : ∀ n, v n ≤ w n := by + intro n + dsimp [v, w] + rw [sub_eq_add_neg] + exact add_le_add (le_refl (u n : X)) + ((neg_nonpos.mpr (smul_nonneg (hr_nonneg n) he.le)).trans + (smul_nonneg (hr_nonneg n) he.le)) + have hv_bdd : BddAbove (Set.range v) := + ⟨w 0, by + rintro _ ⟨n, rfl⟩ + exact (hv_le_w n).trans (hw_anti (Nat.zero_le n))⟩ + let x := sSup (Set.range v) + have hv_lub : IsLUB (Set.range v) x := + ⟨fun _ hy => SigmaConditionallyCompleteLattice.le_csSup _ _ (Set.countable_range _) + hv_bdd hy, + fun _ hy => SigmaConditionallyCompleteLattice.csSup_le _ _ (Set.countable_range _) + (Set.range_nonempty _) hy⟩ + have hw_upper : ∀ n, w n ∈ upperBounds (Set.range v) := by + intro n _ hm + rcases hm with ⟨m, rfl⟩ + by_cases hmn : m ≤ n + · exact (hv_mono hmn).trans (hv_le_w n) + · exact (hv_le_w m).trans (hw_anti (le_of_not_ge hmn)) + have hx_le_w : ∀ n, x ≤ w n := fun n => hv_lub.2 (hw_upper n) + have hdist_order : ∀ n, |(u n : X) - x| ≤ r n • e := by + intro n + have hleft : (u n : X) - x ≤ r n • e := by + rw [sub_le_iff_le_add] + exact (sub_le_iff_le_add.mp (hv_lub.1 ⟨n, rfl⟩)).trans_eq (add_comm _ _) + have hright : x - (u n : X) ≤ r n • e := by + rw [sub_le_iff_le_add] + exact (hx_le_w n).trans_eq (add_comm _ _) + rw [abs] + refine sup_le hleft ?_ + calc -((u n : X) - x) + = x - (u n : X) := by abel + _ ≤ r n • e := hright + have hx_mem : x ∈ OrderIdeal.principalSubmodule e := by + have hdiff_mem : x - (u 0 : X) ∈ OrderIdeal.principal e := by + refine ⟨r 0, hr_nonneg 0, ?_⟩ + rw [abs_of_nonneg he.le] + calc |x - (u 0 : X)| + = |(u 0 : X) - x| := by + rw [show x - (u 0 : X) = -((u 0 : X) - x) by abel, abs_neg] + _ ≤ r 0 • e := hdist_order 0 + have hadd_mem : + (x - (u 0 : X)) + (u 0 : X) ∈ OrderIdeal.principalSubmodule e := + (OrderIdeal.principal e).toSubmodule.add_mem hdiff_mem (u 0).2 + simpa using hadd_mem + refine ⟨⟨x, hx_mem⟩, ?_⟩ + rw [Metric.tendsto_atTop] + intro ε hε + have hr_tend : Filter.Tendsto r Filter.atTop (nhds 0) := by + simpa [r, b] using ((tendsto_pow_atTop_nhds_zero_of_lt_one + (by norm_num : 0 ≤ (1 / 2 : ℝ)) + (by norm_num : (1 / 2 : ℝ) < 1)).const_mul 2) + rw [Metric.tendsto_atTop] at hr_tend + obtain ⟨N, hN⟩ := hr_tend ε hε + refine ⟨N, fun n hn => ?_⟩ + have hr_lt : r n < ε := by + have := hN n hn + rw [dist_eq_norm, Real.norm_eq_abs, sub_zero, abs_of_nonneg (hr_nonneg n)] at this + exact this + have hgauge : OrderIdeal.gaugeNorm e ((u n : X) - x) ≤ r n := + OrderIdeal.gaugeNorm_le_of_abs_le e (hr_nonneg n) (by + simpa [abs_of_nonneg he.le] using hdist_order n) + have hgauge_lt : OrderIdeal.gaugeNorm e ((u n : X) - x) < ε := + hgauge.trans_lt hr_lt + have heq : dist (u n) ⟨x, hx_mem⟩ = + OrderIdeal.gaugeNorm e ((u n : X) - x) := by + simpa only using (dist_principal_eq_gauge (u n) ⟨x, hx_mem⟩) + rw [heq] + exact hgauge_lt + +/-- Every σ-order complete vector lattice is uniformly complete. -/ +theorem isUniformlyCompleteVectorLattice_of_sigmaConditionallyCompleteLattice + (X : Type*) [AddCommGroup X] [SigmaConditionallyCompleteLattice X] + [IsOrderedAddMonoid X] [VectorLattice X] : + IsUniformlyCompleteVectorLattice X := by + let : IsVLArchimedean X := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + exact + { complete_principal := fun e he => + completeSpace_principal_of_sigmaConditionallyCompleteLattice e he } + +/-- Every Banach lattice is uniformly complete. -/ +theorem isUniformlyCompleteVectorLattice_of_banachLattice + (X : Type*) [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [BanachLattice X] : IsUniformlyCompleteVectorLattice X := by + exact + { complete_principal := fun e he => + completeSpace_principal_of_banachLattice e he } diff --git a/LeanPool/FBLOrderContinuity/BanLat/Dual.lean b/LeanPool/FBLOrderContinuity/BanLat/Dual.lean new file mode 100644 index 0000000000..0a4ccffff8 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Dual.lean @@ -0,0 +1,563 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.NormedWeak +public import Mathlib.Analysis.LocallyConvex.SeparatingDual +public import LeanPool.FBLOrderContinuity.BanLat.Operators.Regular +public import LeanPool.FBLOrderContinuity.BanLat.Operators.RieszKantorovich +public import Mathlib.Analysis.Convex.Cone.Dual + + + +/-! +# The order dual and strong dual of a vector or Banach lattice + +The **order dual** `OrderDualSpace X` of a vector lattice `X` is the space of order +bounded real-valued linear functionals on `X`. Since `ℝ` is order complete, the +Riesz–Kantorovich machinery equips it with a canonical order complete vector +lattice structure. The **strong dual** `StrongDual ℝ X` of a normed vector lattice +`X` is the mathlib abbreviation for the space `X →L[ℝ] ℝ` of continuous linear +functionals. For a Banach lattice the two duals coincide as sets — every +continuous functional is order bounded and every order bounded functional is +automatically continuous — and the strong dual inherits the structure of a +Banach lattice. +-/ + +@[expose] public section + +/-! ### The order dual -/ + +/-- The **order dual** of a vector lattice: order bounded real-valued +linear functionals. -/ +abbrev OrderDualSpace (X : Type*) [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] : Type _ := + OrderBoundedHom X ℝ + +namespace OrderDualSpace + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +/-- Order on the order dual: `φ ≤ ψ` iff `φ x ≤ ψ x` for all positive `x`. -/ +theorem le_iff {φ ψ : OrderDualSpace X} : + φ ≤ ψ ↔ ∀ x : X, 0 ≤ x → φ x ≤ ψ x := + OrderBoundedHom.le_iff + +/-- A dual element is positive iff it sends positive elements of `X` to +non-negative reals. -/ +theorem nonneg_iff {φ : OrderDualSpace X} : + 0 ≤ φ ↔ ∀ x : X, 0 ≤ x → 0 ≤ φ x := + OrderBoundedHom.le_iff + +/-- Riesz–Kantorovich: positive part of a dual functional at a positive +element is the supremum of `φ y` over `0 ≤ y ≤ x`. -/ +theorem isLUB_posPart_apply {φ : OrderDualSpace X} {x : X} (hx : 0 ≤ x) : + IsLUB {r : ℝ | ∃ y, 0 ≤ y ∧ y ≤ x ∧ r = φ y} (φ⁺ x) := + OrderBoundedHom.isLUB_posPart_apply hx + +/-- Negative part of a dual functional at a positive element. -/ +theorem isLUB_negPart_apply {φ : OrderDualSpace X} {x : X} (hx : 0 ≤ x) : + IsLUB {r : ℝ | ∃ y, 0 ≤ y ∧ y ≤ x ∧ r = -(φ y)} (φ⁻ x) := + OrderBoundedHom.isLUB_negPart_apply hx + +/-- Modulus of a dual functional at a positive element. -/ +theorem isLUB_abs_apply {φ : OrderDualSpace X} {x : X} (hx : 0 ≤ x) : + IsLUB {r : ℝ | ∃ y, |y| ≤ x ∧ r = |φ y|} (|φ| x) := + OrderBoundedHom.isLUB_abs_apply hx + +/-- Riesz–Kantorovich formula for the supremum of two dual functionals. -/ +theorem isLUB_sup_apply {φ ψ : OrderDualSpace X} {x : X} (hx : 0 ≤ x) : + IsLUB + {r : ℝ | ∃ y z, 0 ≤ y ∧ 0 ≤ z ∧ y + z = x ∧ r = φ y + ψ z} + ((φ ⊔ ψ) x) := + OrderBoundedHom.isLUB_sup_apply hx + +/-- Riesz–Kantorovich formula for the infimum of two dual functionals. -/ +theorem isGLB_inf_apply {φ ψ : OrderDualSpace X} {x : X} (hx : 0 ≤ x) : + IsGLB + {r : ℝ | ∃ y z, 0 ≤ y ∧ 0 ≤ z ∧ y + z = x ∧ r = φ y + ψ z} + ((φ ⊓ ψ) x) := + OrderBoundedHom.isGLB_inf_apply hx + +/-- Every order dual element is regular: it can be written as a difference of +two positive functionals. -/ +theorem isRegularOp (φ : OrderDualSpace X) : + IsRegularOp φ.toLinearMap := + IsOrderBounded.isRegularOp φ.isOrderBounded' + +variable (X) in +/-- The order dual separates points of `X`: every nonzero element is detected by +some order bounded functional. -/ +def SeparatesPoints : Prop := + ∀ x : X, (∀ φ : OrderDualSpace X, φ x = 0) → x = 0 + +/-- Suprema in the order dual are supplied by the Riesz-Kantorovich +order-completeness theorem for order bounded operators. -/ +noncomputable instance instSupSet : SupSet (OrderDualSpace X) where + sSup S := by + classical + exact if h : S.Nonempty ∧ BddAbove S then + (OrderBoundedHom.exists_isLUB h.1 h.2).choose + else 0 + +/-- The chosen supremum in the order dual is the least upper bound of every +non-empty bounded-above set. -/ +theorem isLUB_sSup (S : Set (OrderDualSpace X)) (hbdd : BddAbove S) + (hne : S.Nonempty) : IsLUB S (sSup S) := by + classical + change IsLUB S (if h : S.Nonempty ∧ BddAbove S then + (OrderBoundedHom.exists_isLUB h.1 h.2).choose + else 0) + rw [dite_eq_left ⟨hne, hbdd⟩] + exact (OrderBoundedHom.exists_isLUB hne hbdd).choose_spec + +/-- The order dual is conditionally complete. -/ +noncomputable instance instConditionallyCompleteLattice : + ConditionallyCompleteLattice (OrderDualSpace X) := + conditionallyCompleteLatticeOfLatticeOfsSup _ isLUB_sSup + +end OrderDualSpace + +/-! ### The strong dual -/ + +namespace StrongDual + +section NormedVectorLattice + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [NormedVectorLattice X] + +/-- Every continuous linear functional on a normed vector lattice is order +bounded. -/ +theorem isOrderBounded (φ : StrongDual ℝ X) : + IsOrderBounded φ.toLinearMap := by + intro x hx + refine ⟨‖φ‖ * ‖x‖, mul_nonneg (norm_nonneg _) (norm_nonneg _), fun z hz => ?_⟩ + have hzx : ‖z‖ ≤ ‖x‖ := + norm_le_norm_of_abs_le_abs (by rw [abs_of_nonneg hx]; exact hz) + have h1 : |φ.toLinearMap z| = ‖φ z‖ := (Real.norm_eq_abs _).symm + rw [h1] + exact (φ.le_opNorm z).trans (by gcongr) + +/-- The order bounded functional underlying a continuous linear functional. -/ +def toOrderDualSpace (φ : StrongDual ℝ X) : OrderDualSpace X where + toLinearMap := φ.toLinearMap + isOrderBounded' := isOrderBounded φ + +@[simp] +theorem toOrderDualSpace_apply (φ : StrongDual ℝ X) (x : X) : + toOrderDualSpace φ x = φ x := rfl + +/-- Bundling `toOrderDualSpace` as a real-linear map. -/ +def toOrderDualSpaceLinear : StrongDual ℝ X →ₗ[ℝ] OrderDualSpace X where + toFun := toOrderDualSpace + map_add' _ _ := by ext; rfl + map_smul' _ _ := by ext; rfl + +/-- Order on the strong dual, transported through the order dual. -/ +instance instLE : LE (StrongDual ℝ X) where + le f g := toOrderDualSpace f ≤ toOrderDualSpace g + +instance instLT : LT (StrongDual ℝ X) where + lt f g := toOrderDualSpace f < toOrderDualSpace g + +/-- Order on the strong dual: `φ ≤ ψ` iff `φ x ≤ ψ x` for all positive `x`. -/ +theorem le_iff {φ ψ : StrongDual ℝ X} : + φ ≤ ψ ↔ ∀ x : X, 0 ≤ x → φ x ≤ ψ x := by + change toOrderDualSpace φ ≤ toOrderDualSpace ψ ↔ ∀ x : X, 0 ≤ x → φ x ≤ ψ x + simpa [toOrderDualSpace_apply] using OrderDualSpace.le_iff (φ := toOrderDualSpace φ) + (ψ := toOrderDualSpace ψ) + +/-- A continuous linear functional is positive iff it sends positive elements +of `X` to non-negative reals. -/ +theorem nonneg_iff {φ : StrongDual ℝ X} : + 0 ≤ φ ↔ ∀ x : X, 0 ≤ x → 0 ≤ φ x := by + simpa using (le_iff (φ := 0) (ψ := φ)) + +/-- A positive continuous linear functional is non-negative on positive elements. -/ +theorem apply_nonneg_of_nonneg {φ : StrongDual ℝ X} + (hφ : 0 ≤ φ) {x : X} (hx : 0 ≤ x) : 0 ≤ φ x := + (nonneg_iff.mp hφ) x hx + +/-- A positive continuous linear functional is monotone. -/ +theorem apply_le_apply_of_nonneg {φ : StrongDual ℝ X} + (hφ : 0 ≤ φ) {x y : X} (hxy : x ≤ y) : φ x ≤ φ y := + (Positive.monotone_iff.mpr (nonneg_iff.mp hφ)) hxy + +/-- A positive continuous linear functional is dominated by its value on the modulus. -/ +theorem abs_apply_le_apply_abs {φ : StrongDual ℝ X} + (hφ : 0 ≤ φ) (x : X) : |φ x| ≤ φ |x| := + Positive.abs_le_map_abs (nonneg_iff.mp hφ) x + +theorem toOrderDualSpace_injective : + Function.Injective (toOrderDualSpace (X := X)) := by + intro f g h + ext x + have := congrArg (fun (ψ : OrderDualSpace X) => ψ x) h + simpa using this + +theorem toOrderDualSpace_le {f g : StrongDual ℝ X} : + toOrderDualSpace f ≤ toOrderDualSpace g ↔ f ≤ g := Iff.rfl + +theorem toOrderDualSpace_lt {f g : StrongDual ℝ X} : + toOrderDualSpace f < toOrderDualSpace g ↔ f < g := Iff.rfl + +end NormedVectorLattice + +section WeakConvergence + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [NormedVectorLattice X] + +/-- Every positive element of a normed vector lattice attains its norm at a +positive continuous linear functional of norm at most one. -/ +theorem exists_positive_dual_norming {x : X} (hx : 0 ≤ x) : + ∃ φ : StrongDual ℝ X, 0 ≤ φ ∧ ‖φ‖ ≤ 1 ∧ φ x = ‖x‖ := by + by_cases hx0 : x = 0 + · refine ⟨0, ?_, by simp, by simp [hx0]⟩ + exact nonneg_iff.mpr fun _ _ => by simp + · let N : X → ℝ := fun y => ‖y⁺‖ + have hN_hom : ∀ c : ℝ, 0 < c → ∀ y : X, N (c • y) = c * N y := by + intro c hc y + simp [N, posPart_smul_nonneg hc.le y, norm_smul, Real.norm_of_nonneg hc.le] + have hN_add : ∀ y z : X, N (y + z) ≤ N y + N z := by + intro y z + have hle : |(y + z)⁺| ≤ |y⁺ + z⁺| := by + rw [abs_of_nonneg (posPart_nonneg (y + z)), + abs_of_nonneg (add_nonneg (posPart_nonneg y) (posPart_nonneg z))] + exact posPart_add_le y z + exact (norm_le_norm_of_abs_le_abs hle).trans (norm_add_le y⁺ z⁺) + let p : Subspace ℝ X := ℝ ∙ x + let coord : StrongDual ℝ p := ContinuousLinearEquiv.coord ℝ x hx0 + let f : p →L[ℝ] ℝ := (‖x‖ : ℝ) • coord + have hf_le : ∀ y : (⟨p, f⟩ : X →ₗ.[ℝ] ℝ).domain, + (⟨p, f⟩ : X →ₗ.[ℝ] ℝ) y ≤ N y := by + intro y + let a : ℝ := coord y + have hy_eq : (y : X) = a • x := by + dsimp [a, coord] + exact (congrArg Subtype.val + ((ContinuousLinearEquiv.toSpanNonzeroSingleton ℝ x hx0).apply_symm_apply y)).symm + by_cases ha : 0 ≤ a + · have hpos : ((y : X))⁺ = a • x := by + rw [hy_eq, posPart_smul_nonneg ha, posPart_of_nonneg hx] + simp [f, a, N, hpos, norm_smul, Real.norm_of_nonneg ha, mul_comm] + · have ha' : a ≤ 0 := le_of_not_ge ha + have hnonpos : (y : X) ≤ 0 := by + rw [hy_eq] + exact smul_nonpos_of_nonpos_of_nonneg ha' hx + have hpos : ((y : X))⁺ = 0 := posPart_eq_zero.mpr hnonpos + have hleft : (⟨p, f⟩ : X →ₗ.[ℝ] ℝ) y = ‖x‖ * a := by + simp [f, a] + rw [hleft] + change ‖x‖ * a ≤ ‖((y : X))⁺‖ + rw [hpos, norm_zero] + exact mul_nonpos_of_nonneg_of_nonpos (norm_nonneg x) ha' + obtain ⟨g, hg_eq, hg_le⟩ := + exists_extension_of_le_sublinear (⟨p, f⟩ : X →ₗ.[ℝ] ℝ) N hN_hom hN_add hf_le + have hg_abs : ∀ y : X, |g y| ≤ ‖y‖ := by + intro y + refine abs_le.mpr ⟨?_, ?_⟩ + · have hneg := hg_le (-y) + have hNneg : N (-y) ≤ ‖y‖ := by + exact (NormedVectorLattice.norm_posPart_le (-y)).trans (by rw [norm_neg]) + have : g (-y) ≤ ‖y‖ := hneg.trans hNneg + rwa [map_neg, neg_le] at this + · exact (hg_le y).trans (NormedVectorLattice.norm_posPart_le y) + let φ : StrongDual ℝ X := g.mkContinuous 1 fun y => by + simpa [one_mul] using hg_abs y + refine ⟨φ, ?_, ?_, ?_⟩ + · exact nonneg_iff.mpr fun y hy => by + have hneg := hg_le (-y) + have hNneg : N (-y) = 0 := by + simp [N, posPart_eq_zero.mpr (neg_nonpos.mpr hy)] + rw [hNneg, map_neg] at hneg + simpa [φ] using (show 0 ≤ g y by linarith) + · exact g.mkContinuous_norm_le zero_le_one fun y => by + simpa [one_mul] using hg_abs y + · have hxmem : x ∈ p := Submodule.mem_span_singleton_self x + have hval := hg_eq (⟨x, hxmem⟩ : (⟨p, f⟩ : X →ₗ.[ℝ] ℝ).domain) + have hcoord : coord (⟨x, hxmem⟩ : p) = 1 := by + change (ContinuousLinearEquiv.coord ℝ x hx0) (⟨x, hxmem⟩ : ℝ ∙ x) = 1 + exact ContinuousLinearEquiv.coord_self (𝕜 := ℝ) x hx0 + simpa [φ, f, coord, hcoord] using hval + +/-- **Dini's theorem**: a monotone net in a normed lattice that converges weakly +converges in norm. -/ +theorem tendsto_of_monotone_weak_tendsto {ι : Type*} [Preorder ι] + [IsDirected ι (· ≤ ·)] [Nonempty ι] {u : ι → X} {x : X} + (hmono : Monotone u ∨ Antitone u) + (hweak : Filter.Tendsto (fun i => (toWeakSpace ℝ X) (u i)) Filter.atTop + (nhds ((toWeakSpace ℝ X) x))) : + Filter.Tendsto u Filter.atTop (nhds x) := + NormedVectorLattice.tendsto_of_monotone_weak_tendsto hmono hweak + +end WeakConvergence + +section BanachLattice + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [BanachLattice X] + +/-- For a Banach lattice, every order bounded functional is continuous. -/ +noncomputable def ofOrderDualSpace (f : OrderDualSpace X) : StrongDual ℝ X := + ⟨f.toLinearMap, IsOrderBounded.continuous f.isOrderBounded'⟩ + +@[simp] +theorem ofOrderDualSpace_apply (f : OrderDualSpace X) (x : X) : + ofOrderDualSpace f x = f x := rfl + +/-- For a Banach lattice, the order dual and the strong dual are linearly +equivalent: continuous functionals are exactly the order bounded ones. -/ +noncomputable def equivOrderDualSpace : StrongDual ℝ X ≃ₗ[ℝ] OrderDualSpace X where + toFun := toOrderDualSpace + invFun := ofOrderDualSpace + left_inv _ := by ext; rfl + right_inv _ := by ext; rfl + map_add' _ _ := by ext; rfl + map_smul' _ _ := by ext; rfl + +noncomputable instance instMax : Max (StrongDual ℝ X) where + max f g := ofOrderDualSpace (toOrderDualSpace f ⊔ toOrderDualSpace g) + +noncomputable instance instMin : Min (StrongDual ℝ X) where + min f g := ofOrderDualSpace (toOrderDualSpace f ⊓ toOrderDualSpace g) + +theorem toOrderDualSpace_sup (f g : StrongDual ℝ X) : + toOrderDualSpace (f ⊔ g) = toOrderDualSpace f ⊔ toOrderDualSpace g := by + ext x; rfl + +theorem toOrderDualSpace_inf (f g : StrongDual ℝ X) : + toOrderDualSpace (f ⊓ g) = toOrderDualSpace f ⊓ toOrderDualSpace g := by + ext x; rfl + +/-- The induced lattice structure on the strong dual: `φ ≤ ψ` iff `φ x ≤ ψ x` +for all positive `x`, with sup/inf transported from the order dual. -/ +noncomputable instance instLattice : Lattice (StrongDual ℝ X) := + toOrderDualSpace_injective.lattice _ toOrderDualSpace_le + toOrderDualSpace_lt toOrderDualSpace_sup toOrderDualSpace_inf + +/-- Suprema in the strong dual are transported from the order dual. -/ +noncomputable instance instSupSet : SupSet (StrongDual ℝ X) where + sSup S := ofOrderDualSpace (sSup (toOrderDualSpace '' S : Set (OrderDualSpace X))) + +/-- The chosen supremum in the strong dual is the least upper bound of every +non-empty bounded-above set. -/ +theorem isLUB_sSup (S : Set (StrongDual ℝ X)) (hbdd : BddAbove S) + (hne : S.Nonempty) : IsLUB S (sSup S) := by + change IsLUB S (ofOrderDualSpace + (sSup (toOrderDualSpace '' S : Set (OrderDualSpace X)))) + have hne' : (toOrderDualSpace '' S : Set (OrderDualSpace X)).Nonempty := + hne.image _ + have hbdd' : BddAbove (toOrderDualSpace '' S : Set (OrderDualSpace X)) := by + obtain ⟨u, hu⟩ := hbdd + exact ⟨toOrderDualSpace u, by + rintro _ ⟨v, hv, rfl⟩ + exact hu hv⟩ + have hLUB' := OrderDualSpace.isLUB_sSup + (toOrderDualSpace '' S : Set (OrderDualSpace X)) hbdd' hne' + have hround : toOrderDualSpace + (ofOrderDualSpace (sSup (toOrderDualSpace '' S : Set (OrderDualSpace X)))) = + sSup (toOrderDualSpace '' S : Set (OrderDualSpace X)) := by + ext x + rfl + constructor + · intro a ha + change toOrderDualSpace a ≤ toOrderDualSpace + (ofOrderDualSpace (sSup (toOrderDualSpace '' S : Set (OrderDualSpace X)))) + rw [hround] + exact hLUB'.1 ⟨a, ha, rfl⟩ + · intro u hu + change toOrderDualSpace + (ofOrderDualSpace (sSup (toOrderDualSpace '' S : Set (OrderDualSpace X)))) ≤ + toOrderDualSpace u + rw [hround] + exact hLUB'.2 (by + rintro _ ⟨a, ha, rfl⟩ + exact hu ha) + +/-- The strong dual is conditionally complete. -/ +noncomputable instance instConditionallyCompleteLattice : + ConditionallyCompleteLattice (StrongDual ℝ X) := + conditionallyCompleteLatticeOfLatticeOfsSup _ isLUB_sSup + +theorem toOrderDualSpace_add (f g : StrongDual ℝ X) : + toOrderDualSpace (f + g) = toOrderDualSpace f + toOrderDualSpace g := by + ext; rfl + +theorem toOrderDualSpace_smul (r : ℝ) (f : StrongDual ℝ X) : + toOrderDualSpace (r • f) = r • toOrderDualSpace f := by + ext; rfl + +/-- The strong dual of a Banach lattice is an ordered additive group. -/ +instance instIsOrderedAddMonoid : IsOrderedAddMonoid (StrongDual ℝ X) where + add_le_add_left f g hfg c := by + change toOrderDualSpace f ≤ toOrderDualSpace g at hfg + change toOrderDualSpace (f + c) ≤ toOrderDualSpace (g + c) + rw [toOrderDualSpace_add, toOrderDualSpace_add] + exact IsOrderedAddMonoid.add_le_add_left _ _ hfg c.toOrderDualSpace + +instance instPosSMulMono : PosSMulMono ℝ (StrongDual ℝ X) where + smul_le_smul_of_nonneg_left {r} hr {f g} hfg := by + change toOrderDualSpace f ≤ toOrderDualSpace g at hfg + change toOrderDualSpace (r • f) ≤ toOrderDualSpace (r • g) + rw [toOrderDualSpace_smul, toOrderDualSpace_smul] + exact smul_le_smul_of_nonneg_left hfg hr + +/-- The strong dual of a Banach lattice is a vector lattice. -/ +noncomputable instance instVectorLattice : VectorLattice (StrongDual ℝ X) where + +theorem coe_abs_apply (φ : StrongDual ℝ X) (x : X) : + (|φ| : StrongDual ℝ X) x = |toOrderDualSpace φ| x := rfl + +theorem abs_apply_le_abs_apply_abs (φ : StrongDual ℝ X) (x : X) : + |φ x| ≤ (|φ| : StrongDual ℝ X) (|x|) := by + rw [coe_abs_apply] + exact (OrderBoundedHom.isLUB_abs_apply (f := toOrderDualSpace φ) + (abs_nonneg x)).1 ⟨x, le_refl _, rfl⟩ + +theorem abs_apply_nonneg (φ : StrongDual ℝ X) {x : X} (hx : 0 ≤ x) : + 0 ≤ (|φ| : StrongDual ℝ X) x := by + rw [coe_abs_apply] + exact (OrderBoundedHom.isLUB_abs_apply (f := toOrderDualSpace φ) hx).1 + ⟨0, by simp [hx], by simp⟩ + +/-- For a positive `x`, `|φ| x` is bounded by `‖φ‖ * ‖x‖`. -/ +theorem abs_apply_le_norm_mul (φ : StrongDual ℝ X) {x : X} (hx : 0 ≤ x) : + (|φ| : StrongDual ℝ X) x ≤ ‖φ‖ * ‖x‖ := by + rw [coe_abs_apply] + refine (OrderBoundedHom.isLUB_abs_apply (f := toOrderDualSpace φ) hx).2 ?_ + rintro _ ⟨y, hyx, rfl⟩ + have hy : ‖y‖ ≤ ‖x‖ := + norm_le_norm_of_abs_le_abs (by rw [abs_of_nonneg hx]; exact hyx) + calc |φ y| = ‖φ y‖ := (Real.norm_eq_abs _).symm + _ ≤ ‖φ‖ * ‖y‖ := φ.le_opNorm y + _ ≤ ‖φ‖ * ‖x‖ := by gcongr + +/-- The strong dual carries a solid lattice norm: `|φ| ≤ |ψ|` implies +`‖φ‖ ≤ ‖ψ‖`. -/ +instance instHasSolidNorm : HasSolidNorm (StrongDual ℝ X) where + solid {φ ψ} hφψ := by + refine ContinuousLinearMap.opNorm_le_bound _ (norm_nonneg _) fun x => ?_ + have h1 : |φ x| ≤ (|φ| : StrongDual ℝ X) (|x|) := + abs_apply_le_abs_apply_abs φ x + have hOD : (|φ| : StrongDual ℝ X) (|x|) ≤ (|ψ| : StrongDual ℝ X) (|x|) := by + exact le_iff.mp hφψ _ (abs_nonneg x) + have h2 : (|ψ| : StrongDual ℝ X) (|x|) ≤ ‖ψ‖ * ‖x‖ := by + have := abs_apply_le_norm_mul ψ (abs_nonneg x) + rwa [norm_abs_eq_norm] at this + calc ‖φ x‖ = |φ x| := Real.norm_eq_abs _ + _ ≤ (|ψ| : StrongDual ℝ X) (|x|) := h1.trans hOD + _ ≤ ‖ψ‖ * ‖x‖ := h2 + +/-- The strong dual of a Banach lattice is itself a normed vector lattice. -/ +noncomputable instance instNormedVectorLattice : + NormedVectorLattice (StrongDual ℝ X) where + norm_smul := norm_smul + +/-- The strong dual of a Banach lattice is a Banach lattice. -/ +noncomputable instance instBanachLattice : BanachLattice (StrongDual ℝ X) where + +/-- The dual norm of the modulus equals the dual norm: `‖|φ|‖ = ‖φ‖`. -/ +theorem norm_abs (φ : StrongDual ℝ X) : ‖|φ|‖ = ‖φ‖ := + le_antisymm + (HasSolidNorm.solid (by rw [abs_abs])) + (HasSolidNorm.solid (by rw [abs_abs])) + +/-- For a positive functional, the dual norm is the supremum of `φ x` over the +intersection of the unit ball with the positive cone. -/ +theorem norm_of_nonneg {φ : StrongDual ℝ X} (hφ : 0 ≤ φ) : + ‖φ‖ = sSup ((φ : X → ℝ) '' ({x | ‖x‖ ≤ 1} ∩ {x | 0 ≤ x})) := by + set S := (φ : X → ℝ) '' ({x | ‖x‖ ≤ 1} ∩ {x | 0 ≤ x}) + have hpos : ∀ {x : X}, 0 ≤ x → 0 ≤ φ x := fun {x} hx => + nonneg_iff.mp hφ x hx + have habs_eq : (|φ| : StrongDual ℝ X) = φ := abs_of_nonneg hφ + have hub : ∀ s ∈ S, s ≤ ‖φ‖ := by + rintro _ ⟨x, ⟨hx1, hx0⟩, rfl⟩ + have h1 : ‖φ x‖ ≤ ‖φ‖ * ‖x‖ := φ.le_opNorm x + have h2 : φ x = ‖φ x‖ := by + rw [Real.norm_eq_abs, abs_of_nonneg (hpos hx0)] + rw [h2] + exact h1.trans (by simpa using mul_le_mul_of_nonneg_left hx1 (norm_nonneg _)) + have hbdd : BddAbove S := ⟨‖φ‖, hub⟩ + have hne : S.Nonempty := ⟨0, 0, ⟨by simp, le_refl _⟩, by simp⟩ + have hsup_nn : 0 ≤ sSup S := + Real.sSup_nonneg (by rintro _ ⟨y, ⟨_, hy0⟩, rfl⟩; exact hpos hy0) + apply le_antisymm + · refine ContinuousLinearMap.opNorm_le_bound _ hsup_nn fun x => ?_ + -- ‖φ x‖ ≤ φ |x| (positivity) + have hbound : ‖φ x‖ ≤ φ (|x|) := by + rw [Real.norm_eq_abs] + have h := abs_apply_le_abs_apply_abs φ x + rw [habs_eq] at h; exact h + by_cases hx0 : x = 0 + · subst hx0 + simp only [map_zero, norm_zero, mul_zero] + exact le_refl _ + -- normalise + have hxn : (0 : ℝ) < ‖x‖ := norm_pos_iff.mpr hx0 + set y : X := ‖x‖⁻¹ • |x| + have hy_nn : 0 ≤ y := smul_nonneg (inv_nonneg.mpr hxn.le) (abs_nonneg x) + have hy_norm : ‖y‖ ≤ 1 := by + rw [norm_smul, Real.norm_eq_abs, abs_inv, abs_of_nonneg hxn.le, + norm_abs_eq_norm] + exact (inv_mul_cancel₀ hxn.ne').le + have hyS : φ y ∈ S := ⟨y, ⟨hy_norm, hy_nn⟩, rfl⟩ + have hyS_le : φ y ≤ sSup S := le_csSup hbdd hyS + have hφy : φ y = ‖x‖⁻¹ * φ (|x|) := by + change φ.toLinearMap (‖x‖⁻¹ • |x|) = _ + rw [map_smul]; rfl + have hφabs : φ (|x|) ≤ ‖x‖ * sSup S := by + have h1 := mul_le_mul_of_nonneg_left hyS_le hxn.le + rw [hφy, ← mul_assoc, mul_inv_cancel₀ hxn.ne', one_mul] at h1 + exact h1 + exact hbound.trans (hφabs.trans (by rw [mul_comm])) + · exact csSup_le hne hub + +/-- For a Banach lattice, the order dual separates points. -/ +theorem orderDual_separatesPoints : + OrderDualSpace.SeparatesPoints X := by + intro x hx + refine SeparatingDual.eq_zero_of_forall_dual_eq_zero (R := ℝ) fun f => ?_ + simpa using hx (toOrderDualSpace f) + +/-- If two functionals are disjoint, every positive vector admits a +positive decomposition on which the sum of their values is arbitrarily small. -/ +theorem exists_decomposition_apply_add_apply_lt + {φ ψ : StrongDual ℝ X} (hdisj : φ ⊓ ψ = 0) + {u : X} (hu : 0 ≤ u) {ε : ℝ} (hε : 0 < ε) : + ∃ u₁ u₂ : X, 0 ≤ u₁ ∧ 0 ≤ u₂ ∧ u₁ + u₂ = u ∧ + φ u₁ + ψ u₂ < ε := by + let φ' : OrderDualSpace X := toOrderDualSpace φ + let ψ' : OrderDualSpace X := toOrderDualSpace ψ + have hglb : IsGLB + {r : ℝ | ∃ y z : X, 0 ≤ y ∧ 0 ≤ z ∧ y + z = u ∧ + r = φ' y + ψ' z} 0 := by + have h := OrderDualSpace.isGLB_inf_apply (φ := φ') (ψ := ψ') hu + have hzero : (φ' ⊓ ψ') u = 0 := by + dsimp [φ', ψ'] + change (φ ⊓ ψ) u = 0 + rw [hdisj] + rfl + simpa [hzero] using h + by_contra hno + have hlower : ε ∈ lowerBounds + {r : ℝ | ∃ y z : X, 0 ≤ y ∧ 0 ≤ z ∧ y + z = u ∧ + r = φ' y + ψ' z} := by + rintro r ⟨y, z, hy, hz, hyz, rfl⟩ + exact le_of_not_gt (fun hlt => hno ⟨y, z, hy, hz, hyz, hlt⟩) + have hε_le_zero : ε ≤ 0 := hglb.2 hlower + exact (not_lt_of_ge hε_le_zero) hε + +end BanachLattice + +end StrongDual diff --git a/LeanPool/FBLOrderContinuity/BanLat/Free/FBL.lean b/LeanPool/FBLOrderContinuity/BanLat/Free/FBL.lean new file mode 100644 index 0000000000..3148640fcd --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Free/FBL.lean @@ -0,0 +1,1575 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.FBLOrderContinuity.BanLat.Dual +public import LeanPool.FBLOrderContinuity.BanLat.Free.FVLv +public import LeanPool.OrderClosures.BanLat.Substructures.Sublattice +public import Mathlib.Algebra.Order.Group.Unbundled.Abs +public import Mathlib.Analysis.Normed.Operator.Extend + + + +/-! +# The free Banach lattice generated by a normed space + +This file gives the concrete construction of the free Banach lattice generated by a real +normed space. The ambient functions live on the weak-star closed unit ball of the dual. +The free norm formula is first defined as an extended non-negative real value on all +continuous functions, and then as a real-valued norm on the subspace where that extended +value is finite. The free Banach lattice `FBL E` is realized as the free-norm closure of +the concrete free vector lattice generated by the evaluation maps. +-/ + +@[expose] public section + +open scoped BigOperators + +noncomputable section + +universe u v + +namespace FBL + +variable (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] + +/-- The admissible finite families of dual functionals used to compute the free norm. -/ +def NormAdmissible {n : ℕ} (φ : Fin n → FVLv.dualUnitBall E) : Prop := + ∀ x : E, ‖x‖ ≤ 1 → ∑ i, |(φ i : WeakDual ℝ E) x| ≤ 1 + +/-- The extended free norm on `C(B_{E*}, ℝ)`. + +This value can be infinite for an arbitrary continuous function. The real-valued norm is +therefore defined on the subtype of functions for which this extended value is +finite. -/ +noncomputable def freeNormExt (f : C(FVLv.dualUnitBall E, ℝ)) : ENNReal := + ⨆ (n : ℕ) (φ : Fin n → FVLv.dualUnitBall E) (_h : NormAdmissible E φ), + ENNReal.ofReal (∑ i, |f (φ i)|) + +/-- The finite-free-norm part of `C(B_{E*}, ℝ)` used in the concrete construction. + +This is not the whole continuous function space: the formula defining `freeNormExt` can be +infinite. The subtype records the finiteness needed to attach a genuine real-valued norm. +It also keeps the free-norm structure separate from Mathlib's usual supremum norm on +`C(B_{E*}, ℝ)`. -/ +def FunctionSpace : Type u := + {f : C(FVLv.dualUnitBall E, ℝ) // freeNormExt E f < ⊤} + +namespace FunctionSpace + +/-- The underlying continuous function on the weak-star dual unit ball. -/ +def toContinuousMap (f : FunctionSpace E) : C(FVLv.dualUnitBall E, ℝ) := + f.1 + +/-- Regard a continuous function on the weak-star dual unit ball as an element of the +ambient function space, provided its extended free norm is finite. -/ +def ofContinuousMap (f : C(FVLv.dualUnitBall E, ℝ)) (hf : freeNormExt E f < ⊤) : + FunctionSpace E := + ⟨f, hf⟩ + +instance instCoeContinuousMap : Coe (FunctionSpace E) C(FVLv.dualUnitBall E, ℝ) where + coe f := toContinuousMap E f + +instance instCoeFun : CoeFun (FunctionSpace E) (fun _ => FVLv.dualUnitBall E → ℝ) where + coe f := toContinuousMap E f + +@[simp] +theorem ofContinuousMap_apply (f : C(FVLv.dualUnitBall E, ℝ)) + (hf : freeNormExt E f < ⊤) (φ : FVLv.dualUnitBall E) : + ofContinuousMap E f hf φ = f φ := + rfl + +@[simp] +theorem toContinuousMap_apply (f : FunctionSpace E) (φ : FVLv.dualUnitBall E) : + toContinuousMap E f φ = f φ := + rfl + +end FunctionSpace + +/-- The finiteness assertion built into `FunctionSpace`. -/ +theorem freeNormExt_lt_top (f : FunctionSpace E) : + freeNormExt E (f : C(FVLv.dualUnitBall E, ℝ)) < ⊤ := + f.2 + +/-- The real-valued free norm on the finite-free-norm function space. -/ +noncomputable def freeNorm (f : FunctionSpace E) : ℝ := + (freeNormExt E (f : C(FVLv.dualUnitBall E, ℝ))).toReal + +instance instNormFunctionSpace : Norm (FunctionSpace E) where + norm := freeNorm E + +theorem le_freeNormExt {f : C(FVLv.dualUnitBall E, ℝ)} {n : ℕ} + (φ : Fin n → FVLv.dualUnitBall E) (hφ : NormAdmissible E φ) : + ENNReal.ofReal (∑ i, |f (φ i)|) ≤ freeNormExt E f := by + rw [freeNormExt] + exact le_iSup_of_le n <| le_iSup_of_le φ <| le_iSup_of_le hφ le_rfl + +theorem freeNormExt_le_of_forall {f : C(FVLv.dualUnitBall E, ℝ)} {C : ENNReal} + (h : ∀ (n : ℕ) (φ : Fin n → FVLv.dualUnitBall E), NormAdmissible E φ → + ENNReal.ofReal (∑ i, |f (φ i)|) ≤ C) : + freeNormExt E f ≤ C := by + rw [freeNormExt] + exact iSup_le fun n => iSup_le fun φ => iSup_le fun hφ => h n φ hφ + +theorem freeNormExt_zero : + freeNormExt E (0 : C(FVLv.dualUnitBall E, ℝ)) = 0 := by + simp [freeNormExt] + +theorem freeNormExt_neg (f : C(FVLv.dualUnitBall E, ℝ)) : + freeNormExt E (-f) = freeNormExt E f := by + simp [freeNormExt] + +theorem freeNormExt_smul (c : ℝ) (f : C(FVLv.dualUnitBall E, ℝ)) : + freeNormExt E (c • f) = ENNReal.ofReal |c| * freeNormExt E f := by + rw [freeNormExt, freeNormExt] + rw [ENNReal.mul_iSup] + congr with n + rw [ENNReal.mul_iSup] + congr with φ + rw [ENNReal.mul_iSup] + congr with hφ + simp only [ContinuousMap.coe_smul, Pi.smul_apply, smul_eq_mul, abs_mul] + rw [← ENNReal.ofReal_mul (abs_nonneg c)] + congr 1 + rw [Finset.mul_sum] + +theorem freeNormExt_add_le (f g : C(FVLv.dualUnitBall E, ℝ)) : + freeNormExt E (f + g) ≤ freeNormExt E f + freeNormExt E g := by + apply freeNormExt_le_of_forall + intro n φ hφ + have hsum : + ∑ i, |(f + g) (φ i)| ≤ ∑ i, |f (φ i)| + ∑ i, |g (φ i)| := by + calc + ∑ i, |(f + g) (φ i)| = ∑ i, |f (φ i) + g (φ i)| := by simp + _ ≤ ∑ i, (|f (φ i)| + |g (φ i)|) := by + exact Finset.sum_le_sum fun i _ => abs_add_le (f (φ i)) (g (φ i)) + _ = ∑ i, |f (φ i)| + ∑ i, |g (φ i)| := by rw [Finset.sum_add_distrib] + have hf_nonneg : 0 ≤ ∑ i, |f (φ i)| := Finset.sum_nonneg fun i _ => abs_nonneg _ + have hg_nonneg : 0 ≤ ∑ i, |g (φ i)| := Finset.sum_nonneg fun i _ => abs_nonneg _ + calc + ENNReal.ofReal (∑ i, |(f + g) (φ i)|) + ≤ ENNReal.ofReal (∑ i, |f (φ i)| + ∑ i, |g (φ i)|) := + ENNReal.ofReal_le_ofReal hsum + _ = ENNReal.ofReal (∑ i, |f (φ i)|) + ENNReal.ofReal (∑ i, |g (φ i)|) := by + rw [ENNReal.ofReal_add hf_nonneg hg_nonneg] + _ ≤ freeNormExt E f + freeNormExt E g := + add_le_add (le_freeNormExt E φ hφ) (le_freeNormExt E φ hφ) + +theorem freeNormExt_mono_abs {f g : C(FVLv.dualUnitBall E, ℝ)} + (h : ∀ φ : FVLv.dualUnitBall E, |f φ| ≤ |g φ|) : + freeNormExt E f ≤ freeNormExt E g := by + apply freeNormExt_le_of_forall + intro n φ hφ + exact (ENNReal.ofReal_le_ofReal (Finset.sum_le_sum fun i _ => h (φ i))).trans + (le_freeNormExt E φ hφ) + +theorem freeNormExt_sup_le (f g : C(FVLv.dualUnitBall E, ℝ)) : + freeNormExt E (f ⊔ g) ≤ freeNormExt E f + freeNormExt E g := by + apply freeNormExt_le_of_forall + intro n φ hφ + have hsum : + ∑ i, |(f ⊔ g) (φ i)| ≤ ∑ i, |f (φ i)| + ∑ i, |g (φ i)| := by + calc + ∑ i, |(f ⊔ g) (φ i)| = ∑ i, |f (φ i) ⊔ g (φ i)| := by simp + _ ≤ ∑ i, (|f (φ i)| + |g (φ i)|) := by + exact Finset.sum_le_sum fun i _ => FVLv.abs_sup_le_add_abs (f (φ i)) (g (φ i)) + _ = ∑ i, |f (φ i)| + ∑ i, |g (φ i)| := by rw [Finset.sum_add_distrib] + have hf_nonneg : 0 ≤ ∑ i, |f (φ i)| := Finset.sum_nonneg fun i _ => abs_nonneg _ + have hg_nonneg : 0 ≤ ∑ i, |g (φ i)| := Finset.sum_nonneg fun i _ => abs_nonneg _ + calc + ENNReal.ofReal (∑ i, |(f ⊔ g) (φ i)|) + ≤ ENNReal.ofReal (∑ i, |f (φ i)| + ∑ i, |g (φ i)|) := + ENNReal.ofReal_le_ofReal hsum + _ = ENNReal.ofReal (∑ i, |f (φ i)|) + ENNReal.ofReal (∑ i, |g (φ i)|) := by + rw [ENNReal.ofReal_add hf_nonneg hg_nonneg] + _ ≤ freeNormExt E f + freeNormExt E g := + add_le_add (le_freeNormExt E φ hφ) (le_freeNormExt E φ hφ) + +theorem freeNormExt_inf_le (f g : C(FVLv.dualUnitBall E, ℝ)) : + freeNormExt E (f ⊓ g) ≤ freeNormExt E f + freeNormExt E g := by + apply freeNormExt_le_of_forall + intro n φ hφ + have hsum : + ∑ i, |(f ⊓ g) (φ i)| ≤ ∑ i, |f (φ i)| + ∑ i, |g (φ i)| := by + calc + ∑ i, |(f ⊓ g) (φ i)| = ∑ i, |f (φ i) ⊓ g (φ i)| := by simp + _ ≤ ∑ i, (|f (φ i)| + |g (φ i)|) := by + exact Finset.sum_le_sum fun i _ => FVLv.abs_inf_le_add_abs (f (φ i)) (g (φ i)) + _ = ∑ i, |f (φ i)| + ∑ i, |g (φ i)| := by rw [Finset.sum_add_distrib] + have hf_nonneg : 0 ≤ ∑ i, |f (φ i)| := Finset.sum_nonneg fun i _ => abs_nonneg _ + have hg_nonneg : 0 ≤ ∑ i, |g (φ i)| := Finset.sum_nonneg fun i _ => abs_nonneg _ + calc + ENNReal.ofReal (∑ i, |(f ⊓ g) (φ i)|) + ≤ ENNReal.ofReal (∑ i, |f (φ i)| + ∑ i, |g (φ i)|) := + ENNReal.ofReal_le_ofReal hsum + _ = ENNReal.ofReal (∑ i, |f (φ i)|) + ENNReal.ofReal (∑ i, |g (φ i)|) := by + rw [ENNReal.ofReal_add hf_nonneg hg_nonneg] + _ ≤ freeNormExt E f + freeNormExt E g := + add_le_add (le_freeNormExt E φ hφ) (le_freeNormExt E φ hφ) + +theorem normAdmissible_singleton (φ : FVLv.dualUnitBall E) : + NormAdmissible E (fun _ : Fin 1 => φ) := by + intro x hx + simp only [Fin.sum_univ_one] + have hφmem : WeakDual.toStrongDual (φ : WeakDual ℝ E) ∈ + Metric.closedBall (0 : StrongDual ℝ E) 1 := φ.2 + rw [Metric.mem_closedBall] at hφmem + have hφ : ‖WeakDual.toStrongDual (φ : WeakDual ℝ E)‖ ≤ 1 := by + rwa [dist_eq_norm, sub_zero] at hφmem + have hle : ‖(WeakDual.toStrongDual (φ : WeakDual ℝ E)) x‖ ≤ 1 := by + calc + ‖(WeakDual.toStrongDual (φ : WeakDual ℝ E)) x‖ + ≤ ‖WeakDual.toStrongDual (φ : WeakDual ℝ E)‖ * ‖x‖ := + ContinuousLinearMap.le_opNorm _ _ + _ ≤ 1 * 1 := mul_le_mul hφ hx (norm_nonneg _) zero_le_one + _ = 1 := by norm_num + simpa [Real.norm_eq_abs, WeakDual.toStrongDual_apply] using hle + +theorem coe_eq_zero_of_freeNorm_eq_zero (f : FunctionSpace E) + (h : freeNorm E f = 0) : + (f : C(FVLv.dualUnitBall E, ℝ)) = 0 := by + have hfin : freeNormExt E (f : C(FVLv.dualUnitBall E, ℝ)) ≠ ⊤ := + ne_of_lt (freeNormExt_lt_top E f) + have hext_zero : freeNormExt E (f : C(FVLv.dualUnitBall E, ℝ)) = 0 := by + rcases (ENNReal.toReal_eq_zero_iff + (freeNormExt E (f : C(FVLv.dualUnitBall E, ℝ)))).mp h with h0 | htop + · exact h0 + · exact (hfin htop).elim + ext φ + have hle := le_freeNormExt E (f := (f : C(FVLv.dualUnitBall E, ℝ))) + (fun _ : Fin 1 => φ) (normAdmissible_singleton E φ) + have hofReal_zero : ENNReal.ofReal |f φ| = 0 := + le_antisymm (by simpa [hext_zero] using hle) bot_le + have habs_nonpos : |f φ| ≤ 0 := by + simpa [ENNReal.ofReal_eq_zero] using hofReal_zero + exact abs_eq_zero.mp (le_antisymm habs_nonpos (abs_nonneg _)) + +theorem freeNormExt_dualEval_le (x : E) : + freeNormExt E (FVLv.dualEval E x) ≤ ENNReal.ofReal ‖x‖ := by + apply freeNormExt_le_of_forall + intro n φ hφ + by_cases hx : x = 0 + · subst x + simp [FVLv.dualEval] + · have hxpos : 0 < ‖x‖ := norm_pos_iff.mpr hx + have hscale_norm : ‖‖x‖⁻¹ • x‖ ≤ 1 := by + rw [norm_smul, Real.norm_of_nonneg (inv_nonneg.mpr hxpos.le), + inv_mul_cancel₀ hxpos.ne'] + have hadm := hφ (‖x‖⁻¹ • x) hscale_norm + have hscaled_sum : ∑ i, |(φ i : WeakDual ℝ E) (‖x‖⁻¹ • x)| = + ‖x‖⁻¹ * ∑ i, |(φ i : WeakDual ℝ E) x| := by + calc + ∑ i, |(φ i : WeakDual ℝ E) (‖x‖⁻¹ • x)| = + ∑ i, ‖x‖⁻¹ * |(φ i : WeakDual ℝ E) x| := by + simp [map_smul, abs_mul, abs_of_nonneg (inv_nonneg.mpr hxpos.le)] + _ = ‖x‖⁻¹ * ∑ i, |(φ i : WeakDual ℝ E) x| := by + rw [Finset.mul_sum] + have hmul : ‖x‖⁻¹ * ∑ i, |(φ i : WeakDual ℝ E) x| ≤ 1 := by + rw [← hscaled_sum] + exact hadm + have hsum : ∑ i, |(φ i : WeakDual ℝ E) x| ≤ ‖x‖ := by + calc + ∑ i, |(φ i : WeakDual ℝ E) x| = + ‖x‖ * (‖x‖⁻¹ * ∑ i, |(φ i : WeakDual ℝ E) x|) := by + rw [← mul_assoc, mul_inv_cancel₀ hxpos.ne', one_mul] + _ ≤ ‖x‖ * 1 := mul_le_mul_of_nonneg_left hmul hxpos.le + _ = ‖x‖ := by rw [mul_one] + simpa [FVLv.dualEval_apply] using ENNReal.ofReal_le_ofReal hsum + +/-- Continuous functions on the dual ball with finite extended free norm. -/ +def functionSpaceSubmodule : Submodule ℝ C(FVLv.dualUnitBall E, ℝ) where + carrier := {f | freeNormExt E f < ⊤} + zero_mem' := by + simp [freeNormExt_zero] + add_mem' := by + intro f g hf hg + refine lt_of_le_of_lt (freeNormExt_add_le E f g) ?_ + exact lt_top_iff_ne_top.mpr (ENNReal.add_ne_top.mpr ⟨ne_of_lt hf, ne_of_lt hg⟩) + smul_mem' := by + intro c f hf + change freeNormExt E (c • f) < ⊤ + rw [freeNormExt_smul] + exact lt_top_iff_ne_top.mpr (ENNReal.mul_ne_top ENNReal.ofReal_ne_top (ne_of_lt hf)) + +/-- The additive group inherited by functions of finite free norm. -/ +@[reducible] +def functionSpaceAddCommGroup : AddCommGroup (FunctionSpace E) := + inferInstanceAs (AddCommGroup ↥(functionSpaceSubmodule E)) + +/-- The real module inherited by functions of finite free norm. -/ +@[reducible] +def functionSpaceModule : + @Module ℝ (FunctionSpace E) _ (functionSpaceAddCommGroup E).toAddCommMonoid := + inferInstanceAs (@Module ℝ ↥(functionSpaceSubmodule E) _ _) + +/-- The vector sublattice of continuous functions with finite free norm. -/ +noncomputable def functionSpaceVectorSublattice : + VectorSublattice C(FVLv.dualUnitBall E, ℝ) where + toSubmodule := functionSpaceSubmodule E + sup_mem' := by + intro f g hf hg + refine lt_of_le_of_lt (freeNormExt_sup_le E f g) ?_ + exact lt_top_iff_ne_top.mpr (ENNReal.add_ne_top.mpr ⟨ne_of_lt hf, ne_of_lt hg⟩) + +instance instNormedAddCommGroupFunctionSpace : NormedAddCommGroup (FunctionSpace E) := by + letI : AddCommGroup (FunctionSpace E) := functionSpaceAddCommGroup E + letI : Module ℝ (FunctionSpace E) := functionSpaceModule E + exact NormedAddCommGroup.ofCore (𝕜 := ℝ) { + toCore := { + norm_nonneg := fun _ => ENNReal.toReal_nonneg + norm_smul := by + intro c f + change freeNorm E (c • f) = ‖c‖ * freeNorm E f + change (freeNormExt E (c • (f : C(FVLv.dualUnitBall E, ℝ)))).toReal = + ‖c‖ * (freeNormExt E (f : C(FVLv.dualUnitBall E, ℝ))).toReal + rw [freeNormExt_smul, ENNReal.toReal_mul, ENNReal.toReal_ofReal (abs_nonneg c), + Real.norm_eq_abs] + norm_triangle := by + intro f g + change freeNorm E (f + g) ≤ freeNorm E f + freeNorm E g + have hne : freeNormExt E (f : C(FVLv.dualUnitBall E, ℝ)) + + freeNormExt E (g : C(FVLv.dualUnitBall E, ℝ)) ≠ ⊤ := by + rw [ENNReal.add_ne_top] + exact ⟨ne_of_lt f.2, ne_of_lt g.2⟩ + exact (ENNReal.toReal_mono hne + (freeNormExt_add_le E (f : C(FVLv.dualUnitBall E, ℝ)) + (g : C(FVLv.dualUnitBall E, ℝ)))).trans ENNReal.toReal_add_le + } + norm_eq_zero_iff := by + intro f + constructor + · intro h + exact Subtype.ext (coe_eq_zero_of_freeNorm_eq_zero E f h) + · intro h + subst h + change (freeNormExt E (0 : C(FVLv.dualUnitBall E, ℝ))).toReal = 0 + rw [freeNormExt_zero, ENNReal.toReal_zero] + } + +instance instAddCommGroupFunctionSpace : AddCommGroup (FunctionSpace E) := + NormedAddCommGroup.toAddCommGroup (E := FunctionSpace E) + (self := instNormedAddCommGroupFunctionSpace E) + +instance instNormedSpaceFunctionSpace : + @NormedSpace ℝ (FunctionSpace E) _ + (instNormedAddCommGroupFunctionSpace E).toSeminormedAddCommGroup := by + letI : Module ℝ (FunctionSpace E) := functionSpaceModule E + exact { + toModule := functionSpaceModule E + norm_smul_le := by + intro c f + change freeNorm E (c • f) ≤ ‖c‖ * freeNorm E f + change (freeNormExt E (c • (f : C(FVLv.dualUnitBall E, ℝ)))).toReal ≤ + ‖c‖ * (freeNormExt E (f : C(FVLv.dualUnitBall E, ℝ))).toReal + rw [freeNormExt_smul, ENNReal.toReal_mul, ENNReal.toReal_ofReal (abs_nonneg c), + Real.norm_eq_abs] + } + +instance instMaxFunctionSpace : Max (FunctionSpace E) := by + exact inferInstanceAs (Max (functionSpaceVectorSublattice E)) + +instance instMinFunctionSpace : Min (FunctionSpace E) := by + exact inferInstanceAs (Min (functionSpaceVectorSublattice E)) + +instance instLEFunctionSpace : LE (FunctionSpace E) := by + exact inferInstanceAs (LE (functionSpaceVectorSublattice E)) + +instance instLatticeFunctionSpace : Lattice (FunctionSpace E) := by + exact inferInstanceAs (Lattice (functionSpaceVectorSublattice E)) + +instance instIsOrderedAddMonoidFunctionSpace : + @IsOrderedAddMonoid (FunctionSpace E) + (AddCommGroup.toAddCommMonoid (G := FunctionSpace E) + (self := instAddCommGroupFunctionSpace E)) + (instLatticeFunctionSpace E).toPartialOrder.toPreorder := by + exact inferInstanceAs (IsOrderedAddMonoid (functionSpaceVectorSublattice E)) + +instance instVectorLatticeFunctionSpace : + @VectorLattice (FunctionSpace E) (instAddCommGroupFunctionSpace E) + (instLatticeFunctionSpace E) (instIsOrderedAddMonoidFunctionSpace E) where + toModule := + NormedSpace.toModule (𝕜 := ℝ) (E := FunctionSpace E) + (self := instNormedSpaceFunctionSpace E) + smul_le_smul_of_nonneg_left := by + intro c hc f g hfg + change ∀ φ : FVLv.dualUnitBall E, (c • (f : C(FVLv.dualUnitBall E, ℝ))) φ ≤ + (c • (g : C(FVLv.dualUnitBall E, ℝ))) φ + intro φ + exact smul_le_smul_of_nonneg_left (hfg φ) hc + +instance instContinuousConstSMulFunctionSpace : ContinuousConstSMul ℝ (FunctionSpace E) := by + infer_instance + +instance instNormedVectorLatticeFunctionSpace : + @NormedVectorLattice (FunctionSpace E) (instNormedAddCommGroupFunctionSpace E) + (instLatticeFunctionSpace E) (instIsOrderedAddMonoidFunctionSpace E) where + toVectorLattice := instVectorLatticeFunctionSpace E + solid := by + intro f g hfg + change freeNorm E f ≤ freeNorm E g + apply ENNReal.toReal_mono (ne_of_lt g.2) + apply freeNormExt_mono_abs + intro φ + exact hfg φ + norm_smul := by + intro c f + change freeNorm E (c • f) = ‖c‖ * freeNorm E f + change (freeNormExt E (c • (f : C(FVLv.dualUnitBall E, ℝ)))).toReal = + ‖c‖ * (freeNormExt E (f : C(FVLv.dualUnitBall E, ℝ))).toReal + rw [freeNormExt_smul, ENNReal.toReal_mul, ENNReal.toReal_ofReal (abs_nonneg c), + Real.norm_eq_abs] + +theorem sum_abs_apply_le_freeNorm (f : FunctionSpace E) {n : ℕ} + (φ : Fin n → FVLv.dualUnitBall E) (hφ : NormAdmissible E φ) : + ∑ i, |f (φ i)| ≤ ‖f‖ := by + change ∑ i, |(f : C(FVLv.dualUnitBall E, ℝ)) (φ i)| ≤ freeNorm E f + have hle := le_freeNormExt E (f := (f : C(FVLv.dualUnitBall E, ℝ))) φ hφ + exact (ENNReal.ofReal_le_iff_le_toReal (ne_of_lt (freeNormExt_lt_top E f))).mp hle + +theorem continuousMap_norm_le_freeNorm (f : FunctionSpace E) : + ‖(f : C(FVLv.dualUnitBall E, ℝ))‖ ≤ ‖f‖ := by + refine (ContinuousMap.norm_le (f := (f : C(FVLv.dualUnitBall E, ℝ))) + (C := ‖f‖) (norm_nonneg f)).mpr ?_ + intro φ + rw [Real.norm_eq_abs] + simpa [Fin.sum_univ_one] using + sum_abs_apply_le_freeNorm E f (fun _ : Fin 1 => φ) (normAdmissible_singleton E φ) + +theorem freeNormExt_sub_limit_le_of_cauchySeq {u : ℕ → FunctionSpace E} + {g : C(FVLv.dualUnitBall E, ℝ)} + (hg : Filter.Tendsto (fun n => (u n : C(FVLv.dualUnitBall E, ℝ))) Filter.atTop + (nhds g)) + {N : ℕ} {r : ℝ} + (hN : ∀ᶠ m in Filter.atTop, ‖u m - u N‖ ≤ r) : + freeNormExt E (g - (u N : C(FVLv.dualUnitBall E, ℝ))) ≤ ENNReal.ofReal r := by + apply freeNormExt_le_of_forall + intro n φ hφ + apply ENNReal.ofReal_le_ofReal + have hsum_tend : + Filter.Tendsto + (fun m => ∑ i, |((u m : C(FVLv.dualUnitBall E, ℝ)) - + (u N : C(FVLv.dualUnitBall E, ℝ))) (φ i)|) Filter.atTop + (nhds (∑ i, |(g - (u N : C(FVLv.dualUnitBall E, ℝ))) (φ i)|)) := by + apply tendsto_finsetSum + intro i hi + have hdiff_tend : + Filter.Tendsto + (fun m => (u m : C(FVLv.dualUnitBall E, ℝ)) - + (u N : C(FVLv.dualUnitBall E, ℝ))) Filter.atTop + (nhds (g - (u N : C(FVLv.dualUnitBall E, ℝ)))) := + hg.sub tendsto_const_nhds + have heval_tend : + Filter.Tendsto + (fun m => ((u m : C(FVLv.dualUnitBall E, ℝ)) - + (u N : C(FVLv.dualUnitBall E, ℝ))) (φ i)) Filter.atTop + (nhds ((g - (u N : C(FVLv.dualUnitBall E, ℝ))) (φ i))) := by + exact (((continuous_eval_const (φ i)).tendsto + (g - (u N : C(FVLv.dualUnitBall E, ℝ)))).comp hdiff_tend).congr' <| + Filter.Eventually.of_forall fun _ => by rfl + exact (continuous_abs.tendsto _).comp heval_tend + have htail : + ∀ᶠ m in Filter.atTop, + ∑ i, |((u m : C(FVLv.dualUnitBall E, ℝ)) - + (u N : C(FVLv.dualUnitBall E, ℝ))) (φ i)| ≤ r := by + filter_upwards [hN] with m hm + exact (sum_abs_apply_le_freeNorm E (u m - u N) φ hφ).trans (by simpa using hm) + exact le_of_tendsto_of_tendsto hsum_tend tendsto_const_nhds htail + +theorem freeNormExt_sub_limit_le_of_cauchySeq' {u : ℕ → FunctionSpace E} + {g : C(FVLv.dualUnitBall E, ℝ)} + (hg : Filter.Tendsto (fun n => (u n : C(FVLv.dualUnitBall E, ℝ))) Filter.atTop + (nhds g)) + {N : ℕ} {r : ℝ} + (hN : ∀ᶠ m in Filter.atTop, ‖u N - u m‖ ≤ r) : + freeNormExt E ((u N : C(FVLv.dualUnitBall E, ℝ)) - g) ≤ ENNReal.ofReal r := by + rw [← neg_sub g (u N : C(FVLv.dualUnitBall E, ℝ)), freeNormExt_neg] + apply freeNormExt_sub_limit_le_of_cauchySeq E hg + filter_upwards [hN] with m hm + simpa only [norm_sub_rev] using hm + +private noncomputable instance instCompleteSpaceFunctionSpace : + CompleteSpace (FunctionSpace E) := by + refine Metric.complete_of_cauchySeq_tendsto fun u hu => ?_ + have hu_continuousMap : + CauchySeq (fun n => (u n : C(FVLv.dualUnitBall E, ℝ))) := by + rw [Metric.cauchySeq_iff] at hu ⊢ + intro ε hε + obtain ⟨N, hN⟩ := hu ε hε + refine ⟨N, fun n hn m hm => ?_⟩ + rw [dist_eq_norm] + exact (continuousMap_norm_le_freeNorm E (u n - u m)).trans_lt (by + simpa [dist_eq_norm] using hN n hn m hm) + obtain ⟨g, hg⟩ := cauchySeq_tendsto_of_complete hu_continuousMap + have hg_finite : freeNormExt E g < ⊤ := by + rw [Metric.cauchySeq_iff] at hu + obtain ⟨N, hN⟩ := hu 1 zero_lt_one + have htail : ∀ᶠ m in Filter.atTop, ‖u m - u N‖ ≤ (1 : ℝ) := by + filter_upwards [Filter.eventually_atTop.2 ⟨N, fun m hm => hm⟩] with m hm + exact (le_of_lt (by simpa [dist_eq_norm] using hN m hm N le_rfl)) + have hdiff : + freeNormExt E (g - (u N : C(FVLv.dualUnitBall E, ℝ))) ≤ ENNReal.ofReal 1 := + freeNormExt_sub_limit_le_of_cauchySeq E hg htail + have hdiff_lt : freeNormExt E (g - (u N : C(FVLv.dualUnitBall E, ℝ))) < ⊤ := + lt_of_le_of_lt hdiff (lt_top_iff_ne_top.mpr ENNReal.ofReal_ne_top) + have hg_le : freeNormExt E g ≤ + freeNormExt E (g - (u N : C(FVLv.dualUnitBall E, ℝ))) + + freeNormExt E (u N : C(FVLv.dualUnitBall E, ℝ)) := by + simpa [sub_add_cancel] using + freeNormExt_add_le E (g - (u N : C(FVLv.dualUnitBall E, ℝ))) + (u N : C(FVLv.dualUnitBall E, ℝ)) + exact lt_of_le_of_lt hg_le + (lt_top_iff_ne_top.mpr + (ENNReal.add_ne_top.mpr ⟨ne_of_lt hdiff_lt, ne_of_lt (freeNormExt_lt_top E (u N))⟩)) + refine ⟨FunctionSpace.ofContinuousMap E g hg_finite, ?_⟩ + rw [Metric.tendsto_atTop] + intro ε hε + rw [Metric.cauchySeq_iff] at hu + obtain ⟨N, hN⟩ := hu (ε / 2) (by linarith) + refine ⟨N, fun n hn => ?_⟩ + rw [dist_eq_norm] + have htail : ∀ᶠ m in Filter.atTop, ‖u n - u m‖ ≤ ε / 2 := by + filter_upwards [Filter.eventually_atTop.2 ⟨N, fun m hm => hm⟩] with m hm + exact le_of_lt (by simpa [dist_eq_norm] using hN n hn m hm) + have hdiff : freeNormExt E ((u n : C(FVLv.dualUnitBall E, ℝ)) - g) ≤ + ENNReal.ofReal (ε / 2) := + freeNormExt_sub_limit_le_of_cauchySeq' E hg htail + have hnorm : ‖u n - FunctionSpace.ofContinuousMap E g hg_finite‖ ≤ ε / 2 := by + change (freeNormExt E (((u n - FunctionSpace.ofContinuousMap E g hg_finite : FunctionSpace E) : + C(FVLv.dualUnitBall E, ℝ)))).toReal ≤ ε / 2 + have hcoe : (((u n - FunctionSpace.ofContinuousMap E g hg_finite : FunctionSpace E) : + C(FVLv.dualUnitBall E, ℝ))) = + (u n : C(FVLv.dualUnitBall E, ℝ)) - g := rfl + rw [hcoe] + exact ENNReal.toReal_le_of_le_ofReal (by linarith) hdiff + linarith + +private noncomputable instance instBanachLatticeFunctionSpace : + BanachLattice (FunctionSpace E) where + +/-- The evaluation map `x ↦ x̂` as a function into the ambient free-normed space. -/ +def dualEval (x : E) : FunctionSpace E := + ⟨FVLv.dualEval E x, by + exact lt_of_le_of_lt (freeNormExt_dualEval_le E x) + (lt_top_iff_ne_top.mpr ENNReal.ofReal_ne_top)⟩ + +@[simp] +theorem dualEval_apply (x : E) (φ : FVLv.dualUnitBall E) : + dualEval E x φ = (φ : WeakDual ℝ E) x := by + rfl + +/-- The concrete free vector lattice generated by the evaluation maps inside the +free-normed ambient function space. -/ +def freeVectorLattice : VectorSublattice (FunctionSpace E) := + VectorSublattice.generated (Set.range (dualEval E : E → FunctionSpace E)) + +/-- The concrete free Banach lattice: the closure, for the free norm, of the free vector +lattice generated by `E`. -/ +def closedFreeVectorLattice : VectorSublattice (FunctionSpace E) := + (freeVectorLattice E).topologicalClosure + +end FBL + +/-- The free Banach lattice generated by a real normed space, realized as the free-norm closure of +its concrete free vector lattice in `C(B_{E*}, ℝ)`. -/ +abbrev FBL (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] : + Type u := + FBL.closedFreeVectorLattice E + +namespace FBL + +variable {E : Type u} [NormedAddCommGroup E] [NormedSpace ℝ E] + +instance instCoeFunctionSpace : Coe (FBL E) (FunctionSpace E) where + coe f := f.1 + +instance instCoeFun : CoeFun (FBL E) (fun _ => FVLv.dualUnitBall E → ℝ) where + coe f := (f : FunctionSpace E) + +instance instBanachLatticeFBL : BanachLattice (FBL E) where + toCompleteSpace := by + have hclosed : IsClosed (closedFreeVectorLattice E : Set (FunctionSpace E)) := + (freeVectorLattice E).isClosed_topologicalClosure + exact hclosed.completeSpace_coe + +/-- The canonical embedding of `E` into its free Banach lattice. -/ +def of (x : E) : FBL E := + ⟨dualEval E x, (freeVectorLattice E).le_topologicalClosure + (VectorSublattice.subset_generated _ ⟨x, rfl⟩)⟩ + +@[simp] +theorem of_apply (x : E) (φ : FVLv.dualUnitBall E) : + (of x : FBL E) φ = (φ : WeakDual ℝ E) x := by + rfl + +/-- The canonical map `E → FBL E`, bundled as a real-linear map. -/ +def ofLinear : E →ₗ[ℝ] FBL E := by + refine + { toFun := of + map_add' := ?_ + map_smul' := ?_ } + · intro x y + apply Subtype.ext + apply Subtype.ext + ext φ + exact (φ : WeakDual ℝ E).map_add x y + · intro r x + apply Subtype.ext + apply Subtype.ext + ext φ + exact (φ : WeakDual ℝ E).map_smul r x + +@[simp] +theorem ofLinear_apply (x : E) : ofLinear x = of x := by + rfl + +/-- The canonical map from `E` to `FBL E` preserves norms. -/ +theorem norm_of (x : E) : ‖of x‖ = ‖x‖ := by + refine le_antisymm ?_ ?_ + · change (freeNormExt E (FVLv.dualEval E x)).toReal ≤ ‖x‖ + simpa using ENNReal.toReal_mono ENNReal.ofReal_ne_top (freeNormExt_dualEval_le E x) + · obtain ⟨φ, hφnorm, hφx⟩ := exists_dual_vector'' ℝ x + let ψ : FVLv.dualUnitBall E := ⟨StrongDual.toWeakDual φ, by + dsimp [FVLv.dualUnitBall] + simpa [Metric.mem_closedBall, dist_eq_norm] using hφnorm⟩ + have hle := + sum_abs_apply_le_freeNorm E (of x : FBL E) (fun _ : Fin 1 => ψ) + (normAdmissible_singleton E ψ) + change ‖x‖ ≤ ‖((of x : FBL E) : FunctionSpace E)‖ + simpa [Fin.sum_univ_one, ψ, hφx, Real.norm_eq_abs] using hle + +/-- The canonical map from `E` to `FBL E` is an isometric embedding. -/ +def ofLinearIsometry : E →ₗᵢ[ℝ] FBL E := by + exact + { toLinearMap := ofLinear + norm_map' := norm_of } + +@[simp] +theorem ofLinearIsometry_apply (x : E) : ofLinearIsometry x = of x := by + rfl + +/-- The canonical map from `E` to `FBL E` is injective. -/ +theorem of_injective : Function.Injective (of : E → FBL E) := by + exact ofLinearIsometry.injective + +/-- The copy of the concrete free vector lattice from `FVLv.lean` inside `FBL E`. -/ +def ofFVLv : FVLv E →ₗ[ℝ] FBL E := by + exact (FVLv.lift (ofLinear (E := E))).toLinearMap + +@[simp] +theorem ofFVLv_of (x : E) : ofFVLv (FVLv.of x) = of x := by + change FVLv.lift (ofLinear (E := E)) (FVLv.of x) = of x + exact FVLv.lift_of (T := ofLinear (E := E)) x + +/-- The image of the concrete free vector lattice is dense in `FBL E`. -/ +theorem denseRange_ofFVLv : DenseRange (ofFVLv (E := E)) := by + let hst : (freeVectorLattice E : Set (FunctionSpace E)) ⊆ + (closedFreeVectorLattice E : Set (FunctionSpace E)) := + (freeVectorLattice E).le_topologicalClosure + let ι : freeVectorLattice E → FBL E := Set.inclusion hst + have hι_dense : DenseRange ι := by + change DenseRange (Set.inclusion hst) + exact (denseRange_inclusion_iff hst).2 (by + change ((freeVectorLattice E).topologicalClosure : Set (FunctionSpace E)) ⊆ _ + rw [VectorSublattice.topologicalClosure_coe]) + have hι_range : Set.range ι ⊆ Set.range (ofFVLv (E := E)) := by + intro z hz + rcases hz with ⟨y, rfl⟩ + have hy : (y : FunctionSpace E) ∈ + VectorSublattice.generated (Set.range (dualEval E : E → FunctionSpace E)) := by + simp only [freeVectorLattice] at y + exact y.2 + change (y : FunctionSpace E) ∈ + (VectorSublattice.generated (Set.range (dualEval E : E → FunctionSpace E)) : + Set (FunctionSpace E)) at hy + rw [LLexpr.generated_eq_iUnion_combinations + (Set.range (dualEval E : E → FunctionSpace E))] at hy + simp only [Set.mem_iUnion, LLexpr.combinations, Set.mem_range] at hy + obtain ⟨n, z, e, hz⟩ := hy + choose x hx using fun i : Fin n => (z i).2 + refine ⟨LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e, ?_⟩ + apply Subtype.ext + have hmap : + ofFVLv (LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e) = + LLexpr.eval (fun i : Fin n => of (x i)) e := by + have hof (f : FVLv E) : + ofFVLv f = FVLv.lift (ofLinear (E := E)) f := rfl + have hof_generator (z : E) : + FVLv.lift (ofLinear (E := E)) (FVLv.of z) = of z := + FVLv.lift_of (T := ofLinear (E := E)) z + simpa only [hof, hof_generator] using + LLexpr.map_eval (FVLv.lift (ofLinear (E := E))) + (fun i : Fin n => FVLv.of (x i)) e + calc + ((ofFVLv (LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e) : FBL E) : FunctionSpace E) + = ((LLexpr.eval (fun i : Fin n => of (x i)) e : FBL E) : FunctionSpace E) := by + rw [hmap] + _ = LLexpr.eval (fun i : Fin n => dualEval E (x i)) e := by + have hof (z : E) : ((of z : FBL E) : FunctionSpace E) = dualEval E z := rfl + simpa only [hof] using + (LLexpr.coe_eval_vectorSublattice (closedFreeVectorLattice E) + (fun i : Fin n => of (x i)) e) + _ = LLexpr.eval (fun i : Fin n => (z i : FunctionSpace E)) e := by + congr + funext i + rw [hx i] + _ = (y : FunctionSpace E) := by + have hzfun : Subtype.val ∘ z = fun i => (z i : FunctionSpace E) := by + funext i + rfl + rw [hzfun] at hz + exact hz + apply denseRange_iff_closure_range.mpr + ext z + constructor + · intro _; trivial + · intro _ + have hz : z ∈ closure (Set.range ι) := by + rw [hι_dense.closure_range] + trivial + exact closure_mono hι_range hz + +section UniversalProperty + +variable {X : Type v} [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [BanachLattice X] + +/-- The supremum of a finite nonempty family in a lattice. -/ +noncomputable def finiteSup {ι Y : Type*} [Fintype ι] [Nonempty ι] + [Lattice Y] (y : ι → Y) : Y := + Finset.univ.sup' Finset.univ_nonempty y + +/-- Evaluate a finite real linear combination at a family of vectors. -/ +noncomputable def linCombEval {n : ℕ} {Y : Type*} [AddCommGroup Y] [Module ℝ Y] + (a : Fin n → ℝ) (y : Fin n → Y) : Y := + Fintype.linearCombination ℝ y a + +theorem finiteSup_subtype_eq {n : ℕ} {Y : Type*} [AddCommGroup Y] [Lattice Y] + [IsOrderedAddMonoid Y] [VectorLattice Y] (A : LLexpr.SupLinearCombination n) + [Nonempty {p // p ∈ A.coeffs}] (y : Fin n → Y) : + finiteSup (fun a : {p // p ∈ A.coeffs} => linCombEval a.1 y) = A.eval y := by + let emb : {p // p ∈ A.coeffs} ↪ (Fin n → ℝ) := + ⟨Subtype.val, fun _ _ h => Subtype.ext h⟩ + have huniv : (Finset.univ : Finset {p // p ∈ A.coeffs}) = A.coeffs.attach := by + ext a + simp + have hsattach : A.coeffs.attach.Nonempty := by + rcases A.nonempty with ⟨p, hp⟩ + exact ⟨⟨p, hp⟩, by simp⟩ + have hmap : A.coeffs.attach.map emb = A.coeffs := by + ext a + simp only [Finset.mem_map, Finset.mem_attach, true_and, Subtype.exists, emb] + exact ⟨fun ⟨_, hb, h⟩ => h ▸ hb, fun h => ⟨a, h, rfl⟩⟩ + have hsmap : (A.coeffs.attach.map emb).Nonempty := by + simpa [hmap] using A.nonempty + calc + finiteSup (fun a : {p // p ∈ A.coeffs} => linCombEval a.1 y) + = A.coeffs.attach.sup' hsattach (fun a => linCombEval a.1 y) := by + simp [finiteSup, huniv] + _ = (A.coeffs.attach.map emb).sup' hsmap + (fun a => linCombEval a y) := by + exact + (Finset.sup'_map (s := A.coeffs.attach) (f := emb) + (g := fun a => linCombEval a y) (hs := hsmap)).symm + _ = A.eval y := by + simp [LLexpr.SupLinearCombination.eval, linCombEval, hmap] + +theorem finiteSup_comp_equiv {ι κ Y : Type*} [Fintype ι] [Nonempty ι] [Fintype κ] + [Nonempty κ] [Lattice Y] (e : ι ≃ κ) (f : κ → Y) : + finiteSup (fun i : ι => f (e i)) = finiteSup f := by + refine le_antisymm ?_ ?_ + · unfold finiteSup + rw [Finset.sup'_le_iff] + intro i hi + exact Finset.le_sup' (f := f) (Finset.mem_univ _) + · unfold finiteSup + rw [Finset.sup'_le_iff] + intro j hj + simpa using + (Finset.le_sup' (f := fun i : ι => f (e i)) (Finset.mem_univ (e.symm j))) + +theorem supLinearCombination_exists_tuple {n : ℕ} (A : LLexpr.SupLinearCombination n) : + ∃ m : ℕ, ∃ a : Fin (m + 1) → Fin n → ℝ, + ∀ {Y : Type*} [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + (y : Fin n → Y), + finiteSup (fun i : Fin (m + 1) => linCombEval (a i) y) = A.eval y := by + let I : Type := {p // p ∈ A.coeffs} + let e : I ≃ Fin (Fintype.card I) := Fintype.equivFin I + have hI : Nonempty I := by + rcases A.nonempty with ⟨p, hp⟩ + exact ⟨⟨p, hp⟩⟩ + let m := Fintype.card I - 1 + have hm : m + 1 = Fintype.card I := by + dsimp [m] + exact Nat.succ_pred_eq_of_pos (Fintype.card_pos_iff.mpr hI) + let a : Fin (m + 1) → Fin n → ℝ := fun i => ((e.symm (finCongr hm i)).1) + refine ⟨m, a, ?_⟩ + intro Y _ _ _ _ y + let : Nonempty I := hI + have h₁ : + finiteSup (fun i : Fin (m + 1) => linCombEval (a i) y) = + finiteSup (fun i : Fin (Fintype.card I) => linCombEval ((e.symm i).1) y) := by + simpa [a] using + (finiteSup_comp_equiv (finCongr hm) + (fun i : Fin (Fintype.card I) => linCombEval ((e.symm i).1) y)) + have h₂ : + finiteSup (fun i : Fin (Fintype.card I) => linCombEval ((e.symm i).1) y) = + finiteSup (fun i : I => linCombEval i.1 y) := by + exact finiteSup_comp_equiv e.symm (fun i : I => linCombEval i.1 y) + calc + finiteSup (fun i : Fin (m + 1) => linCombEval (a i) y) + = finiteSup (fun i : Fin (Fintype.card I) => linCombEval ((e.symm i).1) y) := h₁ + _ = finiteSup (fun i : I => linCombEval i.1 y) := h₂ + _ = A.eval y := finiteSup_subtype_eq A y + +theorem finiteSup_map_vecLatHom {ι Y Z : Type*} [Fintype ι] [Nonempty ι] + [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + [AddCommGroup Z] [Lattice Z] [IsOrderedAddMonoid Z] [VectorLattice Z] + (S : VecLatHom Y Z) (y : ι → Y) : + S (finiteSup y) = finiteSup (fun i => S (y i)) := by + unfold finiteSup + change S.toLatticeHom (Finset.univ.sup' Finset.univ_nonempty y) = + Finset.univ.sup' Finset.univ_nonempty (S.toLatticeHom ∘ y) + exact map_finset_sup' S.toLatticeHom Finset.univ_nonempty y + +/-- The algebraic vector-lattice extension of `T` to the dense copy of `FVLv E`. -/ +noncomputable def liftFVLv (T : E →L[ℝ] X) : VecLatHom (FVLv E) X := + FVLv.lift T.toLinearMap + +theorem liftFVLv_of (T : E →L[ℝ] X) (x : E) : + liftFVLv T (FVLv.of x) = T x := by + unfold liftFVLv + exact FVLv.lift_of (T := T.toLinearMap) x + +/-- The linear combination of the canonical free-vector-lattice generators. -/ +noncomputable def fvlvLinearCombination {n : ℕ} + (x : Fin n → E) (a : Fin n → ℝ) : FVLv E := + ∑ i, a i • FVLv.of (x i) + +/-- The image under `T` of a finite linear combination of generators. -/ +noncomputable def imageLinearCombination {n : ℕ} + (T : E →L[ℝ] X) (x : Fin n → E) (a : Fin n → ℝ) : X := + ∑ i, a i • T (x i) + +/-- Evaluate a linear combination of generators at a dual-ball functional. -/ +noncomputable def dualLinearCombination {n : ℕ} + (x : Fin n → E) (a : Fin n → ℝ) (φ : FVLv.dualUnitBall E) : ℝ := + ∑ i, a i * (φ : WeakDual ℝ E) (x i) + +theorem liftFVLv_linearCombination {n : ℕ} (T : E →L[ℝ] X) + (x : Fin n → E) (a : Fin n → ℝ) : + liftFVLv T (fvlvLinearCombination x a) = imageLinearCombination T x a := by + simp [liftFVLv, fvlvLinearCombination, imageLinearCombination] + +theorem liftFVLv_supSubLinearCombination {m p n : ℕ} (T : E →L[ℝ] X) + (x : Fin n → E) (a : Fin (m + 1) → Fin n → ℝ) + (b : Fin (p + 1) → Fin n → ℝ) : + liftFVLv T + (finiteSup (fun i : Fin (m + 1) => fvlvLinearCombination x (a i)) - + finiteSup (fun j : Fin (p + 1) => fvlvLinearCombination x (b j))) = + finiteSup (fun i : Fin (m + 1) => imageLinearCombination T x (a i)) - + finiteSup (fun j : Fin (p + 1) => imageLinearCombination T x (b j)) := by + rw [map_sub, finiteSup_map_vecLatHom, finiteSup_map_vecLatHom] + simp [liftFVLv_linearCombination] + +theorem ofFVLv_linearCombination_apply {n : ℕ} + (x : Fin n → E) (a : Fin n → ℝ) (φ : FVLv.dualUnitBall E) : + (ofFVLv (fvlvLinearCombination x a) : FBL E) φ = + dualLinearCombination x a φ := by + let ev : FBL E →ₗ[ℝ] ℝ := + { toFun := fun f => f φ + map_add' := fun _ _ => rfl + map_smul' := fun _ _ => rfl } + change ev (ofFVLv (fvlvLinearCombination x a)) = dualLinearCombination x a φ + change + ev + (liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap) + (fvlvLinearCombination x a) : FBL E) = + dualLinearCombination x a φ + rw [liftFVLv_linearCombination] + simp [ev, imageLinearCombination, dualLinearCombination, ofLinearIsometry_apply, + smul_eq_mul] + rfl + +/-- Evaluation on the dual ball as a lattice homomorphism from the free Banach lattice. -/ +def evalAtFBL (φ : FVLv.dualUnitBall E) : VecLatHom (FBL E) ℝ where + toFun f := f φ + map_add' _ _ := rfl + map_smul' _ _ := rfl + map_sup' _ _ := rfl + map_inf' _ _ := rfl + +theorem ofFVLv_supSubLinearCombination_apply {m p n : ℕ} + (x : Fin n → E) (a : Fin (m + 1) → Fin n → ℝ) + (b : Fin (p + 1) → Fin n → ℝ) (φ : FVLv.dualUnitBall E) : + (ofFVLv + (finiteSup (fun i : Fin (m + 1) => fvlvLinearCombination x (a i)) - + finiteSup (fun j : Fin (p + 1) => fvlvLinearCombination x (b j))) : + FBL E) φ = + finiteSup (fun i : Fin (m + 1) => dualLinearCombination x (a i) φ) - + finiteSup (fun j : Fin (p + 1) => dualLinearCombination x (b j) φ) := by + let S := evalAtFBL (E := E) φ + unfold ofFVLv + change S + ((FVLv.lift (ofLinear (E := E))) + (finiteSup (fun i : Fin (m + 1) => fvlvLinearCombination x (a i)) - + finiteSup (fun j : Fin (p + 1) => fvlvLinearCombination x (b j)))) = + finiteSup (fun i : Fin (m + 1) => dualLinearCombination x (a i) φ) - + finiteSup (fun j : Fin (p + 1) => dualLinearCombination x (b j) φ) + rw [map_sub] + rw [map_sub] + rw [finiteSup_map_vecLatHom, finiteSup_map_vecLatHom] + rw [finiteSup_map_vecLatHom, finiteSup_map_vecLatHom] + have hA : + (fun i : Fin (m + 1) => + S ((FVLv.lift (ofLinear (E := E))) (fvlvLinearCombination x (a i)))) = + fun i : Fin (m + 1) => dualLinearCombination x (a i) φ := by + funext i + have hS (f : FBL E) : S f = f φ := rfl + have hlift (f : FVLv E) : + FVLv.lift (ofLinear (E := E)) f = ofFVLv f := rfl + simpa only [hS, hlift] using ofFVLv_linearCombination_apply (x := x) (a := a i) φ + have hB : + (fun j : Fin (p + 1) => + S ((FVLv.lift (ofLinear (E := E))) (fvlvLinearCombination x (b j)))) = + fun j : Fin (p + 1) => dualLinearCombination x (b j) φ := by + funext j + have hS (f : FBL E) : S f = f φ := rfl + have hlift (f : FVLv E) : + FVLv.lift (ofLinear (E := E)) f = ofFVLv f := rfl + simpa only [hS, hlift] using ofFVLv_linearCombination_apply (x := x) (a := b j) φ + rw [hA, hB] + +theorem exists_supSubLinearCombination_eval {n : ℕ} (e : LLexpr n) : + ∃ (m p : ℕ) (a : Fin (m + 1) → Fin n → ℝ) (b : Fin (p + 1) → Fin n → ℝ), + ∀ {Y : Type*} [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + (y : Fin n → Y), + LLexpr.eval y e = + finiteSup (fun i : Fin (m + 1) => linCombEval (a i) y) - + finiteSup (fun j : Fin (p + 1) => linCombEval (b j) y) := by + let N := LLexpr.normalize e + obtain ⟨m, a, ha⟩ := supLinearCombination_exists_tuple N.pos + obtain ⟨p, b, hb⟩ := supLinearCombination_exists_tuple N.neg + refine ⟨m, p, a, b, ?_⟩ + intro Y _ _ _ _ y + calc + LLexpr.eval y e = N.eval y := by + exact (LLexpr.normalize_eval y e).symm + _ = finiteSup (fun i : Fin (m + 1) => linCombEval (a i) y) - + finiteSup (fun j : Fin (p + 1) => linCombEval (b j) y) := by + rw [LLexpr.NormalForm.eval, ← ha y, ← hb y] + +theorem exists_supSubLinearCombination_eq (f : FVLv E) : + ∃ (n m p : ℕ) (x : Fin n → E) (a : Fin (m + 1) → Fin n → ℝ) + (b : Fin (p + 1) → Fin n → ℝ), + f = + finiteSup (fun i : Fin (m + 1) => fvlvLinearCombination x (a i)) - + finiteSup (fun j : Fin (p + 1) => fvlvLinearCombination x (b j)) := by + obtain ⟨n, x, e, he⟩ := FVLv.exists_eval_of_eq (E := E) f + obtain ⟨m, p, a, b, hab⟩ := exists_supSubLinearCombination_eval e + refine ⟨n, m, p, x, a, b, ?_⟩ + calc + f = LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e := by + symm + exact he + _ = finiteSup (fun i : Fin (m + 1) => fvlvLinearCombination x (a i)) - + finiteSup (fun j : Fin (p + 1) => fvlvLinearCombination x (b j)) := by + simpa [fvlvLinearCombination, linCombEval, Fintype.linearCombination_apply] using + (hab (fun i : Fin n => FVLv.of (x i))) + +theorem ofFVLv_apply (f : FVLv E) (φ : FVLv.dualUnitBall E) : + (ofFVLv f : FBL E) φ = f φ := by + obtain ⟨n, x, e, hf⟩ := FVLv.exists_eval_of_eq (E := E) f + rw [← hf] + let S : VecLatHom (FVLv E) ℝ := + { toFun := fun g => g φ + map_add' := fun _ _ => rfl + map_smul' := fun _ _ => rfl + map_sup' := fun _ _ => rfl + map_inf' := fun _ _ => rfl } + have hmap : + ofFVLv (LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e) = + LLexpr.eval (fun i : Fin n => of (x i)) e := by + have hof (g : FVLv E) : + ofFVLv g = FVLv.lift (ofLinear (E := E)) g := rfl + have hof_generator (z : E) : + FVLv.lift (ofLinear (E := E)) (FVLv.of z) = of z := + FVLv.lift_of (T := ofLinear (E := E)) z + simpa only [hof, hof_generator] using + LLexpr.map_eval (FVLv.lift (ofLinear (E := E))) + (fun i : Fin n => FVLv.of (x i)) e + have hFVLv : + S (LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e) = + LLexpr.eval (fun i : Fin n => (φ : WeakDual ℝ E) (x i)) e := by + have hS (g : FVLv E) : S g = g φ := rfl + simpa only [hS, FVLv.of_apply] using + LLexpr.map_eval S (fun i : Fin n => FVLv.of (x i)) e + have hFBL : + evalAtFBL φ (LLexpr.eval (fun i : Fin n => of (x i)) e) = + LLexpr.eval (fun i : Fin n => (φ : WeakDual ℝ E) (x i)) e := by + have heval (g : FBL E) : evalAtFBL φ g = g φ := rfl + simpa only [heval, of_apply] using + LLexpr.map_eval (evalAtFBL φ) (fun i : Fin n => of (x i)) e + calc + (ofFVLv (LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e) : FBL E) φ + = (LLexpr.eval (fun i : Fin n => of (x i)) e : FBL E) φ := by + rw [hmap] + _ = evalAtFBL φ (LLexpr.eval (fun i : Fin n => of (x i)) e) := rfl + _ = LLexpr.eval (fun i : Fin n => (φ : WeakDual ℝ E) (x i)) e := hFBL + _ = S (LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e) := by + symm + exact hFVLv + _ = (LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e : FVLv E) φ := rfl + +theorem isLUB_strongDual_apply_finiteSup {ι : Type*} [Fintype ι] [Nonempty ι] + {ψ : StrongDual ℝ X} (hψ : 0 ≤ ψ) (y : ι → X) : + IsLUB + {r : ℝ | ∃ ψi : ι → StrongDual ℝ X, + (∀ i, 0 ≤ ψi i) ∧ (∑ i, ψi i) = ψ ∧ r = ∑ i, ψi i (y i)} + (ψ (finiteSup y)) := by + classical + let S₁ : Set ℝ := + {r : ℝ | ∃ ψi : ι → StrongDual ℝ X, + (∀ i, 0 ≤ ψi i) ∧ (∑ i, ψi i) = ψ ∧ r = ∑ i, ψi i (y i)} + let S₂ : Set ℝ := + {r : ℝ | ∃ φi : ι → OrderDualSpace X, + (∀ i, 0 ≤ φi i) ∧ (∑ i, φi i) = StrongDual.toOrderDualSpace ψ ∧ + r = ∑ i, φi i (y i)} + have hzeroOD : StrongDual.toOrderDualSpace (0 : StrongDual ℝ X) = 0 := by + ext z + rfl + have hroundOD (g : OrderDualSpace X) : + StrongDual.toOrderDualSpace (StrongDual.ofOrderDualSpace g) = g := by + ext z + rfl + have hS : S₁ = S₂ := by + ext r + constructor + · rintro ⟨ψi, hψi0, hsum, hr⟩ + refine ⟨fun i => StrongDual.toOrderDualSpace (ψi i), ?_, ?_, ?_⟩ + · intro i + have h := hψi0 i + change StrongDual.toOrderDualSpace 0 ≤ + StrongDual.toOrderDualSpace (ψi i) at h + simpa only [hzeroOD] using h + · calc + ∑ i, StrongDual.toOrderDualSpace (ψi i) = + StrongDual.toOrderDualSpaceLinear (∑ i, ψi i) := by + simp [StrongDual.toOrderDualSpaceLinear] + _ = StrongDual.toOrderDualSpace ψ := by rw [hsum]; rfl + · simpa [StrongDual.toOrderDualSpace_apply] using hr + · rintro ⟨φi, hφi0, hsum, hr⟩ + refine ⟨fun i => StrongDual.ofOrderDualSpace (φi i), ?_, ?_, ?_⟩ + · intro i + change StrongDual.toOrderDualSpace (0 : StrongDual ℝ X) ≤ + StrongDual.toOrderDualSpace (StrongDual.ofOrderDualSpace (φi i)) + simpa only [hzeroOD, hroundOD] using hφi0 i + · calc + ∑ i, StrongDual.ofOrderDualSpace (φi i) = + StrongDual.equivOrderDualSpace.symm (∑ i, φi i) := by + simp [StrongDual.equivOrderDualSpace] + _ = ψ := by + rw [hsum] + ext x + rfl + · simpa [StrongDual.ofOrderDualSpace_apply] using hr + have hOD : 0 ≤ StrongDual.toOrderDualSpace ψ := by + have h := hψ + change StrongDual.toOrderDualSpace 0 ≤ StrongDual.toOrderDualSpace ψ at h + simpa only [hzeroOD] using h + have hLUB : + IsLUB S₂ ((StrongDual.toOrderDualSpace ψ) (finiteSup y)) := by + simpa [S₂, finiteSup] using + (OrderBoundedHom.isLUB_apply_finset_sup (s := Finset.univ) (hs := Finset.univ_nonempty) + (f := StrongDual.toOrderDualSpace ψ) hOD y) + simpa [S₁, hS, StrongDual.toOrderDualSpace_apply] using hLUB + +theorem strongDual_component_le_of_sum {ι : Type*} [Fintype ι] + {ψi : ι → StrongDual ℝ X} {ψ : StrongDual ℝ X} + (hψi0 : ∀ i, 0 ≤ ψi i) (hsum : ∑ i, ψi i = ψ) (i : ι) : + ψi i ≤ ψ := by + refine (StrongDual.le_iff).2 ?_ + intro z hz + have hsumz : ∑ j, ψi j z = ψ z := by + simpa using congrArg (fun F : StrongDual ℝ X => F z) hsum + exact hsumz ▸ Finset.single_le_sum + (fun j _ => (StrongDual.nonneg_iff.mp (hψi0 j)) z hz) (Finset.mem_univ i) + +theorem strongDual_norm_le_of_nonneg_le {φ ψ : StrongDual ℝ X} + (hφ0 : 0 ≤ φ) (hψ0 : 0 ≤ ψ) (hφψ : φ ≤ ψ) : + ‖φ‖ ≤ ‖ψ‖ := by + exact HasSolidNorm.solid + (by simpa [abs_of_nonneg hφ0, abs_of_nonneg hψ0] using hφψ) + +/-- Pull a dual family back along `T`, normalized by the operator norm. -/ +noncomputable def scaledCompWeakDualFamily {ι : Type*} + (T : E →L[ℝ] X) (ψi : ι → StrongDual ℝ X) : ι → WeakDual ℝ E := + fun i => StrongDual.toWeakDual (‖T‖⁻¹ • (ψi i).comp T) + +theorem scaledCompWeakDualFamily_mem_dualUnitBall {ι : Type*} [Fintype ι] + (T : E →L[ℝ] X) {ψi : ι → StrongDual ℝ X} {ψ : StrongDual ℝ X} + (hψi0 : ∀ i, 0 ≤ ψi i) (hsum : ∑ i, ψi i = ψ) (hψ0 : 0 ≤ ψ) + (hψnorm : ‖ψ‖ ≤ 1) (hT : 0 < ‖T‖) (i : ι) : + scaledCompWeakDualFamily T ψi i ∈ FVLv.dualUnitBall E := by + have hψi_le : ψi i ≤ ψ := strongDual_component_le_of_sum hψi0 hsum i + have hψi_norm : ‖ψi i‖ ≤ ‖ψ‖ := strongDual_norm_le_of_nonneg_le (hψi0 i) hψ0 hψi_le + have hnorm : ‖‖T‖⁻¹ • (ψi i).comp T‖ ≤ 1 := by + calc + ‖‖T‖⁻¹ • (ψi i).comp T‖ = ‖T‖⁻¹ * ‖(ψi i).comp T‖ := by + rw [norm_smul, Real.norm_of_nonneg (inv_nonneg.mpr hT.le)] + _ ≤ ‖T‖⁻¹ * (‖ψi i‖ * ‖T‖) := by + gcongr + exact ContinuousLinearMap.opNorm_comp_le (ψi i) T + _ ≤ ‖T‖⁻¹ * (‖ψ‖ * ‖T‖) := by + gcongr + _ ≤ ‖T‖⁻¹ * (1 * ‖T‖) := by + gcongr + _ = 1 := by + rw [one_mul, inv_mul_cancel₀ hT.ne'] + dsimp [scaledCompWeakDualFamily, FVLv.dualUnitBall] + simpa [Metric.mem_closedBall, dist_eq_norm] using hnorm + +/-- The normalized dual-ball family obtained from a positive dual decomposition. -/ +noncomputable def scaledCompDualFamily {ι : Type*} [Fintype ι] + (T : E →L[ℝ] X) {ψi : ι → StrongDual ℝ X} {ψ : StrongDual ℝ X} + (hψi0 : ∀ i, 0 ≤ ψi i) (hsum : ∑ i, ψi i = ψ) (hψ0 : 0 ≤ ψ) + (hψnorm : ‖ψ‖ ≤ 1) (hT : 0 < ‖T‖) : ι → FVLv.dualUnitBall E := + fun i => + ⟨scaledCompWeakDualFamily T ψi i, + scaledCompWeakDualFamily_mem_dualUnitBall T hψi0 hsum hψ0 hψnorm hT i⟩ + +theorem scaledCompDualFamily_admissible {n : ℕ} + (T : E →L[ℝ] X) {ψi : Fin n → StrongDual ℝ X} {ψ : StrongDual ℝ X} + (hψi0 : ∀ i, 0 ≤ ψi i) (hsum : ∑ i, ψi i = ψ) (hψ0 : 0 ≤ ψ) + (hψnorm : ‖ψ‖ ≤ 1) (hT : 0 < ‖T‖) : + NormAdmissible E + (scaledCompDualFamily (ι := Fin n) (ψi := ψi) (ψ := ψ) T hψi0 hsum hψ0 hψnorm hT) := by + let Φ : Fin n → FVLv.dualUnitBall E := + scaledCompDualFamily (ι := Fin n) (ψi := ψi) (ψ := ψ) T hψi0 hsum hψ0 hψnorm hT + intro z hz + calc + ∑ i, |((Φ i : FVLv.dualUnitBall E) : WeakDual ℝ E) z| + = ∑ i, ‖T‖⁻¹ * |ψi i (T z)| := by + apply Finset.sum_congr rfl + intro i hi + change |(‖T‖⁻¹ * ψi i (T z))| = ‖T‖⁻¹ * |ψi i (T z)| + simp [abs_mul, abs_of_nonneg (inv_nonneg.mpr hT.le)] + _ = ‖T‖⁻¹ * ∑ i, |ψi i (T z)| := by + rw [Finset.mul_sum] + _ ≤ ‖T‖⁻¹ * ∑ i, ψi i (|T z|) := by + refine mul_le_mul_of_nonneg_left ?_ (inv_nonneg.mpr hT.le) + exact Finset.sum_le_sum fun i _ => StrongDual.abs_apply_le_apply_abs (hψi0 i) (T z) + _ = ‖T‖⁻¹ * ψ (|T z|) := by + congr 1 + simpa using congrArg (fun F : StrongDual ℝ X => F (|T z|)) hsum + _ ≤ ‖T‖⁻¹ * ‖T‖ := by + refine mul_le_mul_of_nonneg_left ?_ (inv_nonneg.mpr hT.le) + have hψabs_nonneg : 0 ≤ ψ (|T z|) := (StrongDual.nonneg_iff.mp hψ0) _ (abs_nonneg _) + calc + ψ (|T z|) = ‖ψ (|T z|)‖ := by + rw [Real.norm_eq_abs, abs_of_nonneg hψabs_nonneg] + _ ≤ ‖ψ‖ * ‖|T z|‖ := ψ.le_opNorm (|T z|) + _ = ‖ψ‖ * ‖T z‖ := by rw [norm_abs_eq_norm] + _ ≤ 1 * ‖T z‖ := by + gcongr + _ ≤ 1 * (‖T‖ * ‖z‖) := by + gcongr + exact ContinuousLinearMap.le_opNorm T z + _ ≤ 1 * (‖T‖ * 1) := by + gcongr + _ = ‖T‖ := by ring + _ = 1 := by + rw [inv_mul_cancel₀ hT.ne'] + +theorem ofFVLv_apply_scaledCompDualFamily_nonneg {n : ℕ} + (T : E →L[ℝ] X) {f : FVLv E} (hf : 0 ≤ f) {ψi : Fin n → StrongDual ℝ X} + {ψ : StrongDual ℝ X} (hψi0 : ∀ i, 0 ≤ ψi i) (hsum : ∑ i, ψi i = ψ) + (hψ0 : 0 ≤ ψ) (hψnorm : ‖ψ‖ ≤ 1) (hT : 0 < ‖T‖) (i : Fin n) : + 0 ≤ (ofFVLv f : FBL E) + (scaledCompDualFamily (ι := Fin n) (ψi := ψi) (ψ := ψ) T hψi0 hsum hψ0 hψnorm hT i) := by + simpa [ofFVLv_apply] using + (FVLv.le_def.mp hf + (scaledCompDualFamily (ι := Fin n) (ψi := ψi) (ψ := ψ) T hψi0 hsum hψ0 hψnorm hT i)) + +theorem sum_ofFVLv_apply_scaledCompDualFamily_le {n : ℕ} + (T : E →L[ℝ] X) {f : FVLv E} (hf : 0 ≤ f) {ψi : Fin n → StrongDual ℝ X} + {ψ : StrongDual ℝ X} (hψi0 : ∀ i, 0 ≤ ψi i) (hsum : ∑ i, ψi i = ψ) + (hψ0 : 0 ≤ ψ) (hψnorm : ‖ψ‖ ≤ 1) (hT : 0 < ‖T‖) : + ∑ i, + (ofFVLv f : FBL E) + (scaledCompDualFamily (ι := Fin n) (ψi := ψi) (ψ := ψ) T hψi0 hsum hψ0 hψnorm hT i) ≤ + ‖ofFVLv f‖ := by + let Φ : Fin n → FVLv.dualUnitBall E := + scaledCompDualFamily (ι := Fin n) (ψi := ψi) (ψ := ψ) T hψi0 hsum hψ0 hψnorm hT + calc + ∑ i, (ofFVLv f : FBL E) (Φ i) = ∑ i, |(ofFVLv f : FBL E) (Φ i)| := by + apply Finset.sum_congr rfl + intro i hi + rw [abs_of_nonneg (ofFVLv_apply_scaledCompDualFamily_nonneg + T hf hψi0 hsum hψ0 hψnorm hT i)] + _ ≤ ‖ofFVLv f‖ := by + exact sum_abs_apply_le_freeNorm E (ofFVLv f) + Φ + (scaledCompDualFamily_admissible T hψi0 hsum hψ0 hψnorm hT) + +theorem dualLinearCombination_scaledCompDualFamily_eq {ι : Type*} [Fintype ι] + {κ : Type*} {n : ℕ} (T : E →L[ℝ] X) {ψi : ι → StrongDual ℝ X} {ψ : StrongDual ℝ X} + (hψi0 : ∀ i, 0 ≤ ψi i) (hsum : ∑ i, ψi i = ψ) (hψ0 : 0 ≤ ψ) + (hψnorm : ‖ψ‖ ≤ 1) (hT : 0 < ‖T‖) (x : Fin n → E) (c : κ → Fin n → ℝ) + (i : ι) (k : κ) : + dualLinearCombination x (c k) + (scaledCompDualFamily (ι := ι) (ψi := ψi) (ψ := ψ) T hψi0 hsum hψ0 hψnorm hT i) = + ‖T‖⁻¹ * ψi i (imageLinearCombination T x (c k)) := by + unfold dualLinearCombination imageLinearCombination + calc + ∑ j, + c k j * + (((scaledCompDualFamily (ι := ι) (ψi := ψi) (ψ := ψ) T hψi0 hsum hψ0 hψnorm hT i : + FVLv.dualUnitBall E) : + WeakDual ℝ E) (x j)) + = ∑ j, ‖T‖⁻¹ * (c k j * ψi i (T (x j))) := by + apply Finset.sum_congr rfl + intro j hj + change c k j * (‖T‖⁻¹ * ψi i (T (x j))) = ‖T‖⁻¹ * (c k j * ψi i (T (x j))) + ring + _ = ‖T‖⁻¹ * ∑ j, c k j * ψi i (T (x j)) := by + rw [Finset.mul_sum] + _ = ‖T‖⁻¹ * ψi i (∑ j, c k j • T (x j)) := by + congr 1 + rw [map_sum] + apply Finset.sum_congr rfl + intro j hj + rw [map_smul] + simp [smul_eq_mul] + +theorem dualLinearCombination_le_ofFVLv_add_finiteSup {n m p : ℕ} + {f : FVLv E} (x : Fin n → E) (a : Fin (m + 1) → Fin n → ℝ) + (b : Fin (p + 1) → Fin n → ℝ) + (hf_repr : + f = finiteSup (fun i : Fin (m + 1) => fvlvLinearCombination x (a i)) - + finiteSup (fun j : Fin (p + 1) => fvlvLinearCombination x (b j))) + (φ : FVLv.dualUnitBall E) (i : Fin (m + 1)) : + dualLinearCombination x (a i) φ ≤ + (ofFVLv f : FBL E) φ + + finiteSup (fun j : Fin (p + 1) => dualLinearCombination x (b j) φ) := by + have hf_eval : + (ofFVLv f : FBL E) φ = + finiteSup (fun k : Fin (m + 1) => dualLinearCombination x (a k) φ) - + finiteSup (fun j : Fin (p + 1) => dualLinearCombination x (b j) φ) := by + simpa [hf_repr] using ofFVLv_supSubLinearCombination_apply + (x := x) (a := a) (b := b) φ + have hsup : + dualLinearCombination x (a i) φ ≤ + finiteSup (fun k : Fin (m + 1) => dualLinearCombination x (a k) φ) := by + unfold finiteSup + exact Finset.le_sup' (s := Finset.univ) + (f := fun k : Fin (m + 1) => dualLinearCombination x (a k) φ) + (h := Finset.mem_univ i) + linarith + +theorem finiteSup_dualLinearCombination_scaledCompDualFamily_le {ι : Type*} + [Fintype ι] {n p : ℕ} (T : E →L[ℝ] X) {ψi : ι → StrongDual ℝ X} + {ψ : StrongDual ℝ X} (hψi0 : ∀ i, 0 ≤ ψi i) (hsum : ∑ i, ψi i = ψ) + (hψ0 : 0 ≤ ψ) (hψnorm : ‖ψ‖ ≤ 1) (hT : 0 < ‖T‖) (x : Fin n → E) + (b : Fin (p + 1) → Fin n → ℝ) (i : ι) : + finiteSup (fun j : Fin (p + 1) => + dualLinearCombination x (b j) (scaledCompDualFamily T hψi0 hsum hψ0 hψnorm hT i)) ≤ + ‖T‖⁻¹ * ψi i (finiteSup (fun j : Fin (p + 1) => imageLinearCombination T x (b j))) := by + unfold finiteSup + apply Finset.sup'_le Finset.univ_nonempty + intro j hj + calc + dualLinearCombination x (b j) (scaledCompDualFamily T hψi0 hsum hψ0 hψnorm hT i) + = ‖T‖⁻¹ * ψi i (imageLinearCombination T x (b j)) := by + simpa using dualLinearCombination_scaledCompDualFamily_eq + T hψi0 hsum hψ0 hψnorm hT x b i j + _ ≤ ‖T‖⁻¹ * ψi i (finiteSup (fun j : Fin (p + 1) => imageLinearCombination T x (b j))) := by + refine mul_le_mul_of_nonneg_left ?_ (inv_nonneg.mpr hT.le) + exact StrongDual.apply_le_apply_of_nonneg (hψi0 i) + (by + unfold finiteSup + exact Finset.le_sup' (s := Finset.univ) + (f := fun j : Fin (p + 1) => imageLinearCombination T x (b j)) + (h := Finset.mem_univ j)) + +theorem sum_apply_imageLinearCombination_eq_scaled_sum {ι : Type*} [Fintype ι] + {n : ℕ} (T : E →L[ℝ] X) {ψi : ι → StrongDual ℝ X} {ψ : StrongDual ℝ X} + (hψi0 : ∀ i, 0 ≤ ψi i) (hsum : ∑ i, ψi i = ψ) (hψ0 : 0 ≤ ψ) + (hψnorm : ‖ψ‖ ≤ 1) (hT : 0 < ‖T‖) (x : Fin n → E) (c : ι → Fin n → ℝ) : + ∑ i, ψi i (imageLinearCombination T x (c i)) = + ‖T‖ * ∑ i, + dualLinearCombination x (c i) (scaledCompDualFamily T hψi0 hsum hψ0 hψnorm hT i) := by + calc + ∑ i, ψi i (imageLinearCombination T x (c i)) + = ∑ i, ‖T‖ * dualLinearCombination x (c i) + (scaledCompDualFamily T hψi0 hsum hψ0 hψnorm hT i) := by + apply Finset.sum_congr rfl + intro i hi + rw [dualLinearCombination_scaledCompDualFamily_eq + T hψi0 hsum hψ0 hψnorm hT x c i i] + symm + calc + ‖T‖ * (‖T‖⁻¹ * ψi i (imageLinearCombination T x (c i))) + = (‖T‖ * ‖T‖⁻¹) * ψi i (imageLinearCombination T x (c i)) := by ring + _ = ψi i (imageLinearCombination T x (c i)) := by + rw [mul_inv_cancel₀ hT.ne', one_mul] + _ = ‖T‖ * ∑ i, + dualLinearCombination x (c i) (scaledCompDualFamily T hψi0 hsum hψ0 hψnorm hT i) := by + rw [Finset.mul_sum] + +theorem positive_dual_apply_liftFVLv_nonneg_le (T : E →L[ℝ] X) + {f : FVLv E} (hf : 0 ≤ f) {ψ : StrongDual ℝ X} + (hψ0 : 0 ≤ ψ) (hψnorm : ‖ψ‖ ≤ 1) : + ψ (liftFVLv T f) ≤ ‖T‖ * ‖ofFVLv f‖ := by + classical + by_cases hT0 : ‖T‖ = 0 + · have hT : T = 0 := norm_eq_zero.mp hT0 + subst hT + obtain ⟨n, m, p, x, a, b, hf_repr⟩ := exists_supSubLinearCombination_eq (E := E) f + rw [hf_repr, liftFVLv_supSubLinearCombination] + simp [finiteSup, imageLinearCombination] + · have hT : 0 < ‖T‖ := lt_of_le_of_ne (norm_nonneg T) (by simpa [eq_comm] using hT0) + obtain ⟨n, m, p, x, a, b, hf_repr⟩ := exists_supSubLinearCombination_eq (E := E) f + let A : Fin (m + 1) → X := fun i => imageLinearCombination T x (a i) + let B : Fin (p + 1) → X := fun j => imageLinearCombination T x (b j) + have hA : + ψ (finiteSup A) ≤ ‖T‖ * ‖ofFVLv f‖ + ψ (finiteSup B) := by + refine (isLUB_strongDual_apply_finiteSup (ψ := ψ) hψ0 A).2 ?_ + rintro r ⟨ψi, hψi0, hsum, rfl⟩ + let Φ : Fin (m + 1) → FVLv.dualUnitBall E := + scaledCompDualFamily T hψi0 hsum hψ0 hψnorm hT + calc + ∑ i, ψi i (A i) = ‖T‖ * ∑ i, dualLinearCombination x (a i) (Φ i) := by + simpa [A, Φ] using + sum_apply_imageLinearCombination_eq_scaled_sum + T hψi0 hsum hψ0 hψnorm hT x a + _ ≤ ‖T‖ * ∑ i, + ((ofFVLv f : FBL E) (Φ i) + + finiteSup (fun j : Fin (p + 1) => dualLinearCombination x (b j) (Φ i))) := by + refine mul_le_mul_of_nonneg_left ?_ (norm_nonneg T) + exact Finset.sum_le_sum fun i _ => by + simpa [Φ] using dualLinearCombination_le_ofFVLv_add_finiteSup + (f := f) x a b hf_repr (Φ i) i + _ = ‖T‖ * (∑ i, (ofFVLv f : FBL E) (Φ i)) + + ‖T‖ * + (∑ i, finiteSup (fun j : Fin (p + 1) => dualLinearCombination x (b j) (Φ i))) := by + rw [Finset.sum_add_distrib, mul_add, Finset.mul_sum, Finset.mul_sum] + _ ≤ ‖T‖ * ‖ofFVLv f‖ + + ‖T‖ * + (∑ i, finiteSup (fun j : Fin (p + 1) => dualLinearCombination x (b j) (Φ i))) := by + refine add_le_add ?_ le_rfl + exact mul_le_mul_of_nonneg_left + (by + simpa [Φ] using sum_ofFVLv_apply_scaledCompDualFamily_le + T hf hψi0 hsum hψ0 hψnorm hT) + (norm_nonneg T) + _ ≤ ‖T‖ * ‖ofFVLv f‖ + ‖T‖ * (∑ i, ‖T‖⁻¹ * ψi i (finiteSup B)) := by + refine add_le_add le_rfl ?_ + refine mul_le_mul_of_nonneg_left ?_ (norm_nonneg T) + exact Finset.sum_le_sum fun i _ => by + simpa [B, Φ] using + finiteSup_dualLinearCombination_scaledCompDualFamily_le + T hψi0 hsum hψ0 hψnorm hT x b i + _ = ‖T‖ * ‖ofFVLv f‖ + ψ (finiteSup B) := by + congr 1 + calc + ‖T‖ * ∑ i, (‖T‖⁻¹ * ψi i (finiteSup B)) + = ∑ i, ψi i (finiteSup B) := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro i hi + calc + ‖T‖ * (‖T‖⁻¹ * ψi i (finiteSup B)) + = (‖T‖ * ‖T‖⁻¹) * ψi i (finiteSup B) := by ring + _ = ψi i (finiteSup B) := by rw [mul_inv_cancel₀ hT.ne', one_mul] + _ = ψ (finiteSup B) := by + simpa using congrArg (fun F : StrongDual ℝ X => F (finiteSup B)) hsum + calc + ψ (liftFVLv T f) + = ψ (finiteSup A - finiteSup B) := by + rw [hf_repr, liftFVLv_supSubLinearCombination] + _ = ψ (finiteSup A) - ψ (finiteSup B) := by rw [map_sub] + _ ≤ ‖T‖ * ‖ofFVLv f‖ := by + linarith [hA] + +theorem norm_liftFVLv_le (T : E →L[ℝ] X) (f : FVLv E) : + ‖liftFVLv T f‖ ≤ ‖T‖ * ‖ofFVLv f‖ := by + obtain ⟨ψ, hψ0, hψnorm, hψval⟩ := + StrongDual.exists_positive_dual_norming (x := |liftFVLv T f|) (abs_nonneg _) + have hmap : + (ofFVLv |f| : FBL E) = |ofFVLv f| := by + change liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap) |f| = + |liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap) f| + exact VecLatHom.map_abs + (liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap)) f + calc + ‖liftFVLv T f‖ = ‖|liftFVLv T f|‖ := by rw [norm_abs_eq_norm] + _ = ψ (|liftFVLv T f|) := by rw [← hψval] + _ = ψ (liftFVLv T |f|) := by rw [← VecLatHom.map_abs (liftFVLv T) f] + _ ≤ ‖T‖ * ‖ofFVLv |f|‖ := + positive_dual_apply_liftFVLv_nonneg_le (T := T) (f := |f|) (abs_nonneg f) hψ0 hψnorm + _ = ‖T‖ * ‖ofFVLv f‖ := by rw [hmap, norm_abs_eq_norm] + +theorem dist_liftFVLv_le (T : E →L[ℝ] X) (f g : FVLv E) : + dist (liftFVLv T f) (liftFVLv T g) ≤ ‖T‖ * dist (ofFVLv f) (ofFVLv g) := by + rw [dist_eq_norm, dist_eq_norm, ← map_sub, ← LinearMap.map_sub] + exact norm_liftFVLv_le (T := T) (f - g) + +/-- The continuous extension of the algebraic lift to the free Banach lattice. -/ +noncomputable def liftAux (T : E →L[ℝ] X) : FBL E →L[ℝ] X := + ((liftFVLv T).toLinearMap).extendOfNorm (ofFVLv (E := E)) + +theorem liftAux_ofFVLv (T : E →L[ℝ] X) (f : FVLv E) : + liftAux T (ofFVLv f) = liftFVLv T f := by + have hlift (g : FVLv E) : (liftFVLv T).toLinearMap g = liftFVLv T g := rfl + simpa only [liftAux, hlift] using + LinearMap.extendOfNorm_eq (f := (liftFVLv T).toLinearMap) (e := ofFVLv (E := E)) + (h_dense := denseRange_ofFVLv (E := E)) (h_norm := ⟨‖T‖, norm_liftFVLv_le (T := T)⟩) f + +/-- The vector lattice homomorphic extension of an operator from `E` to a Banach lattice. -/ +def lift (T : E →L[ℝ] X) : VecLatHom (FBL E) X := by + refine VecLatHom.ofIsVecLatHom (liftAux T) ?_ + refine + { map_add := fun _ _ => (liftAux T).map_add _ _ + map_smul := fun _ _ => (liftAux T).map_smul _ _ + map_sup' := ?_ + map_inf' := ?_ } + · intro y z + let e : FVLv E × FVLv E → FBL E × FBL E := fun p => (ofFVLv p.1, ofFVLv p.2) + have he : DenseRange e := (denseRange_ofFVLv (E := E)).prodMap (denseRange_ofFVLv (E := E)) + have hg : Continuous fun p : FBL E × FBL E => liftAux T (p.1 ⊔ p.2) := + (liftAux T).continuous.comp (continuous_fst.sup continuous_snd) + have hh : Continuous fun p : FBL E × FBL E => liftAux T p.1 ⊔ liftAux T p.2 := + ((liftAux T).continuous.comp continuous_fst).sup + ((liftAux T).continuous.comp continuous_snd) + have hEq : + (fun p : FBL E × FBL E => liftAux T (p.1 ⊔ p.2)) = + fun p : FBL E × FBL E => liftAux T p.1 ⊔ liftAux T p.2 := + he.equalizer hg hh (by + funext p + rcases p with ⟨f, g⟩ + have hof_sup : ofFVLv (f ⊔ g) = ofFVLv f ⊔ ofFVLv g := by + change liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap) (f ⊔ g) = + liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap) f ⊔ + liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap) g + exact map_sup _ _ _ + change liftAux T (ofFVLv f ⊔ ofFVLv g) = liftAux T (ofFVLv f) ⊔ liftAux T (ofFVLv g) + rw [← hof_sup, liftAux_ofFVLv, liftAux_ofFVLv, liftAux_ofFVLv, map_sup]) + exact congrFun hEq (y, z) + · intro y z + let e : FVLv E × FVLv E → FBL E × FBL E := fun p => (ofFVLv p.1, ofFVLv p.2) + have he : DenseRange e := (denseRange_ofFVLv (E := E)).prodMap (denseRange_ofFVLv (E := E)) + have hg : Continuous fun p : FBL E × FBL E => liftAux T (p.1 ⊓ p.2) := + (liftAux T).continuous.comp (continuous_fst.inf continuous_snd) + have hh : Continuous fun p : FBL E × FBL E => liftAux T p.1 ⊓ liftAux T p.2 := + ((liftAux T).continuous.comp continuous_fst).inf + ((liftAux T).continuous.comp continuous_snd) + have hEq : + (fun p : FBL E × FBL E => liftAux T (p.1 ⊓ p.2)) = + fun p : FBL E × FBL E => liftAux T p.1 ⊓ liftAux T p.2 := + he.equalizer hg hh (by + funext p + rcases p with ⟨f, g⟩ + have hof_inf : ofFVLv (f ⊓ g) = ofFVLv f ⊓ ofFVLv g := by + change liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap) (f ⊓ g) = + liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap) f ⊓ + liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap) g + exact map_inf _ _ _ + change liftAux T (ofFVLv f ⊓ ofFVLv g) = liftAux T (ofFVLv f) ⊓ liftAux T (ofFVLv g) + rw [← hof_inf, liftAux_ofFVLv, liftAux_ofFVLv, liftAux_ofFVLv, map_inf]) + exact congrFun hEq (y, z) + +/-- The extension from `E` to `X`, bundled as a bounded linear operator. -/ +def liftContinuousLinearMap (T : E →L[ℝ] X) : FBL E →L[ℝ] X := by + exact liftAux T + +@[simp] +theorem liftContinuousLinearMap_apply (T : E →L[ℝ] X) (f : FBL E) : + liftContinuousLinearMap T f = lift T f := by + rfl + +@[simp] +theorem lift_of (T : E →L[ℝ] X) (x : E) : lift T (of x) = T x := by + rw [← ofFVLv_of] + change liftAux T (ofFVLv (FVLv.of x)) = T x + rw [liftAux_ofFVLv] + exact liftFVLv_of T x + +/-- The bounded linear operator attached to the extension preserves the operator norm. -/ +theorem norm_lift (T : E →L[ℝ] X) : ‖liftContinuousLinearMap T‖ = ‖T‖ := by + refine le_antisymm ?_ ?_ + · simpa [liftContinuousLinearMap, liftAux] using + LinearMap.opNorm_extendOfNorm_le (f := (liftFVLv T).toLinearMap) (e := ofFVLv (E := E)) + (h_dense := denseRange_ofFVLv (E := E)) (C := ‖T‖) (norm_nonneg T) + (norm_liftFVLv_le (T := T)) + · calc + ‖T‖ = ‖(liftContinuousLinearMap T).comp + (ofLinearIsometry (E := E)).toContinuousLinearMap‖ := by + congr 1 + ext x + simp [lift_of] + _ ≤ ‖liftContinuousLinearMap T‖ * + ‖(ofLinearIsometry (E := E)).toContinuousLinearMap‖ := + ContinuousLinearMap.opNorm_comp_le _ _ + _ ≤ ‖liftContinuousLinearMap T‖ * 1 := by + gcongr + exact LinearIsometry.norm_toContinuousLinearMap_le (ofLinearIsometry (E := E)) + _ = ‖liftContinuousLinearMap T‖ := by rw [mul_one] + +/-- A vector lattice homomorphism out of `FBL E` is uniquely determined by its values on +the canonical copy of `E`. -/ +theorem lift_unique (T : E →L[ℝ] X) (S : VecLatHom (FBL E) X) + (h : ∀ x : E, S (of x) = T x) : + S = lift T := by + let ι : VecLatHom (FVLv E) (FBL E) := + liftFVLv (T := (ofLinearIsometry (E := E)).toContinuousLinearMap) + have hcomp : S.comp ι = liftFVLv T := by + apply FVLv.lift_unique + intro x + change S (ι (FVLv.of x)) = T x + rw [liftFVLv_of] + exact h x + have hScont : Continuous S.toLinearMap := + Positive.continuous ((Positive.monotone_iff).mp S.monotone) + have hEq : + (S : FBL E → X) = liftContinuousLinearMap T := + (denseRange_ofFVLv (E := E)).equalizer hScont (liftContinuousLinearMap T).continuous (by + funext f + change (S.comp ι) f = liftContinuousLinearMap T (ofFVLv f) + rw [hcomp, liftContinuousLinearMap_apply] + change liftFVLv T f = liftAux T (ofFVLv f) + rw [liftAux_ofFVLv]) + apply DFunLike.ext + intro y + exact congrFun hEq y + +/-- The universal property of `FBL E`: bounded linear maps from `E` into a Banach lattice +extend uniquely to bounded operators from `FBL E` that are vector lattice homomorphisms. +The extension preserves the operator norm. -/ +theorem exists_unique_lift (T : E →L[ℝ] X) : + ∃! S : FBL E →L[ℝ] X, + IsVecLatHom (S : FBL E → X) ∧ (∀ x : E, S (of x) = T x) ∧ + ‖S‖ = ‖T‖ := by + refine ⟨liftContinuousLinearMap T, ?_, ?_⟩ + · exact ⟨(lift T).isVecLatHom, lift_of T, norm_lift T⟩ + · intro S hS + rcases hS with ⟨hSV, hSo, _hSnorm⟩ + let SV : VecLatHom (FBL E) X := VecLatHom.ofIsVecLatHom (S : FBL E → X) hSV + have hSVeq : SV = lift T := lift_unique T SV hSo + ext y + calc + S y = SV y := rfl + _ = lift T y := by rw [hSVeq] + _ = liftContinuousLinearMap T y := by rw [← liftContinuousLinearMap_apply] + +end UniversalProperty + +end FBL diff --git a/LeanPool/FBLOrderContinuity/BanLat/Free/FVL.lean b/LeanPool/FBLOrderContinuity/BanLat/Free/FVL.lean new file mode 100644 index 0000000000..c8ab80419a --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Free/FVL.lean @@ -0,0 +1,730 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Pi +public import LeanPool.OrderClosures.BanLat.LLexpr +public import LeanPool.OrderClosures.BanLat.Operators.Hom +public import LeanPool.OrderClosures.BanLat.Substructures.Sublattice +public import Mathlib.LinearAlgebra.LinearIndependent.Defs + + + +/-! +# Free vector lattices + +This file constructs the free vector lattice on a type of generators as a concrete +vector sublattice of the real-valued function space on `R^A`. +-/ + +@[expose] public section + +universe u v + +/-- The ambient function space `R^(R^A)` used for the concrete representation of `FVL(A)`. -/ +abbrev FVL.FunctionSpace (α : Type u) : Type u := + (α → ℝ) → ℝ + +namespace FVL + +variable {α : Type u} + +/-- The coordinate functional `δ a : R^A → R`. -/ +def coordinate (a : α) : FunctionSpace α := + fun x => x a + +/-- The vector sublattice of `R^(R^A)` generated by the coordinate functionals. -/ +noncomputable def concreteSublattice (α : Type u) : VectorSublattice (FunctionSpace α) := + VectorSublattice.generated (Set.range (coordinate : α → FunctionSpace α)) + +end FVL + +/-- The free vector lattice generated by a type `α`, realized concretely as the sublattice of +`R^(R^A)` generated by the coordinate functionals. -/ +abbrev FVL (α : Type u) : Type u := + FVL.concreteSublattice α + +namespace FVL + +variable {α : Type u} + +instance instIsVLArchimedean : IsVLArchimedean (FVL α) := by + apply isVLArchimedean_of_eq_zero_of_nonneg_of_forall_nsmul_le + intro f g hf hfg + apply Subtype.ext + funext x + exact IsVLArchimedean.eq_zero_of_nonneg_of_forall_nsmul_le (show 0 ≤ f.1 x from hf x) + fun n => show n • f.1 x ≤ g.1 x from hfg n x + +instance instCoeFun : CoeFun (FVL α) (fun _ => (α → ℝ) → ℝ) where + coe f := f.1 + +/-- The canonical map from the generating type to its free vector lattice. -/ +def of (a : α) : FVL α := + ⟨coordinate a, VectorSublattice.subset_generated _ ⟨a, rfl⟩⟩ + +@[simp] +theorem coe_of (a : α) : ((of a : FVL α) : FunctionSpace α) = coordinate a := rfl + +@[simp] +theorem of_apply (a : α) (x : α → ℝ) : (of a : FVL α) x = x a := rfl + +theorem eval_apply {ι X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] {n : ℕ} (y : Fin n → ι → X) + (e : LLexpr n) (t : ι) : + LLexpr.eval y e t = LLexpr.eval (fun i => y i t) e := by + induction e with + | zero => simp [LLexpr.eval] + | var i => simp [LLexpr.eval] + | add e₁ e₂ h₁ h₂ => simp [LLexpr.eval, h₁, h₂] + | smul r e h => simp [LLexpr.eval, h] + | sup e₁ e₂ h₁ h₂ => simp [LLexpr.eval, h₁, h₂] + | inf e₁ e₂ h₁ h₂ => simp [LLexpr.eval, h₁, h₂] + +theorem exists_eval_of_eq (f : FVL α) : + ∃ (n : ℕ) (a : Fin n → α) (e : LLexpr n), + LLexpr.eval (fun i => of (a i)) e = f := by + classical + have hf : (f : FunctionSpace α) ∈ + (VectorSublattice.generated (Set.range (coordinate : α → FunctionSpace α)) : + Set (FunctionSpace α)) := f.2 + rw [LLexpr.generated_eq_iUnion_combinations + (Set.range (coordinate : α → FunctionSpace α))] at hf + simp only [Set.mem_iUnion, LLexpr.combinations, Set.mem_range] at hf + obtain ⟨n, z, e, he⟩ := hf + choose a ha using fun i : Fin n => (z i).2 + refine ⟨n, a, e, ?_⟩ + apply Subtype.ext + calc + ((LLexpr.eval (fun i : Fin n => of (a i)) e : FVL α) : FunctionSpace α) + = LLexpr.eval (fun i : Fin n => coordinate (a i)) e := by + exact LLexpr.coe_eval_vectorSublattice + (concreteSublattice α) (fun i : Fin n => of (a i)) e + _ = LLexpr.eval (fun i : Fin n => (z i : FunctionSpace α)) e := by + congr + funext i + rw [ha i] + _ = f := he + +/-- The canonical map into the concrete free vector lattice is injective. -/ +theorem of_injective : Function.Injective (of : α → FVL α) := by + classical + intro a b h + have hcoord : coordinate a = coordinate b := by + simpa using congrArg (fun f : FVL α => (f : FunctionSpace α)) h + by_contra hne + have hab : b ≠ a := fun hba => hne hba.symm + have hval := congrFun hcoord (fun c => if c = a then (1 : ℝ) else 0) + simp [coordinate, hab] at hval + +/-- The canonical generators linearly generate no non-trivial finite linear relation. -/ +theorem linearIndependent_of : LinearIndependent ℝ (of : α → FVL α) := by + classical + rw [linearIndependent_iff'] + intro s g hsum i hi + have hfun := congrArg (fun f : FVL α => (f : FunctionSpace α) (Pi.single i 1)) hsum + have hfun' : (∑ j ∈ s, g j * coordinate j (Pi.single i 1)) = 0 := by + simpa [of_apply, coordinate, Finset.sum_apply] using hfun + have hsum_eval : (∑ j ∈ s, g j * coordinate j (Pi.single i 1)) = g i := by + rw [Finset.sum_eq_single i] + · simp [coordinate] + · intro j _ hji + simp [coordinate, hji] + · intro hnot + exact (hnot hi).elim + rw [hsum_eval] at hfun' + exact hfun' + +/-- The canonical generators generate `FVL α` as a vector sublattice. -/ +theorem generated_range_of : + VectorSublattice.generated (Set.range (of : α → FVL α)) = ⊤ := by + apply le_antisymm + · intro f _ + exact VectorSublattice.mem_top + · intro f _ + change f ∈ (VectorSublattice.generated (Set.range (of : α → FVL α)) : Set (FVL α)) + obtain ⟨n, a, e, he⟩ := exists_eval_of_eq f + rw [← he] + rw [LLexpr.generated_eq_iUnion_combinations (Set.range (of : α → FVL α))] + simp only [Set.mem_iUnion, LLexpr.combinations, Set.mem_range] + refine ⟨n, fun i : Fin n => ⟨of (a i), ⟨a i, rfl⟩⟩, e, ?_⟩ + rfl + +/-- The partial converse to Yudin's theorem for distinct coordinate functionals. -/ +theorem vanishes_real_of_eval_coordinate_eq_zero {n : ℕ} (e : LLexpr n) + {a : Fin n → α} (ha : Function.Injective a) + (h : LLexpr.eval (fun i => coordinate (a i)) e = 0) : LLexpr.Vanishes ℝ e := by + classical + intro r + let x : α → ℝ := fun b => if hmem : ∃ i, a i = b then r hmem.choose else 0 + have hx : (fun i : Fin n => coordinate (a i) x) = r := by + funext i + have hchoose : a (Classical.choose (show ∃ j, a j = a i from ⟨i, rfl⟩)) = a i := + Classical.choose_spec (show ∃ j, a j = a i from ⟨i, rfl⟩) + have hi : Classical.choose (show ∃ j, a j = a i from ⟨i, rfl⟩) = i := ha hchoose + simp [coordinate, x, hi] + have hzero := congrFun h x + have hzero' : LLexpr.eval (fun i => coordinate (a i) x) e = 0 := by + simpa [eval_apply] using hzero + simpa [hx] using hzero' + +/-- A family in a vector lattice is lattice-linearly independent if every finite +subfamily of distinct indices is lattice-linearly independent: every lattice-linear +expression vanishing on that finite subfamily vanishes identically on `ℝ`. -/ +def LatticeLinearIndependent {ι X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] (x : ι → X) : Prop := + ∀ {n : ℕ} (a : Fin n → ι), Function.Injective a → + ∀ e : LLexpr n, LLexpr.eval (fun i => x (a i)) e = 0 → LLexpr.Vanishes ℝ e + +/-- A set is lattice-linearly independent if its subtype family is lattice-linearly +independent. -/ +def LatticeLinearIndependentOn {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] (s : Set X) : Prop := + LatticeLinearIndependent (fun x : s => (x : X)) + +/-- Distinct coordinate functionals in the concrete model are lattice-linearly independent. -/ +theorem coordinate_latticeLinearIndependent {n : ℕ} {a : Fin n → α} + (ha : Function.Injective a) : + LatticeLinearIndependent (fun i : Fin n => coordinate (a i)) := by + intro m b hb e h + exact vanishes_real_of_eval_coordinate_eq_zero e (ha.comp hb) h + +/-- Distinct canonical generators in `FVL α` are lattice-linearly independent. -/ +theorem of_finiteLatticeLinearIndependent {n : ℕ} {a : Fin n → α} + (ha : Function.Injective a) : + LatticeLinearIndependent (fun i : Fin n => of (a i)) := by + intro m b hb e h + apply vanishes_real_of_eval_coordinate_eq_zero e (ha.comp hb) + have hcoord := congrArg (fun f : FVL α => (f : FunctionSpace α)) h + simpa [LLexpr.coe_eval_vectorSublattice] using hcoord + +/-- The canonical family of generators of a free vector lattice is lattice-linearly +independent. -/ +theorem of_latticeLinearIndependent : LatticeLinearIndependent (of : α → FVL α) := by + intro n a ha e h + exact of_finiteLatticeLinearIndependent ha (fun i => i) Function.injective_id e h + +/-- A finite lattice-expression representation of a free-vector-lattice element. -/ +structure Repr (f : FVL α) where + /-- The number of generators in this representation. -/ + n : ℕ + /-- The generators at which the lattice expression is evaluated. -/ + a : Fin n → α + /-- The lattice expression representing the element. -/ + e : LLexpr n + eval_eq : LLexpr.eval (fun i => of (a i)) e = f + +theorem exists_repr (f : FVL α) : Nonempty (Repr f) := by + obtain ⟨n, a, e, he⟩ := exists_eval_of_eq f + exact ⟨⟨n, a, e, he⟩⟩ + +/-- Choose a finite lattice-expression representation of a free element. -/ +noncomputable def repr (f : FVL α) : Repr f := + Classical.choice (exists_repr f) + +/-- The one-variable representation of a canonical generator. -/ +noncomputable def reprOf (a : α) : Repr (of a : FVL α) where + n := 1 + a := fun _ => a + e := LLexpr.var 0 + eval_eq := by simp [LLexpr.eval] + +/-- Combine two finite representations by addition. -/ +noncomputable def reprAdd {f g : FVL α} (rf : Repr f) (rg : Repr g) : + Repr (f + g) where + n := rf.n + rg.n + a := Fin.append rf.a rg.a + e := + LLexpr.add (LLexpr.reindexExpr (Fin.castAdd rg.n) rf.e) + (LLexpr.reindexExpr (Fin.natAdd rf.n) rg.e) + eval_eq := by + rw [LLexpr.eval_add, LLexpr.eval_reindexExpr, LLexpr.eval_reindexExpr] + simp [rf.eval_eq, rg.eval_eq] + +/-- Scale a finite lattice-expression representation. -/ +noncomputable def reprSmul (r : ℝ) {f : FVL α} (rf : Repr f) : + Repr (r • f) where + n := rf.n + a := rf.a + e := LLexpr.smul r rf.e + eval_eq := by + rw [LLexpr.eval_smul, rf.eval_eq] + +/-- Combine two finite representations by supremum. -/ +noncomputable def reprSup {f g : FVL α} (rf : Repr f) (rg : Repr g) : + Repr (f ⊔ g) where + n := rf.n + rg.n + a := Fin.append rf.a rg.a + e := + LLexpr.sup (LLexpr.reindexExpr (Fin.castAdd rg.n) rf.e) + (LLexpr.reindexExpr (Fin.natAdd rf.n) rg.e) + eval_eq := by + rw [LLexpr.eval_sup, LLexpr.eval_reindexExpr, LLexpr.eval_reindexExpr] + simp [rf.eval_eq, rg.eval_eq] + +/-- Combine two finite representations by infimum. -/ +noncomputable def reprInf {f g : FVL α} (rf : Repr f) (rg : Repr g) : + Repr (f ⊓ g) where + n := rf.n + rg.n + a := Fin.append rf.a rg.a + e := + LLexpr.inf (LLexpr.reindexExpr (Fin.castAdd rg.n) rf.e) + (LLexpr.reindexExpr (Fin.natAdd rf.n) rg.e) + eval_eq := by + rw [LLexpr.eval_inf, LLexpr.eval_reindexExpr, LLexpr.eval_reindexExpr] + simp [rf.eval_eq, rg.eval_eq] + +section Lift + +variable {X : Type v} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +theorem eval_eq_of_coordinate_eval_eq {m n : ℕ} (φ : α → X) + {a : Fin m → α} {b : Fin n → α} {e : LLexpr m} {d : LLexpr n} + (h : LLexpr.eval (fun i => coordinate (a i)) e = + LLexpr.eval (fun i => coordinate (b i)) d) : + LLexpr.eval (fun i => φ (a i)) e = LLexpr.eval (fun i => φ (b i)) d := by + classical + let c : Fin (m + n) → α := Fin.append a b + let E : LLexpr (m + n) := + LLexpr.add (LLexpr.reindexExpr (Fin.castAdd n) e) + (LLexpr.smul (-1) (LLexpr.reindexExpr (Fin.natAdd m) d)) + obtain ⟨k, c', hc', r, hr⟩ := LLexpr.exists_injective_reindex c + have hcoord0 : LLexpr.eval (fun i : Fin (m + n) => coordinate (c i)) E = 0 := by + dsimp [E] + rw [LLexpr.eval_reindexExpr, LLexpr.eval_reindexExpr] + simp [c, h] + have hcoord : LLexpr.eval (fun i => coordinate (c' i)) (LLexpr.reindexExpr r E) = 0 := by + rw [LLexpr.eval_reindexExpr] + have hc_coord : (fun i : Fin (m + n) => coordinate (c' (r i))) = + fun i => coordinate (c i) := by + funext i + rw [hr i] + rw [hc_coord] + exact hcoord0 + have hvreal := vanishes_real_of_eval_coordinate_eq_zero (LLexpr.reindexExpr r E) hc' hcoord + have hXzero := + (LLexpr.vanishes_of_vanishes_real (LLexpr.reindexExpr r E) hvreal X) + (fun i => φ (c' i)) + rw [LLexpr.eval_reindexExpr] at hXzero + have hcφ : (fun i : Fin (m + n) => φ (c' (r i))) = fun i => φ (c i) := by + funext i + rw [hr i] + rw [hcφ] at hXzero + have hdiff : + LLexpr.eval (fun i : Fin m => φ (a i)) e - + LLexpr.eval (fun i : Fin n => φ (b i)) d = 0 := by + simpa [E, c, LLexpr.eval_reindexExpr, sub_eq_add_neg] using hXzero + exact sub_eq_zero.mp hdiff + +theorem eval_eq_of_of_eval_eq {m n : ℕ} (φ : α → X) + {a : Fin m → α} {b : Fin n → α} {e : LLexpr m} {d : LLexpr n} + (h : LLexpr.eval (fun i => of (a i)) e = + LLexpr.eval (fun i => of (b i)) d) : + LLexpr.eval (fun i => φ (a i)) e = LLexpr.eval (fun i => φ (b i)) d := by + apply eval_eq_of_coordinate_eval_eq φ + have hcoord := congrArg (fun f : FVL α => (f : FunctionSpace α)) h + have hleft := LLexpr.coe_eval_vectorSublattice + (concreteSublattice α) (fun i : Fin m => of (a i)) e + have hright := LLexpr.coe_eval_vectorSublattice + (concreteSublattice α) (fun i : Fin n => of (b i)) d + simpa [hleft, hright] using hcoord + +/-- Evaluate a chosen representation under a map from the generators. -/ +noncomputable def liftFun (φ : α → X) (f : FVL α) : X := + LLexpr.eval (fun i => φ ((repr f).a i)) (repr f).e + +theorem liftFun_eq_eval (φ : α → X) {f : FVL α} (r : Repr f) : + liftFun φ f = LLexpr.eval (fun i => φ (r.a i)) r.e := by + exact eval_eq_of_of_eval_eq φ (by rw [(repr f).eval_eq, r.eval_eq]) + +theorem liftFun_of (φ : α → X) (a : α) : liftFun φ (of a) = φ a := by + calc + liftFun φ (of a) = LLexpr.eval (fun i => φ ((reprOf a).a i)) (reprOf a).e := + liftFun_eq_eval φ (reprOf a) + _ = φ a := by simp [reprOf] + +theorem liftFun_add (φ : α → X) (f g : FVL α) : + liftFun φ (f + g) = liftFun φ f + liftFun φ g := by + let rf := repr f + let rg := repr g + let rfg := reprAdd rf rg + calc + liftFun φ (f + g) = LLexpr.eval (fun i => φ (rfg.a i)) rfg.e := + liftFun_eq_eval φ rfg + _ = LLexpr.eval (fun i => φ (rf.a i)) rf.e + + LLexpr.eval (fun i => φ (rg.a i)) rg.e := by + simp [rfg, reprAdd, LLexpr.eval_reindexExpr] + _ = liftFun φ f + liftFun φ g := by + rw [← liftFun_eq_eval φ rf, ← liftFun_eq_eval φ rg] + +theorem liftFun_smul (φ : α → X) (r : ℝ) (f : FVL α) : + liftFun φ (r • f) = r • liftFun φ f := by + let rf := repr f + let rrf := reprSmul r rf + calc + liftFun φ (r • f) = LLexpr.eval (fun i => φ (rrf.a i)) rrf.e := + liftFun_eq_eval φ rrf + _ = r • LLexpr.eval (fun i => φ (rf.a i)) rf.e := by + simp [rrf, reprSmul] + _ = r • liftFun φ f := by + rw [← liftFun_eq_eval φ rf] + +theorem liftFun_sup (φ : α → X) (f g : FVL α) : + liftFun φ (f ⊔ g) = liftFun φ f ⊔ liftFun φ g := by + let rf := repr f + let rg := repr g + let rfg := reprSup rf rg + calc + liftFun φ (f ⊔ g) = LLexpr.eval (fun i => φ (rfg.a i)) rfg.e := + liftFun_eq_eval φ rfg + _ = LLexpr.eval (fun i => φ (rf.a i)) rf.e ⊔ + LLexpr.eval (fun i => φ (rg.a i)) rg.e := by + simp [rfg, reprSup, LLexpr.eval_reindexExpr] + _ = liftFun φ f ⊔ liftFun φ g := by + rw [← liftFun_eq_eval φ rf, ← liftFun_eq_eval φ rg] + +theorem liftFun_inf (φ : α → X) (f g : FVL α) : + liftFun φ (f ⊓ g) = liftFun φ f ⊓ liftFun φ g := by + let rf := repr f + let rg := repr g + let rfg := reprInf rf rg + calc + liftFun φ (f ⊓ g) = LLexpr.eval (fun i => φ (rfg.a i)) rfg.e := + liftFun_eq_eval φ rfg + _ = LLexpr.eval (fun i => φ (rf.a i)) rf.e ⊓ + LLexpr.eval (fun i => φ (rg.a i)) rg.e := by + simp [rfg, reprInf, LLexpr.eval_reindexExpr] + _ = liftFun φ f ⊓ liftFun φ g := by + rw [← liftFun_eq_eval φ rf, ← liftFun_eq_eval φ rg] + +/-- The vector lattice homomorphism out of the concrete free vector lattice induced by a map +from the generators. -/ +noncomputable def lift : (α → X) ≃ VecLatHom (FVL α) X := by + refine + { toFun := fun φ => + { toFun := liftFun φ + map_add' := liftFun_add φ + map_smul' := liftFun_smul φ + map_sup' := liftFun_sup φ + map_inf' := liftFun_inf φ } + invFun := fun T a => T (of a) + left_inv := ?_ + right_inv := ?_ } + · intro φ + funext a + exact liftFun_of φ a + · intro T + apply DFunLike.ext + intro f + let r := repr f + calc + liftFun (fun a => T (of a)) f + = LLexpr.eval (fun i => T (of (r.a i))) r.e := + liftFun_eq_eval (fun a => T (of a)) r + _ = T (LLexpr.eval (fun i => of (r.a i)) r.e) := by + exact (LLexpr.map_eval T (fun i => of (r.a i)) r.e).symm + _ = T f := by rw [r.eval_eq] + +@[simp] +theorem lift_of (φ : α → X) (a : α) : lift φ (of a) = φ a := by + exact congrFun (Equiv.left_inv lift φ) a + +@[simp] +theorem lift_comp_of (T : VecLatHom (FVL α) X) : lift ((T : FVL α → X) ∘ of) = T := by + exact Equiv.right_inv lift T + +/-- A vector lattice homomorphism out of `FVL α` is determined by its values on generators. -/ +theorem lift_unique (φ : α → X) (T : VecLatHom (FVL α) X) + (h : ∀ a, T (of a) = φ a) : T = lift φ := by + calc + T = lift ((T : FVL α → X) ∘ of) := (lift_comp_of T).symm + _ = lift φ := congrArg lift (funext h) + +@[ext] +theorem hom_ext {S T : VecLatHom (FVL α) X} (h : ∀ a, S (of a) = T (of a)) : S = T := by + calc + S = lift ((S : FVL α → X) ∘ of) := (lift_comp_of S).symm + _ = lift ((T : FVL α → X) ∘ of) := congrArg lift (funext h) + _ = T := lift_comp_of T + +theorem lift_eval {n : ℕ} (x : α → X) (a : Fin n → α) (e : LLexpr n) : + lift x (LLexpr.eval (fun i => of (a i)) e) = + LLexpr.eval (fun i => x (a i)) e := by + simpa using LLexpr.map_eval (lift x) (fun i : Fin n => of (a i)) e + +theorem coordinate_eval_eq_of_latticeLinearIndependent {m n : ℕ} (x : α → X) + (hx : LatticeLinearIndependent x) {a : Fin m → α} {b : Fin n → α} + {e : LLexpr m} {d : LLexpr n} + (h : LLexpr.eval (fun i => x (a i)) e = + LLexpr.eval (fun i => x (b i)) d) : + LLexpr.eval (fun i => coordinate (a i)) e = + LLexpr.eval (fun i => coordinate (b i)) d := by + classical + let c : Fin (m + n) → α := Fin.append a b + let E : LLexpr (m + n) := + LLexpr.add (LLexpr.reindexExpr (Fin.castAdd n) e) + (LLexpr.smul (-1) (LLexpr.reindexExpr (Fin.natAdd m) d)) + obtain ⟨k, c', hc', r, hr⟩ := LLexpr.exists_injective_reindex c + have hxzero0 : LLexpr.eval (fun i : Fin (m + n) => x (c i)) E = 0 := by + dsimp [E] + rw [LLexpr.eval_reindexExpr, LLexpr.eval_reindexExpr] + simp [c, h] + have hxzero : LLexpr.eval (fun i => x (c' i)) (LLexpr.reindexExpr r E) = 0 := by + rw [LLexpr.eval_reindexExpr] + have hc_x : (fun i : Fin (m + n) => x (c' (r i))) = fun i => x (c i) := by + funext i + rw [hr i] + rw [hc_x] + exact hxzero0 + have hvreal : LLexpr.Vanishes ℝ (LLexpr.reindexExpr r E) := + hx c' hc' (LLexpr.reindexExpr r E) hxzero + have hcoordZero := + (LLexpr.vanishes_of_vanishes_real (LLexpr.reindexExpr r E) hvreal (FunctionSpace α)) + (fun i => coordinate (c' i)) + rw [LLexpr.eval_reindexExpr] at hcoordZero + have hc_coord : (fun i : Fin (m + n) => coordinate (c' (r i))) = + fun i => coordinate (c i) := by + funext i + rw [hr i] + rw [hc_coord] at hcoordZero + have hdiff : + LLexpr.eval (fun i : Fin m => coordinate (a i)) e - + LLexpr.eval (fun i : Fin n => coordinate (b i)) d = 0 := by + simpa [E, c, LLexpr.eval_reindexExpr, sub_eq_add_neg] using hcoordZero + exact sub_eq_zero.mp hdiff + +/-- A family is lattice-linearly independent iff the canonical vector lattice homomorphism +from the free vector lattice is injective. -/ +theorem latticeLinearIndependent_iff_lift_injective (x : α → X) : + LatticeLinearIndependent x ↔ Function.Injective (lift x) := by + constructor + · intro hx f g hfg + change liftFun x f = liftFun x g at hfg + let rf := repr f + let rg := repr g + have hx_eval : + LLexpr.eval (fun i => x (rf.a i)) rf.e = + LLexpr.eval (fun i => x (rg.a i)) rg.e := by + calc + LLexpr.eval (fun i => x (rf.a i)) rf.e = liftFun x f := + (liftFun_eq_eval x rf).symm + _ = liftFun x g := hfg + _ = LLexpr.eval (fun i => x (rg.a i)) rg.e := liftFun_eq_eval x rg + have hcoord := coordinate_eval_eq_of_latticeLinearIndependent x hx hx_eval + apply Subtype.ext + have hfcoord : (f : FunctionSpace α) = + LLexpr.eval (fun i => coordinate (rf.a i)) rf.e := by + have hrf := congrArg (fun y : FVL α => (y : FunctionSpace α)) rf.eval_eq + simpa [LLexpr.coe_eval_vectorSublattice] using hrf.symm + have hgcoord : (g : FunctionSpace α) = + LLexpr.eval (fun i => coordinate (rg.a i)) rg.e := by + have hrg := congrArg (fun y : FVL α => (y : FunctionSpace α)) rg.eval_eq + simpa [LLexpr.coe_eval_vectorSublattice] using hrg.symm + calc + (f : FunctionSpace α) = LLexpr.eval (fun i => coordinate (rf.a i)) rf.e := hfcoord + _ = LLexpr.eval (fun i => coordinate (rg.a i)) rg.e := hcoord + _ = (g : FunctionSpace α) := hgcoord.symm + · intro hinj n a ha e h + have hf0 : LLexpr.eval (fun i => of (a i)) e = (0 : FVL α) := by + apply hinj + calc + lift x (LLexpr.eval (fun i => of (a i)) e) + = LLexpr.eval (fun i => x (a i)) e := lift_eval x a e + _ = 0 := h + _ = lift x (0 : FVL α) := by simp + have hcoord : LLexpr.eval (fun i => coordinate (a i)) e = 0 := by + have hcoe := congrArg (fun f : FVL α => (f : FunctionSpace α)) hf0 + simpa [LLexpr.coe_eval_vectorSublattice] using hcoe + exact vanishes_real_of_eval_coordinate_eq_zero e ha hcoord + +end Lift + +section Map + +variable {β : Type v} + +/-- The vector lattice homomorphism induced by a map of generators. -/ +noncomputable def map (f : α → β) : VecLatHom (FVL α) (FVL β) := + lift (of ∘ f) + +@[simp] +theorem map_of (f : α → β) (a : α) : map f (of a) = of (f a) := by + exact lift_of (of ∘ f) a + +end Map + +section Generated + +variable {X : Type v} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +/-- The generator `x a`, regarded as an element of the vector sublattice generated by +the family `x`. -/ +def generatedOf (x : α → X) (a : α) : + VectorSublattice.generated (Set.range x) := + ⟨x a, VectorSublattice.subset_generated _ ⟨a, rfl⟩⟩ + +@[simp] +theorem generatedOf_coe (x : α → X) (a : α) : + ((generatedOf x a : + VectorSublattice.generated (Set.range x)) : X) = x a := + rfl + +/-- The canonical homomorphism from `FVL α` to the vector sublattice generated by a family. -/ +noncomputable def toGenerated (x : α → X) : + VecLatHom (FVL α) (VectorSublattice.generated (Set.range x)) := + lift (generatedOf x) + +@[simp] +theorem toGenerated_of (x : α → X) (a : α) : + toGenerated x (of a) = generatedOf x a := by + simp [toGenerated] + +theorem subtype_comp_toGenerated (x : α → X) : + ((VectorSublattice.generated (Set.range x)).subtype).comp + (toGenerated x) = lift x := by + apply hom_ext + intro a + rw [VecLatHom.comp_apply] + simp + +theorem toGenerated_injective {x : α → X} + (hx : LatticeLinearIndependent x) : + Function.Injective (toGenerated x) := by + intro f g hfg + apply (latticeLinearIndependent_iff_lift_injective x).mp hx + rw [← subtype_comp_toGenerated x] + exact congrArg (VectorSublattice.generated (Set.range x)).subtype hfg + +theorem toGenerated_surjective (x : α → X) : + Function.Surjective (toGenerated x) := by + intro y + classical + have hy : (y : X) ∈ (VectorSublattice.generated (Set.range x) : Set X) := y.2 + rw [LLexpr.generated_eq_iUnion_combinations (Set.range x)] at hy + simp only [Set.mem_iUnion, LLexpr.combinations, Set.mem_range] at hy + obtain ⟨n, z, e, he⟩ := hy + choose a ha using fun i : Fin n => (z i).2 + let f : FVL α := LLexpr.eval (fun i : Fin n => of (a i)) e + refine ⟨f, ?_⟩ + apply Subtype.ext + have hmap := LLexpr.map_eval (toGenerated x) (fun i : Fin n => of (a i)) e + calc + (toGenerated x f : X) = + ((LLexpr.eval (fun i : Fin n => toGenerated x (of (a i))) e : + VectorSublattice.generated (Set.range x)) : X) := by + exact congrArg Subtype.val hmap + _ = LLexpr.eval (fun i : Fin n => (z i : X)) e := by + rw [LLexpr.coe_eval_vectorSublattice] + congr + funext i + simp [ha i] + _ = y := he + +/-- If a family is lattice-linearly independent, the free vector lattice on its index type is +isomorphic to the vector sublattice generated by the family. -/ +noncomputable def equivGenerated (x : α → X) (hx : LatticeLinearIndependent x) : + VecLatEquiv (FVL α) (VectorSublattice.generated (Set.range x)) := + { LinearEquiv.ofBijective (toGenerated x).toLinearMap + ⟨toGenerated_injective hx, toGenerated_surjective x⟩ with + map_sup' := (toGenerated x).map_sup' + map_inf' := (toGenerated x).map_inf' } + +@[simp] +theorem equivGenerated_apply (x : α → X) (hx : LatticeLinearIndependent x) (f : FVL α) : + equivGenerated x hx f = toGenerated x f := + rfl + +theorem equivGenerated_of (x : α → X) (hx : LatticeLinearIndependent x) (a : α) : + equivGenerated x hx (of a) = generatedOf x a := by + simp [equivGenerated_apply] + +@[simp] +theorem equivGenerated_symm_generatedOf (x : α → X) (hx : LatticeLinearIndependent x) + (a : α) : + (equivGenerated x hx).symm (generatedOf x a) = of a := by + change (equivGenerated x hx).toLinearEquiv.symm (generatedOf x a) = of a + rw [LinearEquiv.symm_apply_eq] + change generatedOf x a = equivGenerated x hx (of a) + simp + +section GeneratedLift + +variable {Z : Type*} [AddCommGroup Z] [Lattice Z] [IsOrderedAddMonoid Z] + [VectorLattice Z] + +/-- The lifting equivalence for the vector sublattice generated by a lattice-linearly +independent family. -/ +noncomputable def liftGenerated (x : α → X) (hx : LatticeLinearIndependent x) : + (α → Z) ≃ + VecLatHom (VectorSublattice.generated (Set.range x)) Z where + toFun φ := (lift φ).comp (equivGenerated x hx).symm.toVecLatHom + invFun T := fun a => T (generatedOf x a) + left_inv φ := by + funext a + change (lift φ) ((equivGenerated x hx).symm (generatedOf x a)) = φ a + rw [equivGenerated_symm_generatedOf, lift_of] + right_inv T := by + apply DFunLike.ext + intro y + obtain ⟨f, rfl⟩ := (equivGenerated x hx).toLinearEquiv.surjective y + have hsymm : + (equivGenerated x hx).symm ((equivGenerated x hx) f) = f := by + change (equivGenerated x hx).toLinearEquiv.symm + ((equivGenerated x hx).toLinearEquiv f) = f + exact LinearEquiv.left_inv (equivGenerated x hx).toLinearEquiv f + have hhom : + lift (fun a => T (generatedOf x a)) = + T.comp (equivGenerated x hx).toVecLatHom := by + apply hom_ext + intro a + rw [VecLatHom.comp_apply, lift_of] + change T (generatedOf x a) = T (equivGenerated x hx (of a)) + simp + calc + ((lift (fun a => T (generatedOf x a))).comp + (equivGenerated x hx).symm.toVecLatHom) ((equivGenerated x hx) f) + = lift (fun a => T (generatedOf x a)) f := by + rw [VecLatHom.comp_apply] + change (lift fun a => T (generatedOf x a)) + ((equivGenerated x hx).symm ((equivGenerated x hx) f)) = + (lift fun a => T (generatedOf x a)) f + rw [hsymm] + _ = T ((equivGenerated x hx) f) := by + exact congrArg (fun S : VecLatHom (FVL α) Z => S f) hhom + +@[simp] +theorem liftGenerated_generatedOf (x : α → X) (hx : LatticeLinearIndependent x) + (φ : α → Z) (a : α) : + liftGenerated x hx φ (generatedOf x a) = φ a := by + change (lift φ) ((equivGenerated x hx).symm (generatedOf x a)) = φ a + rw [equivGenerated_symm_generatedOf, lift_of] + +/-- A vector lattice homomorphism out of the generated sublattice is determined by its values +on the independent generators. -/ +theorem liftGenerated_unique (x : α → X) (hx : LatticeLinearIndependent x) + (φ : α → Z) + (T : VecLatHom (VectorSublattice.generated (Set.range x)) Z) + (h : ∀ a, T (generatedOf x a) = φ a) : + T = liftGenerated x hx φ := by + have hsymm : (liftGenerated x hx).symm T = φ := funext h + calc + T = liftGenerated x hx ((liftGenerated x hx).symm T) := + (Equiv.apply_symm_apply (liftGenerated x hx) T).symm + _ = liftGenerated x hx φ := by rw [hsymm] + +end GeneratedLift + +end Generated + +end FVL diff --git a/LeanPool/FBLOrderContinuity/BanLat/Free/FVLv.lean b/LeanPool/FBLOrderContinuity/BanLat/Free/FVLv.lean new file mode 100644 index 0000000000..fe454493cd --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Free/FVLv.lean @@ -0,0 +1,623 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.FBLOrderContinuity.BanLat.Free.FVL +public import LeanPool.OrderClosures.BanLat.Examples.CofK.Basic +public import LeanPool.OrderClosures.BanLat.Tactic.LLexpr +public import Mathlib.Analysis.Normed.Module.HahnBanach +public import Mathlib.Analysis.Normed.Module.WeakDual +public import Mathlib.LinearAlgebra.Basis.VectorSpace + + + +/-! +# Free vector lattice over a normed space + +This file gives the concrete construction of the free vector lattice over a +real normed space as the vector sublattice of `C(B_{E*}, ℝ)` generated by +evaluation functions. +-/ + +@[expose] public section + +open scoped BigOperators + +universe u v + +namespace FVLv + +variable (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] + +/-- The closed unit ball of the norm dual, equipped with the weak-star topology. -/ +def dualUnitBall : Set (WeakDual ℝ E) := + WeakDual.toStrongDual ⁻¹' Metric.closedBall (0 : StrongDual ℝ E) 1 + +/-- The dual unit ball is compact for the weak-star topology. -/ +noncomputable instance instCompactSpaceDualUnitBall : CompactSpace (dualUnitBall E) := by + exact isCompact_iff_compactSpace.mp + (WeakDual.isCompact_closedBall (𝕜 := ℝ) (E := E) (0 : StrongDual ℝ E) 1) + +/-- The restriction of the evaluation functional `x̂` to the weak-star compact dual unit ball. -/ +noncomputable def dualEval (x : E) : C(dualUnitBall E, ℝ) where + toFun φ := (φ : WeakDual ℝ E) x + continuous_toFun := by + exact (WeakDual.eval_continuous x).comp continuous_subtype_val + +@[simp] +theorem dualEval_apply (x : E) (φ : dualUnitBall E) : + dualEval E x φ = (φ : WeakDual ℝ E) x := by + rfl + +/-- The concrete vector sublattice of `C(B_{E*}, ℝ)` generated by the evaluation maps. -/ +noncomputable def concreteSublattice : VectorSublattice C(dualUnitBall E, ℝ) := + VectorSublattice.generated (Set.range (dualEval E : E → C(dualUnitBall E, ℝ))) + +end FVLv + +/-- The free vector lattice over a real normed space, realized inside `C(B_{E*}, ℝ)`. -/ +abbrev FVLv (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] : + Type _ := + FVLv.concreteSublattice E + +namespace FVLv + +variable {E : Type u} [NormedAddCommGroup E] [NormedSpace ℝ E] + +noncomputable instance instCoeFun : CoeFun (FVLv E) (fun _ => dualUnitBall E → ℝ) where + coe f := f.1 + +noncomputable instance instCoeContinuousMap : Coe (FVLv E) C(dualUnitBall E, ℝ) where + coe f := f.1 + +@[simp] +theorem add_apply (f g : FVLv E) (φ : dualUnitBall E) : + (f + g : FVLv E) φ = f φ + g φ := by + rfl + +@[simp] +theorem smul_apply (r : ℝ) (f : FVLv E) (φ : dualUnitBall E) : + (r • f : FVLv E) φ = r * f φ := by + rfl + +theorem sup_apply (f g : FVLv E) (φ : dualUnitBall E) : + (f ⊔ g : FVLv E) φ = f φ ⊔ g φ := by + rfl + +theorem inf_apply (f g : FVLv E) (φ : dualUnitBall E) : + (f ⊓ g : FVLv E) φ = f φ ⊓ g φ := by + rfl + +/-- Order on `FVLv E` is inherited pointwise from `C(B_{E*}, ℝ)`. -/ +theorem le_def {f g : FVLv E} : f ≤ g ↔ ∀ φ : dualUnitBall E, f φ ≤ g φ := by + rfl + +/-- The canonical embedding of `E` into its free vector lattice. -/ +noncomputable def of (x : E) : FVLv E := + ⟨dualEval E x, VectorSublattice.subset_generated _ ⟨x, rfl⟩⟩ + +@[simp] +theorem coe_of (x : E) : + ((of x : FVLv E) : C(dualUnitBall E, ℝ)) = dualEval E x := by + rfl + +theorem of_apply (x : E) (φ : dualUnitBall E) : + (of x : FVLv E) φ = (φ : WeakDual ℝ E) x := by + rfl + +/-- The canonical map `E → FVLv E`, bundled as a real-linear map. -/ +noncomputable def ofLinear : E →ₗ[ℝ] FVLv E where + toFun := of + map_add' := by + intro x y + ext φ + exact (φ : WeakDual ℝ E).map_add x y + map_smul' := by + intro r x + ext φ + exact (φ : WeakDual ℝ E).map_smul r x + +@[simp] +theorem ofLinear_apply (x : E) : ofLinear x = of x := by + rfl + +@[simp] +theorem of_zero : of (0 : E) = 0 := by + ext φ + exact (φ : WeakDual ℝ E).map_zero + +@[simp] +theorem of_add (x y : E) : of (x + y) = of x + of y := by + exact (ofLinear (E := E)).map_add x y + +@[simp] +theorem of_smul (r : ℝ) (x : E) : of (r • x) = r • of x := by + exact (ofLinear (E := E)).map_smul r x + +/-- The canonical map into `FVLv E` is injective. -/ +theorem of_injective : Function.Injective (of : E → FVLv E) := by + intro x y hxy + by_contra hne + obtain ⟨φ, hφnorm, hφ⟩ := exists_dual_vector'' ℝ (x - y) + let ψ : dualUnitBall E := ⟨StrongDual.toWeakDual φ, by + dsimp [dualUnitBall] + simpa [Metric.mem_closedBall, dist_eq_norm] using hφnorm⟩ + have hval := congrArg (fun f : FVLv E => f ψ) hxy + have hzero : φ (x - y) = 0 := by + rw [map_sub, sub_eq_zero] + simpa [ψ] using hval + have hnorm_zero : ‖x - y‖ = 0 := by + simpa [hzero] using hφ.symm + exact hne (sub_eq_zero.mp (norm_eq_zero.mp hnorm_zero)) + +/-- The canonical linear map has trivial kernel. -/ +theorem ker_ofLinear : LinearMap.ker (ofLinear (E := E)) = ⊥ := by + exact LinearMap.ker_eq_bot.mpr (of_injective (E := E)) + +/-- Every element of the free vector lattice is the evaluation of a lattice-linear +expression at finitely many canonical generators. -/ +theorem exists_eval_of_eq (f : FVLv E) : + ∃ (n : ℕ) (x : Fin n → E) (e : LLexpr n), + LLexpr.eval (fun i => of (x i)) e = f := by + classical + have hf : (f : C(dualUnitBall E, ℝ)) ∈ + (VectorSublattice.generated + (Set.range (dualEval E : E → C(dualUnitBall E, ℝ))) : + Set C(dualUnitBall E, ℝ)) := f.2 + rw [LLexpr.generated_eq_iUnion_combinations + (Set.range (dualEval E : E → C(dualUnitBall E, ℝ)))] at hf + simp only [Set.mem_iUnion, LLexpr.combinations, Set.mem_range] at hf + obtain ⟨n, z, e, he⟩ := hf + choose x hx using fun i : Fin n => (z i).2 + refine ⟨n, x, e, ?_⟩ + apply Subtype.ext + calc + ((LLexpr.eval (fun i : Fin n => of (x i)) e : FVLv E) : + C(dualUnitBall E, ℝ)) + = LLexpr.eval (fun i : Fin n => dualEval E (x i)) e := by + exact LLexpr.coe_eval_vectorSublattice + (concreteSublattice E) (fun i : Fin n => of (x i)) e + _ = LLexpr.eval (fun i : Fin n => (z i : C(dualUnitBall E, ℝ))) e := by + congr + funext i + rw [hx i] + _ = f := he + +/-- The canonical generators generate `FVLv E` as a vector sublattice. -/ +theorem generated_range_of : + VectorSublattice.generated (Set.range (of : E → FVLv E)) = ⊤ := by + apply le_antisymm + · intro f _ + exact VectorSublattice.mem_top + · intro f _ + change f ∈ (VectorSublattice.generated (Set.range (of : E → FVLv E)) : Set (FVLv E)) + obtain ⟨n, x, e, he⟩ := exists_eval_of_eq (E := E) f + rw [← he] + rw [LLexpr.generated_eq_iUnion_combinations (Set.range (of : E → FVLv E))] + simp only [Set.mem_iUnion, LLexpr.combinations, Set.mem_range] + refine ⟨n, fun i : Fin n => ⟨of (x i), ⟨x i, rfl⟩⟩, e, ?_⟩ + rfl + +/-- Identify a vector sublattice equal to the whole space with its ambient lattice. -/ +noncomputable def equivTopOfEq {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] (Y : VectorSublattice X) (hY : Y = ⊤) : + VecLatEquiv Y X := + { LinearEquiv.ofBijective Y.subtype.toLinearMap + ⟨by + intro a b h + ext + exact h, + by + intro x + refine ⟨⟨x, ?_⟩, rfl⟩ + rw [hY] + exact VectorSublattice.mem_top⟩ with + map_sup' := fun _ _ => rfl + map_inf' := fun _ _ => rfl } + +/-- Evaluation at a dual-ball point as a lattice homomorphism. -/ +noncomputable def evalHom (φ : dualUnitBall E) : VecLatHom (FVLv E) ℝ where + toFun f := f φ + map_add' _ _ := rfl + map_smul' _ _ := rfl + map_sup' _ _ := rfl + map_inf' _ _ := rfl + +theorem eval_apply {n : ℕ} (y : Fin n → FVLv E) (e : LLexpr n) + (φ : dualUnitBall E) : + LLexpr.eval y e φ = LLexpr.eval (fun i => y i φ) e := by + have heval (f : FVLv E) : evalHom φ f = f φ := rfl + simpa only [heval] using (LLexpr.map_eval (evalHom φ) y e) + +theorem eval_const_smul_of_nonneg {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] {n : ℕ} (c : ℝ) (hc : 0 ≤ c) + (x : Fin n → X) (e : LLexpr n) : + LLexpr.eval (fun i => c • x i) e = c • LLexpr.eval x e := by + induction e with + | zero => simp [LLexpr.eval] + | var i => rfl + | add e₁ e₂ h₁ h₂ => simp [LLexpr.eval, h₁, h₂, smul_add] + | smul r e h => + rw [LLexpr.eval_smul, h, LLexpr.eval_smul, smul_smul, smul_smul, mul_comm] + | sup e₁ e₂ h₁ h₂ => + rw [LLexpr.eval_sup, h₁, h₂, LLexpr.eval_sup, nonneg_smul_sup _ _ c hc] + | inf e₁ e₂ h₁ h₂ => + rw [LLexpr.eval_inf, h₁, h₂, LLexpr.eval_inf, nonneg_smul_inf _ _ c hc] + +theorem exists_strongDual_apply_eq_of_linearIndependent {n : ℕ} {x : Fin n → E} + (hx : LinearIndependent ℝ x) (r : Fin n → ℝ) : + ∃ φ : StrongDual ℝ E, ∀ i, φ (x i) = r i := by + classical + let p : Submodule ℝ E := Submodule.span ℝ (Set.range x) + have : FiniteDimensional ℝ p := + FiniteDimensional.span_of_finite (K := ℝ) (A := Set.range x) (Set.finite_range x) + let coeff : p →ₗ[ℝ] Fin n → ℝ := + (Finsupp.linearEquivFunOnFinite ℝ ℝ (Fin n)).toLinearMap.comp hx.repr + let f : p →L[ℝ] Fin n → ℝ := LinearMap.toContinuousLinearMap coeff + obtain ⟨g, hg⟩ := f.exist_extension_of_finiteDimensional_range + let φ : StrongDual ℝ E := ∑ i : Fin n, r i • (ContinuousLinearMap.proj i).comp g + refine ⟨φ, ?_⟩ + intro i + let xi : p := ⟨x i, Submodule.subset_span ⟨i, rfl⟩⟩ + have hcoeff : f xi = Pi.single i (1 : ℝ) := by + change (Finsupp.linearEquivFunOnFinite ℝ ℝ (Fin n)) (hx.repr xi) = Pi.single i 1 + rw [hx.repr_eq_single i xi rfl] + exact Finsupp.linearEquivFunOnFinite_single (R := ℝ) (M := ℝ) (α := Fin n) i 1 + have hgxi : g (x i) = Pi.single i (1 : ℝ) := by + have h := congrArg (fun u : p →L[ℝ] Fin n → ℝ => u xi) hg + simpa [f, xi, hcoeff] using h.symm + calc + φ (x i) = + ∑ j : Fin n, r j * ((Pi.single i (1 : ℝ) : Fin n → ℝ) j) := by + simp [φ, hgxi, ContinuousLinearMap.proj_apply] + _ = r i := by + rw [Finset.sum_eq_single i] + · simp + · intro j _ hji + have hsingle : ((Pi.single i (1 : ℝ) : Fin n → ℝ) j) = 0 := + by + simpa only using + (Pi.single_eq_of_ne (M := fun _ : Fin n => ℝ) hji (1 : ℝ)) + simp [hsingle] + · intro hi + exact (hi (Finset.mem_univ i)).elim + +/-- The image of every linearly independent finite family in `E` is lattice-linearly independent +in `FVLv E`. -/ +theorem latticeLinearIndependent_of_linearIndependent {n : ℕ} {x : Fin n → E} + (hx : LinearIndependent ℝ x) : + FVL.LatticeLinearIndependent (fun i : Fin n => of (x i)) := by + intro m a ha e hzero r + have hxa : LinearIndependent ℝ (fun i : Fin m => x (a i)) := hx.comp a ha + obtain ⟨φ, hφ⟩ := exists_strongDual_apply_eq_of_linearIndependent hxa r + let c : ℝ := max ‖φ‖ 1 + have hc_pos : 0 < c := lt_of_lt_of_le zero_lt_one (le_max_right _ _) + have hc_nonneg : 0 ≤ c := hc_pos.le + have hφ_norm_le : ‖φ‖ ≤ c := le_max_left _ _ + have hscaled_norm : ‖c⁻¹ • φ‖ ≤ 1 := by + rw [norm_smul, Real.norm_of_nonneg (inv_nonneg.mpr hc_nonneg)] + have h := mul_le_mul_of_nonneg_left hφ_norm_le (inv_nonneg.mpr hc_nonneg) + simpa [inv_mul_cancel₀ hc_pos.ne'] using h + let ψ : dualUnitBall E := ⟨StrongDual.toWeakDual (c⁻¹ • φ), by + dsimp [dualUnitBall] + simpa [Metric.mem_closedBall, dist_eq_norm] using hscaled_norm⟩ + have hunit_eval : LLexpr.eval (fun i : Fin m => c⁻¹ * r i) e = 0 := by + have happly := congrArg (fun f : FVLv E => f ψ) hzero + have happly' : LLexpr.eval (fun i : Fin m => (of (x (a i)) : FVLv E) ψ) e = 0 := by + simpa [eval_apply] using happly + have hscaled : + (fun i : Fin m => (c⁻¹ • StrongDual.toWeakDual φ) (x (a i))) = + fun i : Fin m => c⁻¹ * r i := by + funext i + change c⁻¹ * (StrongDual.toWeakDual φ) (x (a i)) = c⁻¹ * r i + rw [StrongDual.toWeakDual_apply, hφ i] + simpa [ψ, hscaled] using happly' + have hscale : + LLexpr.eval r e = c • LLexpr.eval (fun i : Fin m => c⁻¹ * r i) e := by + have h := + eval_const_smul_of_nonneg (X := ℝ) c hc_nonneg (fun i : Fin m => c⁻¹ * r i) e + have hfun : (fun i : Fin m => c • (c⁻¹ * r i)) = r := by + funext i + change c * (c⁻¹ * r i) = r i + rw [← mul_assoc, mul_inv_cancel₀ hc_pos.ne', one_mul] + have hfun' : (fun i : Fin m => c * (c⁻¹ * r i)) = r := by + funext i + rw [← mul_assoc, mul_inv_cancel₀ hc_pos.ne', one_mul] + simpa [hfun, hfun'] using h + rw [hscale, hunit_eval, smul_zero] + +theorem latticeLinearIndependent_of_basis {ι : Type v} (b : Module.Basis ι ℝ E) : + FVL.LatticeLinearIndependent (fun i : ι => of (b i)) := by + intro n a ha e hzero + have hli : FVL.LatticeLinearIndependent (fun i : Fin n => of ((fun j => b (a j)) i)) := + latticeLinearIndependent_of_linearIndependent (x := fun j : Fin n => b (a j)) + (b.linearIndependent.comp a ha) + exact hli (fun i : Fin n => i) Function.injective_id e hzero + +theorem of_mem_generated_basis {ι : Type v} (b : Module.Basis ι ℝ E) (x : E) : + of x ∈ VectorSublattice.generated (Set.range fun i : ι => of (b i)) := by + classical + let Y : VectorSublattice (FVLv E) := + VectorSublattice.generated (Set.range fun i : ι => of (b i)) + have hsum_mem : + Finsupp.linearCombination ℝ (fun i : ι => of (b i)) (b.repr x) ∈ Y := by + rw [Finsupp.linearCombination_apply, Finsupp.sum] + exact Submodule.sum_mem _ fun i _ => + Y.smul_mem _ (VectorSublattice.subset_generated _ ⟨i, rfl⟩) + have hmap : + of (Finsupp.linearCombination ℝ b (b.repr x)) = + Finsupp.linearCombination ℝ (fun i : ι => of (b i)) (b.repr x) := by + change ofLinear (Finsupp.linearCombination ℝ b (b.repr x)) = + Finsupp.linearCombination ℝ (fun i : ι => of (b i)) (b.repr x) + rw [Finsupp.linearCombination_apply, Finsupp.linearCombination_apply, map_finsuppSum] + simp [ofLinear_apply] + rw [← b.linearCombination_repr x] + rw [hmap] + exact hsum_mem + +theorem generated_range_of_basis {ι : Type v} (b : Module.Basis ι ℝ E) : + VectorSublattice.generated (Set.range fun i : ι => of (b i)) = ⊤ := by + apply le_antisymm + · intro f _ + exact VectorSublattice.mem_top + · rw [← generated_range_of (E := E)] + exact VectorSublattice.generated_le (by + rintro _ ⟨x, rfl⟩ + exact of_mem_generated_basis b x) + +/-- The modulus of a supremum is bounded by the sum of the moduli. -/ +theorem abs_sup_le_add_abs {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] (x y : X) : + |x ⊔ y| ≤ |x| + |y| := by + llarith + +/-- The modulus of an infimum is bounded by the sum of the moduli. -/ +theorem abs_inf_le_add_abs {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] (x y : X) : + |x ⊓ y| ≤ |x| + |y| := by + llarith + +theorem sum_abs_nonneg {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] {n : ℕ} (x : Fin n → X) : + 0 ≤ ∑ i : Fin n, |x i| := by + exact Finset.sum_nonneg fun i _ => abs_nonneg (x i) + +theorem exists_abs_eval_le_const_sum_abs {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] {n : ℕ} (x : Fin n → X) (e : LLexpr n) : + ∃ c : ℝ, 0 < c ∧ |LLexpr.eval x e| ≤ c • (∑ i : Fin n, |x i|) := by + induction e with + | zero => + refine ⟨1, zero_lt_one, ?_⟩ + simpa [LLexpr.eval] using sum_abs_nonneg x + | var i => + refine ⟨1, zero_lt_one, ?_⟩ + have hsum : |x i| ≤ ∑ j : Fin n, |x j| := by + exact Finset.single_le_sum (fun j _ => abs_nonneg (x j)) (Finset.mem_univ i) + simpa [LLexpr.eval] using hsum + | add e₁ e₂ h₁ h₂ => + obtain ⟨c₁, hc₁, hle₁⟩ := h₁ + obtain ⟨c₂, hc₂, hle₂⟩ := h₂ + refine ⟨c₁ + c₂, add_pos hc₁ hc₂, ?_⟩ + calc + |LLexpr.eval x (LLexpr.add e₁ e₂)| ≤ |LLexpr.eval x e₁| + |LLexpr.eval x e₂| := by + rw [LLexpr.eval_add] + exact abs_add_le _ _ + _ ≤ c₁ • (∑ i : Fin n, |x i|) + c₂ • (∑ i : Fin n, |x i|) := + add_le_add hle₁ hle₂ + _ = (c₁ + c₂) • (∑ i : Fin n, |x i|) := by rw [add_smul] + | smul r e h => + obtain ⟨c, hc, hle⟩ := h + refine ⟨|r| * c + 1, + add_pos_of_nonneg_of_pos (mul_nonneg (abs_nonneg r) hc.le) zero_lt_one, ?_⟩ + calc + |LLexpr.eval x (LLexpr.smul r e)| = |r| • |LLexpr.eval x e| := by + rw [LLexpr.eval_smul, abs_smul'] + _ ≤ |r| • (c • (∑ i : Fin n, |x i|)) := + smul_le_smul_of_nonneg_left hle (abs_nonneg r) + _ = (|r| * c) • (∑ i : Fin n, |x i|) := by rw [smul_smul] + _ ≤ (|r| * c + 1) • (∑ i : Fin n, |x i|) := by + exact smul_le_smul_of_nonneg_right (le_add_of_nonneg_right zero_le_one) + (sum_abs_nonneg x) + | sup e₁ e₂ h₁ h₂ => + obtain ⟨c₁, hc₁, hle₁⟩ := h₁ + obtain ⟨c₂, hc₂, hle₂⟩ := h₂ + refine ⟨c₁ + c₂, add_pos hc₁ hc₂, ?_⟩ + calc + |LLexpr.eval x (LLexpr.sup e₁ e₂)| ≤ |LLexpr.eval x e₁| + |LLexpr.eval x e₂| := by + rw [LLexpr.eval_sup] + exact abs_sup_le_add_abs _ _ + _ ≤ c₁ • (∑ i : Fin n, |x i|) + c₂ • (∑ i : Fin n, |x i|) := + add_le_add hle₁ hle₂ + _ = (c₁ + c₂) • (∑ i : Fin n, |x i|) := by rw [add_smul] + | inf e₁ e₂ h₁ h₂ => + obtain ⟨c₁, hc₁, hle₁⟩ := h₁ + obtain ⟨c₂, hc₂, hle₂⟩ := h₂ + refine ⟨c₁ + c₂, add_pos hc₁ hc₂, ?_⟩ + calc + |LLexpr.eval x (LLexpr.inf e₁ e₂)| ≤ |LLexpr.eval x e₁| + |LLexpr.eval x e₂| := by + rw [LLexpr.eval_inf] + exact abs_inf_le_add_abs _ _ + _ ≤ c₁ • (∑ i : Fin n, |x i|) + c₂ • (∑ i : Fin n, |x i|) := + add_le_add hle₁ hle₂ + _ = (c₁ + c₂) • (∑ i : Fin n, |x i|) := by rw [add_smul] + +/-- The sublattice generated by a linearly independent finite family is a free vector lattice on +that finite set. -/ +noncomputable def equivGeneratedOfLinearIndependent {n : ℕ} (x : Fin n → E) + (hx : LinearIndependent ℝ x) : + VecLatEquiv (FVL (Fin n)) + (VectorSublattice.generated (Set.range fun i : Fin n => of (x i))) := by + exact FVL.equivGenerated (fun i : Fin n => of (x i)) + (latticeLinearIndependent_of_linearIndependent hx) + +/-- For a Hamel basis of `E`, `FVLv E` is vector-lattice isomorphic to the free vector lattice +on the index set of the basis. -/ +noncomputable def equivFVLOfBasis {ι : Type v} (b : Module.Basis ι ℝ E) : + VecLatEquiv (FVL ι) (FVLv E) := by + exact + (FVL.equivGenerated (fun i : ι => of (b i)) (latticeLinearIndependent_of_basis b)).trans + (equivTopOfEq _ (generated_range_of_basis b)) + +theorem equivFVLOfBasis_of {ι : Type*} (b : Module.Basis ι ℝ E) (i : ι) : + equivFVLOfBasis b (FVL.of i) = of (b i) := by + change (equivTopOfEq + (VectorSublattice.generated (Set.range fun i : ι => of (b i))) + (generated_range_of_basis b)) + (FVL.equivGenerated (fun i : ι => of (b i)) (latticeLinearIndependent_of_basis b) + (FVL.of i)) = of (b i) + rw [FVL.equivGenerated_of] + rfl + +theorem equivFVLOfBasis_symm_of_basis {ι : Type*} (b : Module.Basis ι ℝ E) (i : ι) : + (equivFVLOfBasis b).symm (of (b i)) = FVL.of i := by + change (equivFVLOfBasis b).toLinearEquiv.symm (of (b i)) = FVL.of i + rw [LinearEquiv.symm_apply_eq] + exact (equivFVLOfBasis_of b i).symm + +/-- Every element of `FVLv E` is dominated by a finite positive linear combination of moduli of +canonical generators from the unit ball of `E`. -/ +theorem exists_abs_le_finite_sum_abs_of (f : FVLv E) : + ∃ (n : ℕ) (x : Fin n → E) (c : ℝ), 0 < c ∧ (∀ i, ‖x i‖ ≤ 1) ∧ + |f| ≤ c • (∑ i : Fin n, |of (x i)|) := by + classical + obtain ⟨n, x, e, he⟩ := exists_eval_of_eq (E := E) f + obtain ⟨c, hc, hle⟩ := exists_abs_eval_le_const_sum_abs (fun i : Fin n => of (x i)) e + let M : ℝ := max (∑ i : Fin n, ‖x i‖) 1 + have hM_pos : 0 < M := lt_of_lt_of_le zero_lt_one (le_max_right _ _) + have hM_nonneg : 0 ≤ M := hM_pos.le + let y : Fin n → E := fun i => M⁻¹ • x i + refine ⟨n, y, c * M, mul_pos hc hM_pos, ?_, ?_⟩ + · intro i + rw [norm_smul, Real.norm_of_nonneg (inv_nonneg.mpr hM_nonneg)] + have hxi_sum : ‖x i‖ ≤ ∑ j : Fin n, ‖x j‖ := by + exact Finset.single_le_sum (fun j _ => norm_nonneg (x j)) (Finset.mem_univ i) + have hxi_M : ‖x i‖ ≤ M := hxi_sum.trans (le_max_left _ _) + have h := mul_le_mul_of_nonneg_left hxi_M (inv_nonneg.mpr hM_nonneg) + simpa [inv_mul_cancel₀ hM_pos.ne'] using h + · have hsum_eq : + (∑ i : Fin n, |of (x i)|) = M • (∑ i : Fin n, |of (y i)|) := by + calc + (∑ i : Fin n, |of (x i)|) = ∑ i : Fin n, |M • of (y i)| := by + apply Finset.sum_congr rfl + intro i _ + congr 1 + change of (x i) = M • of (M⁻¹ • x i) + rw [← of_smul, smul_smul, mul_inv_cancel₀ hM_pos.ne', one_smul] + _ = ∑ i : Fin n, M • |of (y i)| := by + apply Finset.sum_congr rfl + intro i _ + rw [abs_smul', abs_of_nonneg hM_nonneg] + _ = M • (∑ i : Fin n, |of (y i)|) := by rw [Finset.smul_sum] + calc + |f| = |LLexpr.eval (fun i : Fin n => of (x i)) e| := by rw [he] + _ ≤ c • (∑ i : Fin n, |of (x i)|) := hle + _ = (c * M) • (∑ i : Fin n, |of (y i)|) := by rw [hsum_eq, smul_smul] + +section Lift + +variable {Y : Type v} [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] + [VectorLattice Y] + +/-- The free-vector-lattice lift constructed from a basis of the generator space. -/ +noncomputable def liftOfBasis {ι : Type*} (b : Module.Basis ι ℝ E) + (T : E →ₗ[ℝ] Y) : VecLatHom (FVLv E) Y := + (FVL.lift (fun i => T (b i))).comp (equivFVLOfBasis b).symm.toVecLatHom + +theorem liftOfBasis_of {ι : Type*} (b : Module.Basis ι ℝ E) + (T : E →ₗ[ℝ] Y) (x : E) : liftOfBasis b T (of x) = T x := by + let L : E →ₗ[ℝ] Y := (liftOfBasis b T).toLinearMap.comp (ofLinear (E := E)) + have hL : L = T := by + apply b.ext + intro i + change liftOfBasis b T (of (b i)) = T (b i) + rw [liftOfBasis, VecLatHom.comp_apply] + change (FVL.lift fun i => T (b i)) ((equivFVLOfBasis b).symm (of (b i))) = T (b i) + rw [equivFVLOfBasis_symm_of_basis, FVL.lift_of] + exact congrArg (fun L : E →ₗ[ℝ] Y => L x) hL + +theorem hom_ext_of {S T : VecLatHom (FVLv E) Y} + (h : ∀ x, S (of x) = T (of x)) : S = T := by + apply DFunLike.ext + intro f + obtain ⟨n, x, e, he⟩ := exists_eval_of_eq (E := E) f + calc + S f = S (LLexpr.eval (fun i : Fin n => of (x i)) e) := by rw [he] + _ = LLexpr.eval (fun i : Fin n => S (of (x i))) e := by + exact LLexpr.map_eval S (fun i : Fin n => of (x i)) e + _ = LLexpr.eval (fun i : Fin n => T (of (x i))) e := by + congr + funext i + rw [h] + _ = T (LLexpr.eval (fun i : Fin n => of (x i)) e) := by + exact (LLexpr.map_eval T (fun i : Fin n => of (x i)) e).symm + _ = T f := by rw [he] + +/-- The universal property of `FVLv E`: linear maps from `E` to a vector lattice `Y` are exactly +vector lattice homomorphisms from `FVLv E` to `Y`. -/ +noncomputable def lift : (E →ₗ[ℝ] Y) ≃ VecLatHom (FVLv E) Y := by + classical + let b := Module.Free.chooseBasis ℝ E + refine + { toFun := liftOfBasis b + invFun := fun S => S.toLinearMap.comp (ofLinear (E := E)) + left_inv := ?_ + right_inv := ?_ } + · intro T + ext x + exact liftOfBasis_of b T x + · intro S + apply hom_ext_of + intro x + exact liftOfBasis_of b (S.toLinearMap.comp (ofLinear (E := E))) x + +@[simp] +theorem lift_of (T : E →ₗ[ℝ] Y) (x : E) : lift T (of x) = T x := by + change liftOfBasis (Module.Free.chooseBasis ℝ E) T (of x) = T x + exact liftOfBasis_of (Module.Free.chooseBasis ℝ E) T x + +@[simp] +theorem lift_comp_of (T : VecLatHom (FVLv E) Y) : + lift (T.toLinearMap.comp (ofLinear (E := E))) = T := by + simpa [lift] using Equiv.apply_symm_apply (lift (E := E) (Y := Y)) T + +/-- A vector lattice homomorphism out of `FVLv E` is uniquely determined by its values on `E`. -/ +theorem lift_unique (T : E →ₗ[ℝ] Y) (S : VecLatHom (FVLv E) Y) + (h : ∀ x, S (of x) = T x) : S = lift T := by + calc + S = lift (S.toLinearMap.comp (ofLinear (E := E))) := (lift_comp_of S).symm + _ = lift T := by + congr + ext x + exact h x + +@[ext] +theorem hom_ext {S T : VecLatHom (FVLv E) Y} (h : ∀ x, S (of x) = T (of x)) : + S = T := by + exact hom_ext_of h + +end Lift + +section Map + +variable {F : Type v} [NormedAddCommGroup F] [NormedSpace ℝ F] + +/-- The vector lattice homomorphism induced by a real-linear map of normed spaces. -/ +noncomputable def map (T : E →ₗ[ℝ] F) : VecLatHom (FVLv E) (FVLv F) := + lift ((ofLinear (E := F)).comp T) + +@[simp] +theorem map_of (T : E →ₗ[ℝ] F) (x : E) : map T (of x) = of (T x) := by + exact lift_of ((ofLinear (E := F)).comp T) x + +end Map + +end FVLv diff --git a/LeanPool/FBLOrderContinuity/BanLat/FunctionalCalculus.lean b/LeanPool/FBLOrderContinuity/BanLat/FunctionalCalculus.lean new file mode 100644 index 0000000000..5dc580b245 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/FunctionalCalculus.lean @@ -0,0 +1,1036 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: Jesús Illescas-Fiorito +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.FBLOrderContinuity.BanLat.AMSpace.Kakutani +public import LeanPool.OrderClosures.BanLat.LLexpr + + + +/-! +# Functional calculus in uniformly complete vector lattices + +This file develops the **lattice-linear** and **positively homogeneous functional calculus** +associated to every tuple `x₁,...,xₙ` in a uniformly complete vector lattice. + +* Lattice-linear functional calculus is defined as the (unique) vector-lattice homomorphism +from `latticeLinearFunctions n` to `X`, such that `coordinate i ↦ x i`. Here, we define +`coordinate i : x ↦ xᵢ` and `latticeLinearFunctions n` is the sublattice of `C(ℝⁿ, ℝ)` generated +by them. + +* Positively homogeneous functional calculus is defined as the (unique) vector-lattice homomorphism +from `posHomFunctions n` to `X` such that `coordinate i ↦ x i`. Here, `posHomFunctions n` is the +vector sublattice of `C(ℝⁿ, ℝ)` consisting of positively homogeneous functions. + +Apart from both uniqueness results, this file also shows that: +* The positively homogeneous functional calculus agrees with the lattice-linear functional calculus +over `latticeLinearFunctions n`. +* `posHomFunctions n` and `C(ellInfinityUnitSphere n, ℝ)`, where `ellInfinityUnitSphere n` denotes +the unit sphere of `(ℝⁿ, ‖·‖_∞)`, are Banach lattice isometric. To do so, we develop the usual +`restriction`-`radialExtension` procedure between these spaces. +* The set of restrictions to the unit sphere of `latticeLinearFunctions n` is dense +in `C(ellInfinityUnitSphere n, ℝ)`. +* Both functional calculi are preserved by lattice homomorphisms. +-/ + +@[expose] public section + +universe u v + +/-! ### Lattice-linear functions in `C(ℝⁿ)` -/ + +/-- Coordinate projections `x ↦ xᵢ` as elements of `C(ℝⁿ, ℝ)`. -/ +noncomputable def continuousCoordinate (n : ℕ) (i : Fin n) : C(Fin n → ℝ, ℝ) where + toFun x := x i + continuous_toFun := by + exact continuous_apply i + +/-- The vector sublattice of `C(ℝⁿ)` generated by coordinate projections. -/ +noncomputable def latticeLinearFunctions (n : ℕ) : + VectorSublattice C(Fin n → ℝ, ℝ) := + VectorSublattice.generated (Set.range (continuousCoordinate n)) + +instance instCoeFunLatticeLinearFunctions : + CoeFun (latticeLinearFunctions n) (fun _ ↦ (Fin n → ℝ) → ℝ) where + coe f := f.1 + +namespace LatticeLinearFunction + +variable {n : ℕ} {X : Type u} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] + +/-- The `i`-th coordinate projection, bundled with a proof of its membership +in `latticeLinearFunctions`. -/ +noncomputable def coordinate (i : Fin n) : latticeLinearFunctions n := + ⟨continuousCoordinate n i, + VectorSublattice.subset_generated _ ⟨i, rfl⟩⟩ + +@[simp] +theorem coordinate_apply (i : Fin n) (x : Fin n → ℝ) : + coordinate i x = x i := by + rfl + +/-- `f ∈ latticeLinearFunctions n` iff it is represented by a lattice-linear +expression. -/ +theorem mem_latticeLinearFunctions_iff (f : C(Fin n → ℝ, ℝ)) : + f ∈ latticeLinearFunctions n ↔ + ∃ e : LLexpr n, LLexpr.eval (continuousCoordinate n) e = f := by + change f ∈ (VectorSublattice.generated (Set.range (continuousCoordinate n)) : + Set C(Fin n → ℝ, ℝ)) ↔ _ + rw [LLexpr.generated_range_eq_combinations] + rfl + +/-- Every lattice-linear function on `ℝⁿ` has a formal +lattice-linear expression representative. -/ +theorem exists_expression (f : latticeLinearFunctions n) : + ∃ e : LLexpr n, + LLexpr.eval (continuousCoordinate n) e = + (f : C(Fin n → ℝ, ℝ)) := by + exact (mem_latticeLinearFunctions_iff f.1).mp f.2 + +/-- For every lattice-linear function on `ℝⁿ`, `expressionRepresentative` is +a formal lattice-linear expression representing it. -/ +noncomputable def expressionRepresentative (f : latticeLinearFunctions n) : LLexpr n := + Classical.choose (exists_expression f) + +/-- Evaluating `expressionRepresentative` at the coordinate functions recovers the +original lattice-linear function. -/ +theorem eval_expressionRepresentative (f : latticeLinearFunctions n) : + LLexpr.eval (continuousCoordinate n) (expressionRepresentative f) = + (f.1 : C(Fin n → ℝ, ℝ)) := + Classical.choose_spec (exists_expression f) + +/-- Evaluating an expression of coordinate functions on `ℝⁿ` at a point agrees +with evaluating the expression directly at that point. -/ +theorem eval_coordinate_apply (r : Fin n → ℝ) (e : LLexpr n) : + LLexpr.eval (continuousCoordinate n) e r = LLexpr.eval r e := by + induction e <;> simp [LLexpr.eval, continuousCoordinate, *] + +/-- Expressions defining the same real-valued function on `ℝⁿ` have equal +evaluations in every vector lattice. -/ +theorem eval_eq_of_eval_coordinate_eq (x : Fin n → X) (e₁ e₂ : LLexpr n) + (h : LLexpr.eval (continuousCoordinate n) e₁ = + LLexpr.eval (continuousCoordinate n) e₂) : + LLexpr.eval x e₁ = LLexpr.eval x e₂ := by + apply LLexpr.eval_eq_of_vanishes_real x e₁ e₂ + intro r + rw [LLexpr.eval_add, LLexpr.eval_smul] + rw [← eval_coordinate_apply r e₁, ← eval_coordinate_apply r e₂, h] + simp + +/-- The **lattice-linear functional calculus** associated +to every tuple `x₁,...,xₙ ∈ X` in a vector lattice. -/ +noncomputable def functionalCalculus (x : Fin n → X) : + VecLatHom (latticeLinearFunctions n) X := by + refine + { toFun := fun f => LLexpr.eval x (expressionRepresentative f) + map_add' := fun f g => ?_ + map_smul' := fun c f => ?_ + map_sup' := fun f g => ?_ + map_inf' := fun f g => ?_ } + · apply eval_eq_of_eval_coordinate_eq x (expressionRepresentative (f + g)) + (.add (expressionRepresentative f) (expressionRepresentative g)) + rw [eval_expressionRepresentative, LLexpr.eval_add, eval_expressionRepresentative, + eval_expressionRepresentative] + rfl + · apply eval_eq_of_eval_coordinate_eq x (expressionRepresentative (c • f)) + (.smul c (expressionRepresentative f)) + rw [eval_expressionRepresentative, LLexpr.eval_smul, eval_expressionRepresentative] + rfl + · apply eval_eq_of_eval_coordinate_eq x (expressionRepresentative (f ⊔ g)) + (.sup (expressionRepresentative f) (expressionRepresentative g)) + rw [eval_expressionRepresentative, LLexpr.eval_sup, eval_expressionRepresentative, + eval_expressionRepresentative] + rfl + · apply eval_eq_of_eval_coordinate_eq x (expressionRepresentative (f ⊓ g)) + (.inf (expressionRepresentative f) (expressionRepresentative g)) + rw [eval_expressionRepresentative, LLexpr.eval_inf, eval_expressionRepresentative, + eval_expressionRepresentative] + rfl + +@[simp] +theorem functionalCalculus_coordinate (x : Fin n → X) (i : Fin n) : + functionalCalculus x (coordinate i) = x i := by + change LLexpr.eval x (expressionRepresentative (coordinate i)) = LLexpr.eval x (.var i) + apply eval_eq_of_eval_coordinate_eq x + rw [eval_expressionRepresentative] + ext r + rfl + +/-- The lattice-linear functional calculus evaluates a formal expression by +substituting the tuple `x` for its variables. -/ +@[simp] +theorem functionalCalculus_eval (x : Fin n → X) (e : LLexpr n) : + functionalCalculus x (LLexpr.eval (fun i ↦ coordinate i) e) = LLexpr.eval x e := by + simpa using LLexpr.map_eval (functionalCalculus x) (fun i ↦ coordinate i) e + +/-- The **lattice-linear functional calculus** associated to `x₁,...,xₙ ∈ X` is the +**unique** vector-lattice homomorphism from `latticeLinearFunctions n` to `X` such +that `coordinate i ↦ x i`. -/ +theorem eq_functionalCalculus_of_map_coordinate (x : Fin n → X) + (T : VecLatHom (latticeLinearFunctions n) X) + (hT : ∀ i, T (coordinate i) = x i) : + T = functionalCalculus x := by + apply VecLatHom.instFunLike.coe_injective + funext f + have hf : LLexpr.eval (fun i => coordinate i) (expressionRepresentative f) = f := by + apply Subtype.ext + rw [LLexpr.coe_eval_vectorSublattice] + exact eval_expressionRepresentative f + calc + T f = T (LLexpr.eval (fun i => coordinate i) (expressionRepresentative f)) := + congrArg T hf.symm + _ = LLexpr.eval (fun i => T (coordinate i)) (expressionRepresentative f) := + LLexpr.map_eval T (fun i => coordinate i) (expressionRepresentative f) + _ = LLexpr.eval x (expressionRepresentative f) := by rw [funext hT] + _ = functionalCalculus x f := rfl + +end LatticeLinearFunction + +/-! ### Functoriality of the lattice-linear functional calculus -/ + +variable {n : ℕ} {X : Type u} {Y : Type v} + [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [VectorLattice X] + [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + +/-- Lattice-linear functional calculus is preserved by lattice homomorphisms: +`T (functionalCalculus x f) = functionalCalculus (Tx) f`. -/ +theorem LatticeLinearFunction.functionalCalculus_map + (T : VecLatHom X Y) (x : Fin n → X) (f : latticeLinearFunctions n) : + T (LatticeLinearFunction.functionalCalculus x f) = + LatticeLinearFunction.functionalCalculus (fun i => T (x i)) f := by + have hcomp : ∀ i, + (T.comp (LatticeLinearFunction.functionalCalculus x)) + (LatticeLinearFunction.coordinate i) = T (x i) := by + intro i + rw [VecLatHom.comp_apply, LatticeLinearFunction.functionalCalculus_coordinate] + have heq := LatticeLinearFunction.eq_functionalCalculus_of_map_coordinate + (fun i => T (x i)) (T.comp (LatticeLinearFunction.functionalCalculus x)) hcomp + simpa [VecLatHom.comp_apply] using DFunLike.congr_fun heq f + +/-! ### Positively homogeneous functions in `ℝⁿ` -/ + +/-- The vector sublattice of `C(ℝⁿ, ℝ)` of positively homogeneous functions. -/ +noncomputable def posHomFunctions (n : ℕ) : + VectorSublattice C(Fin n → ℝ, ℝ) where + toSubmodule := + { carrier := {f | ∀ c : ℝ, 0 ≤ c → ∀ x, f (c • x) = c • f x} + zero_mem' := by + intro c hc x + simp + add_mem' := by + intro f g hf hg c hc x + simp only [ContinuousMap.add_apply, hf c hc x, hg c hc x, smul_add] + smul_mem' := by + intro a f hf c hc x + simp only [ContinuousMap.smul_apply, hf c hc x, smul_smul, mul_comm] + } + sup_mem' := by + intro f g hf hg c hc x + simp only [ContinuousMap.sup_apply, hf c hc x, hg c hc x] + rw [smul_max_of_nonneg hc] + +namespace PosHomFunction + +variable {n : ℕ} + +instance instCoeFun : + CoeFun (posHomFunctions n) (fun _ ↦ (Fin n → ℝ) → ℝ) where + coe f := f.1 + +/-- Positively homogeneous functions are equal if they agree pointwise. -/ +@[ext] +theorem ext {f g : posHomFunctions n} (h : ∀ x, f x = g x) : f = g := by + apply Subtype.ext + exact ContinuousMap.ext h + +@[simp] +theorem map_smul_of_nonneg (f : posHomFunctions n) (c : ℝ) (hc : 0 ≤ c) + (x : Fin n → ℝ) : + f (c • x) = c • f x := by + exact f.2 c hc x + +/-- A positively homogeneous function vanishes at zero. -/ +@[simp] +theorem map_zero (f : posHomFunctions n) : + f 0 = 0 := by + simpa using + map_smul_of_nonneg f 0 le_rfl (0 : Fin n → ℝ) + +/-- The coordinate functions are positively homogeneous. -/ +noncomputable def coordinate (i : Fin n) : posHomFunctions n := + ⟨continuousCoordinate n i, by + intro c hc x + rfl⟩ + +@[simp] +theorem coordinate_apply (i : Fin n) (x : Fin n → ℝ) : + coordinate i x = x i := by + rfl + +/-- Lattice-linear functions on `ℝⁿ` form a sublattice +of continuous positively homogeneous functions. -/ +theorem latticeLinearFunctions_le_posHomFunctions : + latticeLinearFunctions n ≤ posHomFunctions n := by + apply VectorSublattice.generated_le + rintro f ⟨i, rfl⟩ + intro c hc x + rfl + +/-- The inclusion `latticeLinearFunctions n ≤ posHomFunctions n` as a +vector lattice homomorphism. -/ +noncomputable def latticeLinearInclusion : + VecLatHom (latticeLinearFunctions n) (posHomFunctions n) := + VectorSublattice.inclusion latticeLinearFunctions_le_posHomFunctions + +@[simp] +theorem latticeLinearInclusion_apply (f : latticeLinearFunctions n) (x : Fin n → ℝ) : + latticeLinearInclusion f x = f x := by + rfl + +/-! ### Restriction of positively homogeneous functions to the unit sphere of `(ℝⁿ,‖·‖_∞)` -/ + +/-- The unit sphere of `(ℝⁿ,‖·‖_∞)`, an element of which consists of +`⟨point, proof_that_point_lies_on_the_unit_sphere⟩`. -/ +def ellInfinityUnitSphere (n : ℕ) : Set (Fin n → ℝ) := + Metric.sphere 0 1 + +/-- The unit sphere of `(ℝⁿ,‖·‖_∞)` is compact. -/ +noncomputable instance instCompactSpaceEllInfinityUnitSphere : + CompactSpace (ellInfinityUnitSphere n) := by + unfold ellInfinityUnitSphere + infer_instance + +lemma isGreatest_coord_abs (x : ellInfinityUnitSphere n) : + IsGreatest (Set.range fun i : Fin n => |(x : Fin n → ℝ) i|) 1 := by + have hnorm : ‖(x : Fin n → ℝ)‖ = 1 := by + have hx := x.2 + change dist (x : Fin n → ℝ) 0 = 1 at hx + rwa [dist_zero_right] at hx + have : Nonempty (Fin n) := by + have hx_ne : (x : Fin n → ℝ) ≠ 0 := norm_ne_zero_iff.mp (by + rw [hnorm] + norm_num) + obtain ⟨i, hi⟩ := Function.ne_iff.mp hx_ne + exact ⟨i⟩ + obtain ⟨i, hi⟩ := (IsGreatest.pi_norm (x : Fin n → ℝ)).1 + refine ⟨⟨i, ?_⟩, ?_⟩ + · change |(x : Fin n → ℝ) i| = 1 + simpa [Real.norm_eq_abs] using hi.trans hnorm + · rintro _ ⟨j, rfl⟩ + change |(x : Fin n → ℝ) j| ≤ 1 + rw [← Real.norm_eq_abs] + have h := norm_le_pi_norm (x : Fin n → ℝ) j + rw [hnorm] at h + exact h + +/-- Restriction of continuous positively homogeneous functions on `ℝⁿ` to +the unit sphere of `(ℝⁿ,‖·‖_∞)` as a vector lattice homomorphism. -/ +noncomputable def restrict : + VecLatHom (posHomFunctions n) C(ellInfinityUnitSphere n, ℝ) := by + refine + { toFun := fun f => + ⟨fun x => f (x : Fin n → ℝ), + f.1.continuous.comp continuous_subtype_val⟩ + map_add' := ?_ + map_smul' := ?_ + map_sup' := ?_ + map_inf' := ?_ } + all_goals intros; rfl + +/-- Pointwise description of restriction to the unit sphere of `(ℝⁿ,‖·‖_∞)`. -/ +@[simp] +theorem restrict_apply (f : posHomFunctions n) (x : ellInfinityUnitSphere n) : + restrict f x = f (x : Fin n → ℝ) := by + rfl + +/-- The normalization map `ℝⁿ ∖ {0} → {x | ‖x‖_∞ = 1}` given by `x ↦ ‖x‖_∞⁻¹ • x`. -/ +noncomputable def normalize : + {x : Fin n → ℝ // x ≠ 0} → ellInfinityUnitSphere n := fun x => + ⟨‖(x : Fin n → ℝ)‖⁻¹ • x, by + rw [ellInfinityUnitSphere, Metric.mem_sphere, dist_zero_right, norm_smul, norm_inv, + Real.norm_eq_abs, abs_norm, + inv_mul_cancel₀ (norm_ne_zero_iff.mpr x.2)]⟩ + +/-- Normalization is continuous away from the origin. -/ +theorem continuous_normalize : Continuous (normalize (n := n)) := by + apply continuous_induced_rng.mpr + exact (continuous_norm.comp continuous_subtype_val).inv₀ + (fun x => norm_ne_zero_iff.mpr x.2) |>.smul continuous_subtype_val + +/-- For every `x ∈ ℝⁿ, x ≠ 0`, `‖x‖_∞ · normalize x = x`. -/ +lemma norm_smul_normalize (x : {x : Fin n → ℝ // x ≠ 0}) : + ‖(x : Fin n → ℝ)‖ • (normalize x : Fin n → ℝ) = x := by + change ‖(x : Fin n → ℝ)‖ • (‖(x : Fin n → ℝ)‖⁻¹ • (x : Fin n → ℝ)) = + (x : Fin n → ℝ) + rw [smul_smul, mul_inv_cancel₀ (norm_ne_zero_iff.mpr x.2), one_smul] + +/-- Normalize a nonzero vector to the unit sphere of `(ℝⁿ,‖·‖_∞)`. -/ +noncomputable def unitNormalize (x : Fin n → ℝ) (hx : x ≠ 0) : + ellInfinityUnitSphere n := normalize ⟨x, hx⟩ + +/-- Normalization is invariant under multiplication by a positive scalar. -/ +lemma unitNormalize_smul_of_pos (c : ℝ) (hc : 0 < c) + (x : Fin n → ℝ) (hx : x ≠ 0) : + unitNormalize (c • x) (smul_ne_zero hc.ne' hx) = unitNormalize x hx := by + apply Subtype.ext + change ‖c • x‖⁻¹ • (c • x) = ‖x‖⁻¹ • x + rw [norm_smul, Real.norm_of_nonneg hc.le, smul_smul] + apply congrArg (fun a : ℝ => a • x) + field_simp + +/-- A positively homogeneous function is determined by its values over +the unit sphere of `(ℝⁿ,‖·‖_∞)`. -/ +theorem eq_norm_smul_unit (f : posHomFunctions n) {x : Fin n → ℝ} (hx : x ≠ 0) : + f x = ‖x‖ • f (unitNormalize x hx) := by + have h := map_smul_of_nonneg f ‖x‖ (norm_nonneg x) (unitNormalize x hx) + change f (‖x‖ • (unitNormalize x hx : Fin n → ℝ)) = _ at h + have hscale : ‖x‖ • (unitNormalize x hx : Fin n → ℝ) = x := by + simpa only [unitNormalize] using + norm_smul_normalize (⟨x, hx⟩ : {x : Fin n → ℝ // x ≠ 0}) + rw [hscale] at h + exact h + +/-- The `restriction` map is injective. -/ +theorem restrict_injective : Function.Injective (restrict (n := n)) := by + intro f g hfg + apply PosHomFunction.ext + intro x + by_cases hx : x = 0 + · subst x + simp + · rw [eq_norm_smul_unit f hx, eq_norm_smul_unit g hx] + congr 1 + exact congrArg (fun q : C(ellInfinityUnitSphere n, ℝ) => q (unitNormalize x hx)) hfg + +/-- The `radialExtension` of a continuous function on the unit sphere of `(ℝⁿ,‖·‖_∞)` to `ℝⁿ`, +taking the value `0` at zero. -/ +noncomputable def radialExtension (f : C(ellInfinityUnitSphere n, ℝ)) + (x : Fin n → ℝ) : ℝ := + if hx : x = 0 then 0 else + ‖x‖ • f (unitNormalize x hx) + +/-- The radial extension of a continuous function on the unit sphere vanishes at the origin. -/ +@[simp] +theorem radialExtension_zero (f : C(ellInfinityUnitSphere n, ℝ)) : + radialExtension f 0 = 0 := by + simp [radialExtension] + +/-- Formula for the radial extension of a continuous function on the unit sphere +away from the origin. -/ +@[simp] +theorem radialExtension_of_ne (f : C(ellInfinityUnitSphere n, ℝ)) + {x : Fin n → ℝ} (hx : x ≠ 0) : + radialExtension f x = ‖x‖ • f (unitNormalize x hx) := by + rw [radialExtension, dite_eq_right hx] + +/-- A function and its radial extension agree on the unit sphere. -/ +@[simp] +theorem radialExtension_sphere (f : C(ellInfinityUnitSphere n, ℝ)) + (y : ellInfinityUnitSphere n) : radialExtension f (y : Fin n → ℝ) = f y := by + have hnorm : ‖(y : Fin n → ℝ)‖ = 1 := by + have hy_mem := y.2 + change dist (y : Fin n → ℝ) 0 = 1 at hy_mem + rw [dist_zero_right] at hy_mem + exact hy_mem + have hy : (y : Fin n → ℝ) ≠ 0 := by + intro h + rw [h, norm_zero] at hnorm + norm_num at hnorm + rw [radialExtension_of_ne f hy] + have hunit : unitNormalize (y : Fin n → ℝ) hy = y := by + apply Subtype.ext + have hscale := + norm_smul_normalize (⟨(y : Fin n → ℝ), hy⟩ : {x : Fin n → ℝ // x ≠ 0}) + rw [hnorm, one_smul] at hscale + simpa only [unitNormalize] using hscale + rw [hunit] + simp only [hnorm, one_smul] + +/-- The radial extension of a continuous function on the unit sphere is positively homogeneous. -/ +theorem radialExtension_smul_of_nonneg (f : C(ellInfinityUnitSphere n, ℝ)) + (c : ℝ) (hc : 0 ≤ c) (x : Fin n → ℝ) : + radialExtension f (c • x) = c • radialExtension f x := by + rcases hc.eq_or_lt with rfl | hc + · simp + by_cases hx : x = 0 + · subst x + simp + have hcx : c • x ≠ 0 := smul_ne_zero hc.ne' hx + rw [radialExtension_of_ne f hcx, radialExtension_of_ne f hx] + have hnormcx : ‖c • x‖ = c * ‖x‖ := by + rw [norm_smul, Real.norm_of_nonneg hc.le] + rw [unitNormalize_smul_of_pos c hc x hx, hnormcx, smul_smul] + +/-- Radial extension sends a continuous function on the unit sphere of `(ℝⁿ,‖·‖_∞)` to a +continuous positively homogeneous function on `ℝⁿ`. -/ +noncomputable def extend : C(ellInfinityUnitSphere n, ℝ) → posHomFunctions n := by + intro f + refine ⟨⟨radialExtension f, ?_⟩, radialExtension_smul_of_nonneg f⟩ + rw [continuous_iff_continuousAt] + intro x + by_cases hx : x = 0 + · subst x + rw [Metric.continuousAt_iff] + intro ε hε + refine ⟨ε / (‖f‖ + 1), div_pos hε (by positivity), ?_⟩ + intro y hy + rw [dist_zero_right] at hy + rw [radialExtension_zero, dist_zero_right] + by_cases hy0 : y = 0 + · simpa [hy0] using hε + · calc + ‖radialExtension f y‖ = ‖(‖y‖ : ℝ)‖ * ‖f (unitNormalize y hy0)‖ := by + rw [radialExtension_of_ne f hy0, norm_smul] + _ = ‖y‖ * ‖f (unitNormalize y hy0)‖ := by + simp only [Real.norm_eq_abs, abs_of_nonneg (norm_nonneg y)] + _ + ≤ ‖y‖ * ‖f‖ := mul_le_mul_of_nonneg_left + (ContinuousMap.norm_coe_le_norm _ _) (norm_nonneg y) + _ ≤ (ε / (‖f‖ + 1)) * ‖f‖ := + mul_le_mul_of_nonneg_right (le_of_lt hy) (norm_nonneg f) + _ < ε := by + have hf : 0 ≤ ‖f‖ := norm_nonneg f + calc + ε / (‖f‖ + 1) * ‖f‖ < ε / (‖f‖ + 1) * (‖f‖ + 1) := by + exact mul_lt_mul_of_pos_left (by linarith) + (div_pos hε (by positivity)) + _ = ε := by field_simp + · have hcontinuous : ContinuousOn (radialExtension f) ({0}ᶜ : Set (Fin n → ℝ)) := by + rw [continuousOn_iff_continuous_domRestrict] + change Continuous (fun y : {y : Fin n → ℝ // y ≠ 0} => radialExtension f y) + apply Continuous.congr + ((continuous_norm.comp continuous_subtype_val).smul + (f.continuous.comp (continuous_normalize (n := n)))) + intro y + exact (radialExtension_of_ne f y.2).symm + exact hcontinuous.continuousAt (isOpen_compl_singleton.mem_nhds hx) + +/-- Restricting the radial extension of a continuous function on the unit sphere +recovers the original function on the unit sphere of `(ℝⁿ,‖·‖_∞)`. -/ +@[simp] +theorem restrict_extend (f : C(ellInfinityUnitSphere n, ℝ)) : + restrict (extend f) = f := by + ext y + exact radialExtension_sphere f y + +/-- Radially extending a restriction recovers the original positively +homogeneous function. -/ +@[simp] +theorem extend_restrict (f : posHomFunctions n) : + extend (restrict f) = f := by + apply restrict_injective + rw [restrict_extend] + +/-- The vector lattice of continuous positively homogeneous functions on `ℝⁿ` is +isomorphic to the vector lattice of continuous real-valued functions on the +unit sphere of `(ℝⁿ,‖·‖_∞)`. The isomorphism is given by restriction (`restrict`) +and radial extension (`extend`). -/ +noncomputable def ellInfinityUnitSphereEquiv : + VecLatEquiv (posHomFunctions n) C(ellInfinityUnitSphere n, ℝ) := by + exact + { toFun := restrict + invFun := extend + left_inv := extend_restrict + right_inv := restrict_extend + map_add' := (restrict (n := n)).map_add + map_smul' := (restrict (n := n)).map_smul + map_sup' := (restrict (n := n)).map_sup' + map_inf' := (restrict (n := n)).map_inf' } + +/-! +### `posHomFunctions n` as a Banach lattice +-/ + +/-- If `f : posHomFunctions n`, `‖f‖ := ‖restrict f‖_∞`. -/ +noncomputable instance instNorm : Norm (posHomFunctions n) where + norm f := ‖restrict f‖ + +@[simp] +theorem norm_restrict (f : posHomFunctions n) : + ‖restrict f‖ = ‖f‖ := by + rfl + +/-- `posHomFunctions n` becomes a normed additive commutative group. -/ +noncomputable instance instNormedAddCommGroup : + NormedAddCommGroup (posHomFunctions n) := by + exact NormedAddCommGroup.induced (posHomFunctions n) C(ellInfinityUnitSphere n, ℝ) + (restrict (n := n)).toLinearMap.toAddHom restrict_injective + +/-- `posHomFunctions n` becomes a normed vector lattice. -/ +noncomputable instance instNormedVectorLattice : + @NormedVectorLattice (posHomFunctions n) (instNormedAddCommGroup (n := n)) + (posHomFunctions n).instLatticeCoe + (posHomFunctions n).instIsOrderedAddMonoidCoe := by + refine + { solid := ?_ + norm_smul := ?_ } + · intro f g hfg + change ‖restrict f‖ ≤ ‖restrict g‖ + apply HasSolidNorm.solid + simpa only [VecLatHom.map_abs] using (restrict (n := n)).monotone hfg + · intro a f + change ‖restrict (a • f)‖ = ‖a‖ * ‖restrict f‖ + rw [map_smul, norm_smul] + +/-- Restriction is an isometry equivalence between +`posHomFunctions n` and `C(ellInfinityUnitSphere n, ℝ)`. -/ +noncomputable def ellInfinityUnitSphereIsometry : + posHomFunctions n ≃ᵢ C(ellInfinityUnitSphere n, ℝ) := by + exact + { (ellInfinityUnitSphereEquiv (n := n)).toLinearEquiv.toEquiv with + isometry_toFun := Isometry.of_dist_eq fun f g => by + rw [dist_eq_norm, dist_eq_norm] + change ‖restrict f - restrict g‖ = ‖f - g‖ + rw [← map_sub] + rfl } + +/-- `posHomFunctions n` is a Banach lattice. -/ +noncomputable instance instBanachLattice : + @BanachLattice (posHomFunctions n) (instNormedAddCommGroup (n := n)) + (posHomFunctions n).instLatticeCoe + (posHomFunctions n).instIsOrderedAddMonoidCoe := by + let e := ellInfinityUnitSphereIsometry (n := n) + exact { toCompleteSpace := e.completeSpace } + +/-- `restriction` is a Banach-lattice isometric equivalence between +`posHomFunctions n` and `C(ellInfinityUnitSphere n, ℝ)`. -/ +noncomputable def ellInfinityUnitSphereBanachLatEquiv : + BanachLatEquiv (posHomFunctions n) C(ellInfinityUnitSphere n, ℝ) := by + exact + { toLinearIsometryEquiv := + { (ellInfinityUnitSphereEquiv (n := n)).toLinearEquiv with + norm_map' := norm_restrict } + map_sup' := (restrict (n := n)).map_sup' + map_inf' := (restrict (n := n)).map_inf' } + +/-- Restrictions of lattice-linear functions interpolate arbitrary prescribed +values at any two points of the unit sphere. -/ +theorem latticeLinearRestriction_twoPointInterpolation {n : ℕ} + (v : ellInfinityUnitSphere n → ℝ) (y z : ellInfinityUnitSphere n) : + ∃ f : latticeLinearFunctions n, + restrict (latticeLinearInclusion f) y = v y ∧ + restrict (latticeLinearInclusion f) z = v z := by + classical + have hy_coord := isGreatest_coord_abs y + have hz_coord := isGreatest_coord_abs z + obtain ⟨iy, hiy⟩ := hy_coord.1 + obtain ⟨iz, hiz⟩ := hz_coord.1 + let u : latticeLinearFunctions n := + |LatticeLinearFunction.coordinate iy| ⊔ + |LatticeLinearFunction.coordinate iz| + have huy : u (y : Fin n → ℝ) = 1 := by + change max |(y : Fin n → ℝ) iy| |(y : Fin n → ℝ) iz| = 1 + have hiy' : |(y : Fin n → ℝ) iy| = 1 := hiy + rw [hiy', max_eq_left (hy_coord.2 ⟨iz, rfl⟩)] + have huz : u (z : Fin n → ℝ) = 1 := by + change max |(z : Fin n → ℝ) iy| |(z : Fin n → ℝ) iz| = 1 + have hiz' : |(z : Fin n → ℝ) iz| = 1 := hiz + rw [hiz', max_eq_right (hz_coord.2 ⟨iy, rfl⟩)] + by_cases hyz : y = z + · subst z + refine ⟨(v y) • u, ?_, ?_⟩ + · simp [restrict_apply, latticeLinearInclusion_apply, huy] + · simp [restrict_apply, latticeLinearInclusion_apply, huy] + · have hyz_val : (y : Fin n → ℝ) ≠ (z : Fin n → ℝ) := by + intro h + exact hyz (Subtype.ext h) + obtain ⟨k, hk⟩ : ∃ k, (y : Fin n → ℝ) k ≠ (z : Fin n → ℝ) k := by + simpa only [Function.ne_iff] using hyz_val + let q := LatticeLinearFunction.coordinate k + let c := (v z - v y) / (q z - q y) + let g : latticeLinearFunctions n := c • (q - (q y) • u) + (v y) • u + refine ⟨g, ?_, ?_⟩ + · simp only [restrict_apply, latticeLinearInclusion_apply] + change c * (q y - q y * u y) + v y * u y = v y + rw [huy] + ring + · simp only [restrict_apply, latticeLinearInclusion_apply] + change c * (q z - q y * u z) + v y * u z = v z + rw [huz] + have hden : q z - q y ≠ 0 := sub_ne_zero.mpr hk.symm + dsimp [c] + field_simp + ring + +/-- Restrictions of lattice-linear functions to the unit sphere of +`(ℝⁿ, ‖·‖_∞)` are dense in `C(ellInfinityUnitSphere n, ℝ)`. -/ +theorem denseRange_restrict_latticeLinearInclusion : + DenseRange (fun f : latticeLinearFunctions n => restrict (latticeLinearInclusion f)) := by + classical + let A : latticeLinearFunctions n → C(ellInfinityUnitSphere n, ℝ) := fun f => + restrict (latticeLinearInclusion f) + let L : Set C(ellInfinityUnitSphere n, ℝ) := Set.range A + have hL_nonempty : L.Nonempty := ⟨A 0, 0, rfl⟩ + have hL_inf : ∀ f ∈ L, ∀ g ∈ L, f ⊓ g ∈ L := by + rintro _ ⟨f, rfl⟩ _ ⟨g, rfl⟩ + exact ⟨f ⊓ g, by simp [A]⟩ + have hL_sup : ∀ f ∈ L, ∀ g ∈ L, f ⊔ g ∈ L := by + rintro _ ⟨f, rfl⟩ _ ⟨g, rfl⟩ + exact ⟨f ⊔ g, by simp [A]⟩ + have hL_sep : L.SeparatesPointsStrongly := by + intro v y z + obtain ⟨f, hy, hz⟩ := latticeLinearRestriction_twoPointInterpolation v y z + refine ⟨A f, ⟨f, rfl⟩, ?_, ?_⟩ + · simpa [A] using hy + · simpa [A] using hz + rw [show (fun f : latticeLinearFunctions n => restrict (latticeLinearInclusion f)) = A from rfl, + denseRange_iff_closure_range] + exact ContinuousMap.sublattice_closure_eq_top L hL_nonempty hL_inf hL_sup hL_sep + +end PosHomFunction + +/-! ### Positively homogeneous functional calculus -/ + +namespace PosHomFunction + +variable {n : ℕ} {X : Type u} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] + [IsUniformlyCompleteVectorLattice X] + +/-- The zero vector-lattice homomorphism from `posHomFunctions n` to `X`. -/ +noncomputable def zeroVecLatHom : + VecLatHom (posHomFunctions n) X := by + exact + { toFun := fun _ => 0 + map_add' := by simp + map_smul' := by simp + map_sup' := by simp + map_inf' := by simp } + +omit [IsUniformlyCompleteVectorLattice X] in +@[simp] +theorem zeroVecLatHom_apply (f : posHomFunctions n) : + zeroVecLatHom f = (0 : X) := by + rfl + +omit [VectorLattice X] [IsUniformlyCompleteVectorLattice X] in +lemma coordinate_eq_zero_of_sum_abs_eq_zero + (x : Fin n → X) (h : ∑ i, |x i| = 0) (i : Fin n) : + x i = 0 := by + apply (abs_eq_zero_iff_zero (x i)).mp + exact le_antisymm (by + rw [← h] + exact Finset.single_le_sum (fun j _ => abs_nonneg (x j)) (Finset.mem_univ i)) + (abs_nonneg (x i)) + +/-- The positive-sum branch of the positively homogeneous functional calculus, +bundled with its values on the coordinate functions. -/ +noncomputable def functionalCalculusOfPosData + (x : Fin n → X) (h : 0 < ∑ i, |x i|) : + { T : VecLatHom (posHomFunctions n) X // ∀ i, T (coordinate i) = x i } := by + classical + let e : X := ∑ i, |x i| + have he_pos : 0 < e := by simpa [e] using h + have he_nonneg : 0 ≤ e := he_pos.le + letI := OrderIdeal.principalNormedAddCommGroup e + letI : Lattice ↥(OrderIdeal.principal e) := OrderIdeal.instLatticePrincipal e + letI : IsOrderedAddMonoid ↥(OrderIdeal.principal e) := + OrderIdeal.instIsOrderedAddMonoidPrincipal e + letI : AMSpaceWithUnit ↥(OrderIdeal.principal e) := + OrderIdeal.principalAMSpaceWithUnit he_pos.le + (IsUniformlyCompleteVectorLattice.complete_principal e he_pos) + let x' : Fin n → ↥(OrderIdeal.principal e) := fun i => ⟨x i, by + refine ⟨1, zero_le_one, ?_⟩ + rw [one_smul, abs_of_nonneg he_nonneg] + exact Finset.single_le_sum (fun j _ => abs_nonneg (x j)) (Finset.mem_univ i)⟩ + let pullback : VecLatHom (posHomFunctions n) + C(AMSpaceWithUnit.LatticeCharacter ↥(OrderIdeal.principal e), ℝ) := + { toFun := fun f => + ⟨fun φ => f (fun i => φ (x' i)), + f.1.continuous.comp (continuous_pi fun i => + AMSpaceWithUnit.LatticeCharacter.continuous_eval _ (x' i))⟩ + map_add' := fun _ _ => rfl + map_smul' := fun _ _ => rfl + map_sup' := fun _ _ => rfl + map_inf' := fun _ _ => rfl } + let K := OrderIdeal.principalKakutaniEquiv he_pos + let T := (OrderIdeal.principal e).subtype.comp + (K.symm.toVecLatEquiv.toVecLatHom.comp pullback) + refine ⟨T, ?_⟩ + intro i + change ((K.symm (pullback (coordinate i)) : ↥(OrderIdeal.principal e)) : X) = x i + change ((K.symm (pullback (coordinate i)) : ↥(OrderIdeal.principal e)) : X) = + (x' i : X) + apply congrArg Subtype.val + apply K.toLinearIsometryEquiv.injective + change K.toLinearIsometryEquiv + (K.toLinearIsometryEquiv.symm (pullback (coordinate i))) = + K.toLinearIsometryEquiv (x' i) + rw [K.toLinearIsometryEquiv.apply_symm_apply] + ext φ + rfl + +/-- The vector lattice homomorphism defining positively homogeneous functional calculus, +bundled with its values on the coordinate functions. -/ +noncomputable def functionalCalculusData + (x : Fin n → X) : + { T : VecLatHom (posHomFunctions n) X // ∀ i, T (coordinate i) = x i } := by + classical + by_cases h : ∑ i, |x i| = 0 + · refine ⟨zeroVecLatHom, ?_⟩ + intro i + rw [zeroVecLatHom_apply, coordinate_eq_zero_of_sum_abs_eq_zero x h i] + · exact functionalCalculusOfPosData x + (lt_of_le_of_ne (Finset.sum_nonneg fun i _ => abs_nonneg (x i)) (Ne.symm h)) + +/-- The **positively homogeneous functional calculus** associated to +a tuple `x₁,...,xₙ ∈ X`. -/ +noncomputable def functionalCalculus (x : Fin n → X) : + VecLatHom (posHomFunctions n) X := + (functionalCalculusData x).1 + +/-- The positively homogeneous functional calculus sends the `i`-th coordinate +function to `x i`. -/ +@[simp] +theorem functionalCalculus_coordinate (x : Fin n → X) (i : Fin n) : + functionalCalculus x (coordinate i) = x i := by + change (functionalCalculusData x).1 (coordinate i) = x i + exact (functionalCalculusData x).2 i + +/-- On lattice-linear functions, the positively homogeneous functional +calculus agrees with the lattice-linear functional calculus. -/ +@[simp] +theorem functionalCalculus_latticeLinear (x : Fin n → X) + (f : latticeLinearFunctions n) : + functionalCalculus x (latticeLinearInclusion f) = + LatticeLinearFunction.functionalCalculus x f := by + let T := (functionalCalculus x).comp latticeLinearInclusion + have hT : ∀ i, T (LatticeLinearFunction.coordinate i) = x i := by + intro i + exact functionalCalculus_coordinate x i + have heq := LatticeLinearFunction.eq_functionalCalculus_of_map_coordinate x T hT + simpa [T, VecLatHom.comp_apply] using DFunLike.congr_fun heq f + +/-- A positively homogeneous function is bounded by its norm on the unit sphere. -/ +theorem abs_apply_le_norm (f : posHomFunctions n) (x : ellInfinityUnitSphere n) : + |f x| ≤ ‖f‖ := by + simpa [Real.norm_eq_abs] using ContinuousMap.norm_coe_le_norm (restrict f) x + +/-- The pointwise absolute value of a positively homogeneous function is bounded +by its norm multiplied by the radial extension of the constant function `1` on +the unit sphere. -/ +theorem abs_le_norm_smul_unit (f : posHomFunctions n) : + |f| ≤ ‖f‖ • extend 1 := by + intro r + by_cases hr : r = 0 + · subst r + simp + · have hscale : ‖r‖ • (unitNormalize r hr : Fin n → ℝ) = r := by + simpa only [unitNormalize] using + norm_smul_normalize (⟨r, hr⟩ : {x : Fin n → ℝ // x ≠ 0}) + have hf := map_smul_of_nonneg f ‖r‖ (norm_nonneg r) (unitNormalize r hr) + rw [hscale] at hf + have hu : radialExtension (1 : C(ellInfinityUnitSphere n, ℝ)) r = ‖r‖ := by + rw [radialExtension_of_ne 1 hr] + simp + change |f r| ≤ ‖f‖ * radialExtension 1 r + rw [hf, hu, abs_smul, abs_of_nonneg (norm_nonneg r)] + simp only [smul_eq_mul] + rw [mul_comm] + exact mul_le_mul_of_nonneg_right (abs_apply_le_norm f (unitNormalize r hr)) + (norm_nonneg r) + +omit [IsUniformlyCompleteVectorLattice X] in +/-- For every vector lattice homomorphism `V` from `posHomFunctions n` into `X`, +the absolute value of `V f` is bounded by `‖f‖` times the image under `V` of +the radial extension of the constant function `1` on the unit sphere. -/ +theorem abs_map_le_norm_smul_unit + (V : VecLatHom (posHomFunctions n) X) (f : posHomFunctions n) : + |V f| ≤ ‖f‖ • V (extend 1) := by + calc + |V f| = V |f| := (V.map_abs f).symm + _ ≤ V (‖f‖ • extend 1) := V.monotone (abs_le_norm_smul_unit f) + _ = ‖f‖ • V (extend 1) := V.map_smul _ _ + +/-- The positively homogeneous functional calculus associated to `x₁,...,xₙ` is the +**unique** vector-lattice homomorphism from `posHomFunctions n` to `X` whose restriction +to `latticeLinearFunctions n` is `LatticeLinearFunction.functionalCalculus x`. -/ +theorem eq_functionalCalculus_of_eq_latticeLinear (x : Fin n → X) + (V : VecLatHom (posHomFunctions n) X) + (hV : ∀ f : latticeLinearFunctions n, + V (latticeLinearInclusion f) = LatticeLinearFunction.functionalCalculus x f) : + V = functionalCalculus x := by + apply DFunLike.ext V (functionalCalculus x) + intro f + let W := functionalCalculus x + let u : posHomFunctions n := extend 1 + let e : X := |V u| + |W u| + have he : 0 ≤ e := add_nonneg (abs_nonneg _) (abs_nonneg _) + have hzero : |V f - W f| = 0 := + IsVLArchimedean.eq_zero_of_nonneg_of_forall_nsmul_le (abs_nonneg _) fun k => by + rcases k with _ | k + · simpa using he + · have hk : (0 : ℝ) < ((k + 1 : ℕ) : ℝ)⁻¹ := by positivity + obtain ⟨g, hg⟩ := + (Metric.denseRange_iff.mp denseRange_restrict_latticeLinearInclusion) + (restrict f) _ hk + let d : posHomFunctions n := f - latticeLinearInclusion g + have hdnorm : ‖d‖ < ((k + 1 : ℕ) : ℝ)⁻¹ := by + simpa [d, dist_eq_norm, ← map_sub] using hg + have hagree : V (latticeLinearInclusion g) = + W (latticeLinearInclusion g) := by + rw [hV, show W (latticeLinearInclusion g) = + LatticeLinearFunction.functionalCalculus x g by + exact functionalCalculus_latticeLinear x g] + have hdiff : V f - W f = V d - W d := by + simp only [d, map_sub] + rw [hagree] + abel + have hVd : |V d| ≤ ‖d‖ • |V u| := + (abs_map_le_norm_smul_unit V d).trans + (smul_le_smul_of_nonneg_left (le_abs_self _) (norm_nonneg d)) + have hWd : |W d| ≤ ‖d‖ • |W u| := + (abs_map_le_norm_smul_unit W d).trans + (smul_le_smul_of_nonneg_left (le_abs_self _) (norm_nonneg d)) + have hde : |V f - W f| ≤ ((k + 1 : ℕ) : ℝ)⁻¹ • e := by + rw [hdiff] + calc + |V d - W d| = |V d + -(W d)| := by rw [sub_eq_add_neg] + _ ≤ |V d| + |-(W d)| := abs_add_le _ _ + _ = |V d| + |W d| := by rw [abs_neg] + _ ≤ ‖d‖ • |V u| + ‖d‖ • |W u| := add_le_add hVd hWd + _ = ‖d‖ • e := by rw [smul_add] + _ ≤ ((k + 1 : ℕ) : ℝ)⁻¹ • e := + smul_le_smul_of_nonneg_right hdnorm.le he + calc + (k + 1) • |V f - W f| ≤ + (k + 1) • (((k + 1 : ℕ) : ℝ)⁻¹ • e) := + nsmul_le_nsmul_right hde (k + 1) + _ = e := by + rw [← Nat.cast_smul_eq_nsmul ℝ, smul_smul, + mul_inv_cancel₀ (Nat.cast_ne_zero.mpr (Nat.succ_ne_zero k)), one_smul] + change V f = W f + apply sub_eq_zero.mp + apply le_antisymm + · rw [← hzero] + exact le_abs_self _ + · have hneg := neg_le_abs (V f - W f) + rw [hzero] at hneg + exact neg_nonpos.mp hneg + +/-- The **positively homogeneous functional calculus** associated to `x₁,...,xₙ` is the +**unique** vector-lattice homomorphism from `posHomFunctions n` to `X` such that +`coordinate i ↦ x i`. -/ +theorem eq_functionalCalculus_of_map_coordinate (x : Fin n → X) + (V : VecLatHom (posHomFunctions n) X) + (hV : ∀ i, V (coordinate i) = x i) : + V = functionalCalculus x := by + have hV' : ∀ f : latticeLinearFunctions n, + V (latticeLinearInclusion f) = LatticeLinearFunction.functionalCalculus x f := by + let T := V.comp latticeLinearInclusion + have hT : ∀ i, T (LatticeLinearFunction.coordinate i) = x i := by + intro i + exact hV i + have heq := LatticeLinearFunction.eq_functionalCalculus_of_map_coordinate x T hT + intro f + simpa [T, VecLatHom.comp_apply] using DFunLike.congr_fun heq f + exact eq_functionalCalculus_of_eq_latticeLinear x V hV' + +/-- The positively homogeneous functional calculus associated to +the zero tuple is zero. -/ +@[simp] +theorem functionalCalculus_zero (f : posHomFunctions n) : + functionalCalculus (fun _ : Fin n => (0 : X)) f = 0 := by + have hzero : ∀ i, + zeroVecLatHom (PosHomFunction.coordinate i) = (fun _ : Fin n => (0 : X)) i := by + intro i + rw [zeroVecLatHom_apply] + have heq := eq_functionalCalculus_of_map_coordinate + (fun _ : Fin n => (0 : X)) zeroVecLatHom hzero + rw [← heq] + exact zeroVecLatHom_apply f + +end PosHomFunction + +/-! ### Functoriality of positively homogeneous functional calculus -/ + +namespace PosHomFunction + +variable {n : ℕ} {X : Type u} {Y : Type v} + [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [VectorLattice X] + [IsUniformlyCompleteVectorLattice X] + [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + [IsUniformlyCompleteVectorLattice Y] + +/-- Positively homogeneous functional calculus is preserved by lattice homomorphisms: +`T (functionalCalculus x f) = functionalCalculus (Tx) f`. -/ +theorem functionalCalculus_map + (T : VecLatHom X Y) (x : Fin n → X) (f : posHomFunctions n) : + T (functionalCalculus x f) = + functionalCalculus (fun i => T (x i)) f := by + have hcomp : ∀ i, + (T.comp (functionalCalculus x)) (coordinate i) = T (x i) := by + intro i + rw [VecLatHom.comp_apply, functionalCalculus_coordinate] + have heq := eq_functionalCalculus_of_map_coordinate + (X := Y) (fun i => T (x i)) (T.comp (functionalCalculus x)) hcomp + simpa [VecLatHom.comp_apply] using DFunLike.congr_fun heq f + +end PosHomFunction + +/-! ### Composition and substitution in positively homogeneous functional calculus -/ + +namespace PosHomFunction + +variable {m n : ℕ} + +/-- Composition of a positively homogeneous function with a tuple of positively +homogeneous functions. -/ +def comp (f : posHomFunctions m) (g : Fin m → posHomFunctions n) : + posHomFunctions n := by + refine ⟨⟨fun x ↦ f (fun i ↦ g i x), ?_⟩, ?_⟩ + · exact f.1.continuous.comp (continuous_pi fun i ↦ (g i).1.continuous) + · intro c hc x + change f (fun i ↦ g i (c • x)) = c • f (fun i ↦ g i x) + have hg : (fun i ↦ g i (c • x)) = c • (fun i ↦ g i x) := by + funext i + change g i (c • x) = c • g i x + exact map_smul_of_nonneg (g i) c hc x + rw [hg, map_smul_of_nonneg f c hc] + +/-- Pointwise evaluation of a composition of positively homogeneous functions. -/ +@[simp] +theorem comp_apply (f : posHomFunctions m) (g : Fin m → posHomFunctions n) + (x : Fin n → ℝ) : + PosHomFunction.comp f g x = f (fun i ↦ g i x) := by + rfl + +variable {X : Type u} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] + [IsUniformlyCompleteVectorLattice X] + +/-- Substitution of positively homogeneous functions commutes with their +functional calculus. -/ +@[simp] +theorem functionalCalculus_comp (x : Fin n → X) + (g : Fin m → posHomFunctions n) (f : posHomFunctions m) : + functionalCalculus (fun i ↦ functionalCalculus x (g i)) f = + functionalCalculus x (PosHomFunction.comp f g) := by + let := isUniformlyCompleteVectorLattice_of_banachLattice (posHomFunctions n) + let V : VecLatHom (posHomFunctions m) (posHomFunctions n) := + { toFun := fun h ↦ PosHomFunction.comp h g + map_add' := fun _ _ ↦ rfl + map_smul' := fun _ _ ↦ rfl + map_sup' := fun _ _ ↦ rfl + map_inf' := fun _ _ ↦ rfl } + have hV : ∀ i, V (coordinate i) = g i := by + intro i + ext r + change PosHomFunction.comp (coordinate i) g r = g i r + rw [comp_apply, coordinate_apply] + have hcalc : functionalCalculus g = V := + (eq_functionalCalculus_of_map_coordinate g V hV).symm + rw [← functionalCalculus_map (functionalCalculus x) g f, hcalc] + rfl + +end PosHomFunction diff --git a/LeanPool/FBLOrderContinuity/BanLat/NormedWeak.lean b/LeanPool/FBLOrderContinuity/BanLat/NormedWeak.lean new file mode 100644 index 0000000000..86b89a5ee5 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/NormedWeak.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +public import LeanPool.OrderClosures.BanLat.Normed +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.LocallyConvex.WeakSpace +public import Mathlib.Data.Fintype.Order + +/-! +# Monotone weak convergence in normed vector lattices + +Monotone nets that converge weakly converge in norm. +-/ + +@[expose] public section + +namespace NormedVectorLattice + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [NormedVectorLattice X] + +private theorem mem_closure_convexHull_tail_of_weak_tendsto + {ι : Type*} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {u : ι → X} {x : X} + (hweak : Filter.Tendsto (fun i => (toWeakSpace ℝ X) (u i)) Filter.atTop + (nhds ((toWeakSpace ℝ X) x))) (i : ι) : + x ∈ closure (convexHull ℝ (u '' Set.Ici i)) := by + have hx : (toWeakSpace ℝ X) x ∈ + closure (toWeakSpace ℝ X '' convexHull ℝ (u '' Set.Ici i)) := by + apply mem_closure_of_tendsto hweak + filter_upwards [Filter.Ici_mem_atTop i] with j hj + exact ⟨u j, subset_convexHull ℝ _ ⟨j, hj, rfl⟩, rfl⟩ + rw [← (convex_convexHull ℝ (u '' Set.Ici i)).toWeakSpace_closure ℝ] at hx + obtain ⟨y, hy, hyx⟩ := hx + simpa only [(toWeakSpace ℝ X).injective hyx] using hy + +private theorem tendsto_of_monotone_weak_tendsto_aux + {ι : Type*} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {u : ι → X} {x : X} (hmono : Monotone u) + (hweak : Filter.Tendsto (fun i => (toWeakSpace ℝ X) (u i)) Filter.atTop + (nhds ((toWeakSpace ℝ X) x))) : + Filter.Tendsto u Filter.atTop (nhds x) := by + classical + have hle (i : ι) : u i ≤ x := by + apply closure_minimal _ isClosed_Ici + (mem_closure_convexHull_tail_of_weak_tendsto hweak i) + apply convexHull_min _ (convex_Ici (u i)) + rintro _ ⟨j, hij, rfl⟩ + exact hmono hij + rw [Metric.tendsto_nhds] + intro ε hε + let i₀ : ι := Classical.choice inferInstance + obtain ⟨y, hy, hxy⟩ := Metric.mem_closure_iff.mp + (mem_closure_convexHull_tail_of_weak_tendsto hweak i₀) ε hε + obtain ⟨κ, hκ, w, z, hw, hw_one, hz, hwy⟩ := + mem_convexHull_iff_exists_fintype.mp hy + let : Fintype κ := hκ + let r : κ → ι := fun a => (hz a).choose + have hzr (a : κ) : u (r a) = z a := (hz a).choose_spec.2 + obtain ⟨j, hj⟩ := Finite.exists_le r + have hyj : y ≤ u j := by + rw [← hwy] + calc + ∑ a, w a • z a ≤ ∑ a, w a • u j := by + apply Finset.sum_le_sum + intro a _ + apply smul_le_smul_of_nonneg_left _ (hw a) + calc z a = u (r a) := (hzr a).symm + _ ≤ u j := hmono (hj a) + _ = (∑ a, w a) • u j := by rw [Finset.sum_smul] + _ = u j := by rw [hw_one, one_smul] + have hxy_norm : ‖x - y‖ < ε := by simpa only [dist_eq_norm] using hxy + have hnorm_j : ‖x - u j‖ < ε := by + refine (norm_le_norm_of_abs_le_abs ?_).trans_lt hxy_norm + rw [abs_of_nonneg (sub_nonneg.mpr (hle j)), + abs_of_nonneg (sub_nonneg.mpr (hyj.trans (hle j)))] + exact sub_le_sub_left hyj x + filter_upwards [Filter.Ici_mem_atTop j] with k hjk + rw [dist_eq_norm, norm_sub_rev] + refine (norm_le_norm_of_abs_le_abs ?_).trans_lt hnorm_j + rw [abs_of_nonneg (sub_nonneg.mpr (hle k)), + abs_of_nonneg (sub_nonneg.mpr (hle j))] + exact sub_le_sub_left (hmono hjk) x + +/-- **Dini's theorem**: a monotone net in a normed vector lattice that converges weakly +converges in norm. -/ +theorem tendsto_of_monotone_weak_tendsto + {ι : Type*} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {u : ι → X} {x : X} (hmono : Monotone u ∨ Antitone u) + (hweak : Filter.Tendsto (fun i => (toWeakSpace ℝ X) (u i)) Filter.atTop + (nhds ((toWeakSpace ℝ X) x))) : + Filter.Tendsto u Filter.atTop (nhds x) := by + rcases hmono with hmono | hanti + · exact tendsto_of_monotone_weak_tendsto_aux hmono hweak + · have hneg_mono : Monotone fun i => -u i := fun _ _ hij => neg_le_neg (hanti hij) + have hneg_weak : + Filter.Tendsto (fun i => (toWeakSpace ℝ X) (-u i)) Filter.atTop + (nhds ((toWeakSpace ℝ X) (-x))) := by + simpa using hweak.neg + have hneg := tendsto_of_monotone_weak_tendsto_aux hneg_mono hneg_weak + simpa using hneg.neg + + +end NormedVectorLattice diff --git a/LeanPool/FBLOrderContinuity/BanLat/Operators/OrderBounded.lean b/LeanPool/FBLOrderContinuity/BanLat/Operators/OrderBounded.lean new file mode 100644 index 0000000000..b2af03b78f --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Operators/OrderBounded.lean @@ -0,0 +1,247 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Operators.Positive + + + +/-! +# Order bounded operators + +A linear map between vector lattices is **order bounded** if it maps order bounded +sets to order bounded sets. Equivalently, for every positive `x`, there exists a +positive `y` such that `|z| ≤ x` implies `|T z| ≤ y`. Every positive operator is +order bounded, and every order bounded operator from a Banach lattice to a normed +vector lattice is continuous. The bundled type `OrderBoundedHom X Y` carries +the basic algebraic and order instances. +-/ + +@[expose] public section + +variable {X Y : Type*} [AddCommGroup X] [AddCommGroup Y] [Lattice X] [Lattice Y] + [IsOrderedAddMonoid X] [IsOrderedAddMonoid Y] [VectorLattice X] [VectorLattice Y] + +/-- A linear map is *order bounded* if for every positive `x`, the image of the +symmetric order interval `{z | |z| ≤ x}` is order bounded. -/ +def IsOrderBounded (f : X →ₗ[ℝ] Y) : Prop := + ∀ x : X, 0 ≤ x → ∃ y : Y, 0 ≤ y ∧ ∀ z : X, |z| ≤ x → |f z| ≤ y + +namespace Positive + +/-- Every positive operator is order bounded. -/ +theorem isOrderBounded {f : X →ₗ[ℝ] Y} (hf : Positive f) : + IsOrderBounded f := by + intro x hx + refine ⟨f x, hf x hx, fun z hz => ?_⟩ + exact (abs_le_map_abs hf z).trans ((monotone_iff.mpr hf) hz) + +end Positive + +namespace IsOrderBounded + +/-- The sum of order bounded operators is order bounded. -/ +theorem add {f g : X →ₗ[ℝ] Y} (hf : IsOrderBounded f) + (hg : IsOrderBounded g) : + IsOrderBounded (f + g) := by + intro x hx + obtain ⟨yf, hyf, hbf⟩ := hf x hx + obtain ⟨yg, hyg, hbg⟩ := hg x hx + refine ⟨yf + yg, add_nonneg hyf hyg, fun z hz => ?_⟩ + simp only [LinearMap.add_apply] + exact (abs_add_le _ _).trans (add_le_add (hbf z hz) (hbg z hz)) + +/-- The negation of an order bounded operator is order bounded. -/ +theorem neg {f : X →ₗ[ℝ] Y} (hf : IsOrderBounded f) : + IsOrderBounded (-f) := by + intro x hx + obtain ⟨y, hy, hb⟩ := hf x hx + exact ⟨y, hy, fun z hz => by + simp only [LinearMap.neg_apply, abs_neg]; exact hb z hz⟩ + +/-- The difference of order bounded operators is order bounded. -/ +theorem sub {f g : X →ₗ[ℝ] Y} (hf : IsOrderBounded f) + (hg : IsOrderBounded g) : + IsOrderBounded (f - g) := by + rw [sub_eq_add_neg]; exact add hf (neg hg) + +/-- A scalar multiple of an order bounded operator is order +bounded. -/ +theorem smul {f : X →ₗ[ℝ] Y} (hf : IsOrderBounded f) + (r : ℝ) : IsOrderBounded (r • f) := by + intro x hx + obtain ⟨y, hy, hb⟩ := hf x hx + refine ⟨|r| • y, smul_nonneg (abs_nonneg r) hy, fun z hz => ?_⟩ + simp only [LinearMap.smul_apply] + rw [abs_smul' (f z) r] + exact smul_le_smul_of_nonneg_left (hb z hz) (abs_nonneg r) + +variable {X Y : Type*} [NormedAddCommGroup X] [NormedAddCommGroup Y] + [Lattice X] [Lattice Y] [IsOrderedAddMonoid X] [IsOrderedAddMonoid Y] + [BanachLattice X] [NormedVectorLattice Y] + +/-- Every order bounded operator from a Banach lattice to a normed vector lattice +is continuous. -/ +theorem continuous {f : X →ₗ[ℝ] Y} (hf : IsOrderBounded f) : + Continuous f := by + by_contra hcont + have hunb : ∀ C : ℝ, ∃ x : X, C * ‖x‖ < ‖f x‖ := by + by_contra h; push Not at h; obtain ⟨C, hC⟩ := h + exact hcont (continuous_of_linear_of_bound f.map_add f.map_smul hC) + have hseq : ∀ n : ℕ, ∃ x : X, ‖x‖ ≤ (1 / 2 : ℝ) ^ n ∧ (n : ℝ) < ‖f x‖ := by + intro n + obtain ⟨z, hz⟩ := hunb ((n : ℝ) * (2 : ℝ) ^ n) + have hznz : z ≠ 0 := by intro h; simp [h] at hz + refine ⟨((2 : ℝ) ^ n * ‖z‖)⁻¹ • z, ?_, ?_⟩ + · rw [norm_smul, Real.norm_of_nonneg (inv_nonneg.mpr (by positivity))] + rw [inv_mul_le_iff₀ (by positivity : (0 : ℝ) < 2 ^ n * ‖z‖)] + simp [one_div, mul_comm] + · rw [map_smul, norm_smul, Real.norm_of_nonneg (inv_nonneg.mpr (by positivity))] + rw [lt_inv_mul_iff₀ (by positivity : (0 : ℝ) < 2 ^ n * ‖z‖)] + linarith [mul_comm ((n : ℝ) * (2 : ℝ) ^ n) ‖z‖] + choose x hxn hxf using hseq + have habs : Summable (fun n => |x n|) := + .of_norm_bounded (g := fun n => (1 / 2 : ℝ) ^ n) + (summable_geometric_of_lt_one (by norm_num) (by norm_num)) + (fun n => by rw [norm_abs_eq_norm]; exact hxn n) + set y := ∑' n, |x n| + have hy : 0 ≤ y := tsum_nonneg (fun n => abs_nonneg _) + have hle : ∀ n, |x n| ≤ y := + fun n => habs.le_tsum n (fun j _ => abs_nonneg _) + obtain ⟨u, _hu, hbound⟩ := hf y hy + obtain ⟨N, hN⟩ := exists_nat_gt ‖u‖ + have hfN : ‖f (x N)‖ ≤ ‖u‖ := by + have hab : |f (x N)| ≤ u := hbound (x N) (hle N) + exact norm_le_norm_of_abs_le_abs (hab.trans (le_abs_self u)) + exact absurd (lt_of_lt_of_le (hxf N) hfN) (not_lt.mpr hN.le) + +end IsOrderBounded + +/-! ### The space of order bounded operators -/ + +/-- The type of order bounded linear operators from `X` to `Y`. -/ +structure OrderBoundedHom (X : Type*) (Y : Type*) + [AddCommGroup X] [AddCommGroup Y] [Lattice X] + [Lattice Y] [IsOrderedAddMonoid X] + [IsOrderedAddMonoid Y] [VectorLattice X] + [VectorLattice Y] extends X →ₗ[ℝ] Y where + isOrderBounded' : IsOrderBounded toLinearMap + +namespace OrderBoundedHom + +variable {X Y : Type*} [AddCommGroup X] [AddCommGroup Y] + [Lattice X] [Lattice Y] [IsOrderedAddMonoid X] + [IsOrderedAddMonoid Y] [VectorLattice X] + [VectorLattice Y] + +/-- Coercion from `OrderBoundedHom` to functions. -/ +instance instFunLike : + FunLike (OrderBoundedHom X Y) X Y where + coe f := f.toFun + coe_injective := by + intro f g h; cases f; cases g; congr 1 + exact LinearMap.ext (congrFun h) + +@[ext] +theorem ext {f g : OrderBoundedHom X Y} + (h : ∀ x, f x = g x) : f = g := + DFunLike.coe_injective (funext h) + +@[simp] +theorem coe_toLinearMap (f : OrderBoundedHom X Y) : + ⇑f.toLinearMap = ⇑f := rfl + +/-- The underlying linear map of an order-bounded operator has the same values. -/ +@[simp] +theorem toLinearMap_apply (f : OrderBoundedHom X Y) (x : X) : + f.toLinearMap x = f x := rfl + +theorem toLinearMap_injective : + Function.Injective (OrderBoundedHom.toLinearMap : + OrderBoundedHom X Y → X →ₗ[ℝ] Y) := fun _ _ h => + ext fun x => congrFun (congrArg DFunLike.coe h) x + +/-- Bundle a positive linear operator as an `OrderBoundedHom`. -/ +def ofPositive (f : X →ₗ[ℝ] Y) (hf : Positive f) : OrderBoundedHom X Y := + ⟨f, hf.isOrderBounded⟩ + +@[simp] +theorem ofPositive_apply (f : X →ₗ[ℝ] Y) (hf : Positive f) (x : X) : + ofPositive f hf x = f x := rfl + +instance instZero : Zero (OrderBoundedHom X Y) := + ⟨ofPositive 0 fun _ _ => by simp⟩ + +/-- The zero order-bounded operator vanishes at every point. -/ +@[simp] +theorem zero_apply (x : X) : (0 : OrderBoundedHom X Y) x = (0 : Y) := rfl + +instance instAdd : Add (OrderBoundedHom X Y) := + ⟨fun f g => ⟨f.toLinearMap + g.toLinearMap, + IsOrderBounded.add f.isOrderBounded' g.isOrderBounded'⟩⟩ + +instance instNeg : Neg (OrderBoundedHom X Y) := + ⟨fun f => ⟨-f.toLinearMap, + IsOrderBounded.neg f.isOrderBounded'⟩⟩ + +instance instSub : Sub (OrderBoundedHom X Y) := + ⟨fun f g => ⟨f.toLinearMap - g.toLinearMap, + IsOrderBounded.sub f.isOrderBounded' g.isOrderBounded'⟩⟩ + +instance instSMulNat : SMul ℕ (OrderBoundedHom X Y) := + ⟨fun n f => ⟨n • f.toLinearMap, by + rw [← Nat.cast_smul_eq_nsmul ℝ] + exact IsOrderBounded.smul f.isOrderBounded' n⟩⟩ + +instance instSMulInt : SMul ℤ (OrderBoundedHom X Y) := + ⟨fun n f => ⟨n • f.toLinearMap, by + rw [← Int.cast_smul_eq_zsmul ℝ] + exact IsOrderBounded.smul f.isOrderBounded' n⟩⟩ + +noncomputable instance : + AddCommGroup (OrderBoundedHom X Y) := + toLinearMap_injective.addCommGroup _ + rfl (fun _ _ => rfl) (fun _ => rfl) + (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) + +noncomputable instance : + Module ℝ (OrderBoundedHom X Y) where + smul r f := ⟨r • f.toLinearMap, + IsOrderBounded.smul f.isOrderBounded' r⟩ + one_smul f := ext fun x => one_smul ℝ (f x) + mul_smul r s f := ext fun x => mul_smul r s (f x) + smul_zero r := ext fun _ => smul_zero r + smul_add r f g := ext fun x => smul_add r (f x) (g x) + add_smul r s f := ext fun x => add_smul r s (f x) + zero_smul f := ext fun x => zero_smul ℝ (f x) + +noncomputable instance : + PartialOrder (OrderBoundedHom X Y) := + PartialOrder.lift OrderBoundedHom.toLinearMap toLinearMap_injective + +/-- The operator ordering: `f ≤ g` iff for every `x ≥ 0` we have +`f x ≤ g x`. -/ +theorem le_iff {f g : OrderBoundedHom X Y} : + f ≤ g ↔ ∀ x : X, 0 ≤ x → f x ≤ g x := + Positive.le_iff + +instance : + IsOrderedAddMonoid (OrderBoundedHom X Y) where + add_le_add_left _ _ hab c := le_iff.mpr fun x hx => + add_le_add_left (le_iff.mp hab x hx) (c x) + +instance : + PosSMulMono ℝ (OrderBoundedHom X Y) where + smul_le_smul_of_nonneg_left _ hr _ _ hfg := le_iff.mpr fun x hx => + smul_le_smul_of_nonneg_left (le_iff.mp hfg x hx) hr + +end OrderBoundedHom diff --git a/LeanPool/FBLOrderContinuity/BanLat/Operators/OrderContinuous.lean b/LeanPool/FBLOrderContinuity/BanLat/Operators/OrderContinuous.lean new file mode 100644 index 0000000000..8bd5b22b58 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Operators/OrderContinuous.lean @@ -0,0 +1,746 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Convergences.Order +public import LeanPool.OrderClosures.BanLat.OrderContinuous.Basic +public import LeanPool.FBLOrderContinuity.BanLat.Operators.RieszKantorovich +public import Mathlib.Data.List.TFAE + + + +/-! +# Order continuous operators + +This file introduces order continuous linear operators between vector lattices. For order bounded +operators with order complete codomain, it states the characterisation by decreasing zero nets and +by the positive part, negative part, and modulus. +-/ + +@[expose] public section + +universe u v w + +variable {X : Type u} {Y : Type v} [AddCommGroup X] [AddCommGroup Y] + [Lattice X] [Lattice Y] [IsOrderedAddMonoid X] [IsOrderedAddMonoid Y] + [VectorLattice X] [VectorLattice Y] + +/-- A linear operator is **order continuous** if it preserves order convergence of nets. + +The index set is constrained to live in the same universe as the domain, matching the convention +used for order continuous norms. -/ +def IsOrderContinuousOp (T : X →ₗ[ℝ] Y) : Prop := + ∀ {ι : Type u} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {x : ι → X} {a : X}, + OrderConvergesTo x a → OrderConvergesTo (fun i => T (x i)) (T a) + +namespace OrderContinuousOp + +/-- The set of order-continuous order bounded operators. -/ +def OrderContinuousOperator : Set (OrderBoundedHom X Y) := + {T | IsOrderContinuousOp T.toLinearMap} + +@[simp] +theorem mem_OrderContinuousOperator (T : OrderBoundedHom X Y) : + T ∈ OrderContinuousOperator (X := X) (Y := Y) ↔ IsOrderContinuousOp T.toLinearMap := by + rfl + +private lemma obAdd_apply (S T : OrderBoundedHom X Y) (x : X) : + (S + T) x = S x + T x := rfl + +private lemma obNeg_apply (T : OrderBoundedHom X Y) (x : X) : + (-T) x = -T x := rfl + +private lemma obSmul_apply (c : ℝ) (T : OrderBoundedHom X Y) (x : X) : + (c • T) x = c • T x := rfl + +private lemma zero_mem_OrderContinuousOperator : + (0 : OrderBoundedHom X Y) ∈ OrderContinuousOperator (X := X) (Y := Y) := by + rw [mem_OrderContinuousOperator] + intro ι _ _ _ x a hx + refine ⟨PUnit, inferInstance, inferInstance, inferInstance, fun _ => 0, ?_, ?_, ?_, ?_⟩ + · intro _ _ _ + exact le_rfl + · intro _ + exact le_rfl + · simp + · intro _ + filter_upwards with i + change |(0 : Y) - 0| ≤ 0 + simp + +private lemma add_mem_OrderContinuousOperator {S T : OrderBoundedHom X Y} + (hS : S ∈ OrderContinuousOperator (X := X) (Y := Y)) + (hT : T ∈ OrderContinuousOperator (X := X) (Y := Y)) : + S + T ∈ OrderContinuousOperator (X := X) (Y := Y) := by + rw [mem_OrderContinuousOperator] at hS hT ⊢ + intro ι _ _ _ x a hx + simpa only [OrderBoundedHom.toLinearMap_apply, obAdd_apply] using (hS hx).add (hT hx) + +private lemma neg_mem_OrderContinuousOperator {T : OrderBoundedHom X Y} + (hT : T ∈ OrderContinuousOperator (X := X) (Y := Y)) : + -T ∈ OrderContinuousOperator (X := X) (Y := Y) := by + rw [mem_OrderContinuousOperator] at hT ⊢ + intro ι _ _ _ x a hx + simpa only [OrderBoundedHom.toLinearMap_apply, obNeg_apply] using (hT hx).neg + +private lemma smul_mem_OrderContinuousOperator (c : ℝ) {T : OrderBoundedHom X Y} + (hT : T ∈ OrderContinuousOperator (X := X) (Y := Y)) : + c • T ∈ OrderContinuousOperator (X := X) (Y := Y) := by + rw [mem_OrderContinuousOperator] at hT ⊢ + intro ι _ _ _ x a hx + simpa only [OrderBoundedHom.toLinearMap_apply, obSmul_apply] using (hT hx).smul c + +private lemma isGLB_range_abs_of_orderConvergesTo_zero + {Z : Type w} [AddCommGroup Z] [Lattice Z] [IsOrderedAddMonoid Z] + {ι : Type u} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] {x : ι → Z} + (hx : OrderConvergesTo x 0) : + IsGLB (Set.range fun i => |x i|) 0 := by + rcases hx with ⟨κ, hκpre, hκdir, hκnon, r, _hranti, _hrnn, hrglb, hrevent⟩ + let : Preorder κ := hκpre + let : IsDirected κ (· ≤ ·) := hκdir + let : Nonempty κ := hκnon + refine ⟨?_, ?_⟩ + · rintro _ ⟨i, rfl⟩ + exact abs_nonneg _ + · intro w hw + apply hrglb.2 + intro y hy + rcases hy with ⟨k, rfl⟩ + have hevent := hrevent k + rcases hevent.exists with ⟨i, hi⟩ + calc + w ≤ |x i| := hw ⟨i, rfl⟩ + _ = |x i - 0| := by rw [sub_zero] + _ ≤ r k := hi + +private lemma orderConvergesTo_abs_sub_zero + {Z : Type w} [AddCommGroup Z] [Lattice Z] [IsOrderedAddMonoid Z] + {ι : Type u} [Preorder ι] + {x : ι → Z} {a : Z} (hx : OrderConvergesTo x a) : + OrderConvergesTo (fun i => |x i - a|) 0 := by + rcases hx with ⟨κ, hκpre, hκdir, hκnon, r, hranti, hrnn, hrglb, hrevent⟩ + let : Preorder κ := hκpre + let : IsDirected κ (· ≤ ·) := hκdir + let : Nonempty κ := hκnon + refine ⟨κ, inferInstance, inferInstance, inferInstance, r, hranti, hrnn, hrglb, ?_⟩ + intro k + exact (hrevent k).mono fun i hi => by + simpa [sub_zero, abs_abs] using hi + +private lemma orderConvergesTo_of_sub_zero + {Z : Type w} [AddCommGroup Z] [Lattice Z] + {ι : Type u} [Preorder ι] + {x : ι → Z} {a : Z} (hx : OrderConvergesTo (fun i => x i - a) 0) : + OrderConvergesTo x a := by + rcases hx with ⟨κ, hκpre, hκdir, hκnon, r, hranti, hrnn, hrglb, hrevent⟩ + let : Preorder κ := hκpre + let : IsDirected κ (· ≤ ·) := hκdir + let : Nonempty κ := hκnon + refine ⟨κ, inferInstance, inferInstance, inferInstance, r, hranti, hrnn, hrglb, ?_⟩ + intro k + exact (hrevent k).mono fun i hi => by + simpa [sub_zero] using hi + +private lemma orderConvergesTo_zero_of_abs_le + {Z : Type w} [AddCommGroup Z] [Lattice Z] + {ι : Type u} [Preorder ι] {x y : ι → Z} + (hy : OrderConvergesTo y 0) (hle : ∀ i, |x i| ≤ y i) : + OrderConvergesTo x 0 := by + rcases hy with ⟨κ, hκpre, hκdir, hκnon, r, hranti, hrnn, hrglb, hrevent⟩ + let : Preorder κ := hκpre + let : IsDirected κ (· ≤ ·) := hκdir + let : Nonempty κ := hκnon + refine ⟨κ, inferInstance, inferInstance, inferInstance, r, hranti, hrnn, hrglb, ?_⟩ + intro k + exact (hrevent k).mono fun i hi => by + calc + |x i - 0| = |x i| := by rw [sub_zero] + _ ≤ y i := hle i + _ ≤ |y i| := le_abs_self _ + _ = |y i - 0| := by rw [sub_zero] + _ ≤ r k := hi + +variable {X : Type u} {Y : Type v} [AddCommGroup X] [AddCommGroup Y] + [Lattice X] [ConditionallyCompleteLattice Y] [IsOrderedAddMonoid X] + [IsOrderedAddMonoid Y] [VectorLattice X] [VectorLattice Y] + +private lemma abs_apply_le_modulus_apply_abs (T : OrderBoundedHom X Y) (x : X) : + |T x| ≤ (|T| : OrderBoundedHom X Y) |x| := by + exact (OrderBoundedHom.isLUB_abs_apply (f := T) (x := |x|) (abs_nonneg x)).1 + ⟨x, le_rfl, rfl⟩ + +private lemma positive_orderContinuous_of_decreasing_abs_glb_zero {S : OrderBoundedHom X Y} + (hS : (0 : OrderBoundedHom X Y) ≤ S) + (hcrit : ∀ {ι : Type u} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {x : ι → X}, + Antitone x → (∀ i, 0 ≤ x i) → IsGLB (Set.range x) 0 → + IsGLB (Set.range fun i => |S (x i)|) 0) : + IsOrderContinuousOp S.toLinearMap := by + intro ι _ _ _ x a hx + rcases hx with ⟨κ, hκpre, hκdir, hκnon, r, hranti, hrnn, hrglb, hrevent⟩ + let : Preorder κ := hκpre + let : IsDirected κ (· ≤ ·) := hκdir + let : Nonempty κ := hκnon + have hSpos : Positive S.toLinearMap := fun y hy => by + simpa only [OrderBoundedHom.zero_apply, OrderBoundedHom.toLinearMap_apply] using + OrderBoundedHom.le_iff.mp hS y hy + have hSmono : Monotone S.toLinearMap := Positive.monotone_iff.mpr hSpos + have hglb_abs : IsGLB (Set.range fun k => |S (r k)|) 0 := + hcrit hranti hrnn hrglb + have hglb : IsGLB (Set.range fun k => S (r k)) 0 := by + have hrange : Set.range (fun k => |S (r k)|) = Set.range (fun k => S (r k)) := by + ext y + constructor + · rintro ⟨k, rfl⟩ + exact ⟨k, (abs_of_nonneg (hSpos (r k) (hrnn k))).symm⟩ + · rintro ⟨k, rfl⟩ + exact ⟨k, abs_of_nonneg (hSpos (r k) (hrnn k))⟩ + rwa [hrange] at hglb_abs + let rangeIdx : Type v := Set.range fun k => S (r k) + let lambdaIdx : Type v := OrderDual rangeIdx + let : IsDirected lambdaIdx (· ≤ ·) := ⟨fun a b => by + rcases (OrderDual.ofDual a : rangeIdx).2 with ⟨ka, hka⟩ + rcases (OrderDual.ofDual b : rangeIdx).2 with ⟨kb, hkb⟩ + obtain ⟨m, hkam, hkbm⟩ := directed_of (· ≤ ·) ka kb + refine ⟨OrderDual.toDual (⟨S (r m), ⟨m, rfl⟩⟩ : rangeIdx), ?_, ?_⟩ + · change (⟨S (r m), ⟨m, rfl⟩⟩ : rangeIdx) ≤ OrderDual.ofDual a + change S (r m) ≤ ((OrderDual.ofDual a : rangeIdx) : Y) + rw [← hka] + exact hSmono (hranti hkam) + · change (⟨S (r m), ⟨m, rfl⟩⟩ : rangeIdx) ≤ OrderDual.ofDual b + change S (r m) ≤ ((OrderDual.ofDual b : rangeIdx) : Y) + rw [← hkb] + exact hSmono (hranti hkbm)⟩ + let : Nonempty lambdaIdx := by + obtain ⟨k⟩ := hκnon + exact ⟨OrderDual.toDual (⟨S (r k), ⟨k, rfl⟩⟩ : rangeIdx)⟩ + have hglb_lift : + IsGLB (Set.range fun k : lambdaIdx => ((OrderDual.ofDual k : rangeIdx) : Y)) 0 := by + have hrange : + Set.range (fun k : lambdaIdx => ((OrderDual.ofDual k : rangeIdx) : Y)) = + Set.range fun k => S (r k) := by + ext y + constructor + · rintro ⟨k, rfl⟩ + exact (OrderDual.ofDual k : rangeIdx).2 + · rintro ⟨k, rfl⟩ + exact ⟨OrderDual.toDual (⟨S (r k), ⟨k, rfl⟩⟩ : rangeIdx), rfl⟩ + rwa [hrange] + refine ⟨lambdaIdx, inferInstance, inferInstance, inferInstance, + fun k => ((OrderDual.ofDual k : rangeIdx) : Y), ?_, ?_, hglb_lift, ?_⟩ + · intro k l hkl + exact hkl + · intro k + rcases (OrderDual.ofDual k : rangeIdx).2 with ⟨m, hm⟩ + change 0 ≤ ((OrderDual.ofDual k : rangeIdx) : Y) + rw [← hm] + exact hSpos (r m) (hrnn m) + · intro k + rcases (OrderDual.ofDual k : rangeIdx).2 with ⟨m, hmk⟩ + exact (hrevent m).mono fun i hi => by + calc + |S.toLinearMap (x i) - S.toLinearMap a| = |S.toLinearMap (x i - a)| := by + rw [map_sub] + _ ≤ S.toLinearMap |x i - a| := Positive.abs_le_map_abs hSpos (x i - a) + _ ≤ S.toLinearMap (r m) := hSmono hi + _ = ((OrderDual.ofDual k : rangeIdx) : Y) := hmk + +private lemma posPart_decreasing_abs_glb_zero (T : OrderBoundedHom X Y) + (hcrit : ∀ {ι : Type u} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {x : ι → X}, + Antitone x → (∀ i, 0 ≤ x i) → IsGLB (Set.range x) 0 → + IsGLB (Set.range fun i => |T (x i)|) 0) + {ι : Type u} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {x : ι → X} (hanti : Antitone x) (hnn : ∀ i, 0 ≤ x i) + (hglb : IsGLB (Set.range x) 0) : + IsGLB (Set.range fun i => |T⁺ (x i)|) 0 := by + have hTpos_pos : Positive T⁺.toLinearMap := fun y hy => by + simpa only [OrderBoundedHom.zero_apply, OrderBoundedHom.toLinearMap_apply] using + OrderBoundedHom.le_iff.mp (posPart_nonneg T) y hy + have hTpos_mono : Monotone T⁺.toLinearMap := Positive.monotone_iff.mpr hTpos_pos + have hglb_pos : IsGLB (Set.range fun i => T⁺ (x i)) 0 := by + refine ⟨?_, ?_⟩ + · rintro _ ⟨i, rfl⟩ + exact hTpos_pos (x i) (hnn i) + · intro z hz + obtain ⟨i0⟩ := (inferInstance : Nonempty ι) + let x0 := x i0 + have hx0 : 0 ≤ x0 := hnn i0 + have hz_le_sub : ∀ u : X, 0 ≤ u → u ≤ x0 → z ≤ T⁺ x0 - T u := by + intro u hu0 hux + let τ : Type u := {j : ι // i0 ≤ j} + let : Preorder τ := inferInstance + let : IsDirected τ (· ≤ ·) := ⟨fun a b => by + obtain ⟨k, hak, hbk⟩ := directed_of (· ≤ ·) a.1 b.1 + exact ⟨⟨k, le_trans a.2 hak⟩, hak, hbk⟩⟩ + let : Nonempty τ := ⟨⟨i0, le_rfl⟩⟩ + let y : τ → X := fun j => u ⊓ x j.1 + have hy_anti : Antitone y := fun a b hab => by + exact inf_le_inf_left u (hanti hab) + have hy_nn : ∀ j, 0 ≤ y j := fun j => le_inf hu0 (hnn j.1) + have hy_glb : IsGLB (Set.range y) 0 := by + refine ⟨?_, ?_⟩ + · rintro _ ⟨j, rfl⟩ + exact hy_nn j + · intro w hw + apply hglb.2 + rintro _ ⟨i, rfl⟩ + obtain ⟨k, hi0k, hik⟩ := directed_of (· ≤ ·) i0 i + calc + w ≤ y ⟨k, hi0k⟩ := hw ⟨⟨k, hi0k⟩, rfl⟩ + _ ≤ x k := inf_le_right + _ ≤ x i := hanti hik + have hTy_glb : IsGLB (Set.range fun j : τ => |T (y j)|) 0 := + hcrit hy_anti hy_nn hy_glb + have hz_lower : + z - (T⁺ x0 - T u) ∈ lowerBounds (Set.range fun j : τ => |T (y j)|) := by + rintro _ ⟨j, rfl⟩ + have hxj_le_x0 : x j.1 ≤ x0 := hanti j.2 + have hy_le_u : y j ≤ u := inf_le_left + have hdiff_nn : 0 ≤ u - y j := sub_nonneg.mpr hy_le_u + have hdiff_le : u - y j ≤ x0 - x j.1 := by + rw [show u - y j = (u - x j.1)⁺ from sub_inf_eq_posPart u (x j.1)] + have hmono : (u - x j.1)⁺ ≤ (x0 - x j.1)⁺ := + posPart_mono (sub_le_sub_right hux (x j.1)) + rwa [posPart_of_nonneg (sub_nonneg.mpr hxj_le_x0)] at hmono + have hTdiff : T (u - y j) ≤ T⁺ (x0 - x j.1) := by + calc + T (u - y j) ≤ T⁺ (u - y j) := + OrderBoundedHom.le_iff.mp (le_posPart T) (u - y j) hdiff_nn + _ ≤ T⁺ (x0 - x j.1) := hTpos_mono hdiff_le + have hlin : T u - T (y j) ≤ T⁺ x0 - T⁺ (x j.1) := by + change T.toLinearMap u - T.toLinearMap (y j) ≤ + T⁺.toLinearMap x0 - T⁺.toLinearMap (x j.1) + rw [← map_sub T.toLinearMap, ← map_sub T⁺.toLinearMap] + exact hTdiff + have hsum : T⁺ (x j.1) + T u ≤ T⁺ x0 + T (y j) := by + have hTu : T u ≤ T⁺ x0 - T⁺ (x j.1) + T (y j) := + sub_le_iff_le_add.mp hlin + calc + T⁺ (x j.1) + T u = T u + T⁺ (x j.1) := by abel + _ ≤ (T⁺ x0 - T⁺ (x j.1) + T (y j)) + T⁺ (x j.1) := + add_le_add_left hTu _ + _ = T⁺ x0 + T (y j) := by abel + have hzj : z ≤ T⁺ (x j.1) := hz ⟨j.1, rfl⟩ + have hz_to : z ≤ T⁺ x0 + T (y j) - T u := by + exact hzj.trans (le_sub_iff_add_le.mpr hsum) + have hz_sub : z - (T⁺ x0 - T u) ≤ T (y j) := by + rw [sub_le_iff_le_add] + convert hz_to using 1 + abel + exact hz_sub.trans (le_abs_self _) + have hz_sub_nonpos : z - (T⁺ x0 - T u) ≤ 0 := hTy_glb.2 hz_lower + exact sub_nonpos.mp hz_sub_nonpos + have hLUB := OrderBoundedHom.isLUB_posPart_apply (f := T) hx0 + have hupper : T⁺ x0 - z ∈ upperBounds {w | ∃ y, 0 ≤ y ∧ y ≤ x0 ∧ w = T y} := by + rintro _ ⟨u, hu0, hux, rfl⟩ + have hzle := hz_le_sub u hu0 hux + exact le_sub_iff_add_le.mpr (by + have h := le_sub_iff_add_le.mp hzle + simpa [add_comm] using h) + have hle := hLUB.2 hupper + rwa [le_sub_iff_add_le, add_comm, add_le_iff_nonpos_left] at hle + have hrange : Set.range (fun i => |T⁺ (x i)|) = Set.range (fun i => T⁺ (x i)) := by + ext y + constructor + · rintro ⟨i, rfl⟩ + exact ⟨i, (abs_of_nonneg (hTpos_pos (x i) (hnn i))).symm⟩ + · rintro ⟨i, rfl⟩ + exact ⟨i, abs_of_nonneg (hTpos_pos (x i) (hnn i))⟩ + rwa [hrange] + +private lemma decreasing_abs_glb_zero_of_orderContinuous {T : OrderBoundedHom X Y} + (hT : IsOrderContinuousOp T.toLinearMap) : + ∀ {ι : Type u} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {x : ι → X}, + Antitone x → (∀ i, 0 ≤ x i) → IsGLB (Set.range x) 0 → + IsGLB (Set.range fun i => |T (x i)|) 0 := by + intro ι _ _ _ x hanti hnn hglb + have hx := orderConvergesTo_of_antitone_isGLB hanti hglb + have hTx : OrderConvergesTo (fun i => T (x i)) 0 := by + simpa [map_zero] using hT hx + exact isGLB_range_abs_of_orderConvergesTo_zero hTx + +private lemma parts_orderContinuous_of_decreasing_abs_glb_zero (T : OrderBoundedHom X Y) + (hcrit : ∀ {ι : Type u} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {x : ι → X}, + Antitone x → (∀ i, 0 ≤ x i) → IsGLB (Set.range x) 0 → + IsGLB (Set.range fun i => |T (x i)|) 0) : + IsOrderContinuousOp T⁺.toLinearMap ∧ IsOrderContinuousOp T⁻.toLinearMap := by + constructor + · exact positive_orderContinuous_of_decreasing_abs_glb_zero (posPart_nonneg T) + (posPart_decreasing_abs_glb_zero T hcrit) + · have hcrit_neg : + ∀ {ι : Type u} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {x : ι → X}, + Antitone x → (∀ i, 0 ≤ x i) → IsGLB (Set.range x) 0 → + IsGLB (Set.range fun i => |(-T : OrderBoundedHom X Y) (x i)|) 0 := by + intro ι _ _ _ x hanti hnn hglb + have hbase := hcrit hanti hnn hglb + have hrange : + Set.range (fun i => |(-T : OrderBoundedHom X Y) (x i)|) = + Set.range (fun i => |T (x i)|) := by + ext y + constructor + · rintro ⟨i, rfl⟩ + refine ⟨i, ?_⟩ + change |T.toLinearMap (x i)| = |(-T.toLinearMap) (x i)| + rw [LinearMap.neg_apply, abs_neg] + · rintro ⟨i, rfl⟩ + refine ⟨i, ?_⟩ + change |(-T.toLinearMap) (x i)| = |T.toLinearMap (x i)| + rw [LinearMap.neg_apply, abs_neg] + rwa [hrange] + have hneg : IsOrderContinuousOp ((-T : OrderBoundedHom X Y)⁺).toLinearMap := + positive_orderContinuous_of_decreasing_abs_glb_zero + (S := (-T : OrderBoundedHom X Y)⁺) (posPart_nonneg (-T : OrderBoundedHom X Y)) + (posPart_decreasing_abs_glb_zero (-T : OrderBoundedHom X Y) hcrit_neg) + have hneg_eq : (-T : OrderBoundedHom X Y)⁺ = T⁻ := by + rw [negPart_def, posPart_def] + rwa [← hneg_eq] + +private lemma modulus_orderContinuous_of_parts (T : OrderBoundedHom X Y) + (hparts : IsOrderContinuousOp T⁺.toLinearMap ∧ IsOrderContinuousOp T⁻.toLinearMap) : + IsOrderContinuousOp (|T| : OrderBoundedHom X Y).toLinearMap := by + intro ι _ _ _ x a hx + have hsum := (hparts.1 hx).add (hparts.2 hx) + have habs : (|T| : OrderBoundedHom X Y) = T⁺ + T⁻ := (posPart_add_negPart T).symm + simpa only [habs, OrderBoundedHom.toLinearMap_apply, obAdd_apply] using hsum + +private lemma orderContinuous_of_modulus_orderContinuous (T : OrderBoundedHom X Y) + (hmod : IsOrderContinuousOp (|T| : OrderBoundedHom X Y).toLinearMap) : + IsOrderContinuousOp T.toLinearMap := by + intro ι _ _ _ x a hx + have hxabs := orderConvergesTo_abs_sub_zero hx + have hmod_abs : + OrderConvergesTo (fun i => (|T| : OrderBoundedHom X Y).toLinearMap |x i - a|) 0 := by + simpa [map_zero] using hmod hxabs + have hsub : OrderConvergesTo (fun i => T.toLinearMap (x i) - T.toLinearMap a) 0 := + orderConvergesTo_zero_of_abs_le hmod_abs fun i => by + calc + |T.toLinearMap (x i) - T.toLinearMap a| = |T.toLinearMap (x i - a)| := by + rw [← map_sub T.toLinearMap] + _ ≤ (|T| : OrderBoundedHom X Y) |x i - a| := by + simpa using abs_apply_le_modulus_apply_abs T (x i - a) + exact orderConvergesTo_of_sub_zero hsub + +/-- For an order bounded operator into an order complete vector lattice, order continuity is +characterised by the infimum of `|T x_i|` on decreasing zero nets, and equivalently by +order continuity of the positive part, negative part, or modulus. -/ +theorem characterization + (T : OrderBoundedHom X Y) : + List.TFAE [ + IsOrderContinuousOp T.toLinearMap, + (∀ {ι : Type u} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + {x : ι → X}, + Antitone x → (∀ i, 0 ≤ x i) → IsGLB (Set.range x) 0 → + IsGLB (Set.range fun i => |T (x i)|) 0), + IsOrderContinuousOp T⁺.toLinearMap ∧ IsOrderContinuousOp T⁻.toLinearMap, + IsOrderContinuousOp (|T| : OrderBoundedHom X Y).toLinearMap] := by + refine List.tfae_of_cycle ?_ (orderContinuous_of_modulus_orderContinuous T) + simp only [List.isChain_cons_cons] + exact ⟨decreasing_abs_glb_zero_of_orderContinuous, + parts_orderContinuous_of_decreasing_abs_glb_zero T, + modulus_orderContinuous_of_parts T, List.IsChain.singleton _⟩ + +section Functional + +variable {X : Type u} [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [NormedVectorLattice X] [CompleteSpace X] [IsOrderContinuousNorm X] + +private lemma real_orderConvergesTo_of_tendsto + {ι : Type u} [Preorder ι] + {x : ι → ℝ} {a : ℝ} (hx : Filter.Tendsto x Filter.atTop (nhds a)) : + OrderConvergesTo x a := by + let Pos : Type := {ε : ℝ // 0 < ε} + let κ : Type := OrderDual Pos + have : Nonempty κ := ⟨OrderDual.toDual (⟨1, by norm_num⟩ : Pos)⟩ + have : IsDirected κ (· ≤ ·) := by + refine ⟨fun p q => ?_⟩ + let p' : Pos := OrderDual.ofDual p + let q' : Pos := OrderDual.ofDual q + let δ : ℝ := min (p' : ℝ) (q' : ℝ) / 2 + have hmin : 0 < min (p' : ℝ) (q' : ℝ) := lt_min p'.property q'.property + have hδ_pos : 0 < δ := by + exact half_pos hmin + refine ⟨OrderDual.toDual (⟨δ, hδ_pos⟩ : Pos), ?_, ?_⟩ + · change (⟨δ, hδ_pos⟩ : Pos) ≤ OrderDual.ofDual p + change δ ≤ (p' : ℝ) + have hδ_le_min : δ ≤ min (p' : ℝ) (q' : ℝ) := by + dsimp [δ] + linarith [le_of_lt hmin] + exact hδ_le_min.trans (min_le_left _ _) + · change (⟨δ, hδ_pos⟩ : Pos) ≤ OrderDual.ofDual q + change δ ≤ (q' : ℝ) + have hδ_le_min : δ ≤ min (p' : ℝ) (q' : ℝ) := by + dsimp [δ] + linarith [le_of_lt hmin] + exact hδ_le_min.trans (min_le_right _ _) + refine ⟨κ, inferInstance, inferInstance, inferInstance, + fun p => ((OrderDual.ofDual p : Pos) : ℝ), ?_, ?_, ?_, ?_⟩ + · intro p q hpq + change ((OrderDual.ofDual q : Pos) : ℝ) ≤ ((OrderDual.ofDual p : Pos) : ℝ) + exact hpq + · intro p + exact le_of_lt (OrderDual.ofDual p : Pos).property + · refine ⟨?_, ?_⟩ + · rintro _ ⟨p, rfl⟩ + exact le_of_lt (OrderDual.ofDual p : Pos).property + · intro w hw + by_contra hle + have hw_pos : 0 < w := lt_of_not_ge hle + let p : κ := OrderDual.toDual (⟨w / 2, half_pos hw_pos⟩ : Pos) + have hwp := hw ⟨p, rfl⟩ + change w ≤ w / 2 at hwp + linarith + · intro p + have hp_pos : 0 < ((OrderDual.ofDual p : Pos) : ℝ) := + (OrderDual.ofDual p : Pos).property + have h_event := Metric.tendsto_nhds.mp hx ((OrderDual.ofDual p : Pos) : ℝ) hp_pos + exact h_event.mono fun i hi => by + exact le_of_lt (by simpa [Real.dist_eq] using hi) + +/-- On a Banach lattice with order-continuous norm, every order bounded real-valued +functional is order continuous. -/ +theorem functional_orderContinuous_of_orderContinuousNorm (f : OrderBoundedHom X ℝ) : + IsOrderContinuousOp f.toLinearMap := by + intro ι _ _ _ x a hx + have hx_tend : Filter.Tendsto x Filter.atTop (nhds a) := + tendsto_of_orderConvergesTo_of_isOrderContinuousNorm hx + let : BanachLattice X := {} + have hf_cont : Continuous f.toLinearMap := IsOrderBounded.continuous f.isOrderBounded' + have hf_tend : Filter.Tendsto (fun i => f.toLinearMap (x i)) Filter.atTop + (nhds (f.toLinearMap a)) := + (hf_cont.tendsto a).comp hx_tend + exact real_orderConvergesTo_of_tendsto hf_tend + +end Functional + +private lemma orderContinuous_of_abs_le_abs {S T : OrderBoundedHom X Y} + (hT : T ∈ OrderContinuousOperator (X := X) (Y := Y)) (hST : |S| ≤ |T|) : + S ∈ OrderContinuousOperator (X := X) (Y := Y) := by + rw [mem_OrderContinuousOperator] at hT ⊢ + have hmodT : IsOrderContinuousOp (|T| : OrderBoundedHom X Y).toLinearMap := + modulus_orderContinuous_of_parts T + (parts_orderContinuous_of_decreasing_abs_glb_zero T + (decreasing_abs_glb_zero_of_orderContinuous hT)) + apply orderContinuous_of_modulus_orderContinuous S + intro ι _ _ _ x a hx + have hxabs := orderConvergesTo_abs_sub_zero hx + have hdom : + OrderConvergesTo (fun i => (|T| : OrderBoundedHom X Y).toLinearMap |x i - a|) 0 := by + simpa [map_zero] using hmodT hxabs + have hsub : OrderConvergesTo + (fun i => (|S| : OrderBoundedHom X Y).toLinearMap (x i) - + (|S| : OrderBoundedHom X Y).toLinearMap a) 0 := + orderConvergesTo_zero_of_abs_le hdom fun i => by + calc + |(|S| : OrderBoundedHom X Y).toLinearMap (x i) - + (|S| : OrderBoundedHom X Y).toLinearMap a| = + |(|S| : OrderBoundedHom X Y).toLinearMap (x i - a)| := by + rw [← map_sub] + _ ≤ (|(|S| : OrderBoundedHom X Y)| : OrderBoundedHom X Y) |x i - a| := by + simpa using abs_apply_le_modulus_apply_abs (|S| : OrderBoundedHom X Y) (x i - a) + _ = (|S| : OrderBoundedHom X Y) |x i - a| := by + have hSabs_nonneg : (0 : OrderBoundedHom X Y) ≤ |S| := abs_nonneg S + rw [abs_of_nonneg hSabs_nonneg] + _ ≤ (|T| : OrderBoundedHom X Y) |x i - a| := + OrderBoundedHom.le_iff.mp hST _ (abs_nonneg _) + exact orderConvergesTo_of_sub_zero hsub + +private lemma exists_orderIdeal_coe_eq_OrderContinuousOperator : + ∃ J : OrderIdeal (OrderBoundedHom X Y), + (J : Set (OrderBoundedHom X Y)) = OrderContinuousOperator (X := X) (Y := Y) := by + let M : Submodule ℝ (OrderBoundedHom X Y) := + { carrier := OrderContinuousOperator (X := X) (Y := Y) + zero_mem' := zero_mem_OrderContinuousOperator + add_mem' := fun {S T} hS hT => add_mem_OrderContinuousOperator hS hT + smul_mem' := fun c {T} hT => smul_mem_OrderContinuousOperator c hT } + refine ⟨OrderIdeal.ofSolid M ?_, rfl⟩ + intro T S hT hST + exact orderContinuous_of_abs_le_abs hT hST + +private lemma isGLB_range_sub_apply_of_isLUB {S : Set (OrderBoundedHom X Y)} + {T : OrderBoundedHom X Y} {x : X} + (hLUB : IsLUB ((fun A : OrderBoundedHom X Y => A x) '' S) (T x)) : + IsGLB (Set.range fun A : S => (T - A.1) x) 0 := by + refine ⟨?_, ?_⟩ + · rintro _ ⟨A, rfl⟩ + change 0 ≤ T.toLinearMap x - A.1.toLinearMap x + exact sub_nonneg.mpr (hLUB.1 ⟨A.1, A.2, rfl⟩) + · intro y hy + have hub : T x - y ∈ upperBounds ((fun A : OrderBoundedHom X Y => A x) '' S) := by + rintro _ ⟨A, hA, rfl⟩ + have hyA : y ≤ (T - A) x := hy ⟨⟨A, hA⟩, rfl⟩ + change y ≤ T.toLinearMap x - A.toLinearMap x at hyA + exact le_sub_iff_add_le.mpr (by + have h := le_sub_iff_add_le.mp hyA + simpa [add_comm] using h) + have hle := hLUB.2 hub + have hneg : 0 ≤ -y := by + have h := sub_nonneg.mpr hle + convert h using 1 + abel + exact neg_nonneg.mp hneg + +private lemma positive_directed_isLUB_mem_OrderContinuousOperator + {S : Set (OrderBoundedHom X Y)} + (hS : S ⊆ OrderContinuousOperator (X := X) (Y := Y)) + (hpos : ∀ A ∈ S, (0 : OrderBoundedHom X Y) ≤ A) (hdir : DirectedOn (· ≤ ·) S) + (hne : S.Nonempty) {T : OrderBoundedHom X Y} (hT : IsLUB S T) : + T ∈ OrderContinuousOperator (X := X) (Y := Y) := by + rw [mem_OrderContinuousOperator] + have hT_nonneg : (0 : OrderBoundedHom X Y) ≤ T := by + obtain ⟨A, hA⟩ := hne + exact (hpos A hA).trans (hT.1 hA) + apply positive_orderContinuous_of_decreasing_abs_glb_zero (S := T) + · exact hT_nonneg + intro ι _ _ _ x hanti hnn hglb + have hTpos_fun : Positive T.toLinearMap := fun z hz => by + simpa only [OrderBoundedHom.zero_apply, OrderBoundedHom.toLinearMap_apply] using + OrderBoundedHom.le_iff.mp hT_nonneg z hz + have hglb_T : IsGLB (Set.range fun i => T (x i)) 0 := by + refine ⟨?_, ?_⟩ + · rintro _ ⟨i, rfl⟩ + exact hTpos_fun (x i) (hnn i) + · intro y hy + obtain ⟨i0⟩ := (inferInstance : Nonempty ι) + have hx0 : 0 ≤ x i0 := hnn i0 + obtain ⟨U, hU, hpoint⟩ := + OrderBoundedHom.isLUB_of_directedOn (X := X) (Y := Y) hne hdir ⟨T, hT.1⟩ + have hUT : U = T := hU.unique hT + have hpoint_T : + IsLUB ((fun A : OrderBoundedHom X Y => A (x i0)) '' S) (T (x i0)) := by + simpa [hUT] using hpoint hx0 + have hdiff_glb := + isGLB_range_sub_apply_of_isLUB (S := S) (T := T) hpoint_T + apply hdiff_glb.2 + intro d hd + rcases hd with ⟨A, rfl⟩ + have hAoc : IsOrderContinuousOp A.1.toLinearMap := + (mem_OrderContinuousOperator A.1).mp (hS A.2) + have hA_nonneg : (0 : OrderBoundedHom X Y) ≤ A.1 := hpos A.1 A.2 + have hApos_fun : Positive A.1.toLinearMap := fun z hz => by + simpa only [OrderBoundedHom.zero_apply, OrderBoundedHom.toLinearMap_apply] using + OrderBoundedHom.le_iff.mp hA_nonneg z hz + have hA_glb_abs := decreasing_abs_glb_zero_of_orderContinuous hAoc hanti hnn hglb + have hA_glb : IsGLB (Set.range fun i => A.1 (x i)) 0 := by + have hrange : Set.range (fun i => |A.1 (x i)|) = + Set.range (fun i => A.1 (x i)) := by + ext z + constructor + · rintro ⟨i, rfl⟩ + exact ⟨i, (abs_of_nonneg (hApos_fun (x i) (hnn i))).symm⟩ + · rintro ⟨i, rfl⟩ + exact ⟨i, abs_of_nonneg (hApos_fun (x i) (hnn i))⟩ + rwa [hrange] at hA_glb_abs + have hy_lower : + y - (T - A.1) (x i0) ∈ lowerBounds (Set.range fun i => A.1 (x i)) := by + rintro _ ⟨k, rfl⟩ + obtain ⟨m, hi0m, hkm⟩ := directed_of (· ≤ ·) i0 k + have hx0m_nonneg : 0 ≤ x i0 - x m := sub_nonneg.mpr (hanti hi0m) + have hA_le_T := hT.1 A.2 + have hAT_diff : A.1 (x i0 - x m) ≤ T (x i0 - x m) := + OrderBoundedHom.le_iff.mp hA_le_T _ hx0m_nonneg + have hTm_le : T (x m) ≤ (T - A.1) (x i0) + A.1 (x m) := by + have hAT_diff' : + A.1.toLinearMap (x i0) - A.1.toLinearMap (x m) ≤ + T.toLinearMap (x i0) - T.toLinearMap (x m) := by + change A.1.toLinearMap (x i0 - x m) ≤ T.toLinearMap (x i0 - x m) at hAT_diff + simpa [map_sub] using hAT_diff + change T.toLinearMap (x m) ≤ + T.toLinearMap (x i0) - A.1.toLinearMap (x i0) + A.1.toLinearMap (x m) + rw [show T.toLinearMap (x i0) - A.1.toLinearMap (x i0) + + A.1.toLinearMap (x m) = + T.toLinearMap (x i0) - + (A.1.toLinearMap (x i0) - A.1.toLinearMap (x m)) by abel] + exact le_sub_iff_add_le.mpr (by + rw [add_comm] + exact le_sub_iff_add_le.mp hAT_diff') + have hy_m : y ≤ T (x m) := hy ⟨m, rfl⟩ + have hy_to_m : y - (T - A.1) (x i0) ≤ A.1 (x m) := + sub_le_iff_le_add.mpr (by simpa [add_comm] using hy_m.trans hTm_le) + exact hy_to_m.trans (Positive.monotone_iff.mpr hApos_fun (hanti hkm)) + exact sub_nonpos.mp (hA_glb.2 hy_lower) + have hrange : Set.range (fun i => |T (x i)|) = Set.range (fun i => T (x i)) := by + ext z + constructor + · rintro ⟨i, rfl⟩ + exact ⟨i, (abs_of_nonneg (hTpos_fun (x i) (hnn i))).symm⟩ + · rintro ⟨i, rfl⟩ + exact ⟨i, abs_of_nonneg (hTpos_fun (x i) (hnn i))⟩ + rwa [hrange] + +private lemma isLUB_mem_OrderContinuousOperator {S : Set (OrderBoundedHom X Y)} + (hS : S ⊆ OrderContinuousOperator (X := X) (Y := Y)) (hne : S.Nonempty) + {T : OrderBoundedHom X Y} (hT : IsLUB S T) : + T ∈ OrderContinuousOperator (X := X) (Y := Y) := by + obtain ⟨J, hJ⟩ := exists_orderIdeal_coe_eq_OrderContinuousOperator (X := X) (Y := Y) + let B : Band (OrderBoundedHom X Y) := + Band.ofPosDirectedSSupMem J fun S hSJ hpos hdir hneS T hT => by + change T ∈ (J : Set (OrderBoundedHom X Y)) + rw [hJ] + exact positive_directed_isLUB_mem_OrderContinuousOperator + (fun A hA => by rw [← hJ]; exact hSJ hA) hpos hdir hneS hT + rw [← hJ] + exact B.sSup_mem (fun A hA => by + change A ∈ (J : Set (OrderBoundedHom X Y)) + rw [hJ] + exact hS hA) hne hT + +private lemma exists_band_coe_eq_OrderContinuousOperator : + ∃ B : Band (OrderBoundedHom X Y), + (B : Set (OrderBoundedHom X Y)) = OrderContinuousOperator (X := X) (Y := Y) := by + obtain ⟨J, hJ⟩ := exists_orderIdeal_coe_eq_OrderContinuousOperator (X := X) (Y := Y) + refine ⟨{ toOrderIdeal := J, sSup_mem' := ?_ }, hJ⟩ + intro S hS hne T hT + change T ∈ (J : Set (OrderBoundedHom X Y)) + rw [hJ] + exact isLUB_mem_OrderContinuousOperator (X := X) (Y := Y) + (fun A hA => by rw [← hJ]; exact hS hA) hne hT + +private lemma decomposition_OrderContinuousOperator (T : OrderBoundedHom X Y) : + ∃ S R : OrderBoundedHom X Y, + S ∈ OrderContinuousOperator (X := X) (Y := Y) ∧ + R ∈ disjointComplement (OrderContinuousOperator (X := X) (Y := Y)) ∧ T = S + R := by + let : ConditionallyCompleteLattice (OrderBoundedHom X Y) := + @conditionallyCompleteLatticeOfPosSet (OrderBoundedHom X Y) _ _ _ + (fun {S} _ hne hbdd => OrderBoundedHom.exists_isLUB (S := S) hne hbdd) + have : HasProjectionProperty (OrderBoundedHom X Y) := + HasProjectionProperty.of_isOrderComplete + obtain ⟨B, hB⟩ := exists_band_coe_eq_OrderContinuousOperator (X := X) (Y := Y) + obtain ⟨P, hP⟩ := HasProjectionProperty.exists_projectionBand B + obtain ⟨S, R, hS, hR, hT⟩ := P.decomposition T + refine ⟨S, R, ?_, ?_, hT⟩ + · rw [← hB, ← hP] + exact hS + · rw [← hB, ← hP] + exact hR + +/-- Ogasawara's theorem: The order-continuous order bounded operators + form a projection band in the lattice of order bounded operators. -/ +theorem ogasawara_theorem + {Y : Type v} [AddCommGroup Y] [ConditionallyCompleteLattice Y] + [IsOrderedAddMonoid Y] [VectorLattice Y] : + ∃ B : ProjectionBand (OrderBoundedHom X Y), + (B : Set (OrderBoundedHom X Y)) = OrderContinuousOperator (X := X) (Y := Y) := by + let : ConditionallyCompleteLattice (OrderBoundedHom X Y) := + @conditionallyCompleteLatticeOfPosSet (OrderBoundedHom X Y) _ _ _ + (fun {S} _ hne hbdd => OrderBoundedHom.exists_isLUB (S := S) hne hbdd) + have : HasProjectionProperty (OrderBoundedHom X Y) := + HasProjectionProperty.of_isOrderComplete + obtain ⟨B, hB⟩ := exists_band_coe_eq_OrderContinuousOperator (X := X) (Y := Y) + obtain ⟨P, hP⟩ := HasProjectionProperty.exists_projectionBand B + exact ⟨P, hP.trans hB⟩ + +end OrderContinuousOp diff --git a/LeanPool/FBLOrderContinuity/BanLat/Operators/Regular.lean b/LeanPool/FBLOrderContinuity/BanLat/Operators/Regular.lean new file mode 100644 index 0000000000..b1618fcbc5 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Operators/Regular.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.FBLOrderContinuity.BanLat.Operators.OrderBounded +public import LeanPool.OrderClosures.BanLat.OrderComplete + + + +/-! +# Regular operators + +An operator between vector lattices is **regular** (`IsRegularOp`) if it can +be written as the difference of two positive operators. Every regular operator +is order bounded; when the codomain is order complete, the converse holds. +-/ + +@[expose] public section + +variable {X Y : Type*} [AddCommGroup X] [AddCommGroup Y] + [Lattice X] [Lattice Y] [IsOrderedAddMonoid X] + [IsOrderedAddMonoid Y] [VectorLattice X] [VectorLattice Y] + +/-- A linear map is **regular** if it is the difference of two positive +operators. -/ +def IsRegularOp (f : X →ₗ[ℝ] Y) : Prop := + ∃ g h : X →ₗ[ℝ] Y, Positive g ∧ Positive h ∧ f = g - h + +namespace IsRegularOp + +/-- Every regular operator is order bounded. -/ +theorem isOrderBounded {f : X →ₗ[ℝ] Y} + (hf : IsRegularOp f) : IsOrderBounded f := by + obtain ⟨g, h, hg, hh, rfl⟩ := hf + exact IsOrderBounded.sub + (Positive.isOrderBounded hg) (Positive.isOrderBounded hh) + +end IsRegularOp diff --git a/LeanPool/FBLOrderContinuity/BanLat/Operators/RieszKantorovich.lean b/LeanPool/FBLOrderContinuity/BanLat/Operators/RieszKantorovich.lean new file mode 100644 index 0000000000..f1367564c8 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Operators/RieszKantorovich.lean @@ -0,0 +1,1293 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import Mathlib.Algebra.Order.Group.Pointwise.Bounds +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.FBLOrderContinuity.BanLat.Operators.OrderBounded +public import LeanPool.FBLOrderContinuity.BanLat.Operators.Regular +public import LeanPool.OrderClosures.BanLat.OrderComplete +public import LeanPool.FBLOrderContinuity.BanLat.RieszDec +public import LeanPool.FBLOrderContinuity.BanLat.Substructures.Band.PPP + + + +/-! +# The Riesz-Kantorovich theorem + +When the codomain `Y` is order complete, the space `OrderBoundedHom X Y` of +order bounded operators is an order complete vector lattice, with explicit +formulas for the lattice operations (the **Riesz-Kantorovich formulas**). +-/ + +@[expose] public section + +namespace OrderBoundedHom + +open scoped Pointwise + +variable {X Y : Type*} [AddCommGroup X] [AddCommGroup Y] + [Lattice X] [ConditionallyCompleteLattice Y] [IsOrderedAddMonoid X] + [IsOrderedAddMonoid Y] [VectorLattice X] + [VectorLattice Y] + +/-! ### Positive part construction for the Riesz-Kantorovich theorem -/ + +/-- Values of an order-bounded operator on the interval from zero to `x`. -/ +def ppSet (f : OrderBoundedHom X Y) (x : X) : Set Y := + { w | ∃ y, 0 ≤ y ∧ y ≤ x ∧ w = f y } + + +lemma ppSet_nonempty (f : OrderBoundedHom X Y) {x : X} + (hx : 0 ≤ x) : (ppSet f x).Nonempty := + ⟨0, 0, le_rfl, hx, (map_zero f.toLinearMap).symm⟩ + + +lemma ppSet_bddAbove (f : OrderBoundedHom X Y) {x : X} + (hx : 0 ≤ x) : BddAbove (ppSet f x) := by + obtain ⟨u, _, hbound⟩ := f.isOrderBounded' x hx + exact ⟨u, fun _ ⟨y, hy, hyx, hw⟩ => hw ▸ + (le_abs_self _).trans + (hbound y (sup_le hyx (neg_nonpos_of_nonneg hy |>.trans hx)))⟩ + +/-- The Riesz–Kantorovich supremum on positive vectors, extended by zero elsewhere. -/ +noncomputable def ppFun (f : OrderBoundedHom X Y) + (x : X) : Y := by + classical + exact if 0 ≤ x then sSup (ppSet f x) else 0 + +lemma ppFun_isLUB (f : OrderBoundedHom X Y) {x : X} + (hx : 0 ≤ x) : IsLUB (ppSet f x) (ppFun f x) := by + simp only [ppFun, ite_eq_left hx] + exact isLUB_csSup (ppSet_nonempty f hx) (ppSet_bddAbove f hx) + +lemma ppFun_nonneg (f : OrderBoundedHom X Y) {x : X} + (hx : 0 ≤ x) : 0 ≤ ppFun f x := + (ppFun_isLUB f hx).1 + ⟨0, le_rfl, hx, (map_zero f.toLinearMap).symm⟩ + +lemma le_ppFun (f : OrderBoundedHom X Y) {x : X} + (hx : 0 ≤ x) : f x ≤ ppFun f x := + (ppFun_isLUB f hx).1 ⟨x, hx, le_refl x, rfl⟩ + +lemma ppFun_le (f : OrderBoundedHom X Y) {x : X} + (hx : 0 ≤ x) {u : Y} + (hu : u ∈ upperBounds (ppSet f x)) : ppFun f x ≤ u := + (ppFun_isLUB f hx).2 hu + +lemma ppFun_add (f : OrderBoundedHom X Y) {x y : X} + (hx : 0 ≤ x) (hy : 0 ≤ y) : + ppFun f (x + y) = ppFun f x + ppFun f y := by + apply le_antisymm + · -- ≤: Riesz decomposition + apply ppFun_le f (add_nonneg hx hy) + intro w ⟨z, hz, hzxy, hw⟩ + obtain ⟨z₁, z₂, hz₁, hz₁x, hz₂, hz₂y, hsum⟩ := + riesz_decomposition z x y hz hx hy hzxy + rw [hw, hsum] + change f.toLinearMap (z₁ + z₂) ≤ ppFun f x + ppFun f y + rw [map_add] + exact add_le_add + ((ppFun_isLUB f hx).1 ⟨z₁, hz₁, hz₁x, rfl⟩) + ((ppFun_isLUB f hy).1 ⟨z₂, hz₂, hz₂y, rfl⟩) + · -- ≥: double LUB argument + have step1 : ∀ w₁ ∈ ppSet f x, ∀ w₂ ∈ ppSet f y, + w₁ + w₂ ≤ ppFun f (x + y) := by + intro w₁ ⟨z₁, hz₁, hz₁x, hw₁⟩ w₂ ⟨z₂, hz₂, hz₂y, hw₂⟩ + rw [hw₁, hw₂] + change f.toLinearMap z₁ + f.toLinearMap z₂ ≤ ppFun f (x + y) + rw [← map_add] + exact (ppFun_isLUB f (add_nonneg hx hy)).1 + ⟨z₁ + z₂, add_nonneg hz₁ hz₂, add_le_add hz₁x hz₂y, rfl⟩ + have step2 : ∀ w₂ ∈ ppSet f y, + ppFun f x + w₂ ≤ ppFun f (x + y) := by + intro w₂ hw₂ + have hub : ppFun f (x + y) - w₂ ∈ upperBounds (ppSet f x) := + fun w₁ hw₁ => + le_sub_iff_add_le.mpr (step1 w₁ hw₁ w₂ hw₂) + exact le_sub_iff_add_le.mp (ppFun_le f hx hub) + have hub : ppFun f (x + y) - ppFun f x ∈ + upperBounds (ppSet f y) := + fun w₂ hw₂ => le_sub_iff_add_le.mpr + (by rw [add_comm]; exact step2 w₂ hw₂) + rw [add_comm] + exact le_sub_iff_add_le.mp (ppFun_le f hy hub) + +/-! ### The positive part operator -/ + +/-- The linear extension of the Riesz–Kantorovich positive-cone formula. -/ +noncomputable def ppOp (f : OrderBoundedHom X Y) : + X →ₗ[ℝ] Y := by + haveI : IsVLArchimedean Y := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + exact Positive.extension (fun x hx => ppFun_nonneg f hx) + (fun _ _ hx hy => ppFun_add f hx hy) + +lemma ppOp_apply_nonneg (f : OrderBoundedHom X Y) + {x : X} (hx : 0 ≤ x) : ppOp f x = ppFun f x := by + have : IsVLArchimedean Y := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + exact Positive.extension_nonneg (fun x hx => ppFun_nonneg f hx) + (fun _ _ hx hy => ppFun_add f hx hy) hx + +lemma ppOp_positive (f : OrderBoundedHom X Y) : + Positive (ppOp f) := by + have : IsVLArchimedean Y := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + exact Positive.extension_positive + (fun x hx => ppFun_nonneg f hx) + (fun _ _ hx hy => ppFun_add f hx hy) + +lemma le_ppOp (f : OrderBoundedHom X Y) {x : X} + (hx : 0 ≤ x) : f x ≤ ppOp f x := + ppOp_apply_nonneg f hx ▸ le_ppFun f hx + +lemma ppOp_le (f g : OrderBoundedHom X Y) + (hg0 : ∀ x : X, 0 ≤ x → 0 ≤ g x) + (hgf : ∀ x : X, 0 ≤ x → f x ≤ g x) + {x : X} (hx : 0 ≤ x) : ppOp f x ≤ g x := by + rw [ppOp_apply_nonneg f hx] + apply ppFun_le f hx + intro _ ⟨y, hy, hyx, hw⟩ + rw [hw] + exact (hgf y hy).trans + ((Positive.monotone_iff.mpr + (show Positive g.toLinearMap from hg0)) hyx) + +/-! ### Sup, inf and lattice laws -/ + +/-- The positive part of an order-bounded operator. -/ +noncomputable def obPosPart + (f : OrderBoundedHom X Y) : OrderBoundedHom X Y := + ⟨ppOp f, Positive.isOrderBounded (ppOp_positive f)⟩ + +lemma obPosPart_apply (f : OrderBoundedHom X Y) (x : X) : + obPosPart f x = ppOp f x := rfl + +lemma obPosPart_nonneg (f : OrderBoundedHom X Y) : + (0 : OrderBoundedHom X Y) ≤ obPosPart f := + le_iff.mpr fun x hx => by + simpa only [zero_apply, obPosPart_apply] using ppOp_positive f x hx + +lemma le_obPosPart (f : OrderBoundedHom X Y) : + f ≤ obPosPart f := + le_iff.mpr fun _ hx => le_ppOp f hx + +lemma obPosPart_le {f g : OrderBoundedHom X Y} + (hg0 : (0 : OrderBoundedHom X Y) ≤ g) (hgf : f ≤ g) : + obPosPart f ≤ g := + le_iff.mpr fun x hx => by + apply ppOp_le f g _ _ hx + · intro y hy + simpa only [zero_apply] using le_iff.mp hg0 y hy + · intro y hy; exact le_iff.mp hgf y hy + +/-- Supremum of two order-bounded operators, constructed from the positive part. -/ +noncomputable def obSup + (f g : OrderBoundedHom X Y) : OrderBoundedHom X Y := + g + obPosPart (f - g) + +/-- Infimum of two order-bounded operators, constructed from their supremum. -/ +noncomputable def obInf + (f g : OrderBoundedHom X Y) : OrderBoundedHom X Y := + f + g - obSup f g + +lemma le_obSup_left (f g : OrderBoundedHom X Y) : + f ≤ obSup f g := by + change f ≤ g + obPosPart (f - g) + have h1 := add_le_add_left (le_obPosPart (f - g)) g + rw [sub_add_cancel, add_comm] at h1 + exact h1 + +lemma le_obSup_right (f g : OrderBoundedHom X Y) : + g ≤ obSup f g := by + change g ≤ g + obPosPart (f - g) + exact le_add_of_nonneg_right (obPosPart_nonneg (f - g)) + +lemma obSup_le {f g h : OrderBoundedHom X Y} + (hfh : f ≤ h) (hgh : g ≤ h) : + obSup f g ≤ h := by + change g + obPosPart (f - g) ≤ h + have h1 : obPosPart (f - g) ≤ h - g := + obPosPart_le (sub_nonneg.mpr hgh) + (sub_le_sub_right hfh g) + have h2 := add_le_add_left h1 g + rw [sub_add_cancel, add_comm] at h2 + exact h2 + +lemma obInf_le_left (f g : OrderBoundedHom X Y) : + obInf f g ≤ f := by + have : obInf f g = f - obPosPart (f - g) := by + change f + g - (g + obPosPart (f - g)) = + f - obPosPart (f - g); abel + rw [this] + exact sub_le_self f (obPosPart_nonneg (f - g)) + +lemma obInf_le_right (f g : OrderBoundedHom X Y) : + obInf f g ≤ g := by + have h1 : obInf f g = f - obPosPart (f - g) := by + change f + g - (g + obPosPart (f - g)) = + f - obPosPart (f - g); abel + rw [h1] + calc f - obPosPart (f - g) + ≤ f - (f - g) := + sub_le_sub_left (le_obPosPart (f - g)) f + _ = g := by abel + +lemma le_obInf {f g h : OrderBoundedHom X Y} + (hhf : h ≤ f) (hhg : h ≤ g) : + h ≤ obInf f g := by + have key : obPosPart (f - g) ≤ f - h := + obPosPart_le (sub_nonneg.mpr hhf) + (sub_le_sub_left hhg f) + have h2 : obInf f g = f - obPosPart (f - g) := by + change f + g - (g + obPosPart (f - g)) = + f - obPosPart (f - g); abel + rw [h2] + calc h = f - (f - h) := by abel + _ ≤ f - obPosPart (f - g) := + sub_le_sub_left key f + +/-- When the codomain is order complete, the space of order bounded +operators is a lattice. -/ +noncomputable instance instLattice : + Lattice (OrderBoundedHom X Y) := + { (inferInstance : + PartialOrder (OrderBoundedHom X Y)) with + sup := obSup + inf := obInf + le_sup_left := le_obSup_left + le_sup_right := le_obSup_right + sup_le := fun _ _ _ hfh hgh => obSup_le hfh hgh + inf_le_left := obInf_le_left + inf_le_right := obInf_le_right + le_inf := fun _ _ _ hhf hhg => le_obInf hhf hhg } + +/-- When the codomain is order complete, the space of order bounded +operators is a vector lattice. -/ +noncomputable instance instVectorLattice : + VectorLattice (OrderBoundedHom X Y) := + { (inferInstance : Module ℝ (OrderBoundedHom X Y)), + (inferInstance : + PosSMulMono ℝ (OrderBoundedHom X Y)) with } + +/-! ### Riesz-Kantorovich formulas -/ + + +lemma sub_apply (f g : OrderBoundedHom X Y) (y : X) : + (f - g : OrderBoundedHom X Y) y = f y - g y := + show (f.toLinearMap - g.toLinearMap) y = _ from + LinearMap.sub_apply _ _ _ + + +lemma add_apply' (f g : OrderBoundedHom X Y) (y : X) : + (f + g : OrderBoundedHom X Y) y = f y + g y := + show (f.toLinearMap + g.toLinearMap) y = _ from + LinearMap.add_apply _ _ _ + + +lemma map_sub_val (f : OrderBoundedHom X Y) (a b : X) : + f (a - b) = f a - f b := + show f.toLinearMap (a - b) = _ from map_sub f.toLinearMap a b + +private lemma map_neg_value (f : OrderBoundedHom X Y) (x : X) : f (-x) = -f x := + map_neg f.toLinearMap x + +lemma sup_zero_eq_obPosPart + (f : OrderBoundedHom X Y) : + f ⊔ 0 = obPosPart f := by + have : f ⊔ (0 : OrderBoundedHom X Y) = + (0 : OrderBoundedHom X Y) + obPosPart (f - 0) := rfl + rw [sub_zero, zero_add] at this; exact this + +lemma posPart_apply_eq_ppFun + {f : OrderBoundedHom X Y} {x : X} (hx : 0 ≤ x) : + f⁺ x = ppFun f x := by + rw [posPart_def, sup_zero_eq_obPosPart] + simpa only [obPosPart_apply] using ppOp_apply_nonneg f hx + +/-- The positive part at a positive element is the supremum over +the order interval `[0, x]`. -/ +theorem isLUB_posPart_apply + {f : OrderBoundedHom X Y} {x : X} (hx : 0 ≤ x) : + IsLUB {w | ∃ y, 0 ≤ y ∧ y ≤ x ∧ w = f y} + (f⁺ x) := by + rw [posPart_apply_eq_ppFun hx]; exact ppFun_isLUB f hx + +/-- The negative part at a positive element. -/ +theorem isLUB_negPart_apply + {f : OrderBoundedHom X Y} {x : X} (hx : 0 ≤ x) : + IsLUB {w | ∃ y, 0 ≤ y ∧ y ≤ x ∧ w = -(f y)} + (f⁻ x) := by + have h : f⁻ = (-f)⁺ := by rw [negPart_def, posPart_def] + rw [h, posPart_apply_eq_ppFun hx] + exact ppFun_isLUB (-f) hx + +/-- The supremum of order bounded operators at a positive element +is given by the Riesz-Kantorovich formula. -/ +theorem isLUB_sup_apply + {f g : OrderBoundedHom X Y} {x : X} (hx : 0 ≤ x) : + IsLUB + {w | ∃ y z, 0 ≤ y ∧ 0 ≤ z ∧ y + z = x + ∧ w = f y + g z} + ((f ⊔ g) x) := by + have hval : (f ⊔ g) x = g x + (f - g)⁺ x := by + have h := sup_eq_add_posPart_sub f g; rw [h, add_apply'] + have hbridge : ∀ y : X, f y + g (x - y) = g x + (f - g) y := by + intro y; rw [sub_apply, map_sub_val]; abel + rw [hval, posPart_apply_eq_ppFun hx] + have hPP := ppFun_isLUB (f - g) hx + constructor + · intro w ⟨y, z, hy, hz, hyz, hw⟩ + have hyx : y ≤ x := hyz ▸ le_add_of_nonneg_right hz + rw [hw, show z = x - y from eq_sub_of_add_eq' hyz, hbridge] + gcongr; exact hPP.1 ⟨y, hy, hyx, rfl⟩ + · intro u hu + rw [show g x + ppFun (f - g) x = + ppFun (f - g) x + g x from add_comm _ _, + ← le_sub_iff_add_le] + apply hPP.2 + intro v ⟨y, hy, hyx, hv⟩ + rw [le_sub_iff_add_le, hv, add_comm, ← hbridge] + exact hu ⟨y, x - y, hy, sub_nonneg.mpr hyx, by abel, rfl⟩ + + +lemma map_add_val (f : OrderBoundedHom X Y) (a b : X) : + f (a + b) = f a + f b := + show f.toLinearMap _ = _ from map_add f.toLinearMap a b + + +lemma neg_apply' (f : OrderBoundedHom X Y) (y : X) : + (-f : OrderBoundedHom X Y) y = -(f y) := + show (-f.toLinearMap) y = _ from LinearMap.neg_apply _ _ + +/-- The infimum of order bounded operators at a positive element. -/ +theorem isGLB_inf_apply + {f g : OrderBoundedHom X Y} {x : X} (hx : 0 ≤ x) : + IsGLB + {w | ∃ y z, 0 ≤ y ∧ 0 ≤ z ∧ y + z = x + ∧ w = f y + g z} + ((f ⊓ g) x) := by + set S := {w : Y | ∃ y z, 0 ≤ y ∧ 0 ≤ z ∧ y + z = x + ∧ w = f y + g z} + set c := f x + g x + have hsym : ∀ w ∈ S, c - w ∈ S := by + intro w ⟨y, z, hy, hz, hyz, hw⟩ + refine ⟨z, y, hz, hy, by rw [add_comm]; exact hyz, ?_⟩ + rw [hw]; simp only [c] + rw [← hyz, map_add_val f y z, map_add_val g y z]; abel + have hinf : (f ⊓ g) x = c - (f ⊔ g) x := by + have h : (f ⊓ g : OrderBoundedHom X Y) = f + g - (f ⊔ g) := + eq_sub_of_add_eq' ((add_comm _ _).trans (inf_add_sup f g)) + rw [h, sub_apply, add_apply'] + rw [hinf] + have hLUB : IsLUB S ((f ⊔ g) x) := isLUB_sup_apply hx + exact ⟨fun _ hw => sub_le_comm.mp (hLUB.1 (hsym _ hw)), + fun _ hb => le_sub_comm.mpr + (hLUB.2 fun _ hw => le_sub_comm.mp (hb (hsym _ hw)))⟩ + +omit [VectorLattice X] in +lemma nonneg_of_disjoint_add_eq {y z x : X} + (hx : 0 ≤ x) (hdisj : IsVLDisjoint y z) (hsum : y + z = x) : + 0 ≤ y ∧ 0 ≤ z := by + have habs : |y| + |z| = x := by + calc + |y| + |z| = |y + z| := (abs_add_of_isVLDisjoint hdisj).symm + _ = x := by rw [hsum, abs_of_nonneg hx] + rw [← hsum] at habs + have hsub : (|y| - y) + (|z| - z) = 0 := by + calc + (|y| - y) + (|z| - z) = (|y| + |z|) - (y + z) := by abel + _ = 0 := by rw [habs, sub_self] + have hy' : 0 ≤ |y| - y := sub_nonneg.mpr (le_abs_self y) + have hz' : 0 ≤ |z| - z := sub_nonneg.mpr (le_abs_self z) + have hy0 : |y| - y = 0 := by + apply le_antisymm + · calc + |y| - y ≤ (|y| - y) + (|z| - z) := le_add_of_nonneg_right hz' + _ = 0 := hsub + · exact hy' + have hz0 : |z| - z = 0 := by + rw [hy0, zero_add] at hsub + exact hsub + constructor + · rw [(sub_eq_zero.mp hy0).symm] + exact abs_nonneg y + · rw [(sub_eq_zero.mp hz0).symm] + exact abs_nonneg z + +lemma isGLB_inf_apply_disjoint_zero + [HasPrincipalProjectionProperty X] + {f g : OrderBoundedHom X Y} {x : X} (hx : 0 ≤ x) + (hfg0 : f ⊓ g = 0) : + IsGLB + {w | ∃ y z, IsVLDisjoint y z ∧ y + z = x + ∧ w = f y + g z} + 0 := by + let S : Set Y := {w | ∃ y z, 0 ≤ y ∧ 0 ≤ z ∧ y + z = x ∧ w = f y + g z} + let D : Set Y := {w | ∃ y z, IsVLDisjoint y z ∧ y + z = x ∧ w = f y + g z} + have hf0 : (0 : OrderBoundedHom X Y) ≤ f := by + simpa [hfg0] using (inf_le_left : f ⊓ g ≤ f) + have hg0 : (0 : OrderBoundedHom X Y) ≤ g := by + simpa [hfg0] using (inf_le_right : f ⊓ g ≤ g) + have hS : IsGLB S 0 := by + simpa only [S, hfg0, zero_apply] using (isGLB_inf_apply (f := f) (g := g) hx) + refine ⟨?_, ?_⟩ + · intro w hw + rcases hw with ⟨y, z, hdisj, hyz, rfl⟩ + obtain ⟨hy, hz⟩ := nonneg_of_disjoint_add_eq hx hdisj hyz + exact add_nonneg (le_iff.mp hf0 y hy) (le_iff.mp hg0 z hz) + · intro b hb + have hhalf_lb : (1 / 2 : ℝ) • b ∈ lowerBounds S := by + intro w hw + rcases hw with ⟨y, z, hy, hz, hyz, rfl⟩ + obtain ⟨u, v, huv, hu, hv, hu_le, hv_le, huvsum⟩ := + exists_disjoint_add_eq_add_of_hasPrincipalProjectionProperty hy hz + have hbuv : b ≤ f u + g v := + hb ⟨u, v, huv, huvsum.trans hyz, rfl⟩ + have hfu : f u ≤ (2 : ℕ) • f y := by + have hmono : Monotone f.toLinearMap := + Positive.monotone_iff.mpr (show Positive f.toLinearMap from le_iff.mp hf0) + calc + f u ≤ f ((2 : ℕ) • y) := hmono hu_le + _ = (2 : ℕ) • f y := by + change f.toLinearMap ((2 : ℕ) • y) = (2 : ℕ) • f.toLinearMap y + rw [map_nsmul] + have hgv : g v ≤ (2 : ℕ) • g z := by + have hmono : Monotone g.toLinearMap := + Positive.monotone_iff.mpr (show Positive g.toLinearMap from le_iff.mp hg0) + calc + g v ≤ g ((2 : ℕ) • z) := hmono hv_le + _ = (2 : ℕ) • g z := by + change g.toLinearMap ((2 : ℕ) • z) = (2 : ℕ) • g.toLinearMap z + rw [map_nsmul] + calc + (1 / 2 : ℝ) • b ≤ (1 / 2 : ℝ) • (f u + g v) := + smul_le_smul_of_nonneg_left hbuv (by positivity) + _ ≤ (1 / 2 : ℝ) • ((2 : ℕ) • f y + (2 : ℕ) • g z) := + smul_le_smul_of_nonneg_left (add_le_add hfu hgv) (by positivity) + _ = ((1 / 2 : ℝ) + (1 / 2 : ℝ)) • f y + + (((1 / 2 : ℝ) + (1 / 2 : ℝ)) : ℝ) • g z := by + rw [two_nsmul, two_nsmul, smul_add, smul_add, smul_add, ← add_smul, ← add_smul] + _ = (1 : ℝ) • f y + (1 : ℝ) • g z := by + rw [show ((1 / 2 : ℝ) + (1 / 2 : ℝ)) = 1 by norm_num] + _ = f y + g z := by simp + have hhalf_le : (1 / 2 : ℝ) • b ≤ 0 := hS.2 hhalf_lb + have htwo : + (2 : ℝ) • ((1 / 2 : ℝ) • b) ≤ (2 : ℝ) • (0 : Y) := + smul_le_smul_of_nonneg_left hhalf_le (show (0 : ℝ) ≤ 2 by positivity) + simpa using htwo + +lemma isGLB_inf_apply_disjoint_aux + [HasPrincipalProjectionProperty X] + {f g : OrderBoundedHom X Y} {x : X} (hx : 0 ≤ x) : + IsGLB + {w | ∃ y z, IsVLDisjoint y z ∧ y + z = x + ∧ w = f y + g z} + ((f ⊓ g) x) := by + let h : OrderBoundedHom X Y := f ⊓ g + let f' : OrderBoundedHom X Y := f - h + let g' : OrderBoundedHom X Y := g - h + let D' : Set Y := {w | ∃ y z, IsVLDisjoint y z ∧ y + z = x ∧ w = f' y + g' z} + have hf'0 : (0 : OrderBoundedHom X Y) ≤ f' := by + refine le_iff.mpr ?_ + intro y hy + dsimp [f', h] + rw [sub_apply] + exact sub_nonneg.mpr (le_iff.mp inf_le_left y hy) + have hg'0 : (0 : OrderBoundedHom X Y) ≤ g' := by + refine le_iff.mpr ?_ + intro y hy + dsimp [g', h] + rw [sub_apply] + exact sub_nonneg.mpr (le_iff.mp inf_le_right y hy) + have hdisj' : IsVLDisjoint f' g' := by + dsimp [f', g', h] + exact isVLDisjoint_sub_inf f g + have hfg'0 : f' ⊓ g' = 0 := + inf_eq_zero_of_isVLDisjoint hf'0 hg'0 hdisj' + have hD' : IsGLB D' 0 := + isGLB_inf_apply_disjoint_zero (f := f') (g := g') hx hfg'0 + have hset : + ((fun w => h x + w) '' D') = + {w | ∃ y z, IsVLDisjoint y z ∧ y + z = x + ∧ w = f y + g z} := by + ext w + constructor + · rintro ⟨w', ⟨y, z, hdisj, hyz, hw'⟩, rfl⟩ + refine ⟨y, z, hdisj, hyz, ?_⟩ + rw [hw'] + dsimp [f', g', h] + rw [sub_apply, sub_apply, ← hyz, map_add_val (f ⊓ g) y z] + abel + · rintro ⟨y, z, hdisj, hyz, rfl⟩ + refine ⟨f' y + g' z, ⟨y, z, hdisj, hyz, rfl⟩, ?_⟩ + dsimp [f', g', h] + rw [sub_apply, sub_apply, ← hyz, map_add_val (f ⊓ g) y z] + abel + rw [← hset] + simpa [h] using isGLB_const_add (h x) hD' + +/-- **Disjoint Riesz-Kantorovich formula for the supremum.** If `X` has the +Principal Projection Property, then for `x ≥ 0` the value `(f ⊔ g) x` is the +supremum of `f y + g z` over all disjoint decompositions `x = y + z`. -/ +theorem isLUB_sup_apply_disjoint [HasPrincipalProjectionProperty X] + {f g : OrderBoundedHom X Y} {x : X} (hx : 0 ≤ x) : + IsLUB + {w | ∃ y z, IsVLDisjoint y z ∧ y + z = x + ∧ w = f y + g z} + ((f ⊔ g) x) := by + have hneg : + IsGLB + {w | ∃ y z, IsVLDisjoint y z ∧ y + z = x + ∧ w = (-f) y + (-g) z} + (((-f) ⊓ (-g)) x) := + isGLB_inf_apply_disjoint_aux (f := -f) (g := -g) hx + have hval : (((-f) ⊓ (-g)) x) = -((f ⊔ g) x) := by + rw [show ((-f) ⊓ (-g) : OrderBoundedHom X Y) = -(f ⊔ g) by rw [neg_sup], neg_apply'] + refine ⟨?_, ?_⟩ + · rintro w ⟨y, z, hdisj, hyz, rfl⟩ + have hw : + - (f y + g z) ∈ + {w | ∃ y z, IsVLDisjoint y z ∧ y + z = x + ∧ w = (-f) y + (-g) z} := by + refine ⟨y, z, hdisj, hyz, ?_⟩ + rw [neg_apply', neg_apply'] + abel + have hle := hneg.1 hw + rw [hval] at hle + exact neg_le_neg_iff.mp hle + · intro u hu + have hulb : + -u ∈ lowerBounds + {w | ∃ y z, IsVLDisjoint y z ∧ y + z = x + ∧ w = (-f) y + (-g) z} := by + rintro _ ⟨y, z, hdisj, hyz, rfl⟩ + have hle : f y + g z ≤ u := hu ⟨y, z, hdisj, hyz, rfl⟩ + simpa [neg_apply', neg_add, add_comm, add_left_comm, add_assoc] + using (neg_le_neg hle) + have hle := hneg.2 hulb + rw [hval] at hle + exact neg_le_neg_iff.mp hle + +/-- **Disjoint Riesz-Kantorovich formula for the infimum.** If `X` has the +Principal Projection Property, then for `x ≥ 0` the value `(f ⊓ g) x` is the +infimum of `f y + g z` over all disjoint decompositions `x = y + z`. -/ +theorem isGLB_inf_apply_disjoint [HasPrincipalProjectionProperty X] + {f g : OrderBoundedHom X Y} {x : X} (hx : 0 ≤ x) : + IsGLB + {w | ∃ y z, IsVLDisjoint y z ∧ y + z = x + ∧ w = f y + g z} + ((f ⊓ g) x) := by + exact isGLB_inf_apply_disjoint_aux hx + +/-- The modulus at a positive element. -/ +theorem isLUB_abs_apply + {f : OrderBoundedHom X Y} {x : X} (hx : 0 ≤ x) : + IsLUB {w | ∃ y, |y| ≤ x ∧ w = |f y|} + (|f| x) := by + have habs_val : |f| x = f⁺ x + f⁻ x := by + have h : (|f| : OrderBoundedHom X Y) = f⁺ + f⁻ := + (posPart_add_negPart f).symm + rw [h]; exact add_apply' f⁺ f⁻ x + constructor + · -- Upper bound: |f y| ≤ |f| x for |y| ≤ x + intro w ⟨y, hyx, hw⟩ + rw [hw, habs_val] + have hPP := isLUB_posPart_apply (f := f) hx + have hNP := isLUB_negPart_apply (f := f) hx + have hpos_le : y⁺ ≤ x := + (sup_le (le_abs_self y) (abs_nonneg y)).trans hyx + have hneg_le : y⁻ ≤ x := + (sup_le (neg_le_abs y) (abs_nonneg y)).trans hyx + have hfy : f y = f y⁺ - f y⁻ := by + rw [← map_sub_val]; congr 1; exact (posPart_sub_negPart y).symm + have hfyle : f y ≤ f⁺ x + f⁻ x := by + rw [hfy, sub_eq_add_neg] + exact add_le_add + (hPP.1 ⟨y⁺, posPart_nonneg y, hpos_le, rfl⟩) + (hNP.1 ⟨y⁻, negPart_nonneg y, hneg_le, rfl⟩) + have hnfyle : -(f y) ≤ f⁺ x + f⁻ x := by + rw [hfy, neg_sub, sub_eq_add_neg] + exact add_le_add + (hPP.1 ⟨y⁻, negPart_nonneg y, hneg_le, rfl⟩) + (hNP.1 ⟨y⁺, posPart_nonneg y, hpos_le, rfl⟩) + exact sup_le hfyle hnfyle + · -- LUB: any upper bound u of B satisfies |f| x ≤ u + intro u hu + change (f ⊔ (-f : OrderBoundedHom X Y)) x ≤ u + have hLUB : IsLUB _ ((f ⊔ (-f : OrderBoundedHom X Y)) x) := + isLUB_sup_apply hx + exact hLUB.2 fun w ⟨a, b, ha, hb, hab, hw⟩ => by + have habsle : |a - b| ≤ x := + sup_le + ((sub_le_self a hb).trans (hab ▸ le_add_of_nonneg_right hb)) + ((neg_sub a b ▸ (sub_le_self b ha).trans + (hab ▸ le_add_of_nonneg_left ha))) + have hweq : w = f (a - b) := by + rw [hw, neg_apply', map_sub_val]; abel + rw [hweq] + exact (le_abs_self _).trans (hu ⟨a - b, habsle, rfl⟩) + +/-! ### Dual Riesz-Kantorovich formulas + +The **dual** Riesz-Kantorovich formulas are companions to those above: instead +of computing the lattice operations of varying operators at a fixed positive +element of `X`, they fix a positive operator `f : X → Y` and describe `f` +applied to a lattice expression in `X` (`x⁺`, `x ⊔ y`, `|x|`, ...) as a +supremum or infimum taken over the order interval `[0, f]` of operators +dominated by `f`. +-/ + +/-! #### Witness operator construction + +For a positive operator `f` and a positive element `x₀`, we build an operator +`wit f x₀` with `0 ≤ wit f x₀ ≤ f`, equal to `f` at `x₀`, and vanishing on +elements disjoint from `x₀`. Concretely we set +`wit f x₀ y = sup_n f (y ⊓ n • x₀)` on the positive cone and extend linearly. -/ + + +lemma f_mono_of_nonneg {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) : Monotone f.toLinearMap := + Positive.monotone_iff.mpr fun y hy => by + have := le_iff.mp hf y hy + simpa only [zero_apply, toLinearMap_apply] using this + + +lemma f_apply_nonneg {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {y : X} (hy : 0 ≤ y) : 0 ≤ f y := by + have := le_iff.mp hf y hy + simpa only [zero_apply] using this + +/-- The value of the witness operator on the positive cone: +`witFun f x₀ y = sup_n f (y ⊓ n • x₀)`. Defaults to `0` outside the regime where +the supremum exists. -/ +noncomputable def witFun (f : OrderBoundedHom X Y) (x₀ y : X) : Y := + sSup (Set.range fun n : ℕ => f (y ⊓ n • x₀)) + +lemma witFun_isLUB {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ y : X} + (_hx₀ : 0 ≤ x₀) (_hy : 0 ≤ y) : + IsLUB (Set.range fun n : ℕ => f (y ⊓ n • x₀)) (witFun f x₀ y) := by + refine isLUB_csSup ⟨_, 0, rfl⟩ ⟨f y, ?_⟩ + rintro _ ⟨n, rfl⟩ + exact f_mono_of_nonneg hf inf_le_left + +lemma witFun_le_f {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ y : X} + (hx₀ : 0 ≤ x₀) (hy : 0 ≤ y) : witFun f x₀ y ≤ f y := by + apply (witFun_isLUB hf hx₀ hy).2 + rintro _ ⟨n, rfl⟩ + exact f_mono_of_nonneg hf inf_le_left + +lemma witFun_nonneg {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ y : X} + (hx₀ : 0 ≤ x₀) (hy : 0 ≤ y) : 0 ≤ witFun f x₀ y := by + refine (witFun_isLUB hf hx₀ hy).1 ⟨0, ?_⟩ + change f (y ⊓ (0 : ℕ) • x₀) = 0 + rw [zero_nsmul, inf_of_le_right hy] + exact map_zero f.toLinearMap + +lemma witFun_eq_at {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ : X} (hx₀ : 0 ≤ x₀) : + witFun f x₀ x₀ = f x₀ := by + refine le_antisymm (witFun_le_f hf hx₀ hx₀) ?_ + refine (witFun_isLUB hf hx₀ hx₀).1 ⟨1, ?_⟩ + change f (x₀ ⊓ (1 : ℕ) • x₀) = f x₀ + rw [one_nsmul, inf_idem] + +lemma witFun_zero_of_disjoint {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ y : X} + (hx₀ : 0 ≤ x₀) (hy : 0 ≤ y) (hd : y ⊓ x₀ = 0) : + witFun f x₀ y = 0 := by + have hyn : ∀ n : ℕ, y ⊓ n • x₀ = 0 := by + intro n + induction n with + | zero => rw [zero_nsmul, inf_of_le_right hy] + | succ n ih => + have hle : y ⊓ (n + 1) • x₀ ≤ y ⊓ (n • x₀) + y ⊓ x₀ := by + rw [succ_nsmul] + exact inf_le_inf_add_inf_of_nonneg y (n • x₀) x₀ hy + (nsmul_nonneg hx₀ n) hx₀ + rw [ih, hd, add_zero] at hle + exact le_antisymm hle (le_inf hy (nsmul_nonneg hx₀ (n + 1))) + refine le_antisymm ?_ (witFun_nonneg hf hx₀ hy) + apply (witFun_isLUB hf hx₀ hy).2 + rintro _ ⟨n, rfl⟩ + change f (y ⊓ n • x₀) ≤ 0 + rw [hyn n] + exact (map_zero f.toLinearMap).le + +lemma witFun_add {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ y₁ y₂ : X} + (hx₀ : 0 ≤ x₀) (hy₁ : 0 ≤ y₁) (hy₂ : 0 ≤ y₂) : + witFun f x₀ (y₁ + y₂) = witFun f x₀ y₁ + witFun f x₀ y₂ := by + refine le_antisymm ?_ ?_ + · apply (witFun_isLUB hf hx₀ (add_nonneg hy₁ hy₂)).2 + rintro _ ⟨n, rfl⟩ + have hznn : 0 ≤ (y₁ + y₂) ⊓ n • x₀ := + le_inf (add_nonneg hy₁ hy₂) (nsmul_nonneg hx₀ n) + have hzy : (y₁ + y₂) ⊓ n • x₀ ≤ y₁ + y₂ := inf_le_left + obtain ⟨z₁, z₂, hz₁nn, hz₁y₁, hz₂nn, hz₂y₂, hzeq⟩ := + riesz_decomposition (x := (y₁ + y₂) ⊓ n • x₀) y₁ y₂ hznn hy₁ hy₂ hzy + have hz_le : (y₁ + y₂) ⊓ n • x₀ ≤ n • x₀ := inf_le_right + have hz₁_nx : z₁ ≤ n • x₀ := + ((le_add_of_nonneg_right hz₂nn).trans hzeq.symm.le).trans hz_le + have hz₂_nx : z₂ ≤ n • x₀ := + ((le_add_of_nonneg_left hz₁nn).trans hzeq.symm.le).trans hz_le + have hz₁_inf : z₁ ≤ y₁ ⊓ n • x₀ := le_inf hz₁y₁ hz₁_nx + have hz₂_inf : z₂ ≤ y₂ ⊓ n • x₀ := le_inf hz₂y₂ hz₂_nx + calc f ((y₁ + y₂) ⊓ n • x₀) + = f (z₁ + z₂) := by rw [hzeq] + _ = f z₁ + f z₂ := map_add f.toLinearMap z₁ z₂ + _ ≤ f (y₁ ⊓ n • x₀) + f (y₂ ⊓ n • x₀) := + add_le_add (f_mono_of_nonneg hf hz₁_inf) (f_mono_of_nonneg hf hz₂_inf) + _ ≤ witFun f x₀ y₁ + witFun f x₀ y₂ := + add_le_add ((witFun_isLUB hf hx₀ hy₁).1 ⟨n, rfl⟩) + ((witFun_isLUB hf hx₀ hy₂).1 ⟨n, rfl⟩) + · have step1 : ∀ n m : ℕ, + f (y₁ ⊓ n • x₀) + f (y₂ ⊓ m • x₀) ≤ witFun f x₀ (y₁ + y₂) := by + intro n m + have hsum : (y₁ ⊓ n • x₀) + (y₂ ⊓ m • x₀) ≤ (y₁ + y₂) ⊓ ((n + m) • x₀) := by + refine le_inf (add_le_add inf_le_left inf_le_left) ?_ + rw [add_nsmul]; exact add_le_add inf_le_right inf_le_right + calc f (y₁ ⊓ n • x₀) + f (y₂ ⊓ m • x₀) + = f ((y₁ ⊓ n • x₀) + (y₂ ⊓ m • x₀)) := + (map_add f.toLinearMap _ _).symm + _ ≤ f ((y₁ + y₂) ⊓ (n + m) • x₀) := f_mono_of_nonneg hf hsum + _ ≤ witFun f x₀ (y₁ + y₂) := + (witFun_isLUB hf hx₀ (add_nonneg hy₁ hy₂)).1 ⟨n + m, rfl⟩ + have step2 : ∀ m : ℕ, + witFun f x₀ y₁ + f (y₂ ⊓ m • x₀) ≤ witFun f x₀ (y₁ + y₂) := by + intro m + have hub : witFun f x₀ (y₁ + y₂) - f (y₂ ⊓ m • x₀) ∈ + upperBounds (Set.range fun n : ℕ => f (y₁ ⊓ n • x₀)) := by + rintro _ ⟨n, rfl⟩ + exact le_sub_iff_add_le.mpr (step1 n m) + exact le_sub_iff_add_le.mp ((witFun_isLUB hf hx₀ hy₁).2 hub) + have hub : witFun f x₀ (y₁ + y₂) - witFun f x₀ y₁ ∈ + upperBounds (Set.range fun n : ℕ => f (y₂ ⊓ n • x₀)) := by + rintro _ ⟨m, rfl⟩ + rw [le_sub_iff_add_le, add_comm]; exact step2 m + have h := (witFun_isLUB hf hx₀ hy₂).2 hub + have h2 := le_sub_iff_add_le.mp h + rwa [add_comm] at h2 + +/-- The witness linear map for `f` and `x₀ ≥ 0`. -/ +noncomputable def witLin {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ : X} (hx₀ : 0 ≤ x₀) : + X →ₗ[ℝ] Y := by + haveI : IsVLArchimedean Y := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + exact Positive.extension + (fun y hy => witFun_nonneg hf hx₀ hy) + (fun y₁ y₂ hy₁ hy₂ => witFun_add hf hx₀ hy₁ hy₂) + +lemma witLin_apply_nonneg {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ y : X} + (hx₀ : 0 ≤ x₀) (hy : 0 ≤ y) : witLin hf hx₀ y = witFun f x₀ y := by + have : IsVLArchimedean Y := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + exact Positive.extension_nonneg _ _ hy + +lemma witLin_positive {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ : X} (hx₀ : 0 ≤ x₀) : + Positive (witLin hf hx₀) := by + have : IsVLArchimedean Y := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + exact Positive.extension_positive _ _ + +/-- The witness operator as an `OrderBoundedHom`. -/ +noncomputable def witOp {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ : X} (hx₀ : 0 ≤ x₀) : + OrderBoundedHom X Y := + ⟨witLin hf hx₀, Positive.isOrderBounded (witLin_positive hf hx₀)⟩ + +lemma witOp_apply {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ : X} (hx₀ : 0 ≤ x₀) (y : X) : + witOp hf hx₀ y = witLin hf hx₀ y := rfl + +lemma witOp_nonneg {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ : X} (hx₀ : 0 ≤ x₀) : + (0 : OrderBoundedHom X Y) ≤ witOp hf hx₀ := + le_iff.mpr fun y hy => by + have h := witLin_positive hf hx₀ y hy + change (0 : Y) ≤ witLin hf hx₀ y at h + simpa only [zero_apply, witOp_apply] using h + +lemma witOp_le_f {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ : X} (hx₀ : 0 ≤ x₀) : + witOp hf hx₀ ≤ f := + le_iff.mpr fun y hy => by + change witLin hf hx₀ y ≤ f y + rw [witLin_apply_nonneg hf hx₀ hy] + exact witFun_le_f hf hx₀ hy + +lemma witOp_apply_self {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ : X} (hx₀ : 0 ≤ x₀) : + witOp hf hx₀ x₀ = f x₀ := by + change witLin hf hx₀ x₀ = f x₀ + rw [witLin_apply_nonneg hf hx₀ hx₀, witFun_eq_at hf hx₀] + +lemma witOp_apply_disjoint {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) {x₀ y : X} (hx₀ : 0 ≤ x₀) + (hy : 0 ≤ y) (hd : y ⊓ x₀ = 0) : witOp hf hx₀ y = 0 := by + change witLin hf hx₀ y = 0 + rw [witLin_apply_nonneg hf hx₀ hy, witFun_zero_of_disjoint hf hx₀ hy hd] + +/-- The witness operator at `x = x⁺ - x⁻` recovers `f x⁺`. -/ +lemma witOp_apply_eq_posPart {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) (x : X) : + witOp hf (posPart_nonneg x) x = f x⁺ := by + have hlin : (witOp hf (posPart_nonneg x)).toLinearMap x = + (witOp hf (posPart_nonneg x)).toLinearMap x⁺ - + (witOp hf (posPart_nonneg x)).toLinearMap x⁻ := by + rw [← map_sub, posPart_sub_negPart] + change (witOp hf (posPart_nonneg x)).toLinearMap x = f x⁺ + rw [hlin] + have h1 : (witOp hf (posPart_nonneg x)).toLinearMap x⁺ = f x⁺ := + witOp_apply_self hf (posPart_nonneg x) + have h2 : (witOp hf (posPart_nonneg x)).toLinearMap x⁻ = 0 := by + apply witOp_apply_disjoint hf (posPart_nonneg x) (negPart_nonneg x) + rw [inf_comm]; exact posPart_inf_negPart_eq_zero x + rw [h1, h2, sub_zero] + +/-! #### Dual Riesz–Kantorovich theorems -/ + +/-- **Dual Riesz-Kantorovich for the positive part.** For a positive order +bounded operator `f : X → Y` and an arbitrary `x : X`, the value `f x⁺` is the +supremum of `g x` taken over all order bounded operators `g` with `0 ≤ g ≤ f`. +-/ +theorem isLUB_apply_posPart {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) (x : X) : + IsLUB {w | ∃ g : OrderBoundedHom X Y, 0 ≤ g ∧ g ≤ f ∧ w = g x} + (f x⁺) := by + refine ⟨?_, ?_⟩ + · rintro _ ⟨g, hg0, hgf, rfl⟩ + have hg_neg : 0 ≤ g x⁻ := f_apply_nonneg hg0 (negPart_nonneg x) + have key : g x = g x⁺ - g x⁻ := by + change g.toLinearMap x = g.toLinearMap x⁺ - g.toLinearMap x⁻ + rw [← map_sub, posPart_sub_negPart] + rw [key] + exact (sub_le_self _ hg_neg).trans (le_iff.mp hgf x⁺ (posPart_nonneg x)) + · intro u hu + have hwit_in : + witOp hf (posPart_nonneg x) x ∈ + {w | ∃ g : OrderBoundedHom X Y, 0 ≤ g ∧ g ≤ f ∧ w = g x} := + ⟨witOp hf (posPart_nonneg x), witOp_nonneg hf (posPart_nonneg x), + witOp_le_f hf (posPart_nonneg x), rfl⟩ + have hub := hu hwit_in + rwa [witOp_apply_eq_posPart hf x] at hub + +/-- **Dual Riesz-Kantorovich for the negative part.** For a positive order +bounded operator `f` and `x : X`, `f x⁻ = sup {-(g x) | 0 ≤ g ≤ f}`. -/ +theorem isLUB_apply_negPart {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) (x : X) : + IsLUB {w | ∃ g : OrderBoundedHom X Y, 0 ≤ g ∧ g ≤ f ∧ w = -(g x)} + (f x⁻) := by + have hpp := isLUB_apply_posPart hf (-x) + rw [posPart_neg] at hpp + have hgneg : ∀ g : OrderBoundedHom X Y, g (-x) = -(g x) := fun g => by + change g.toLinearMap (-x) = -(g.toLinearMap x); rw [map_neg] + refine ⟨?_, ?_⟩ + · rintro _ ⟨g, hg0, hgf, rfl⟩ + have hmem : g (-x) ∈ + {w | ∃ g : OrderBoundedHom X Y, 0 ≤ g ∧ g ≤ f ∧ w = g (-x)} := + ⟨g, hg0, hgf, rfl⟩ + have h1 := hpp.1 hmem + rw [hgneg] at h1; exact h1 + · intro u hu + apply hpp.2 + rintro _ ⟨g, hg0, hgf, rfl⟩ + have hin : -(g x) ∈ + {w | ∃ g : OrderBoundedHom X Y, 0 ≤ g ∧ g ≤ f ∧ w = -(g x)} := + ⟨g, hg0, hgf, rfl⟩ + have h1 := hu hin + rw [hgneg]; exact h1 + +/-- **Dual Riesz-Kantorovich for the supremum.** For a positive order bounded +operator `f` and `x y : X`, +`f (x ⊔ y) = sup {g x + (f - g) y | 0 ≤ g ≤ f}`. -/ +theorem isLUB_apply_sup {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) (x y : X) : + IsLUB {w | ∃ g : OrderBoundedHom X Y, + 0 ≤ g ∧ g ≤ f ∧ w = g x + (f - g) y} + (f (x ⊔ y)) := by + -- Use x ⊔ y = y + (x - y)⁺ + have hxy : (x ⊔ y) = y + (x - y)⁺ := by + rw [posPart_def, add_sup, add_sub_cancel, add_zero, sup_comm] + have hfxy : f (x ⊔ y) = f y + f ((x - y)⁺) := by + rw [hxy]; exact map_add_val f y _ + rw [hfxy] + refine ⟨?_, ?_⟩ + · rintro _ ⟨g, hg0, hgf, rfl⟩ + have hgxy : g x + (f - g) y = f y + g (x - y) := by + rw [sub_apply, map_sub_val g]; abel + rw [hgxy] + have hgneg : 0 ≤ g (x - y)⁻ := f_apply_nonneg hg0 (negPart_nonneg _) + have hgsplit : g (x - y) = g (x - y)⁺ - g (x - y)⁻ := by + change g.toLinearMap (x - y) = g.toLinearMap (x - y)⁺ - g.toLinearMap (x - y)⁻ + rw [← map_sub, posPart_sub_negPart] + have h1 : g (x - y) ≤ g (x - y)⁺ := by rw [hgsplit]; exact sub_le_self _ hgneg + have h2 : g (x - y)⁺ ≤ f (x - y)⁺ := le_iff.mp hgf _ (posPart_nonneg _) + exact add_le_add (le_refl (f y)) (h1.trans h2) + · intro u hu + set g := witOp hf (posPart_nonneg (x - y)) with hgdef + have hg0 : (0 : OrderBoundedHom X Y) ≤ g := witOp_nonneg hf _ + have hgf : g ≤ f := witOp_le_f hf _ + have hgxy : g (x - y) = f (x - y)⁺ := witOp_apply_eq_posPart hf (x - y) + have hin : g x + (f - g) y ∈ + {w | ∃ g : OrderBoundedHom X Y, 0 ≤ g ∧ g ≤ f ∧ w = g x + (f - g) y} := + ⟨g, hg0, hgf, rfl⟩ + have hub := hu hin + have hcalc : g x + (f - g) y = f y + f (x - y)⁺ := by + have h0 : g x + (f - g) y = f y + g (x - y) := by + rw [sub_apply, map_sub_val g]; abel + rw [h0, hgxy] + rw [hcalc] at hub; exact hub + +/-- **Dual Riesz-Kantorovich for the infimum.** For a positive order bounded +operator `f` and `x y : X`, +`f (x ⊓ y) = inf {g x + (f - g) y | 0 ≤ g ≤ f}`. -/ +theorem isGLB_apply_inf {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) (x y : X) : + IsGLB {w | ∃ g : OrderBoundedHom X Y, + 0 ≤ g ∧ g ≤ f ∧ w = g x + (f - g) y} + (f (x ⊓ y)) := by + simpa only [Set.neg_ofPred, map_neg_value, ← neg_inf, ← neg_add, neg_neg, neg_inj] using + (isLUB_apply_sup hf (-x) (-y)).neg + +lemma sum_apply_finset {ι : Type*} (s : Finset ι) + (g : ι → OrderBoundedHom X Y) (x : X) : + (∑ i ∈ s, g i) x = ∑ i ∈ s, g i x := by + induction s using Finset.cons_induction with + | empty => + change (0 : X →ₗ[ℝ] Y) x = 0 + simp + | cons a s ha ih => + rw [Finset.sum_cons, Finset.sum_cons, add_apply', ih] + +/-- **Dual Riesz-Kantorovich for finite suprema.** For a positive order bounded +operator `f` and a non-empty finite family `x`, `f` applied to the supremum of +the family is the supremum of the sums `∑ i ∈ s, g i (x i)`, where the positive +operators `g i` form a finite decomposition of `f`. -/ +theorem isLUB_apply_finset_sup {ι : Type*} {s : Finset ι} (hs : s.Nonempty) + {f : OrderBoundedHom X Y} (hf : (0 : OrderBoundedHom X Y) ≤ f) (x : ι → X) : + IsLUB {w | ∃ g : ι → OrderBoundedHom X Y, + (∀ i ∈ s, (0 : OrderBoundedHom X Y) ≤ g i) ∧ + (∑ i ∈ s, g i = f) ∧ + w = ∑ i ∈ s, g i (x i)} + (f (s.sup' hs x)) := by + classical + revert f x + induction hs using Finset.Nonempty.cons_induction with + | singleton a => + intro f hf x + refine ⟨?_, ?_⟩ + · rintro _ ⟨g, _hg0, hgsum, rfl⟩ + exact le_of_eq (by + simpa using congrArg (fun h : OrderBoundedHom X Y => h (x a)) hgsum) + · intro u hu + exact hu ⟨fun _ => f, by simpa using hf, by simp, by simp⟩ + | cons a t ha ht ih => + intro f hf x + refine ⟨?_, ?_⟩ + · rintro _ ⟨g, hg0, hgsum, rfl⟩ + let x₀ := (Finset.cons a t ha).sup' (Finset.cons_nonempty ha) x + calc + (∑ i ∈ Finset.cons a t ha, g i (x i)) ≤ + ∑ i ∈ Finset.cons a t ha, g i x₀ := by + refine Finset.sum_le_sum fun i hi => ?_ + exact f_mono_of_nonneg (hg0 i hi) (Finset.le_sup' (f := x) hi) + _ = f x₀ := by rw [← sum_apply_finset, hgsum] + · intro u hu + rw [Finset.sup'_cons ht x] + have hsup := isLUB_apply_sup hf (x a) (t.sup' ht x) + apply hsup.2 + rintro _ ⟨g, hg0, hgf, rfl⟩ + have hrest := ih (f := f - g) (sub_nonneg.mpr hgf) x + have hle : (f - g) (t.sup' ht x) ≤ u - g (x a) := by + apply hrest.2 + rintro _ ⟨k, hk0, hksum, rfl⟩ + rw [le_sub_iff_add_le] + let G : ι → OrderBoundedHom X Y := fun i => if i = a then g else k i + have hG0 : ∀ i ∈ Finset.cons a t ha, (0 : OrderBoundedHom X Y) ≤ G i := by + intro i hi + rcases Finset.mem_cons.mp hi with rfl | hit + · simp [G, hg0] + · have hia : i ≠ a := fun h => ha (h ▸ hit) + simp [G, hia, hk0 i hit] + have hGsum : ∑ i ∈ Finset.cons a t ha, G i = f := by + rw [Finset.sum_cons] + have hsum_t : ∑ i ∈ t, G i = f - g := by + rw [← hksum] + refine Finset.sum_congr rfl fun i hit => ?_ + have hia : i ≠ a := fun h => ha (h ▸ hit) + simp [G, hia] + rw [hsum_t] + rw [show G a = g by simp [G]] + abel + have hfull : (∑ i ∈ Finset.cons a t ha, G i (x i)) ≤ u := + hu ⟨G, hG0, hGsum, rfl⟩ + rw [Finset.sum_cons] at hfull + have hsum_t : ∑ i ∈ t, G i (x i) = ∑ i ∈ t, k i (x i) := by + refine Finset.sum_congr rfl fun i hit => ?_ + have hia : i ≠ a := fun h => ha (h ▸ hit) + simp [G, hia] + rw [hsum_t] at hfull + simpa [G, add_comm] using hfull + have := le_sub_iff_add_le.mp hle + rwa [add_comm] at this + +/-- **Dual Riesz-Kantorovich for finite infima.** For a positive order bounded +operator `f` and a non-empty finite family `x`, `f` applied to the infimum of +the family is the infimum of the sums `∑ i ∈ s, g i (x i)`, where the positive +operators `g i` form a finite decomposition of `f`. -/ +theorem isGLB_apply_finset_inf {ι : Type*} {s : Finset ι} (hs : s.Nonempty) + {f : OrderBoundedHom X Y} (hf : (0 : OrderBoundedHom X Y) ≤ f) (x : ι → X) : + IsGLB {w | ∃ g : ι → OrderBoundedHom X Y, + (∀ i ∈ s, (0 : OrderBoundedHom X Y) ≤ g i) ∧ + (∑ i ∈ s, g i = f) ∧ + w = ∑ i ∈ s, g i (x i)} + (f (s.inf' hs x)) := by + have hsup : s.sup' hs (fun i => -x i) = -(s.inf' hs x) := + (map_finset_inf' (OrderIso.neg X) hs x).symm + simpa only [Set.neg_ofPred, map_neg_value, hsup, Finset.sum_neg_distrib, neg_neg, neg_inj] using + (isLUB_apply_finset_sup hs hf (fun i => -x i)).neg + +/-- **Dual Riesz-Kantorovich for the modulus.** For a positive order bounded +operator `f` and `x : X`, +`f |x| = sup {g x - (f - g) x | 0 ≤ g ≤ f}`. -/ +theorem isLUB_apply_abs {f : OrderBoundedHom X Y} + (hf : (0 : OrderBoundedHom X Y) ≤ f) (x : X) : + IsLUB {w | ∃ g : OrderBoundedHom X Y, + 0 ≤ g ∧ g ≤ f ∧ w = g x - (f - g) x} + (f |x|) := by + -- |x| = x⁺ + x⁻ and g x - (f - g) x = 2 g x - f x. Reduce to posPart formula. + have habs : |x| = x⁺ + x⁻ := (posPart_add_negPart x).symm + -- Note: x = x⁺ - x⁻, so f x = f x⁺ - f x⁻, and 2 f x⁺ - f x = f x⁺ + f x⁻ = f |x|. + have hfabs : f |x| = 2 • f x⁺ - f x := by + rw [habs, map_add_val] + have : f x = f x⁺ - f x⁻ := by rw [← map_sub_val, posPart_sub_negPart] + rw [this]; abel + rw [hfabs] + have hpp := isLUB_apply_posPart hf x + refine ⟨?_, ?_⟩ + · rintro _ ⟨g, hg0, hgf, rfl⟩ + have heq : g x - (f - g) x = 2 • g x - f x := by + rw [sub_apply, two_smul]; abel + rw [heq] + have hgx : g x ≤ f x⁺ := hpp.1 ⟨g, hg0, hgf, rfl⟩ + have h2 : 2 • g x ≤ 2 • f x⁺ := by + rw [two_smul, two_smul]; exact add_le_add hgx hgx + exact sub_le_sub_right h2 _ + · intro u hu + set g := witOp hf (posPart_nonneg x) with hgdef + have hg0 : (0 : OrderBoundedHom X Y) ≤ g := witOp_nonneg hf _ + have hgf : g ≤ f := witOp_le_f hf _ + have hgx : g x = f x⁺ := witOp_apply_eq_posPart hf x + have hin : g x - (f - g) x ∈ + {w | ∃ g : OrderBoundedHom X Y, 0 ≤ g ∧ g ≤ f ∧ w = g x - (f - g) x} := + ⟨g, hg0, hgf, rfl⟩ + have hub := hu hin + have heq : g x - (f - g) x = 2 • f x⁺ - f x := by + rw [sub_apply, hgx, two_smul]; abel + rw [heq] at hub; exact hub + +/-- The supremum of a non-empty upward-directed bounded above set of order +bounded operators exists and is computed pointwise on the positive cone: +its value at any positive `x` is the supremum of `{g x | g ∈ S}`. -/ +theorem isLUB_of_directedOn + {S : Set (OrderBoundedHom X Y)} (hne : S.Nonempty) + (hdir : DirectedOn (· ≤ ·) S) (hbdd : BddAbove S) : + ∃ f : OrderBoundedHom X Y, IsLUB S f ∧ + ∀ {x : X}, 0 ≤ x → + IsLUB ((fun g : OrderBoundedHom X Y => g x) '' S) (f x) := by + classical + have : IsVLArchimedean Y := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + obtain ⟨g₀, hg₀⟩ := hne + obtain ⟨h, hh⟩ := hbdd + have aux : ∀ {x : X}, 0 ≤ x → + ∃ s : Y, IsLUB ((fun g : OrderBoundedHom X Y => g x - g₀ x) '' S) s := by + intro x hx + refine ⟨_, isLUB_csSup ⟨0, g₀, hg₀, sub_self _⟩ ⟨h x - g₀ x, ?_⟩⟩ + rintro _ ⟨g, hg, rfl⟩ + exact sub_le_sub_right (le_iff.mp (hh hg) x hx) _ + let σ : X → Y := fun x => if hx : 0 ≤ x then (aux hx).choose else 0 + have σ_isLUB : ∀ {x : X} (hx : 0 ≤ x), + IsLUB ((fun g : OrderBoundedHom X Y => g x - g₀ x) '' S) (σ x) := by + intro x hx + change IsLUB _ (if hx : 0 ≤ x then (aux hx).choose else 0) + rw [dite_eq_left hx] + exact (aux hx).choose_spec + have σ_nn : ∀ x, 0 ≤ x → 0 ≤ σ x := fun x hx => by + have h1 := (σ_isLUB hx).1 ⟨g₀, hg₀, sub_self _⟩ + simpa using h1 + have σ_add : ∀ x y, 0 ≤ x → 0 ≤ y → σ (x + y) = σ x + σ y := by + intro x y hx hy + refine le_antisymm ?_ ?_ + · apply (σ_isLUB (add_nonneg hx hy)).2 + rintro _ ⟨g, hg, rfl⟩ + change g (x + y) - g₀ (x + y) ≤ σ x + σ y + have hgxy : g (x + y) - g₀ (x + y) = (g x - g₀ x) + (g y - g₀ y) := by + rw [map_add_val g, map_add_val g₀]; abel + rw [hgxy] + exact add_le_add ((σ_isLUB hx).1 ⟨g, hg, rfl⟩) + ((σ_isLUB hy).1 ⟨g, hg, rfl⟩) + · have step1 : ∀ w₁ ∈ ((fun g : OrderBoundedHom X Y => g x - g₀ x) '' S), + ∀ w₂ ∈ ((fun g : OrderBoundedHom X Y => g y - g₀ y) '' S), + w₁ + w₂ ≤ σ (x + y) := by + rintro _ ⟨g₁, hg₁, rfl⟩ _ ⟨g₂, hg₂, rfl⟩ + obtain ⟨g, hg, hg₁g, hg₂g⟩ := hdir g₁ hg₁ g₂ hg₂ + have h1 : g₁ x - g₀ x ≤ g x - g₀ x := + sub_le_sub_right (le_iff.mp hg₁g x hx) _ + have h2 : g₂ y - g₀ y ≤ g y - g₀ y := + sub_le_sub_right (le_iff.mp hg₂g y hy) _ + have h3 : (g x - g₀ x) + (g y - g₀ y) = g (x + y) - g₀ (x + y) := by + rw [map_add_val g, map_add_val g₀]; abel + calc g₁ x - g₀ x + (g₂ y - g₀ y) + ≤ (g x - g₀ x) + (g y - g₀ y) := add_le_add h1 h2 + _ = g (x + y) - g₀ (x + y) := h3 + _ ≤ σ (x + y) := + (σ_isLUB (add_nonneg hx hy)).1 ⟨g, hg, rfl⟩ + have step2 : ∀ w₂ ∈ ((fun g : OrderBoundedHom X Y => g y - g₀ y) '' S), + σ x + w₂ ≤ σ (x + y) := by + intro w₂ hw₂ + have hub : σ (x + y) - w₂ ∈ upperBounds + ((fun g : OrderBoundedHom X Y => g x - g₀ x) '' S) := + fun w₁ hw₁ => le_sub_iff_add_le.mpr (step1 w₁ hw₁ w₂ hw₂) + exact le_sub_iff_add_le.mp ((σ_isLUB hx).2 hub) + have hub2 : σ (x + y) - σ x ∈ upperBounds + ((fun g : OrderBoundedHom X Y => g y - g₀ y) '' S) := by + intro w₂ hw₂ + rw [le_sub_iff_add_le, add_comm] + exact step2 w₂ hw₂ + have h3 := (σ_isLUB hy).2 hub2 + have := le_sub_iff_add_le.mp h3 + rwa [add_comm] at this + let T : X →ₗ[ℝ] Y := Positive.extension σ_nn σ_add + have hT_pos : Positive T := Positive.extension_positive σ_nn σ_add + have hT_apply : ∀ {x : X}, 0 ≤ x → T x = σ x := + fun {x} hx => Positive.extension_nonneg σ_nn σ_add hx + let Tob : OrderBoundedHom X Y := ⟨T, hT_pos.isOrderBounded⟩ + refine ⟨Tob + g₀, ?_, ?_⟩ + · refine ⟨fun g hg => le_iff.mpr fun x hx => ?_, + fun k hk => le_iff.mpr fun x hx => ?_⟩ + · rw [add_apply'] + change g x ≤ T x + g₀ x + rw [hT_apply hx] + have : g x - g₀ x ≤ σ x := (σ_isLUB hx).1 ⟨g, hg, rfl⟩ + exact sub_le_iff_le_add.mp this + · rw [add_apply'] + change T x + g₀ x ≤ k x + rw [hT_apply hx] + have hub : k x - g₀ x ∈ upperBounds + ((fun g : OrderBoundedHom X Y => g x - g₀ x) '' S) := by + rintro _ ⟨g, hg, rfl⟩ + exact sub_le_sub_right (le_iff.mp (hk hg) x hx) _ + have h1 := (σ_isLUB hx).2 hub + exact le_sub_iff_add_le.mp h1 + · intro x hx + refine ⟨?_, ?_⟩ + · rintro _ ⟨g, hg, rfl⟩ + rw [add_apply'] + change g x ≤ T x + g₀ x + rw [hT_apply hx] + have : g x - g₀ x ≤ σ x := (σ_isLUB hx).1 ⟨g, hg, rfl⟩ + exact sub_le_iff_le_add.mp this + · intro u hu + rw [add_apply'] + change T x + g₀ x ≤ u + rw [hT_apply hx] + have hub : u - g₀ x ∈ upperBounds + ((fun g : OrderBoundedHom X Y => g x - g₀ x) '' S) := by + rintro _ ⟨g, hg, rfl⟩ + exact sub_le_sub_right (hu ⟨g, hg, rfl⟩) _ + have h1 := (σ_isLUB hx).2 hub + exact le_sub_iff_add_le.mp h1 + +/-- When the codomain is order complete, every non-empty bounded above set +of order bounded operators admits a least upper bound. -/ +theorem exists_isLUB + {S : Set (OrderBoundedHom X Y)} (hne : S.Nonempty) (hbdd : BddAbove S) : + ∃ f : OrderBoundedHom X Y, IsLUB S f := by + classical + let S' : Set (OrderBoundedHom X Y) := + {f | ∃ F : Finset (OrderBoundedHom X Y), ∃ hF : F.Nonempty, + ↑F ⊆ S ∧ f = F.sup' hF id} + have hS'_ne : S'.Nonempty := by + obtain ⟨g, hg⟩ := hne + refine ⟨g, {g}, Finset.singleton_nonempty g, ?_, ?_⟩ + · simpa using hg + · simp + have hS'_bdd : BddAbove S' := by + obtain ⟨h, hh⟩ := hbdd + refine ⟨h, ?_⟩ + rintro _ ⟨F, hF, hFS, rfl⟩ + exact Finset.sup'_le hF id (fun g hgF => hh (hFS hgF)) + have hS'_dir : DirectedOn (· ≤ ·) S' := by + rintro _ ⟨F₁, hF₁, hF₁S, rfl⟩ _ ⟨F₂, hF₂, hF₂S, rfl⟩ + have hU : (F₁ ∪ F₂).Nonempty := hF₁.mono Finset.subset_union_left + refine ⟨(F₁ ∪ F₂).sup' hU id, ⟨F₁ ∪ F₂, hU, ?_, rfl⟩, ?_, ?_⟩ + · intro g hg + rcases Finset.mem_union.mp hg with h | h + · exact hF₁S h + · exact hF₂S h + · exact Finset.sup'_le hF₁ id (fun g hg => + Finset.le_sup' id (Finset.mem_union_left _ hg)) + · exact Finset.sup'_le hF₂ id (fun g hg => + Finset.le_sup' id (Finset.mem_union_right _ hg)) + obtain ⟨f, hLUB, _⟩ := isLUB_of_directedOn hS'_ne hS'_dir hS'_bdd + refine ⟨f, ?_, ?_⟩ + · intro g hg + exact hLUB.1 ⟨{g}, Finset.singleton_nonempty g, + by simpa using hg, by simp⟩ + · intro k hk + apply hLUB.2 + rintro _ ⟨F, hF, hFS, rfl⟩ + exact Finset.sup'_le hF id (fun g hgF => hk (hFS hgF)) + +/-- The Riesz-Kantorovich conditional completeness structure on order bounded +operators. This packages `OrderBoundedHom.exists_isLUB`; files can opt into it +locally as a typeclass instance. -/ +@[reducible] +noncomputable def conditionallyCompleteLattice : + ConditionallyCompleteLattice (OrderBoundedHom X Y) := by + classical + letI : SupSet (OrderBoundedHom X Y) := + ⟨fun S => if h : S.Nonempty ∧ BddAbove S then (exists_isLUB h.1 h.2).choose else 0⟩ + have hsSup : ∀ (S : Set (OrderBoundedHom X Y)), BddAbove S → S.Nonempty → + IsLUB S (sSup S) := by + intro S hbdd hne + change IsLUB S + (if h : S.Nonempty ∧ BddAbove S then (exists_isLUB h.1 h.2).choose else 0) + rw [dite_eq_left ⟨hne, hbdd⟩] + exact (exists_isLUB hne hbdd).choose_spec + exact conditionallyCompleteLatticeOfLatticeOfsSup _ hsSup + +end OrderBoundedHom + +/-- When the codomain is order complete, every order bounded operator +is regular. -/ +theorem IsOrderBounded.isRegularOp + {X Y : Type*} [AddCommGroup X] [AddCommGroup Y] + [Lattice X] [ConditionallyCompleteLattice Y] + [IsOrderedAddMonoid X] [IsOrderedAddMonoid Y] + [VectorLattice X] [VectorLattice Y] + {f : X →ₗ[ℝ] Y} (hf : IsOrderBounded f) : + IsRegularOp f := by + let F : OrderBoundedHom X Y := ⟨f, hf⟩ + refine ⟨F⁺.toLinearMap, F⁻.toLinearMap, ?_, ?_, ?_⟩ + · intro x hx + change (0 : Y) ≤ F⁺ x + have h := OrderBoundedHom.le_iff.mp (posPart_nonneg F) x hx + change (0 : Y) ≤ F⁺ x at h + exact h + · intro x hx + change (0 : Y) ≤ F⁻ x + have h := OrderBoundedHom.le_iff.mp (negPart_nonneg F) x hx + change (0 : Y) ≤ F⁻ x at h + exact h + · exact (congrArg OrderBoundedHom.toLinearMap (posPart_sub_negPart F)).symm diff --git a/LeanPool/FBLOrderContinuity/BanLat/OrderDense.lean b/LeanPool/FBLOrderContinuity/BanLat/OrderDense.lean new file mode 100644 index 0000000000..d551912278 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/OrderDense.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Substructures.Sublattice + + + +/-! +# Order dense subsets of a vector lattice + +A subset `s` of a vector lattice `X` is **order dense** when every strictly +positive element of `X` dominates a strictly positive element of `s`. -/ + +@[expose] public section + +/-- A subset `s` of a preordered type with a `0` is **order dense** if every +strictly positive element dominates some strictly positive element of `s`. -/ +def IsOrderDense {X : Type*} [Zero X] [Preorder X] (s : Set X) : Prop := + ∀ ⦃x : X⦄, 0 < x → ∃ y ∈ s, 0 < y ∧ y ≤ x + +namespace IsOrderDense + +variable {X : Type*} [Zero X] [Preorder X] + +/-- The whole space is order dense. -/ +theorem univ : IsOrderDense (Set.univ : Set X) := + fun _ hx => ⟨_, Set.mem_univ _, hx, le_rfl⟩ + +/-- Order density is monotone in the underlying set. -/ +theorem mono {s t : Set X} (hst : s ⊆ t) (hs : IsOrderDense s) : + IsOrderDense t := fun _ hx => + let ⟨y, hy, hy_pos, hy_le⟩ := hs hx + ⟨y, hst hy, hy_pos, hy_le⟩ + +end IsOrderDense + +/-- A vector sublattice is **order dense** when its underlying set is. -/ +abbrev VectorSublattice.IsOrderDense {X : Type*} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] (Y : VectorSublattice X) : Prop := + _root_.IsOrderDense (Y : Set X) diff --git a/LeanPool/FBLOrderContinuity/BanLat/Pi.lean b/LeanPool/FBLOrderContinuity/BanLat/Pi.lean new file mode 100644 index 0000000000..091f955d12 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Pi.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +public import LeanPool.OrderClosures.BanLat.Pi +public import Mathlib.Analysis.Normed.Lp.PiLp + +/-! +# Products of vector, normed and Banach lattices + +Given a family `(X i)` of vector lattices, the product `∀ i, X i` carries a +pointwise vector lattice structure. When each `X i` is a normed (resp. Banach) +lattice and the index set is finite, the ℓ^p product `PiLp p X` is again a +normed (resp. Banach) lattice for `1 ≤ p ≤ ∞`. Moreover, the ℓ^∞ product of +AM-spaces is an AM-space, and the ℓ^1 product of AL-spaces is an AL-space. +-/ + +@[expose] public section + +open scoped ENNReal + +/-! ### ℓ^p product + +For a finite index set `ι` and `1 ≤ p ≤ ∞`, the ℓ^p product of normed vector +lattices is again a normed vector lattice, and Banachness is preserved. The +order structure is pointwise; only the norm depends on `p`. +-/ + +namespace PiLp + +variable {ι : Type*} [Fintype ι] {p : ℝ≥0∞} [Fact (1 ≤ p)] {X : ι → Type*} + +section Order + +variable [∀ i, NormedAddCommGroup (X i)] [∀ i, Lattice (X i)] + [∀ i, IsOrderedAddMonoid (X i)] + +/-- Pointwise `≤` on `PiLp p X`. -/ +instance instLE : LE (PiLp p X) where + le x y := ∀ i, x i ≤ y i + +/-- Pointwise `<` on `PiLp p X`. -/ +instance instLT : LT (PiLp p X) where + lt x y := WithLp.ofLp x < WithLp.ofLp y + +/-- Pointwise `⊔` on `PiLp p X`. -/ +instance instMax : Max (PiLp p X) where + max x y := WithLp.toLp p (fun i => x i ⊔ y i) + +/-- Pointwise `⊓` on `PiLp p X`. -/ +instance instMin : Min (PiLp p X) where + min x y := WithLp.toLp p (fun i => x i ⊓ y i) + +/-- Pointwise lattice structure on `PiLp p X`. -/ +instance instLattice : Lattice (PiLp p X) := + Function.Injective.lattice (β := ∀ i, X i) WithLp.ofLp (WithLp.ofLp_injective p) + Iff.rfl Iff.rfl (fun _ _ => rfl) (fun _ _ => rfl) + +/-- The order on `PiLp p X` is compatible with addition. -/ +instance instIsOrderedAddMonoid : IsOrderedAddMonoid (PiLp p X) := + Function.Injective.isOrderedAddMonoid (β := PiLp p X) (α := ∀ i, X i) + WithLp.ofLp (fun _ _ => rfl) Iff.rfl + +/-- The ℓ^p norm is solid: `|x| ≤ |y|` implies `‖x‖ ≤ ‖y‖`. -/ +instance instHasSolidNorm [∀ i, HasSolidNorm (X i)] : HasSolidNorm (PiLp p X) where + solid := fun x y h => by + -- pointwise bound on norms via the solid norm of each factor + have hpt : ∀ i, ‖x i‖ ≤ ‖y i‖ := fun i => + HasSolidNorm.solid (α := X i) (h i) + rcases eq_or_ne p ∞ with hp | hp + · subst hp + simp only [PiLp.norm_eq_ciSup] + exact ciSup_mono (Set.Finite.bddAbove (Set.finite_range _)) hpt + · have h1 : (1 : ℝ≥0∞) ≤ p := Fact.out + have hpos : 0 < p.toReal := by + have := ENNReal.toReal_lt_toReal (by norm_num) hp |>.mpr + (lt_of_lt_of_le (by norm_num : (0 : ℝ≥0∞) < 1) h1) + simpa using this + simp only [PiLp.norm_eq_sum hpos] + gcongr with i + exact hpt i + +end Order + +/-! #### Vector and Banach lattice structure -/ + +variable [∀ i, NormedAddCommGroup (X i)] [∀ i, Lattice (X i)] + [∀ i, IsOrderedAddMonoid (X i)] + +instance instPosSMulMono [∀ i, NormedVectorLattice (X i)] : + PosSMulMono ℝ (PiLp p X) where + smul_le_smul_of_nonneg_left := by + intro a ha b₁ b₂ hb i + exact smul_le_smul_of_nonneg_left (hb i) ha + +/-- The ℓ^p product of normed vector lattices is a vector lattice. -/ +instance instVectorLattice [∀ i, NormedVectorLattice (X i)] : + VectorLattice (PiLp p X) := ⟨⟩ + +/-- The ℓ^p product of normed vector lattices is a normed vector lattice. -/ +instance instNormedVectorLattice [∀ i, NormedVectorLattice (X i)] : + NormedVectorLattice (PiLp p X) where + +/-- The ℓ^p product of Banach lattices is a Banach lattice. -/ +instance instBanachLattice [∀ i, BanachLattice (X i)] : + BanachLattice (PiLp p X) where + +end PiLp diff --git a/LeanPool/FBLOrderContinuity/BanLat/Quotient.lean b/LeanPool/FBLOrderContinuity/BanLat/Quotient.lean new file mode 100644 index 0000000000..76cc51ec0e --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Quotient.lean @@ -0,0 +1,611 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Substructures.Ideal +public import LeanPool.OrderClosures.BanLat.Operators.Hom +public import Mathlib.Analysis.Normed.Group.Quotient +public import Mathlib.LinearAlgebra.Quotient.Defs +public import Mathlib.LinearAlgebra.Quotient.Basic + + + +/-! +# Quotients of vector and Banach lattices + +The quotient of a vector lattice `X` by an order ideal `J` carries a natural +vector lattice structure for which the canonical projection is a lattice +homomorphism. When `X` is a normed vector lattice and `J` is norm-closed, +the quotient norm is a lattice norm; completeness passes to the quotient. +-/ + +@[expose] public section + +section -- Algebraic quotient + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +namespace OrderIdeal + +/-! ### Kernel characterisation -/ + +/-- The kernel of a vector lattice homomorphism is an order ideal. -/ +noncomputable def ofKerVecLatHom {Y : Type*} [AddCommGroup Y] + [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + (T : VecLatHom X Y) : OrderIdeal X := + OrderIdeal.ofSolid (LinearMap.ker T.toLinearMap) fun x y hx hle => by + rw [LinearMap.mem_ker] at hx ⊢ + have hTx : (T : X → Y) x = 0 := hx + have hab : |T y| ≤ |T x| := by + rw [← VecLatHom.map_abs, ← VecLatHom.map_abs] + exact T.monotone hle + rw [hTx, abs_zero] at hab + have := (abs_eq_zero_iff_zero (T y)).mp (le_antisymm hab (abs_nonneg _)) + exact this + +/-- The underlying submodule of `ofKerVecLatHom T` is `ker T`. -/ +theorem ofKerVecLatHom_toSubmodule {Y : Type*} + [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] + [VectorLattice Y] (T : VecLatHom X Y) : + (ofKerVecLatHom T).toSubmodule = + LinearMap.ker T.toLinearMap := rfl + +variable (J : OrderIdeal X) + +/-! ### Lattice structure on the quotient -/ + +theorem sup_sub_mem (J : OrderIdeal X) {a₁ a₂ b₁ b₂ : X} + (h₁ : a₁ - b₁ ∈ J.toSubmodule) (h₂ : a₂ - b₂ ∈ J.toSubmodule) : + (a₁ ⊔ a₂) - (b₁ ⊔ b₂) ∈ J.toSubmodule := by + have key : (a₁ ⊔ a₂) - (b₁ ⊔ b₂) = + ((a₁ ⊔ a₂) - (b₁ ⊔ a₂)) + ((b₁ ⊔ a₂) - (b₁ ⊔ b₂)) := by abel + rw [key] + apply J.toSubmodule.add_mem + · exact J.mem_of_abs_le_abs h₁ + (abs_sup_sub_sup_le_abs a₁ b₁ a₂) + · exact J.mem_of_abs_le_abs h₂ (by + rw [sup_comm b₁ a₂, sup_comm b₁ b₂] + exact abs_sup_sub_sup_le_abs a₂ b₂ b₁) + +theorem inf_sub_mem (J : OrderIdeal X) {a₁ a₂ b₁ b₂ : X} + (h₁ : a₁ - b₁ ∈ J.toSubmodule) (h₂ : a₂ - b₂ ∈ J.toSubmodule) : + (a₁ ⊓ a₂) - (b₁ ⊓ b₂) ∈ J.toSubmodule := by + have h₁' : -a₁ - (-b₁) ∈ J.toSubmodule := by + rw [show -a₁ - (-b₁) = -(a₁ - b₁) from by abel] + exact J.toSubmodule.neg_mem h₁ + have h₂' : -a₂ - (-b₂) ∈ J.toSubmodule := by + rw [show -a₂ - (-b₂) = -(a₂ - b₂) from by abel] + exact J.toSubmodule.neg_mem h₂ + have key : a₁ ⊓ a₂ - (b₁ ⊓ b₂) = + -((-a₁ ⊔ -a₂) - (-b₁ ⊔ -b₂)) := by + have := neg_inf a₁ a₂; have := neg_inf b₁ b₂ + rw [show a₁ ⊓ a₂ = -(-a₁ ⊔ -a₂) from by rw [← neg_inf]; simp, + show b₁ ⊓ b₂ = -(-b₁ ⊔ -b₂) from by rw [← neg_inf]; simp] + abel + rw [key] + exact J.toSubmodule.neg_mem (sup_sub_mem J h₁' h₂') + +/-- Supremum on the quotient by an order ideal, computed on representatives. -/ +noncomputable def quotSup (J : OrderIdeal X) : + X ⧸ J.toSubmodule → X ⧸ J.toSubmodule → X ⧸ J.toSubmodule := + fun a b => Quotient.liftOn₂' a b + (fun x y => (Submodule.Quotient.mk (x ⊔ y) : X ⧸ J.toSubmodule)) + (fun a₁ a₂ b₁ b₂ h₁ h₂ => by + rw [Submodule.Quotient.eq] + rw [Submodule.quotientRel_def] at h₁ h₂ + exact sup_sub_mem J h₁ h₂) + +/-- Infimum on the quotient by an order ideal, computed on representatives. -/ +noncomputable def quotInf (J : OrderIdeal X) : + X ⧸ J.toSubmodule → X ⧸ J.toSubmodule → X ⧸ J.toSubmodule := + fun a b => Quotient.liftOn₂' a b + (fun x y => (Submodule.Quotient.mk (x ⊓ y) : X ⧸ J.toSubmodule)) + (fun a₁ a₂ b₁ b₂ h₁ h₂ => by + rw [Submodule.Quotient.eq] + rw [Submodule.quotientRel_def] at h₁ h₂ + exact inf_sub_mem J h₁ h₂) + +theorem quotSup_mk (J : OrderIdeal X) (x y : X) : + quotSup J (Submodule.Quotient.mk x) (Submodule.Quotient.mk y) = + Submodule.Quotient.mk (x ⊔ y) := rfl + +theorem quotInf_mk (J : OrderIdeal X) (x y : X) : + quotInf J (Submodule.Quotient.mk x) (Submodule.Quotient.mk y) = + Submodule.Quotient.mk (x ⊓ y) := rfl + +/-- The quotient of a vector lattice by an order ideal is a lattice, +with `Q(x) ⊔ Q(y) = Q(x ⊔ y)`. -/ +noncomputable instance instQuotientLattice : + Lattice (X ⧸ J.toSubmodule) := by + letI : Max (X ⧸ J.toSubmodule) := ⟨quotSup J⟩ + letI : Min (X ⧸ J.toSubmodule) := ⟨quotInf J⟩ + exact Lattice.mk' + (fun a b => by + induction a, b using Quotient.inductionOn₂' + exact congr_arg Submodule.Quotient.mk (sup_comm _ _)) + (fun a b c => by + induction a, b, c using Quotient.inductionOn₃' + exact congr_arg Submodule.Quotient.mk (sup_assoc _ _ _)) + (fun a b => by + induction a, b using Quotient.inductionOn₂' + exact congr_arg Submodule.Quotient.mk (inf_comm _ _)) + (fun a b c => by + induction a, b, c using Quotient.inductionOn₃' + exact congr_arg Submodule.Quotient.mk (inf_assoc _ _ _)) + (fun a b => by + induction a, b using Quotient.inductionOn₂' + exact congr_arg Submodule.Quotient.mk sup_inf_self) + (fun a b => by + induction a, b using Quotient.inductionOn₂' + exact congr_arg Submodule.Quotient.mk inf_sup_self) + +/-- `a ≤ b` in the quotient lattice iff `a ⊔ b = b`. -/ +theorem quot_le_iff {a b : X ⧸ J.toSubmodule} : + a ≤ b ↔ a ⊔ b = b := + Iff.rfl + + +/-- The quotient order is compatible with addition. -/ +instance instQuotientIsOrderedAddMonoid : + IsOrderedAddMonoid (X ⧸ J.toSubmodule) where + add_le_add_left := fun a b hab c => by + rw [quot_le_iff] at hab ⊢ + induction a, b, c using Quotient.inductionOn₃' + rename_i x y z + change Quotient.mk'' (x ⊔ y) = Quotient.mk'' y at hab + change Quotient.mk'' ((x + z) ⊔ (y + z)) = + Quotient.mk'' (y + z) + rw [show (x + z) ⊔ (y + z) = (x ⊔ y) + z from + (sup_add x y z).symm] + have hmem : (x ⊔ y) - y ∈ J.toSubmodule := + (Submodule.Quotient.eq J.toSubmodule).mp hab + exact (Submodule.Quotient.eq J.toSubmodule).mpr + (by convert hmem using 1; abel) + +/-- The quotient of a vector lattice by an order ideal is a vector +lattice. The `Module ℝ` structure is inherited from Mathlib's quotient +module. -/ +noncomputable instance instQuotientVectorLattice : + VectorLattice (X ⧸ J.toSubmodule) := + { (inferInstance : Module ℝ (X ⧸ J.toSubmodule)) with + smul_le_smul_of_nonneg_left := fun c hc a b hab => by + rw [quot_le_iff] at hab ⊢ + induction a, b using Quotient.inductionOn₂' + rename_i x y + change Quotient.mk'' (x ⊔ y) = Quotient.mk'' y at hab + change Quotient.mk'' ((c • x) ⊔ (c • y)) = + Quotient.mk'' (c • y) + rw [show (c • x) ⊔ (c • y) = c • (x ⊔ y) from + (nonneg_smul_sup x y c hc).symm] + have hmem : (x ⊔ y) - y ∈ J.toSubmodule := + (Submodule.Quotient.eq J.toSubmodule).mp hab + exact (Submodule.Quotient.eq J.toSubmodule).mpr + (by rw [show c • (x ⊔ y) - c • y = c • ((x ⊔ y) - y) + from (smul_sub c _ _).symm] + exact J.toSubmodule.smul_mem c hmem) } + +/-! ### The quotient map as a lattice homomorphism -/ + +/-- Abbreviation for the canonical linear quotient map. -/ +abbrev mkQ : X →ₗ[ℝ] X ⧸ J.toSubmodule := + Submodule.mkQ J.toSubmodule + +/-- The quotient map preserves suprema. -/ +theorem mkQ_sup (x y : X) : + J.mkQ (x ⊔ y) = J.mkQ x ⊔ J.mkQ y := rfl + +/-- The quotient map preserves infima. -/ +theorem mkQ_inf (x y : X) : + J.mkQ (x ⊓ y) = J.mkQ x ⊓ J.mkQ y := rfl + +/-- The quotient map preserves absolute values. -/ +theorem mkQ_abs (x : X) : + J.mkQ |x| = |J.mkQ x| := by + simp only [abs, J.mkQ_sup, map_neg] + +/-- The quotient map as a vector lattice homomorphism. -/ +noncomputable def mkQVecLatHom : + VecLatHom X (X ⧸ J.toSubmodule) := + { J.mkQ with + map_sup' := fun x y => J.mkQ_sup x y + map_inf' := fun x y => J.mkQ_inf x y } + +/-- `mkQVecLatHom` agrees with the canonical linear quotient map. -/ +@[simp] +theorem mkQVecLatHom_apply (x : X) : + J.mkQVecLatHom x = J.mkQ x := rfl + +/-! ### Lifting properties -/ + +/-- Every positive element in the quotient has a positive +representative. -/ +theorem lift_pos {φ : X ⧸ J.toSubmodule} (hφ : 0 ≤ φ) : + ∃ x : X, 0 ≤ x ∧ J.mkQ x = φ := by + obtain ⟨a, rfl⟩ := Submodule.Quotient.mk_surjective J.toSubmodule φ + refine ⟨a⁺, posPart_nonneg a, ?_⟩ + change J.mkQ a⁺ = J.mkQ a + calc J.mkQ a⁺ = J.mkQ (a ⊔ 0) := rfl + _ = J.mkQ a ⊔ J.mkQ 0 := J.mkQ_sup a 0 + _ = J.mkQ a ⊔ 0 := by rw [map_zero] + _ = J.mkQ a := sup_eq_left.mpr hφ + +/-- If `φ ≤ ψ` in the quotient, any representative of `φ` can be +dominated by a representative of `ψ`. -/ +theorem lift_le {φ ψ : X ⧸ J.toSubmodule} (h : φ ≤ ψ) + (x : X) (hx : J.mkQ x = φ) : + ∃ y : X, J.mkQ y = ψ ∧ x ≤ y := by + obtain ⟨b, rfl⟩ := Submodule.Quotient.mk_surjective J.toSubmodule ψ + refine ⟨x ⊔ b, ?_, le_sup_left⟩ + change J.mkQ (x ⊔ b) = J.mkQ b + rw [J.mkQ_sup, hx] + exact sup_eq_right.mpr h + +/-- If `x ≤ z` in `X` and `Q(x) ≤ φ ≤ Q(z)`, there exists `y ∈ φ` +with `x ≤ y ≤ z`. -/ +theorem lift_between {x z : X} (hxz : x ≤ z) + {φ : X ⧸ J.toSubmodule} + (hx : J.mkQ x ≤ φ) (hz : φ ≤ J.mkQ z) : + ∃ y : X, J.mkQ y = φ ∧ x ≤ y ∧ y ≤ z := by + obtain ⟨a, rfl⟩ := Submodule.Quotient.mk_surjective J.toSubmodule φ + refine ⟨(x ⊔ a) ⊓ z, ?_, le_inf le_sup_left hxz, inf_le_right⟩ + change J.mkQ ((x ⊔ a) ⊓ z) = J.mkQ a + rw [J.mkQ_inf, J.mkQ_sup] + have h1 : J.mkQ x ⊔ J.mkQ a = J.mkQ a := sup_eq_right.mpr + (by simpa only [Submodule.mkQ_apply] using hx) + have h2 : J.mkQ a ⊓ J.mkQ z = J.mkQ a := inf_eq_left.mpr + (by simpa only [Submodule.mkQ_apply] using hz) + rw [h1, h2] + +/-- If `0 ≤ y` and `Q(y) = |φ|`, there exists `x ∈ φ` with +`|x| ≤ y`. -/ +theorem lift_abs_le {φ : X ⧸ J.toSubmodule} {y : X} + (hy : 0 ≤ y) (habs : J.mkQ y = |φ|) : + ∃ x : X, J.mkQ x = φ ∧ |x| ≤ y := by + obtain ⟨a, rfl⟩ := Submodule.Quotient.mk_surjective J.toSubmodule φ + have habs' : J.mkQ y = |J.mkQ a| := habs + rw [← J.mkQ_abs] at habs' + have ha_le : J.mkQ a ≤ J.mkQ y := by + calc J.mkQ a ≤ |J.mkQ a| := le_abs_self _ + _ = J.mkQ |a| := (J.mkQ_abs a).symm + _ = J.mkQ y := habs'.symm + have hle_a : J.mkQ (-y) ≤ J.mkQ a := by + rw [map_neg] + calc -J.mkQ y = -(J.mkQ |a|) := by rw [habs'] + _ = J.mkQ (-|a|) := (map_neg J.mkQ |a|).symm + _ ≤ J.mkQ a := by + apply J.mkQVecLatHom.monotone + calc -|a| = (-a) ⊓ a := by + rw [abs, neg_sup, neg_neg, inf_comm] + _ ≤ a := inf_le_right + obtain ⟨x, hx_eq, hx_ge, hx_le⟩ := + J.lift_between (neg_le_self hy) hle_a ha_le + refine ⟨x, hx_eq, ?_⟩ + rw [abs]; exact sup_le hx_le (neg_le.mp hx_ge) + +/-- An increasing positive sequence in the quotient can be lifted to +an increasing positive sequence of representatives. -/ +theorem lift_increasing_seq + (φ : ℕ → X ⧸ J.toSubmodule) + (hpos : ∀ n, 0 ≤ φ n) (hmono : Monotone φ) : + ∃ f : ℕ → X, + (∀ n, J.mkQ (f n) = φ n) ∧ + (∀ n, 0 ≤ f n) ∧ Monotone f := by + -- Build the sequence by dependent choice: each step lifts and + -- dominates the previous element. + -- Step function: given xₙ with mkQ xₙ = φ n and 0 ≤ xₙ, + -- produce x_{n+1} with mkQ x_{n+1} = φ (n+1) and xₙ ≤ x_{n+1}. + have step : ∀ n (x : X), 0 ≤ x → J.mkQ x = φ n → + ∃ y : X, 0 ≤ y ∧ J.mkQ y = φ (n + 1) ∧ x ≤ y := by + intro n x hnn heq + obtain ⟨y, hy_eq, hxy⟩ := J.lift_le (hmono (Nat.le_succ n)) x heq + exact ⟨y, le_trans hnn hxy, hy_eq, hxy⟩ + -- Base case + obtain ⟨x₀, hx₀_nn, hx₀_eq⟩ := J.lift_pos (hpos 0) + -- Build the sequence as ℕ → {x : X // 0 ≤ x ∧ J.mkQ x = φ n} + -- using Nat.rec + let F : (n : ℕ) → {x : X // 0 ≤ x ∧ J.mkQ x = φ n} := + fun n => Nat.rec + ⟨x₀, hx₀_nn, hx₀_eq⟩ + (fun k (prev : {x : X // 0 ≤ x ∧ J.mkQ x = φ k}) => + ⟨(step k prev.1 prev.2.1 prev.2.2).choose, + (step k prev.1 prev.2.1 prev.2.2).choose_spec.1, + (step k prev.1 prev.2.1 prev.2.2).choose_spec.2.1⟩) + n + refine ⟨fun n => (F n).1, fun n => (F n).2.2, fun n => (F n).2.1, ?_⟩ + apply monotone_nat_of_le_succ + intro n + exact (step n (F n).1 (F n).2.1 (F n).2.2).choose_spec.2.2 + +/-! ### Factoring operators through the quotient -/ + +/-- A positive operator whose kernel contains `J` factors through +the quotient as a positive operator. -/ +theorem liftQ_positive {Y : Type*} [AddCommGroup Y] + [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + (T : X →ₗ[ℝ] Y) + (hker : J.toSubmodule ≤ LinearMap.ker T) + (hpos : Positive T) : + Positive (Submodule.liftQ J.toSubmodule T hker) := by + intro φ hφ + obtain ⟨x, hx_nn, hx_eq⟩ := J.lift_pos hφ + rw [← hx_eq] + change 0 ≤ T x + exact hpos x hx_nn + +/-- A vector lattice homomorphism whose kernel contains `J` factors +through the quotient as a vector lattice homomorphism. -/ +noncomputable def liftQVecLatHom {Y : Type*} + [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] + [VectorLattice Y] (T : VecLatHom X Y) + (hker : J.toSubmodule ≤ LinearMap.ker T.toLinearMap) : + VecLatHom (X ⧸ J.toSubmodule) Y := + { Submodule.liftQ J.toSubmodule T.toLinearMap hker with + map_sup' := fun a b => by + induction a, b using Quotient.inductionOn₂' + change Submodule.liftQ J.toSubmodule T.toLinearMap hker + (J.mkQ (_ ⊔ _)) = _ + rw [J.mkQ_sup] + change T (_ ⊔ _) = T _ ⊔ T _ + exact T.map_sup' _ _ + map_inf' := fun a b => by + induction a, b using Quotient.inductionOn₂' + change Submodule.liftQ J.toSubmodule T.toLinearMap hker + (J.mkQ (_ ⊓ _)) = _ + rw [J.mkQ_inf] + change T (_ ⊓ _) = T _ ⊓ T _ + exact T.map_inf' _ _ } + +/-- The factored lattice hom agrees with the original on +representatives. -/ +@[simp] +theorem liftQVecLatHom_apply {Y : Type*} + [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] + [VectorLattice Y] (T : VecLatHom X Y) + (hker : J.toSubmodule ≤ LinearMap.ker T.toLinearMap) + (x : X) : + J.liftQVecLatHom T hker (Submodule.Quotient.mk x) = T x := rfl + +/-! ### Uniformly closed ideals and the Archimedean property -/ + +/-- An order ideal is **uniformly closed** if it is closed under +uniform convergence: whenever `(xₙ) ⊂ J` and +`|x - xₙ| ≤ (1/(n+1)) • u` for some `u ≥ 0`, then `x ∈ J`. -/ +def IsUniformlyClosed : Prop := + ∀ (x u : X) (f : ℕ → X), 0 ≤ u → + (∀ n, f n ∈ J) → + (∀ n, |x - f n| ≤ (1 / (↑(n + 1) : ℝ)) • u) → + x ∈ J + +theorem mkQ_eq_zero_iff {x : X} : + J.mkQ x = 0 ↔ x ∈ J := by + rw [← LinearMap.mem_ker, Submodule.ker_mkQ] + exact Iff.rfl + +theorem archimedean_of_uniformlyClosed + (huc : J.IsUniformlyClosed) : + IsVLArchimedean (X ⧸ J.toSubmodule) := by + apply isVLArchimedean_of_eq_zero_of_nonneg_of_forall_nsmul_le + intro φ ψ hφ hsmul + obtain ⟨a, ha_nn, ha_eq⟩ := J.lift_pos hφ + obtain ⟨y, rfl⟩ := + Submodule.Quotient.mk_surjective J.toSubmodule ψ + set u := |y| with hu_def + have hu_nn : (0 : X) ≤ u := abs_nonneg y + have hsmul' : ∀ n : ℕ, n • J.mkQ a ≤ J.mkQ u := fun n => + calc n • J.mkQ a = n • φ := by rw [ha_eq] + _ ≤ J.mkQ y := hsmul n + _ ≤ |J.mkQ y| := le_abs_self _ + _ = J.mkQ u := (J.mkQ_abs y).symm + -- For each n, build fₙ ∈ J with |a - fₙ| ≤ (1/(n+1)) • u + have key : ∀ n : ℕ, ∃ fn : X, fn ∈ J ∧ + |a - fn| ≤ (1 / (↑(n + 1) : ℝ)) • u := by + intro n + have hc_pos : (0 : ℝ) < ↑(n + 1) := + Nat.cast_pos.mpr (Nat.succ_pos n) + have hc_ne : (↑(n + 1) : ℝ) ≠ 0 := ne_of_gt hc_pos + -- dₘ = (n+1) • a - ((n+1) • a ⊓ u) is in J + have hdm_mem : (n + 1) • a - ((n + 1) • a ⊓ u) ∈ J := by + rw [← J.mkQ_eq_zero_iff, map_sub, map_nsmul, J.mkQ_inf, map_nsmul, + inf_eq_left.mpr (hsmul' (n + 1)), sub_self] + -- fₙ = (n+1)⁻¹ • dₘ ∈ J + set fn := (↑(n + 1) : ℝ)⁻¹ • + ((n + 1) • a - ((n + 1) • a ⊓ u)) + refine ⟨fn, J.toSubmodule.smul_mem _ hdm_mem, ?_⟩ + -- a - fₙ = (n+1)⁻¹ • ((n+1) • a ⊓ u) + have step : a - fn = (↑(n + 1) : ℝ)⁻¹ • + ((n + 1) • a ⊓ u) := by + have h : (↑(n + 1) : ℝ)⁻¹ • ((n + 1) : ℕ) • a = a := by + rw [← Nat.cast_smul_eq_nsmul ℝ (n + 1) a, smul_smul, + inv_mul_cancel₀ hc_ne, one_smul] + calc a - fn + _ = a - (↑(n + 1) : ℝ)⁻¹ • (n + 1) • a + + (↑(n + 1) : ℝ)⁻¹ • ((n + 1) • a ⊓ u) := by + change a - (↑(n + 1) : ℝ)⁻¹ • + ((n + 1) • a - (n + 1) • a ⊓ u) = _ + rw [smul_sub]; abel + _ = _ := by rw [h, sub_self, zero_add] + have hcm_nn : (0 : X) ≤ (n + 1) • a ⊓ u := + le_inf (nsmul_nonneg ha_nn _) hu_nn + rw [step, abs_of_nonneg (smul_nonneg (inv_pos.mpr hc_pos).le + hcm_nn), one_div] + exact smul_le_smul_of_nonneg_left + inf_le_right (inv_pos.mpr hc_pos).le + have hmem : a ∈ J := + huc a u (fun n => (key n).choose) hu_nn + (fun n => (key n).choose_spec.1) + (fun n => (key n).choose_spec.2) + rw [← ha_eq, ← J.mkQ_eq_zero_iff.mpr hmem] + +theorem uniformlyClosed_of_archimedean + (harch : IsVLArchimedean (X ⧸ J.toSubmodule)) : + J.IsUniformlyClosed := by + intro x u f hu hfJ hbound + have hQf : ∀ n : ℕ, J.mkQ (f n) = 0 := fun n => + J.mkQ_eq_zero_iff.mpr (hfJ n) + have hQx_bound : ∀ n : ℕ, |J.mkQ x| ≤ + (1 / (↑(n + 1) : ℝ)) • J.mkQ u := fun n => + calc |J.mkQ x| + = |J.mkQ x - J.mkQ (f n)| := by rw [hQf n, sub_zero] + _ = |J.mkQ (x - f n)| := by rw [map_sub] + _ = J.mkQ |x - f n| := (J.mkQ_abs (x - f n)).symm + _ ≤ J.mkQ ((1 / (↑(n + 1) : ℝ)) • u) := + J.mkQVecLatHom.monotone (hbound n) + _ = _ := by rw [map_smul] + have hsmul : ∀ m : ℕ, m • |J.mkQ x| ≤ J.mkQ u := by + intro m; rcases m with _ | n + · simp only [zero_nsmul]; exact J.mkQVecLatHom.monotone hu + · rw [show (n + 1) • |J.mkQ x| = + (↑(n + 1) : ℝ) • |J.mkQ x| from + (Nat.cast_smul_eq_nsmul ℝ (n + 1) _).symm] + calc (↑(n + 1) : ℝ) • |J.mkQ x| + ≤ (↑(n + 1) : ℝ) • ((1 / (↑(n + 1) : ℝ)) • J.mkQ u) := + smul_le_smul_of_nonneg_left (hQx_bound n) + (Nat.cast_nonneg' (n + 1)) + _ = J.mkQ u := by + rw [smul_smul, one_div, mul_inv_cancel₀ + (Nat.cast_ne_zero.mpr (Nat.succ_ne_zero n)), one_smul] + have habs_zero := harch.eq_zero_of_nonneg_of_forall_nsmul_le + (abs_nonneg (J.mkQ x)) hsmul + exact J.mkQ_eq_zero_iff.mp + ((abs_eq_zero_iff_zero (J.mkQ x)).mp habs_zero) + +/-- The quotient `X ⧸ J` is Archimedean iff `J` is uniformly +closed. -/ +theorem quotient_archimedean_iff_uniformlyClosed : + IsVLArchimedean (X ⧸ J.toSubmodule) ↔ + J.IsUniformlyClosed := + ⟨uniformlyClosed_of_archimedean J, archimedean_of_uniformlyClosed J⟩ + +end OrderIdeal + +end -- Algebraic quotient + +section -- Normed quotient + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [NormedVectorLattice X] + +namespace OrderIdeal + +variable (J : OrderIdeal X) + +/-! ### Normed quotient -/ + +/-- The quotient of a normed vector lattice by a closed order ideal +is a normed additive commutative group: the quotient seminorm +separates points. -/ +@[reducible] +noncomputable def quotientNormedAddCommGroup + (hJ : IsClosed (J : Set X)) : + NormedAddCommGroup (X ⧸ J.toSubmodule) := + haveI : IsClosed (J.toSubmodule : Set X) := hJ + Submodule.Quotient.normedAddCommGroup J.toSubmodule + +/-- The quotient of a normed vector lattice by a closed order ideal +is a normed vector lattice: the quotient norm is a lattice norm. -/ +@[reducible] +noncomputable def quotientNormedVectorLattice + (hJ : IsClosed (J : Set X)) : + @NormedVectorLattice (X ⧸ J.toSubmodule) + (quotientNormedAddCommGroup J hJ) + (instQuotientLattice J) (instQuotientIsOrderedAddMonoid J) := by + haveI hcl : IsClosed (J.toSubmodule : Set X) := hJ + letI : NormedAddCommGroup (X ⧸ J.toSubmodule) := quotientNormedAddCommGroup J hJ + letI : Lattice (X ⧸ J.toSubmodule) := instQuotientLattice J + letI : IsOrderedAddMonoid (X ⧸ J.toSubmodule) := instQuotientIsOrderedAddMonoid J + letI : VectorLattice (X ⧸ J.toSubmodule) := instQuotientVectorLattice J + let solidNorm : HasSolidNorm (X ⧸ J.toSubmodule) := { + solid := fun {a b} hab => by + apply le_of_forall_pos_lt_add' + intro ε hε + obtain ⟨β, hβ_eq, hβ_norm⟩ := + Submodule.Quotient.norm_mk_lt b hε + -- lift_between with [-|β|, |β|] + have hle_neg_abs : -|β| ≤ |β| := + le_trans (neg_nonpos_of_nonneg (abs_nonneg β)) (abs_nonneg β) + have hQ_abs : J.mkQ (|β|) = |b| := by + rw [J.mkQ_abs]; exact congrArg (|·|) hβ_eq + have ha_le : a ≤ J.mkQ (|β|) := by + rw [hQ_abs]; exact le_trans (le_abs_self a) hab + have neg_abs_le_self : ∀ (x : X ⧸ J.toSubmodule), -|x| ≤ x := + fun x => by + change -(x ⊔ -x) ≤ x + rw [neg_sup, neg_neg] + exact inf_le_right + have hle_a : J.mkQ (-|β|) ≤ a := by + rw [map_neg, hQ_abs] + exact le_trans (neg_le_neg hab) (neg_abs_le_self a) + obtain ⟨γ, hγ_eq, hγ_ge, hγ_le⟩ := + J.lift_between hle_neg_abs hle_a ha_le + have hγ_abs : |γ| ≤ |β| := by + have h1 : |γ| ≤ |( |β| )| := + abs_le_abs hγ_le (neg_le.mp hγ_ge) + rwa [abs_abs] at h1 + have : ‖J.mkQ γ‖ ≤ ‖γ‖ := + Submodule.Quotient.norm_mk_le (S := J.toSubmodule) γ + calc + ‖a‖ = ‖J.mkQ γ‖ := by rw [hγ_eq] + _ ≤ ‖γ‖ := this + _ ≤ ‖β‖ := norm_le_norm_of_abs_le_abs hγ_abs + _ < ‖b‖ + ε := hβ_norm + } + let normSmul : NormSMulClass ℝ (X ⧸ J.toSubmodule) := { + norm_smul := fun r x => by + have : NormSMulClass ℝ (X ⧸ J.toSubmodule) := + @NormedSpace.toNormSMulClass ℝ (X ⧸ J.toSubmodule) _ + (Submodule.Quotient.seminormedAddCommGroup J.toSubmodule) + (Submodule.Quotient.normedSpace J.toSubmodule ℝ) + exact this.norm_smul r x + } + exact @NormedVectorLattice.mk (X ⧸ J.toSubmodule) + (quotientNormedAddCommGroup J hJ) + (instQuotientLattice J) + (instQuotientIsOrderedAddMonoid J) + (instQuotientVectorLattice J) + solidNorm + normSmul + +end OrderIdeal + +end -- Normed quotient + +section -- Banach lattice quotient + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [BanachLattice X] + +namespace OrderIdeal + +variable (J : OrderIdeal X) + +/-- The quotient of a Banach lattice by a closed order ideal is a +Banach lattice. -/ +@[reducible] +noncomputable def quotientBanachLattice + (hJ : IsClosed (J : Set X)) : + @BanachLattice (X ⧸ J.toSubmodule) + (quotientNormedAddCommGroup J hJ) + (instQuotientLattice J) (instQuotientIsOrderedAddMonoid J) := + haveI : IsClosed (J.toSubmodule : Set X) := hJ + letI : NormedAddCommGroup (X ⧸ J.toSubmodule) := quotientNormedAddCommGroup J hJ + let completeSpace : CompleteSpace (X ⧸ J.toSubmodule) := inferInstance + @BanachLattice.mk (X ⧸ J.toSubmodule) + (quotientNormedAddCommGroup J hJ) + (instQuotientLattice J) + (instQuotientIsOrderedAddMonoid J) + (quotientNormedVectorLattice J hJ) + completeSpace + +end OrderIdeal + +end -- Banach lattice quotient diff --git a/LeanPool/FBLOrderContinuity/BanLat/RieszDec.lean b/LeanPool/FBLOrderContinuity/BanLat/RieszDec.lean new file mode 100644 index 0000000000..5740c88d68 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/RieszDec.lean @@ -0,0 +1,318 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Basic + + + +/-! +# The Riesz decomposition theorem + +This file collects the Riesz decomposition theorem and its refinements in a lattice-ordered +abelian group: the binary form, the matrix form for two partitions of the same sum, the +version with a finite sum on the left, the absolute-value decomposition, and the +identification of sum intervals. +-/ + +@[expose] public section + +open scoped Pointwise + +section LatticeOrderedGroup + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + +/-- Riesz decomposition: if `0 ≤ x ≤ y + z` with `y, z ≥ 0`, then `x = x₁ + x₂` +with `0 ≤ x₁ ≤ y` and `0 ≤ x₂ ≤ z`. -/ +theorem riesz_decomposition (x y z : X) (xnonneg : 0 ≤ x) (ynonneg : 0 ≤ y) + (znonneg : 0 ≤ z) (h : x ≤ y + z) : ∃ x1 x2 : X, (0 ≤ x1) ∧ (x1 ≤ y) ∧ + (0 ≤ x2) ∧ (x2 ≤ z) ∧ (x = x1 + x2) := by + use (x ⊓ y); use (x - x ⊓ y) + repeat (any_goals constructor) + · exact le_inf xnonneg ynonneg + · exact inf_le_right + · simp + · rw [sub_inf] + have : x - y ≤ z := by + calc + x - y = x + (-y) := by rw [sub_eq_add_neg] + _ ≤ (y + z) + (-y) := by apply add_le_add h (le_refl (-y)) + _ ≤ z := by simp + rw [le_iff_posPart_negPart] at this + rw [sub_self, sup_comm, ← posPart_def] + rw [← posPart_of_nonneg znonneg] + exact this.1 + · simp + +private lemma riesz_split_sum : + ∀ {n : ℕ} (u : X) (z : Fin n → X), 0 ≤ u → (∀ j, 0 ≤ z j) → + u ≤ ∑ j, z j → + ∃ x : Fin n → X, (∀ j, 0 ≤ x j) ∧ (∀ j, x j ≤ z j) ∧ u = ∑ j, x j := by + intro n + induction n with + | zero => + intro u z hu _ h + refine ⟨Fin.elim0, fun j => j.elim0, fun j => j.elim0, ?_⟩ + rw [Fin.sum_univ_zero] at h ⊢ + exact le_antisymm h hu + | succ n ih => + intro u z hu hz h + rw [Fin.sum_univ_succ] at h + obtain ⟨a, b, ha_nn, ha_le, hb_nn, hb_le, hab⟩ := + riesz_decomposition u (z 0) (∑ j : Fin n, z j.succ) hu (hz 0) + (Finset.sum_nonneg fun j _ => hz _) h + obtain ⟨x', hx'_nn, hx'_le, hx'_sum⟩ := + ih b (fun j => z j.succ) hb_nn (fun j => hz _) hb_le + refine ⟨Fin.cons a x', ?_, ?_, ?_⟩ + · intro j + induction j using Fin.cases with + | zero => simpa using ha_nn + | succ i => simpa using hx'_nn i + · intro j + induction j using Fin.cases with + | zero => simpa using ha_le + | succ i => simpa using hx'_le i + · rw [Fin.sum_univ_succ, Fin.cons_zero] + simp only [Fin.cons_succ] + rw [hab, hx'_sum] + +/-- Matrix form of Riesz decomposition: if two finite sums of non-negative vectors agree, +there is a non-negative matrix whose row sums recover the first family and whose column +sums recover the second. -/ +theorem riesz_decomposition_matrix : + ∀ {m n : ℕ} (u : Fin m → X) (z : Fin n → X), + (∀ i, 0 ≤ u i) → (∀ j, 0 ≤ z j) → ∑ i, u i = ∑ j, z j → + ∃ x : Fin m → Fin n → X, + (∀ i j, 0 ≤ x i j) ∧ + (∀ i, u i = ∑ j, x i j) ∧ + (∀ j, z j = ∑ i, x i j) := by + intro m + induction m with + | zero => + intro n u z _ hz heq + refine ⟨fun i _ => i.elim0, fun i => i.elim0, fun i => i.elim0, ?_⟩ + intro j + have h0 : ∑ j, z j = 0 := by rw [← heq, Fin.sum_univ_zero] + have hzj : z j ≤ 0 := by + have := Finset.single_le_sum (f := z) (fun j' _ => hz j') (Finset.mem_univ j) + rw [h0] at this; exact this + rw [le_antisymm hzj (hz j)] + exact (Fin.sum_univ_zero _).symm + | succ m ih => + intro n u z hu hz heq + have hu0_le : u 0 ≤ ∑ j, z j := by + rw [← heq, Fin.sum_univ_succ] + exact le_add_of_nonneg_right (Finset.sum_nonneg fun i _ => hu _) + obtain ⟨x0, hx0_nn, hx0_le, hx0_sum⟩ := + riesz_split_sum (u 0) z (hu 0) hz hu0_le + let z' : Fin n → X := fun j => z j - x0 j + have hz'_nn : ∀ j, 0 ≤ z' j := fun j => sub_nonneg.mpr (hx0_le j) + have heq' : ∑ i, (u ∘ Fin.succ) i = ∑ j, z' j := by + rw [Fin.sum_univ_succ] at heq + have hsum_sub : ∑ j, z' j = (∑ j, z j) - ∑ j, x0 j := by + simp [z', Finset.sum_sub_distrib] + rw [hsum_sub, ← heq, ← hx0_sum] + simp [Function.comp] + obtain ⟨y, hy_nn, hy_row, hy_col⟩ := + ih (u ∘ Fin.succ) z' (fun i => hu _) hz'_nn heq' + refine ⟨Fin.cons x0 y, ?_, ?_, ?_⟩ + · intro i j + induction i using Fin.cases with + | zero => simpa using hx0_nn j + | succ i => simpa using hy_nn i j + · intro i + induction i using Fin.cases with + | zero => + simp only [Fin.cons_zero] + rw [hx0_sum] + | succ i => + simp only [Fin.cons_succ] + exact hy_row i + · intro j + rw [Fin.sum_univ_succ, Fin.cons_zero] + simp only [Fin.cons_succ] + have hz'_eq : z j - x0 j = ∑ i, y i j := hy_col j + have : z j = x0 j + (z j - x0 j) := by abel + rw [this, hz'_eq] + +/-- Riesz decomposition with several summands on the left: if `∑ᵢ uᵢ ≤ x + y` with all +terms non-negative, each `uᵢ` splits as `vᵢ + wᵢ` so that `∑ᵢ vᵢ ≤ x` and `∑ᵢ wᵢ ≤ y`. -/ +theorem riesz_decomposition_sum_le {k : ℕ} (u : Fin k → X) (x y : X) + (hu : ∀ i, 0 ≤ u i) (hx : 0 ≤ x) (hy : 0 ≤ y) + (h : ∑ i, u i ≤ x + y) : + ∃ v w : Fin k → X, + (∀ i, 0 ≤ v i) ∧ (∀ i, 0 ≤ w i) ∧ + (∑ i, v i ≤ x) ∧ (∑ i, w i ≤ y) ∧ + (∀ i, u i = v i + w i) := by + obtain ⟨a, b, ha_nn, ha_le, hb_nn, hb_le, hab⟩ := + riesz_decomposition (∑ i, u i) x y (Finset.sum_nonneg fun i _ => hu _) hx hy h + let z : Fin 2 → X := ![a, b] + have hz_nn : ∀ j, 0 ≤ z j := by + intro j; fin_cases j + · exact ha_nn + · exact hb_nn + have hsum_eq : ∑ i, u i = ∑ j, z j := by + rw [hab, Fin.sum_univ_two] + rfl + obtain ⟨M, hM_nn, hM_row, hM_col⟩ := + riesz_decomposition_matrix u z hu hz_nn hsum_eq + refine ⟨fun i => M i 0, fun i => M i 1, ?_, ?_, ?_, ?_, ?_⟩ + · intro i; exact hM_nn i 0 + · intro i; exact hM_nn i 1 + · have hcol := hM_col 0 + have : a = ∑ i, M i 0 := hcol + rw [← this]; exact ha_le + · have hcol := hM_col 1 + have : b = ∑ i, M i 1 := hcol + rw [← this]; exact hb_le + · intro i + have := hM_row i + rw [Fin.sum_univ_two] at this + exact this + +/-- Decomposing a vector according to a splitting of its absolute value: if `|x| = u + v` +with `u, v ≥ 0`, then `x = y + z` for some `y, z` with `|y| = u` and `|z| = v`. -/ +theorem exists_abs_decomposition {x u v : X} (hu : 0 ≤ u) (hv : 0 ≤ v) + (h : |x| = u + v) : + ∃ y z : X, x = y + z ∧ |y| = u ∧ |z| = v := by + set a := x⁺ ⊓ u with ha_def + set b := x⁻ ⊓ u with hb_def + have ha_nn : 0 ≤ a := le_inf (posPart_nonneg _) hu + have hb_nn : 0 ≤ b := le_inf (negPart_nonneg _) hu + have ha_le_pp : a ≤ x⁺ := inf_le_left + have hb_le_np : b ≤ x⁻ := inf_le_left + have ha_le_u : a ≤ u := inf_le_right + have hb_le_u : b ≤ u := inf_le_right + have hab_disj : a ⊓ b = 0 := by + apply le_antisymm _ (le_inf ha_nn hb_nn) + calc a ⊓ b ≤ x⁺ ⊓ x⁻ := inf_le_inf ha_le_pp hb_le_np + _ = 0 := posPart_inf_negPart_eq_zero _ + have hab_eq : a + b = u := by + have hle : a + b ≤ u := by + have e : a + b = a ⊔ b := by + have := inf_add_sup a b + rw [hab_disj, zero_add] at this + exact this.symm + rw [e]; exact sup_le ha_le_u hb_le_u + have hge : u ≤ a + b := by + have hle_u : u ≤ x⁺ + x⁻ := by + rw [posPart_add_negPart, h] + exact le_add_of_nonneg_right hv + obtain ⟨u₁, u₂, h1_nn, h1_le, h2_nn, h2_le, huuv⟩ := + riesz_decomposition u x⁺ x⁻ hu (posPart_nonneg _) (negPart_nonneg _) hle_u + have h1a : u₁ ≤ a := le_inf h1_le (by rw [huuv]; exact le_add_of_nonneg_right h2_nn) + have h2b : u₂ ≤ b := le_inf h2_le (by rw [huuv]; exact le_add_of_nonneg_left h1_nn) + rw [huuv]; exact add_le_add h1a h2b + exact le_antisymm hle hge + let y := a - b + refine ⟨y, x - y, by abel, ?_, ?_⟩ + · have hy_pp : y⁺ = a := (uniqueness_posPart y rfl hab_disj).symm + have hy_np : y⁻ = b := by + have hneg : -y = b - a := by simp [y] + have hba_disj : b ⊓ a = 0 := by rw [inf_comm]; exact hab_disj + have h1 : (-y)⁺ = b := (uniqueness_posPart (-y) hneg hba_disj).symm + rw [← posPart_neg]; exact h1 + rw [← posPart_add_negPart, hy_pp, hy_np, hab_eq] + · -- |x - y| = v + -- z = x - y = (x⁺ - a) - (x⁻ - b) + set a' := x⁺ - a with ha'_def + set b' := x⁻ - b with hb'_def + have ha'_nn : 0 ≤ a' := sub_nonneg.mpr ha_le_pp + have hb'_nn : 0 ≤ b' := sub_nonneg.mpr hb_le_np + have ha'_le_pp : a' ≤ x⁺ := sub_le_self _ ha_nn + have hb'_le_np : b' ≤ x⁻ := sub_le_self _ hb_nn + have hab'_disj : a' ⊓ b' = 0 := by + apply le_antisymm _ (le_inf ha'_nn hb'_nn) + calc a' ⊓ b' ≤ x⁺ ⊓ x⁻ := inf_le_inf ha'_le_pp hb'_le_np + _ = 0 := posPart_inf_negPart_eq_zero _ + have hxy : x - y = a' - b' := by + change x - (a - b) = (x⁺ - a) - (x⁻ - b) + conv_lhs => rw [← posPart_sub_negPart x] + abel + have hz_pp : (x - y)⁺ = a' := by + rw [hxy]; exact (uniqueness_posPart _ rfl hab'_disj).symm + have hz_np : (x - y)⁻ = b' := by + rw [hxy] + have hneg : -(a' - b') = b' - a' := by abel + have hba'_disj : b' ⊓ a' = 0 := by rw [inf_comm]; exact hab'_disj + have h1 : (-(a' - b'))⁺ = b' := (uniqueness_posPart _ hneg hba'_disj).symm + rw [← posPart_neg]; exact h1 + have hab'_sum : a' + b' = v := by + have key : (a + b) + (a' + b') = u + v := by + change (a + b) + ((x⁺ - a) + (x⁻ - b)) = u + v + rw [← h, ← posPart_add_negPart] + abel + rw [hab_eq] at key + exact add_left_cancel key + rw [← posPart_add_negPart, hz_pp, hz_np, hab'_sum] + +/-- Riesz decomposition for the absolute value: if `|x| ≤ v₁ + ⋯ + vₙ` with each `vᵢ ≥ 0`, +then `x = x₁ + ⋯ + xₙ` with `|xᵢ| ≤ |x| ⊓ vᵢ`. -/ +theorem riesz_decomposition_abs : + ∀ {n : ℕ} (x : X) (v : Fin n → X), + (∀ i, 0 ≤ v i) → |x| ≤ ∑ i, v i → + ∃ y : Fin n → X, x = ∑ i, y i ∧ ∀ i, |y i| ≤ |x| ⊓ v i := by + intro n + induction n with + | zero => + intro x v _ h + rw [Fin.sum_univ_zero] at h + have habs : |x| = 0 := le_antisymm h (abs_nonneg _) + have hx : x = 0 := (abs_eq_zero_iff_zero x).mp habs + refine ⟨Fin.elim0, ?_, ?_⟩ + · rw [Fin.sum_univ_zero]; exact hx + · intro i; exact i.elim0 + | succ n ih => + intro x v hv h + rw [Fin.sum_univ_succ] at h + -- Split |x| = u + w with 0 ≤ u ≤ v 0 and 0 ≤ w ≤ ∑ v i.succ + obtain ⟨u, w, hu_nn, hu_le, hw_nn, hw_le, huw⟩ := + riesz_decomposition |x| (v 0) (∑ i : Fin n, v i.succ) (abs_nonneg _) (hv 0) + (Finset.sum_nonneg fun i _ => hv _) h + -- Split x = y0 + x' with |y0| = u and |x'| = w + obtain ⟨y0, x', hxsum, hy0_abs, hx'_abs⟩ := exists_abs_decomposition hu_nn hw_nn huw + -- Apply ih to x' and v ∘ Fin.succ + have hx'_le : |x'| ≤ ∑ i : Fin n, v i.succ := hx'_abs ▸ hw_le + obtain ⟨y', hy'_sum, hy'_abs⟩ := ih x' (fun i => v i.succ) (fun i => hv _) hx'_le + refine ⟨Fin.cons y0 y', ?_, ?_⟩ + · rw [Fin.sum_univ_succ, Fin.cons_zero] + simp only [Fin.cons_succ] + rw [hxsum, hy'_sum] + · intro i + induction i using Fin.cases with + | zero => + simp only [Fin.cons_zero] + refine le_inf ?_ ?_ + · rw [hy0_abs, huw]; exact le_add_of_nonneg_right hw_nn + · rw [hy0_abs]; exact hu_le + | succ i => + simp only [Fin.cons_succ] + have h1 : |y' i| ≤ |x'| ⊓ v i.succ := hy'_abs i + have h2 : |x'| ≤ |x| := by + rw [hx'_abs, huw] + exact le_add_of_nonneg_left hu_nn + exact h1.trans (inf_le_inf_right _ h2) + +/-- The order intervals of non-negative endpoints satisfy `[0, x] + [0, y] = [0, x + y]`. -/ +theorem Icc_add_Icc_of_nonneg {x y : X} (hx : 0 ≤ x) (hy : 0 ≤ y) : + Set.Icc (0 : X) x + Set.Icc (0 : X) y = Set.Icc (0 : X) (x + y) := by + ext c + rw [Set.mem_add] + constructor + · rintro ⟨a, ha, b, hb, rfl⟩ + exact ⟨add_nonneg ha.1 hb.1, add_le_add ha.2 hb.2⟩ + · rintro ⟨hc0, hc⟩ + obtain ⟨a, b, ha0, ha, hb0, hb, heq⟩ := riesz_decomposition c x y hc0 hx hy hc + exact ⟨a, ⟨ha0, ha⟩, b, ⟨hb0, hb⟩, heq.symm⟩ + +end LatticeOrderedGroup diff --git a/LeanPool/FBLOrderContinuity/BanLat/Sublattice.lean b/LeanPool/FBLOrderContinuity/BanLat/Sublattice.lean new file mode 100644 index 0000000000..79bd55c2f5 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Sublattice.lean @@ -0,0 +1,238 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +public import LeanPool.OrderClosures.BanLat.Substructures.Sublattice +public import LeanPool.OrderClosures.BanLat.Operators.Hom + +/-! +# Subtype algebra and homomorphisms for vector sublattices + +Extends the shared BanLat core with its carrier-based algebra and the canonical inclusions. +-/ + +@[expose] public section + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +namespace VectorSublattice + +/-- Vector sublattices are determined by their members. -/ +@[ext] theorem ext {Y Z : VectorSublattice X} (h : ∀ x, x ∈ Y ↔ x ∈ Z) : Y = Z := + SetLike.ext h + +/-- Vector sublattices are additive subgroups of their ambient vector lattice. -/ +instance addSubgroupClass : + AddSubgroupClass (VectorSublattice X) X where + zero_mem := fun Y => Y.toSubmodule.zero_mem + add_mem := fun {Y _ _} hx hy => Y.toSubmodule.add_mem hx hy + neg_mem := fun {Y _} hx => Y.toSubmodule.neg_mem hx + +/-- Vector sublattices are closed under real scalar multiplication. -/ +instance smulMemClass : + SMulMemClass (VectorSublattice X) ℝ X where + smul_mem := fun {Y} r _ hx => Y.toSubmodule.smul_mem r hx + + +variable (Y : VectorSublattice X) + +/-- A vector sublattice contains zero. -/ +protected theorem zero_mem : (0 : X) ∈ Y := by + exact Y.toSubmodule.zero_mem + +/-- A vector sublattice is closed under addition. -/ +protected theorem add_mem {x y : X} (hx : x ∈ Y) (hy : y ∈ Y) : + x + y ∈ Y := by + exact Y.toSubmodule.add_mem hx hy + +/-- A vector sublattice is closed under negation. -/ +protected theorem neg_mem {x : X} (hx : x ∈ Y) : + -x ∈ Y := by + exact Y.toSubmodule.neg_mem hx + +/-- A vector sublattice is closed under subtraction. -/ +protected theorem sub_mem {x y : X} (hx : x ∈ Y) (hy : y ∈ Y) : + x - y ∈ Y := by + exact Y.toSubmodule.sub_mem hx hy + +/-- A vector sublattice is closed under real scalar multiplication. -/ +protected theorem smul_mem (c : ℝ) {x : X} (hx : x ∈ Y) : + c • x ∈ Y := by + exact Y.toSubmodule.smul_mem c hx + + +/-- A vector sublattice inherits supremum from its ambient vector lattice. -/ +instance instSupCoe : Max Y where + max x y := ⟨x ⊔ y, Y.sup_mem x.2 y.2⟩ + +/-- A vector sublattice inherits infimum from its ambient vector lattice. -/ +instance instInfCoe : Min Y where + min x y := ⟨x ⊓ y, Y.inf_mem x.2 y.2⟩ + +/-- Suprema in a vector sublattice are computed in the ambient vector lattice. -/ +@[simp, norm_cast] +theorem coe_sup (x y : Y) : + ((x ⊔ y : Y) : X) = (x : X) ⊔ (y : X) := by + rfl + +/-- Infima in a vector sublattice are computed in the ambient vector lattice. -/ +@[simp, norm_cast] +theorem coe_inf (x y : Y) : + ((x ⊓ y : Y) : X) = (x : X) ⊓ (y : X) := by + rfl + +/-- The supremum of two explicitly constructed sublattice elements is computed +in the ambient vector lattice. -/ +@[simp] +theorem mk_sup_mk (x y : X) (hx : x ∈ Y) (hy : y ∈ Y) : + (⟨x, hx⟩ ⊔ ⟨y, hy⟩ : Y) = + ⟨x ⊔ y, Y.sup_mem hx hy⟩ := by + rfl + +/-- The infimum of two explicitly constructed sublattice elements is computed +in the ambient vector lattice. -/ +@[simp] +theorem mk_inf_mk (x y : X) (hx : x ∈ Y) (hy : y ∈ Y) : + (⟨x, hx⟩ ⊓ ⟨y, hy⟩ : Y) = + ⟨x ⊓ y, Y.inf_mem hx hy⟩ := by + rfl + +/-- The lattice structure on the subtype of a vector sublattice. -/ +noncomputable instance instLatticeCoe : Lattice Y := instLatticeSubtype Y + +/-- The inherited additive order agrees with the shared submodule model. -/ +instance instIsOrderedAddMonoidCoe : + @IsOrderedAddMonoid Y inferInstance + (instLatticeCoe Y).toPartialOrder.toPreorder := instIsOrderedAddMonoidSubtype Y + +/-- Nonnegative scalar multiplication is monotone in a vector sublattice. -/ +instance instPosSMulMonoCoe : PosSMulMono ℝ Y := instPosSMulMonoSubtype Y + +/-- The carrier and submodule models use the same vector-lattice structure. -/ +instance instVectorLatticeCoe : + @VectorLattice Y inferInstance (instLatticeCoe Y) + (instIsOrderedAddMonoidCoe Y) := instVectorLatticeSubtype Y + + +end VectorSublattice + +namespace VectorSublattice + +/-- The canonical inclusion of a vector sublattice into its ambient vector lattice. -/ +def subtype (Y : VectorSublattice X) : VecLatHom Y X where + toFun y := y + map_add' _ _ := rfl + map_smul' _ _ := rfl + map_sup' _ _ := rfl + map_inf' _ _ := rfl + +/-- The canonical inclusion maps a vector-sublattice element to its underlying value. -/ +@[simp] +theorem subtype_apply (Y : VectorSublattice X) (y : Y) : + Y.subtype y = (y : X) := rfl + +/-- The canonical inclusion of a vector sublattice is injective. -/ +theorem subtype_injective (Y : VectorSublattice X) : + Function.Injective Y.subtype := + Subtype.coe_injective + +/-- The inclusion of a vector sublattice into a larger vector sublattice. -/ +def inclusion {Y Z : VectorSublattice X} (h : Y ≤ Z) : + VecLatHom Y Z where + toFun := Set.inclusion h + map_add' _ _ := rfl + map_smul' _ _ := rfl + map_sup' _ _ := rfl + map_inf' _ _ := rfl + +/-- Sublattice inclusion agrees with the corresponding set inclusion. -/ +theorem inclusion_apply {Y Z : VectorSublattice X} (h : Y ≤ Z) (y : Y) : + inclusion h y = Set.inclusion h y := rfl + +/-- Inclusion into a larger vector sublattice is injective. -/ +theorem inclusion_injective {Y Z : VectorSublattice X} (h : Y ≤ Z) : + Function.Injective (inclusion h) := + Set.inclusion_injective h + +end VectorSublattice + +namespace LLexpr + +/-- Evaluation in a vector sublattice agrees with evaluation in the ambient lattice. -/ +theorem coe_eval_vectorSublattice {n : ℕ} (Y : VectorSublattice X) + (y : Fin n → Y) (e : LLexpr n) : + ((eval y e : Y) : X) = eval (fun i ↦ (y i : X)) e := by + simpa using map_eval Y.subtype y e + + +end LLexpr + +section Normed + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [NormedVectorLattice X] + +namespace VectorSublattice + +variable (Y : VectorSublattice X) + +/-- A vector sublattice of a normed vector lattice is itself a normed vector +lattice under the induced norm and lattice operations. -/ +instance instNormedVectorLatticeCoe : + @NormedVectorLattice Y inferInstance (instLatticeCoe Y) + (instIsOrderedAddMonoidCoe Y) := instNormedVectorLatticeSubtype Y + +/-- The underlying set of the topological closure of a vector sublattice is +the closure of its underlying set. -/ +@[simp] +theorem topologicalClosure_coe (Y : VectorSublattice X) : + (Y.topologicalClosure : Set X) = closure (Y : Set X) := + Submodule.topologicalClosure_coe Y.toSubmodule + +/-- A vector sublattice is contained in its topological closure. -/ +theorem le_topologicalClosure (Y : VectorSublattice X) : + Y ≤ Y.topologicalClosure := + Y.toSubmodule.le_topologicalClosure + +/-- The topological closure of a vector sublattice is closed. -/ +theorem isClosed_topologicalClosure (Y : VectorSublattice X) : + IsClosed (Y.topologicalClosure : Set X) := + Y.toSubmodule.isClosed_topologicalClosure + +/-- The topological closure of a vector sublattice is contained in every +closed vector sublattice containing it. -/ +theorem topologicalClosure_minimal {Y Z : VectorSublattice X} + (hYZ : Y ≤ Z) (hZ : IsClosed (Z : Set X)) : + Y.topologicalClosure ≤ Z := by + change closure (Y : Set X) ⊆ (Z : Set X) + exact closure_minimal hYZ hZ + + + +end VectorSublattice + +end Normed + +section Banach + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [BanachLattice X] + +namespace VectorSublattice + +/-- A closed vector sublattice of a Banach lattice is a Banach lattice. -/ +@[reducible] +noncomputable def banachLatticeCoe (Y : VectorSublattice X) + (hclosed : IsClosed (Y : Set X)) : + @BanachLattice Y inferInstance (instLatticeCoe Y) + (instIsOrderedAddMonoidCoe Y) where + toCompleteSpace := hclosed.completeSpace_coe + +end VectorSublattice + +end Banach diff --git a/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/Generated.lean b/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/Generated.lean new file mode 100644 index 0000000000..283a2a58dc --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/Generated.lean @@ -0,0 +1,479 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Substructures.Band.DisjointComplement +public import LeanPool.FBLOrderContinuity.BanLat.Substructures.Band.Lattice + + + +/-! +# The band generated by a set + +The band generated by a set `s ⊆ X` is the smallest band of `X` containing +`s`, obtained as the infimum of all bands containing `s`. + +In an Archimedean vector lattice the double disjoint complement `Aᵈᵈ` +coincides with the band generated by `A`. As consequences we obtain four +equivalent descriptions of the band generated by an order ideal in terms of +suprema, a concrete description of the principal band as the supremum of +the increasing sequence `x ⊓ n • a`, and the characterisation of weak +order units as those non-negative elements that generate the whole space +as a band. As another consequence, every band of a normed vector lattice is +norm closed. +-/ + +@[expose] public section + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +namespace Band + +/-- The band generated by a set `s`: the smallest band of `X` containing +`s`. -/ +def generated (s : Set X) : Band X := + sInf {B : Band X | s ⊆ B} + +/-- The principal band generated by an element. -/ +abbrev principal (a : X) : Band X := generated ({a} : Set X) + +/-- The generating set is contained in the band it generates. -/ +theorem subset_generated (s : Set X) : s ⊆ (generated s : Set X) := by + intro x hx + rw [SetLike.mem_coe, generated, mem_sInf] + exact fun B hB => hB hx + +/-- The band generated by `s` is contained in every band containing `s`. -/ +theorem generated_le {s : Set X} {B : Band X} (h : s ⊆ B) : + generated s ≤ B := + sInf_le h + +/-! ### Characterisation of bands via disjoint complements -/ + +omit [VectorLattice X] in +private lemma posPart_mem_dd {A : Set X} + {x : X} (hx : x ∈ Aᵈᵈ) : x⁺ ∈ Aᵈᵈ := fun a ha => + (hx a ha).mono_left (by + rw [abs_of_nonneg (posPart_nonneg x)] + exact sup_le (le_abs_self x) (abs_nonneg x)) + +omit [VectorLattice X] in +private lemma negPart_mem_dd {A : Set X} + {x : X} (hx : x ∈ Aᵈᵈ) : x⁻ ∈ Aᵈᵈ := fun a ha => + (hx a ha).mono_left (by + rw [abs_of_nonneg (negPart_nonneg x)] + exact sup_le (neg_le_abs x) (abs_nonneg x)) + +omit [VectorLattice X] in +private lemma solid_dd {A : Set X} {x y : X} + (hx : x ∈ Aᵈᵈ) (h : |y| ≤ |x|) : y ∈ Aᵈᵈ := fun a ha => + (hx a ha).mono_left h + +private lemma archimedean_disjoint_step [IsVLArchimedean X] + {v t w : X} (hv_nn : 0 ≤ v) (ht_nn : 0 ≤ t) (hw_nn : 0 ≤ w) + (ht_le_v : t ≤ v) (hbound : ∀ n : ℕ, v ⊓ (n • t - w) ≤ 0) : t = 0 := by + let : DistribLattice X := AddCommGroup.toDistribLattice X + refine IsVLArchimedean.eq_zero_of_nonneg_of_forall_nsmul_le (y := w) ht_nn + (fun n => ?_) + have h_nv_nn : (0 : X) ≤ n • v := nsmul_nonneg hv_nn n + have h_nt_le_nv : n • t ≤ n • v := nsmul_le_nsmul_right ht_le_v n + have hkey1 : v ⊓ (n • t - w)⁺ = 0 := by + refine le_antisymm ?_ (le_inf hv_nn (posPart_nonneg _)) + calc v ⊓ (n • t - w)⁺ + = v ⊓ ((n • t - w) ⊔ 0) := by rw [posPart_def] + _ = (v ⊓ (n • t - w)) ⊔ (v ⊓ 0) := inf_sup_left v _ _ + _ ≤ 0 := sup_le (hbound n) (by rw [inf_of_le_right hv_nn]) + have hkey2 : (n • t - w)⁺ ⊓ (n • v) = 0 := by + have hdisj : IsVLDisjoint (n • t - w)⁺ v := by + change |(n • t - w)⁺| ⊓ |v| = 0 + rw [abs_of_nonneg (posPart_nonneg _), abs_of_nonneg hv_nn, inf_comm] + exact hkey1 + have hdisj_n : IsVLDisjoint (n • t - w)⁺ ((n : ℝ) • v) := + hdisj.smul_right (n : ℝ) + have hh : |(n • t - w)⁺| ⊓ |(n : ℝ) • v| = 0 := hdisj_n + rw [abs_of_nonneg (posPart_nonneg _), + abs_of_nonneg (smul_nonneg (Nat.cast_nonneg n) hv_nn)] at hh + rw [show (n • v : X) = ((n : ℝ) • v) from (Nat.cast_smul_eq_nsmul ℝ n v).symm] + exact hh + have hpos_le_nt : (n • t - w)⁺ ≤ n • t := + sup_le (sub_le_self _ hw_nn) (nsmul_nonneg ht_nn n) + have hpos_le_nv : (n • t - w)⁺ ≤ n • v := hpos_le_nt.trans h_nt_le_nv + have hpos_zero : (n • t - w)⁺ = 0 := by + have : (n • t - w)⁺ = (n • t - w)⁺ ⊓ (n • v) := + (inf_eq_left.mpr hpos_le_nv).symm + exact this.trans hkey2 + have h_le : n • t - w ≤ 0 := posPart_eq_zero.mp hpos_zero + exact sub_nonpos.mp h_le + +/-- The hard direction: in an Archimedean vector lattice, a non-negative +element of `Aᵈᵈ` lies in the band generated by `A`. -/ +private lemma mem_generated_of_nonneg_of_mem_ddc [IsVLArchimedean X] + (A : Set X) {x : X} (hx : 0 ≤ x) (hxAdd : x ∈ Aᵈᵈ) : + x ∈ Band.generated A := by + set G : Band X := Band.generated A with hG_def + have hAG : A ⊆ (G : Set X) := subset_generated A + -- It suffices to show `IsLUB (G ∩ [0, x]) x`, since `G` is a band. + suffices h : IsLUB ((G.toOrderIdeal : Set X) ∩ Set.Icc 0 x) x by + refine G.sSup_mem (S := (G.toOrderIdeal : Set X) ∩ Set.Icc 0 x) + (fun y hy => hy.1) + ⟨0, G.toOrderIdeal.toSubmodule.zero_mem, le_refl 0, hx⟩ h + refine ⟨fun b hb => hb.2.2, ?_⟩ + intro u hu + have hu_nn : 0 ≤ u := hu ⟨G.toOrderIdeal.toSubmodule.zero_mem, le_refl 0, hx⟩ + set v : X := (x - u)⁺ with hv_def + have hv_nn : 0 ≤ v := posPart_nonneg _ + have hv_le_x : v ≤ x := sup_le (sub_le_self _ hu_nn) hx + have hv_Add : v ∈ Aᵈᵈ := + solid_dd hxAdd (by rw [abs_of_nonneg hv_nn, abs_of_nonneg hx]; exact hv_le_x) + have hv_Ad : v ∈ Aᵈ := by + intro a ha + set t : X := v ⊓ |a| with ht_def + have ht_nn : 0 ≤ t := le_inf hv_nn (abs_nonneg _) + have ht_le_v : t ≤ v := inf_le_left + have ht_le_abs : t ≤ |a| := inf_le_right + have habs_G : |a| ∈ G := G.abs_mem (hAG ha) + have ht_G : t ∈ G := G.solid habs_G ht_nn ht_le_abs + set w : X := x ⊓ u with hw_def + have hbound : ∀ n : ℕ, v ⊓ (n • t - w) ≤ 0 := by + intro n + have hnt_G : n • t ∈ G := G.toSubmodule.nsmul_mem ht_G n + have hnt_nn : 0 ≤ n • t := nsmul_nonneg ht_nn n + have hxnt_G : x ⊓ n • t ∈ G := + G.solid hnt_G (le_inf hx hnt_nn) inf_le_right + have hxnt_le_x : x ⊓ n • t ≤ x := inf_le_left + have hxnt_le_u : x ⊓ n • t ≤ u := + hu ⟨hxnt_G, le_inf hx hnt_nn, hxnt_le_x⟩ + have hxnt_le_w : x ⊓ n • t ≤ w := le_inf hxnt_le_x hxnt_le_u + have hv_eq : v = x - w := by rw [hv_def, hw_def, sub_inf_eq_posPart] + have h1 : v ⊓ (n • t - w) = x ⊓ n • t - w := by + rw [hv_eq, ← inf_sub] + rw [h1] + exact sub_nonpos.mpr hxnt_le_w + have hw_nn : 0 ≤ w := le_inf hx hu_nn + have ht_zero : t = 0 := + archimedean_disjoint_step hv_nn ht_nn hw_nn ht_le_v hbound + change |v| ⊓ |a| = 0 + rw [abs_of_nonneg hv_nn] + exact ht_zero + have hv_zero : v = 0 := + disjointComplement_inter_eq_zero Aᵈ ⟨hv_Ad, hv_Add⟩ + have hxu : (x - u)⁺ = 0 := hv_zero + rw [posPart_eq_zero, sub_nonpos] at hxu + exact hxu + +/-- In an Archimedean vector lattice, the double disjoint complement of a set +equals the band it generates. -/ +theorem disjointComplement_disjointComplement_eq_generated + [IsVLArchimedean X] (A : Set X) : + ((Aᵈ)ᵈ : Set X) = (generated A : Set X) := by + apply Set.Subset.antisymm + · intro x hx + have hxp : x⁺ ∈ Band.generated A := + mem_generated_of_nonneg_of_mem_ddc A (posPart_nonneg x) (posPart_mem_dd hx) + have hxn : x⁻ ∈ Band.generated A := + mem_generated_of_nonneg_of_mem_ddc A (negPart_nonneg x) (negPart_mem_dd hx) + have := (Band.generated A).toSubmodule.sub_mem hxp hxn + rwa [posPart_sub_negPart] at this + · exact generated_le (B := Band.disjointComplement Aᵈ) + (subset_disjointComplement_disjointComplement A) + +/-- The band generated by a set together with its disjoint complement is the +whole space. -/ +theorem generated_union_disjointComplement_eq_top [IsVLArchimedean X] (A : Set X) : + generated (A ∪ Aᵈ) = (⊤ : Band X) := by + apply le_antisymm + · exact le_top + · intro x _ + have hx : x ∈ ((A ∪ Aᵈ)ᵈ)ᵈ := by + rw [disjointComplement_union_disjointComplement_eq_singleton A] + intro a ha + rw [Set.mem_singleton_iff.mp ha] + exact isVLDisjoint_zero_right x + rwa [disjointComplement_disjointComplement_eq_generated] at hx + +/-- In an Archimedean vector lattice, every band equals its double disjoint +complement. -/ +theorem eq_disjointComplement_disjointComplement [IsVLArchimedean X] + (B : Band X) : ((↑B : Set X)ᵈ)ᵈ = ↑B := by + rw [disjointComplement_disjointComplement_eq_generated] + exact congrArg _ (le_antisymm (generated_le (fun _ h => h)) (subset_generated _)) + +/-- In an Archimedean vector lattice, every band is the disjoint complement of +some set. -/ +theorem exists_eq_disjointComplement [IsVLArchimedean X] (B : Band X) : + ∃ A : Set X, Aᵈ = ↑B := + ⟨(B : Set X)ᵈ, eq_disjointComplement_disjointComplement B⟩ + +/-! ### Description of the band generated by an ideal + +For an order ideal `J`, the positive part of the band generated by `J` +admits four equivalent descriptions: it consists of those non-negative +elements `x` that are the supremum of an upward-directed net in `J`, +equivalently, the supremum of a non-empty set of non-negative elements +of `J`, equivalently, the supremum of `J ∩ [0, x]`. -/ + +/-- Backward direction: if `IsLUB D x` for some non-empty `D ⊆ J`, then `x` +belongs to the band generated by `J`. -/ +private lemma mem_generated_of_isLUB_subset {J : OrderIdeal X} {x : X} + {D : Set X} (hne : D.Nonempty) (hDJ : D ⊆ (J : Set X)) (hx : IsLUB D x) : + x ∈ generated (J : Set X) := + (generated (J : Set X)).sSup_mem + (fun _ hy => subset_generated _ (hDJ hy)) hne hx + +/-- Forward direction (Archimedean): if `0 ≤ x` belongs to the band generated +by an order ideal `J`, then `x` is the supremum of `J ∩ [0, x]`. -/ +private lemma isLUB_inter_of_mem_generated_orderIdeal [IsVLArchimedean X] + (J : OrderIdeal X) {x : X} (hx : 0 ≤ x) + (hxG : x ∈ generated (J : Set X)) : + IsLUB ((J : Set X) ∩ Set.Icc 0 x) x := by + have hxAdd : x ∈ ((J : Set X)ᵈ)ᵈ := by + rw [disjointComplement_disjointComplement_eq_generated]; exact hxG + refine ⟨fun b hb => hb.2.2, ?_⟩ + intro u hu + have hu_nn : 0 ≤ u := hu ⟨J.toSubmodule.zero_mem, le_refl 0, hx⟩ + set v : X := (x - u)⁺ with hv_def + have hv_nn : 0 ≤ v := posPart_nonneg _ + have hv_le_x : v ≤ x := sup_le (sub_le_self _ hu_nn) hx + have hv_Add : v ∈ ((J : Set X)ᵈ)ᵈ := + solid_dd hxAdd (by rw [abs_of_nonneg hv_nn, abs_of_nonneg hx]; exact hv_le_x) + have hv_Ad : v ∈ ((J : Set X))ᵈ := by + intro a ha + set t : X := v ⊓ |a| with ht_def + have ht_nn : 0 ≤ t := le_inf hv_nn (abs_nonneg _) + have ht_le_v : t ≤ v := inf_le_left + have ht_le_abs : t ≤ |a| := inf_le_right + have habs_J : |a| ∈ J := J.abs_mem ha + set w : X := x ⊓ u with hw_def + have hbound : ∀ n : ℕ, v ⊓ (n • t - w) ≤ 0 := by + intro n + have hnabs_J : n • |a| ∈ J := J.toSubmodule.nsmul_mem habs_J n + have hnabs_nn : 0 ≤ n • |a| := nsmul_nonneg (abs_nonneg _) n + have hnt_le_nabs : n • t ≤ n • |a| := nsmul_le_nsmul_right ht_le_abs n + have hxnt_le_xnabs : x ⊓ n • t ≤ x ⊓ n • |a| := + inf_le_inf_left _ hnt_le_nabs + have hxnabs_J : x ⊓ n • |a| ∈ J := + J.solid hnabs_J (le_inf hx hnabs_nn) inf_le_right + have hxnabs_le_x : x ⊓ n • |a| ≤ x := inf_le_left + have hxnabs_le_u : x ⊓ n • |a| ≤ u := + hu ⟨hxnabs_J, le_inf hx hnabs_nn, hxnabs_le_x⟩ + have hxnt_le_x : x ⊓ n • t ≤ x := inf_le_left + have hxnt_le_u : x ⊓ n • t ≤ u := hxnt_le_xnabs.trans hxnabs_le_u + have hxnt_le_w : x ⊓ n • t ≤ w := le_inf hxnt_le_x hxnt_le_u + have hv_eq : v = x - w := by rw [hv_def, hw_def, sub_inf_eq_posPart] + have h1 : v ⊓ (n • t - w) = x ⊓ n • t - w := by + rw [hv_eq, ← inf_sub] + rw [h1] + exact sub_nonpos.mpr hxnt_le_w + have hw_nn : 0 ≤ w := le_inf hx hu_nn + have ht_zero : t = 0 := + archimedean_disjoint_step hv_nn ht_nn hw_nn ht_le_v hbound + change |v| ⊓ |a| = 0 + rw [abs_of_nonneg hv_nn]; exact ht_zero + have hv_zero : v = 0 := + disjointComplement_inter_eq_zero (J : Set X)ᵈ ⟨hv_Ad, hv_Add⟩ + have hxu : (x - u)⁺ = 0 := hv_zero + rw [posPart_eq_zero, sub_nonpos] at hxu + exact hxu + +/-- For an order ideal `J` and a non-negative element `x`, `x` belongs to +the band generated by `J` iff `x` is the supremum of an upward-directed +non-empty set of non-negative elements of `J`. -/ +theorem mem_generated_orderIdeal_iff_isLUB_directed [IsVLArchimedean X] + (J : OrderIdeal X) {x : X} (hx : 0 ≤ x) : + x ∈ generated (J : Set X) ↔ + ∃ S : Set X, S.Nonempty ∧ S ⊆ (J : Set X) ∧ (∀ y ∈ S, 0 ≤ y) + ∧ DirectedOn (· ≤ ·) S ∧ IsLUB S x := by + refine ⟨fun hxG => ?_, ?_⟩ + · refine ⟨(J : Set X) ∩ Set.Icc 0 x, + ⟨0, J.toSubmodule.zero_mem, le_refl 0, hx⟩, + fun _ hy => hy.1, fun _ hy => hy.2.1, ?_, ?_⟩ + · rintro a ⟨haJ, ha0, hax⟩ b ⟨hbJ, _, hbx⟩ + exact ⟨a ⊔ b, ⟨J.sup_mem haJ hbJ, le_sup_of_le_left ha0, sup_le hax hbx⟩, + le_sup_left, le_sup_right⟩ + · exact isLUB_inter_of_mem_generated_orderIdeal J hx hxG + · rintro ⟨S, hne, hSJ, _, _, hx⟩ + exact mem_generated_of_isLUB_subset hne hSJ hx + +/-- For an order ideal `J` and a non-negative element `x`, `x` belongs to +the band generated by `J` iff `x` is the supremum of a non-empty set of +non-negative elements of `J`. -/ +theorem mem_generated_orderIdeal_iff_isLUB_nonneg [IsVLArchimedean X] + (J : OrderIdeal X) {x : X} (hx : 0 ≤ x) : + x ∈ generated (J : Set X) ↔ + ∃ D : Set X, D.Nonempty ∧ D ⊆ (J : Set X) ∧ (∀ y ∈ D, 0 ≤ y) + ∧ IsLUB D x := by + refine ⟨fun hxG => ?_, ?_⟩ + · refine ⟨(J : Set X) ∩ Set.Icc 0 x, + ⟨0, J.toSubmodule.zero_mem, le_refl 0, hx⟩, + fun _ hy => hy.1, fun _ hy => hy.2.1, ?_⟩ + exact isLUB_inter_of_mem_generated_orderIdeal J hx hxG + · rintro ⟨D, hne, hDJ, _, hx⟩ + exact mem_generated_of_isLUB_subset hne hDJ hx + +/-- For an order ideal `J` and a non-negative element `x`, `x` belongs to +the band generated by `J` iff `x` is the supremum of `J ∩ [0, x]`. -/ +theorem mem_generated_orderIdeal_iff_isLUB_inter [IsVLArchimedean X] + (J : OrderIdeal X) {x : X} (hx : 0 ≤ x) : + x ∈ generated (J : Set X) ↔ + IsLUB ((J : Set X) ∩ Set.Icc 0 x) x := by + refine ⟨isLUB_inter_of_mem_generated_orderIdeal J hx, fun h => ?_⟩ + exact mem_generated_of_isLUB_subset (D := (J : Set X) ∩ Set.Icc 0 x) + ⟨0, J.toSubmodule.zero_mem, le_refl 0, hx⟩ + (fun _ hy => hy.1) h + +/-! ### Description of the principal band + +The band generated by a single non-negative element `a` admits a concrete +description: a non-negative `x` belongs to it iff `x` is the supremum of +the increasing sequence `x ⊓ n • a` for `n ∈ ℕ`. -/ + +/-- Forward direction (Archimedean): if `0 ≤ x` belongs to the band generated +by `{a}` for some `0 ≤ a`, then `x` is the supremum of `x ⊓ n • a`. -/ +private lemma isLUB_inf_nsmul_of_mem_generated_singleton [IsVLArchimedean X] + {a x : X} (ha : 0 ≤ a) (hx : 0 ≤ x) + (hxG : x ∈ generated ({a} : Set X)) : + IsLUB (Set.range fun n : ℕ => x ⊓ n • a) x := by + have hxAdd : x ∈ (({a} : Set X)ᵈ)ᵈ := by + rw [disjointComplement_disjointComplement_eq_generated]; exact hxG + refine ⟨?_, ?_⟩ + · rintro _ ⟨_, rfl⟩; exact inf_le_left + intro u hu + have h0 : x ⊓ (0 : ℕ) • a = 0 := by + rw [zero_nsmul]; exact inf_of_le_right hx + have hu_nn : 0 ≤ u := h0 ▸ hu ⟨0, rfl⟩ + set v : X := (x - u)⁺ with hv_def + have hv_nn : 0 ≤ v := posPart_nonneg _ + have hv_le_x : v ≤ x := sup_le (sub_le_self _ hu_nn) hx + have hv_Add : v ∈ (({a} : Set X)ᵈ)ᵈ := + solid_dd hxAdd (by rw [abs_of_nonneg hv_nn, abs_of_nonneg hx]; exact hv_le_x) + have hv_Ad : v ∈ (({a} : Set X))ᵈ := by + rintro b rfl + set t : X := v ⊓ |b| with ht_def + have ht_nn : 0 ≤ t := le_inf hv_nn (abs_nonneg _) + have ht_le_v : t ≤ v := inf_le_left + have ht_le_abs : t ≤ |b| := inf_le_right + have habs_eq : |b| = b := abs_of_nonneg ha + set w : X := x ⊓ u with hw_def + have hbound : ∀ n : ℕ, v ⊓ (n • t - w) ≤ 0 := by + intro n + have ht_le_b : t ≤ b := habs_eq ▸ ht_le_abs + have hnt_le_nb : n • t ≤ n • b := nsmul_le_nsmul_right ht_le_b n + have hxnt_le_xnb : x ⊓ n • t ≤ x ⊓ n • b := + inf_le_inf_left _ hnt_le_nb + have hxnb_le_u : x ⊓ n • b ≤ u := hu ⟨n, rfl⟩ + have hxnt_le_x : x ⊓ n • t ≤ x := inf_le_left + have hxnt_le_u : x ⊓ n • t ≤ u := hxnt_le_xnb.trans hxnb_le_u + have hxnt_le_w : x ⊓ n • t ≤ w := le_inf hxnt_le_x hxnt_le_u + have hv_eq : v = x - w := by rw [hv_def, hw_def, sub_inf_eq_posPart] + have h1 : v ⊓ (n • t - w) = x ⊓ n • t - w := by + rw [hv_eq, ← inf_sub] + rw [h1] + exact sub_nonpos.mpr hxnt_le_w + have hw_nn : 0 ≤ w := le_inf hx hu_nn + have ht_zero : t = 0 := + archimedean_disjoint_step hv_nn ht_nn hw_nn ht_le_v hbound + change |v| ⊓ |b| = 0 + rw [abs_of_nonneg hv_nn]; exact ht_zero + have hv_zero : v = 0 := + disjointComplement_inter_eq_zero ({a} : Set X)ᵈ ⟨hv_Ad, hv_Add⟩ + have hxu : (x - u)⁺ = 0 := hv_zero + rw [posPart_eq_zero, sub_nonpos] at hxu + exact hxu + +/-- For non-negative `a` and `x`, `x` belongs to the band generated by +`{a}` iff `x` is the supremum of the sequence `x ⊓ n • a`. -/ +theorem mem_generated_singleton_iff_isLUB_inf_nsmul [IsVLArchimedean X] + {a x : X} (ha : 0 ≤ a) (hx : 0 ≤ x) : + x ∈ generated ({a} : Set X) ↔ + IsLUB (Set.range fun n : ℕ => x ⊓ n • a) x := by + refine ⟨isLUB_inf_nsmul_of_mem_generated_singleton ha hx, fun h => ?_⟩ + set G : Band X := generated ({a} : Set X) with hG_def + have ha_G : a ∈ G := subset_generated _ rfl + refine G.sSup_mem (S := Set.range fun n : ℕ => x ⊓ n • a) ?_ + (Set.range_nonempty _) h + rintro _ ⟨n, rfl⟩ + have hna_G : n • a ∈ G := G.toSubmodule.nsmul_mem ha_G n + have hna_nn : 0 ≤ n • a := nsmul_nonneg ha n + exact G.solid hna_G (le_inf hx hna_nn) inf_le_right + +end Band + +/-! ### Weak order units -/ + +/-- In an Archimedean vector lattice, a non-negative element `e` is a weak +order unit iff the band it generates is the whole space. -/ +theorem weakOrderUnit_iff_generated_singleton_eq_top [IsVLArchimedean X] + {e : X} (he : 0 ≤ e) : + WeakOrderUnit e ↔ Band.generated {e} = ⊤ := by + constructor + · rintro ⟨_, hwou⟩ + apply SetLike.coe_set_eq.mp + rw [← Band.disjointComplement_disjointComplement_eq_generated] + show ((({e} : Set X)ᵈ)ᵈ : Set X) = (⊤ : Band X) + ext x + refine ⟨fun _ => trivial, fun _ y hy => ?_⟩ + have hye : IsVLDisjoint y e := hy e rfl + rw [hwou y hye] + exact isVLDisjoint_zero_right x + · intro htop + refine ⟨he, fun x hxe => ?_⟩ + have hx_in : x ∈ ((↑(Band.generated ({e} : Set X)) : Set X)) := by + rw [show Band.generated ({e} : Set X) = ⊤ from htop]; trivial + rw [← Band.disjointComplement_disjointComplement_eq_generated] at hx_in + have hxe' : x ∈ ({e} : Set X)ᵈ := fun a ha => by + rcases ha with rfl; exact hxe + have hx_self : IsVLDisjoint x x := + isVLDisjoint_comm.mp (hx_in x hxe') + have h : |x| ⊓ |x| = 0 := hx_self + rw [inf_idem] at h + exact (abs_eq_zero_iff_zero x).mp h + +/-! ### Closedness in normed vector lattices -/ + +section Normed + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [NormedVectorLattice X] + +namespace Band + +variable (B : Band X) + +/-- Every band of a normed vector lattice is norm closed: it equals its double +disjoint complement, which is closed. -/ +theorem isClosed_coe : IsClosed ((B : Set X)) := by + rw [← Band.eq_disjointComplement_disjointComplement B] + exact isClosed_disjointComplement _ + +end Band + +end Normed + +section Banach + +variable {X : Type*} [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [BanachLattice X] + +namespace Band + +variable (B : Band X) + +/-- A band of a Banach lattice, equipped with the inherited normed vector +lattice structure, is itself a Banach lattice. -/ +noncomputable instance instBanachLatticeCoe : + BanachLattice B.toVectorSublattice := + VectorSublattice.banachLatticeCoe B.toVectorSublattice B.isClosed_coe + +end Band + +end Banach diff --git a/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/Lattice.lean b/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/Lattice.lean new file mode 100644 index 0000000000..cfcf3ac56a --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/Lattice.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Substructures.Band.Basic + + + +/-! +# The lattice of bands + +The collection of bands of a vector lattice `X`, ordered by inclusion, forms a +complete lattice. It contains the whole space `⊤ = X`, the trivial band +`⊥ = {0}`, and is closed under arbitrary intersections; binary infima are +given by intersection. +-/ + +@[expose] public section + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +namespace Band + +/-! ### The order on bands -/ + +/-- Bands of `X`, ordered by inclusion, form a partial order. -/ +instance : PartialOrder (Band X) := .ofSetLike (Band X) + +/-! ### Arbitrary intersections, top and bottom -/ + +/-- Arbitrary intersections of bands are bands. -/ +instance : InfSet (Band X) where + sInf S := + { toOrderIdeal := sInf ((·.toOrderIdeal) '' S) + sSup_mem' := by + intro T hTsub hne x hx + refine OrderIdeal.mem_sInf.mpr ?_ + rintro _ ⟨B, hB, rfl⟩ + refine B.sSup_mem (fun s hs => ?_) hne hx + exact OrderIdeal.mem_sInf.mp (hTsub hs) _ ⟨B, hB, rfl⟩ } + +@[simp] theorem mem_sInf {S : Set (Band X)} {x : X} : + x ∈ (sInf S : Band X) ↔ ∀ B ∈ S, x ∈ B := by + change x ∈ (sInf ((·.toOrderIdeal) '' S) : OrderIdeal X) ↔ _ + rw [OrderIdeal.mem_sInf] + exact ⟨fun h B hB => h _ ⟨B, hB, rfl⟩, + by rintro h _ ⟨B, hB, rfl⟩; exact h B hB⟩ + +/-- The whole space `X` is a band. -/ +instance : Top (Band X) where + top := + { toOrderIdeal := ⊤ + sSup_mem' := fun _ _ _ _ _ => OrderIdeal.mem_top } + +@[simp] theorem mem_top {x : X} : x ∈ (⊤ : Band X) := Submodule.mem_top + +/-- The trivial band `{0}` is a band. -/ +instance : Bot (Band X) where + bot := + { toOrderIdeal := ⊥ + sSup_mem' := by + intro S hSsub hne x hx + obtain ⟨s₀, hs₀⟩ := hne + have hs₀_eq : s₀ = 0 := OrderIdeal.mem_bot.mp (hSsub hs₀) + have hub : x ≤ 0 := + hx.2 (fun s hs => by + rw [OrderIdeal.mem_bot.mp (hSsub hs)]) + have hlb : 0 ≤ x := by + have h := hx.1 hs₀; rwa [hs₀_eq] at h + exact OrderIdeal.mem_bot.mpr (le_antisymm hub hlb) } + +@[simp] theorem mem_bot {x : X} : x ∈ (⊥ : Band X) ↔ x = 0 := + Submodule.mem_bot ℝ + +/-! ### The complete lattice of bands -/ + +/-- Bands of `X`, ordered by inclusion, form a complete lattice. Arbitrary +infima are given by intersection, the bottom element is the trivial band +`{0}`, and the top element is the whole space. -/ +instance : CompleteLattice (Band X) where + __ := (inferInstance : PartialOrder (Band X)) + sup B₁ B₂ := sInf {K : Band X | B₁ ≤ K ∧ B₂ ≤ K} + inf B₁ B₂ := + { toOrderIdeal := B₁.toOrderIdeal ⊓ B₂.toOrderIdeal + sSup_mem' := by + intro S hSsub hne x hx + refine ⟨B₁.sSup_mem (fun s hs => (hSsub hs).1) hne hx, + B₂.sSup_mem (fun s hs => (hSsub hs).2) hne hx⟩ } + top := ⊤ + bot := ⊥ + sInf := sInf + sSup S := sInf {K : Band X | ∀ B ∈ S, B ≤ K} + le_top := fun _ _ _ => Submodule.mem_top + bot_le := fun B x hx => by + rw [mem_bot.mp hx]; exact B.toOrderIdeal.toSubmodule.zero_mem + le_sup_left := fun B₁ _ x hx => by + rw [mem_sInf]; rintro K ⟨h₁, _⟩; exact h₁ hx + le_sup_right := fun _ B₂ x hx => by + rw [mem_sInf]; rintro K ⟨_, h₂⟩; exact h₂ hx + sup_le := fun B₁ B₂ K h₁ h₂ x hx => by + rw [mem_sInf] at hx; exact hx K ⟨h₁, h₂⟩ + inf_le_left := fun _ _ _ hx => hx.1 + inf_le_right := fun _ _ _ hx => hx.2 + le_inf := fun _ _ _ h₁ h₂ _ hx => ⟨h₁ hx, h₂ hx⟩ + isLUB_sSup := fun S => by + refine ⟨?_, ?_⟩ + · intro J hJ x hx + rw [mem_sInf] + intro K hK + exact hK J hJ hx + · intro J hJ x hx + rw [mem_sInf] at hx + exact hx J hJ + isGLB_sInf := fun S => by + refine ⟨?_, ?_⟩ + · intro J hJ x hx + rw [mem_sInf] at hx + exact hx J hJ + · intro J hJ x hx + rw [mem_sInf] + intro K hK + exact hJ hK hx + +@[simp] theorem inf_toOrderIdeal (B₁ B₂ : Band X) : + (B₁ ⊓ B₂).toOrderIdeal = B₁.toOrderIdeal ⊓ B₂.toOrderIdeal := rfl + +end Band diff --git a/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/PPP.lean b/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/PPP.lean new file mode 100644 index 0000000000..6321925f00 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/PPP.lean @@ -0,0 +1,422 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.FBLOrderContinuity.BanLat.Substructures.Band.Projection +public import LeanPool.OrderClosures.BanLat.OrderComplete + + + +/-! +# The (principal) projection property + +A vector lattice has the **Projection Property** (PP) when every band is a +projection band, and the **Principal Projection Property** (PPP) when every +principal band is a projection band. Clearly PP implies PPP. + +The two main sources of these properties come from order completeness: order +complete vector lattices have PP, and σ-order complete vector lattices have +PPP. Under PPP, two positive elements admit a positive disjoint refinement of +their sum with controlled summands. Finally, PP and PPP both imply the +Archimedean property. +-/ + +@[expose] public section + +/-! ### The projection properties -/ + +section Defs + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +/-- A vector lattice has the **Projection Property** (PP) when every band in +`X` is a projection band. -/ +class HasProjectionProperty (X : Type*) [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] : Prop where + exists_projectionBand : ∀ B : Band X, ∃ P : ProjectionBand X, + (P : Set X) = (B : Set X) + +/-- A vector lattice has the **Principal Projection Property** (PPP) when every +principal band in `X` is a projection band. -/ +class HasPrincipalProjectionProperty (X : Type*) [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] : Prop where + exists_projectionBand : ∀ a : X, ∃ P : ProjectionBand X, + (P : Set X) = (Band.generated ({a} : Set X) : Set X) + +/-- PP implies PPP. -/ +instance (priority := 100) HasPrincipalProjectionProperty.of_hasProjectionProperty + [HasProjectionProperty X] : HasPrincipalProjectionProperty X where + exists_projectionBand a := + HasProjectionProperty.exists_projectionBand (Band.generated ({a} : Set X)) + +end Defs + +/-! ### Order completeness implies the projection properties -/ + +section OrderComplete + +/-- An order complete vector lattice has the Projection Property. -/ +instance (priority := 100) HasProjectionProperty.of_isOrderComplete + {X : Type*} [AddCommGroup X] [ConditionallyCompleteLattice X] + [IsOrderedAddMonoid X] [VectorLattice X] : + HasProjectionProperty X := by + have : IsVLArchimedean X := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + refine ⟨fun B => ?_⟩ + apply (ProjectionBand.projectionBand_iff_isLUB_inter_Icc B).mpr + intro x hx + refine ⟨sSup ((B : Set X) ∩ Set.Icc 0 x), + isLUB_csSup ⟨0, B.toOrderIdeal.toSubmodule.zero_mem, le_refl 0, hx⟩ + ⟨x, fun _ hy => hy.2.2⟩⟩ + +/-- A σ-order complete vector lattice has the Principal Projection Property. -/ +instance (priority := 100) + HasPrincipalProjectionProperty.of_isSigmaOrderComplete + {X : Type*} [AddCommGroup X] [SigmaConditionallyCompleteLattice X] + [IsOrderedAddMonoid X] [VectorLattice X] : + HasPrincipalProjectionProperty X := by + have : IsVLArchimedean X := IsVLArchimedean_of_sigmaConditionallyCompleteLattice + refine ⟨fun a => ?_⟩ + have hband_eq : (Band.generated ({a} : Set X) : Set X) + = (Band.generated ({|a|} : Set X) : Set X) := by + apply le_antisymm <;> apply Band.generated_le <;> rintro y rfl + · refine (Band.generated _).mem_of_abs_le_abs + (Band.subset_generated _ rfl) ?_ + rw [abs_abs] + · exact (Band.generated _).abs_mem (Band.subset_generated _ rfl) + have habs_nn : (0 : X) ≤ |a| := abs_nonneg a + have hLUB : ∀ x : X, 0 ≤ x → + ∃ s, IsLUB (Set.range fun n : ℕ => x ⊓ (n : ℕ) • |a|) s := by + intro x hx + have hcount : (Set.range fun n : ℕ => x ⊓ (n : ℕ) • |a|).Countable := + Set.countable_range _ + have hne : (Set.range fun n : ℕ => x ⊓ (n : ℕ) • |a|).Nonempty := + Set.range_nonempty _ + have hbdd : BddAbove (Set.range fun n : ℕ => x ⊓ (n : ℕ) • |a|) := + ⟨x, by rintro _ ⟨n, rfl⟩; exact inf_le_left⟩ + refine ⟨sSup _, + fun _ hy => SigmaConditionallyCompleteLattice.le_csSup _ _ hcount hbdd hy, + fun _ hy => SigmaConditionallyCompleteLattice.csSup_le _ _ hcount hne hy⟩ + obtain ⟨P, hP⟩ := + (ProjectionBand.principalBand_projectionBand_iff_isLUB_range habs_nn).mpr hLUB + exact ⟨P, hP.trans hband_eq.symm⟩ + +end OrderComplete + +section Rest + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +/-! ### Disjoint refinement of finite positive families + +Under PPP, any finite family of positive vectors may be replaced by a +pairwise disjoint family of positive vectors, dominated termwise by the +original family, whose sum equals the supremum of the original family. -/ + +/-- For two positive elements in a vector lattice with PPP, their sum can be +rewritten as a sum of two positive disjoint elements, with the new summands +dominated by `2 • x` and `2 • y` respectively. -/ +theorem exists_disjoint_add_eq_add_of_hasPrincipalProjectionProperty + [HasPrincipalProjectionProperty X] {x y : X} (hx : 0 ≤ x) (hy : 0 ≤ y) : + ∃ u v : X, IsVLDisjoint u v ∧ 0 ≤ u ∧ 0 ≤ v ∧ + u ≤ (2 : ℕ) • x ∧ v ≤ (2 : ℕ) • y ∧ u + v = x + y := by + obtain ⟨P, hP⟩ := HasPrincipalProjectionProperty.exists_projectionBand ((x - y)⁺) + set a := x + y + set u := P.bandProjection a + set v := a - u + have ha : 0 ≤ a := by simp [a, add_nonneg hx hy] + have hu_mem : u ∈ (P : Set X) := by + exact P.bandProjection_mem a + have hv_mem : v ∈ disjointComplement (P : Set X) := by + simpa [u, v] using P.id_sub_bandProjection_mem a + have huv : IsVLDisjoint u v := + isVLDisjoint_comm.mp (hv_mem _ hu_mem) + have hu0 : 0 ≤ u := by + simpa [u] using Positive.zero_le_iff.mp P.bandProjection_nonneg a ha + have hv0 : 0 ≤ v := by + have hu_le_a : u ≤ a := by + simpa [u] using Positive.le_iff.mp P.bandProjection_le_id a ha + simpa [v] using sub_nonneg.mpr hu_le_a + have hmono : Monotone P.bandProjection := + Positive.monotone_iff.mpr (Positive.zero_le_iff.mp P.bandProjection_nonneg) + have hgen_sub : + (Band.generated ({(x - y)⁺} : Set X) : Set X) ⊆ + disjointComplement ({(x - y)⁻} : Set X) := by + refine Band.generated_le (B := Band.disjointComplement ({(x - y)⁻} : Set X)) ?_ + intro z hz + rw [Set.mem_singleton_iff] at hz + subst z + change (x - y)⁺ ∈ disjointComplement ({(x - y)⁻} : Set X) + rw [mem_disjointComplement_iff] + intro w hw + rw [Set.mem_singleton_iff] at hw + subst w + exact isVLDisjoint_posPart_negPart (x - y) + have hneg_mem : (x - y)⁻ ∈ disjointComplement (P : Set X) := by + intro z hz + have hz_gen : z ∈ (Band.generated ({(x - y)⁺} : Set X) : Set X) := by + simpa [hP] using hz + have hz_dc : z ∈ disjointComplement ({(x - y)⁻} : Set X) := + hgen_sub hz_gen + exact isVLDisjoint_comm.mp (hz_dc _ (Set.mem_singleton _)) + have hPneg_zero : P.bandProjection ((x - y)⁻) = 0 := + P.bandProjection_eq_zero_of_mem_dc hneg_mem + have ha_le_x : a ≤ (2 : ℕ) • x + (x - y)⁻ := by + have hyx_le : y - x ≤ (x - y)⁻ := by + rw [show y - x = -(x - y) by abel, negPart_def] + exact le_sup_left + calc + a = (2 : ℕ) • x + (y - x) := by + simp [a] + abel + _ ≤ (2 : ℕ) • x + (x - y)⁻ := by gcongr + have hu_le : u ≤ (2 : ℕ) • x := by + calc + u ≤ P.bandProjection ((2 : ℕ) • x + (x - y)⁻) := by + simpa [u] using hmono ha_le_x + _ = P.bandProjection ((2 : ℕ) • x) + P.bandProjection ((x - y)⁻) := by + rw [map_add] + _ = P.bandProjection ((2 : ℕ) • x) := by rw [hPneg_zero, add_zero] + _ ≤ (2 : ℕ) • x := by + exact Positive.le_iff.mp P.bandProjection_le_id _ (nsmul_nonneg hx 2) + have hpos_mem : (x - y)⁺ ∈ (P : Set X) := by + rw [hP] + exact Band.subset_generated _ rfl + have hpos_mem_comp : + (x - y)⁺ ∈ disjointComplement ((Pᶜ : ProjectionBand X) : Set X) := by + intro z hz + exact isVLDisjoint_comm.mp (hz _ hpos_mem) + have hPcpos_zero : (Pᶜ : ProjectionBand X).bandProjection ((x - y)⁺) = 0 := + (Pᶜ : ProjectionBand X).bandProjection_eq_zero_of_mem_dc hpos_mem_comp + have hmono_comp : Monotone (Pᶜ : ProjectionBand X).bandProjection := + Positive.monotone_iff.mpr + (Positive.zero_le_iff.mp (Pᶜ : ProjectionBand X).bandProjection_nonneg) + have ha_le_y : a ≤ (2 : ℕ) • y + (x - y)⁺ := by + have hxy_le : x - y ≤ (x - y)⁺ := by + rw [posPart_def] + exact le_sup_left + calc + a = (2 : ℕ) • y + (x - y) := by + simp [a] + abel + _ ≤ (2 : ℕ) • y + (x - y)⁺ := by gcongr + have hv_eq : (Pᶜ : ProjectionBand X).bandProjection a = v := by + rw [ProjectionBand.bandProjection_compl] + simp [u, v] + have hv_le : v ≤ (2 : ℕ) • y := by + calc + v = (Pᶜ : ProjectionBand X).bandProjection a := hv_eq.symm + _ ≤ (Pᶜ : ProjectionBand X).bandProjection ((2 : ℕ) • y + (x - y)⁺) := + hmono_comp ha_le_y + _ = (Pᶜ : ProjectionBand X).bandProjection ((2 : ℕ) • y) + + (Pᶜ : ProjectionBand X).bandProjection ((x - y)⁺) := by + rw [map_add] + _ = (Pᶜ : ProjectionBand X).bandProjection ((2 : ℕ) • y) := by + rw [hPcpos_zero, add_zero] + _ ≤ (2 : ℕ) • y := by + exact Positive.le_iff.mp (Pᶜ : ProjectionBand X).bandProjection_le_id _ + (nsmul_nonneg hy 2) + refine ⟨u, v, huv, hu0, hv0, hu_le, hv_le, ?_⟩ + calc + u + v = a := by + simp [v] + _ = x + y := by simp [a] + +/-! ### The Archimedean property -/ + +private def IsPosSupFromIdeal (J : OrderIdeal X) (x : X) : Prop := + ∃ S : Set X, S.Nonempty ∧ S ⊆ (J : Set X) ∧ (∀ s ∈ S, 0 ≤ s) ∧ IsLUB S x + +private lemma IsPosSupFromIdeal.zero (J : OrderIdeal X) : + IsPosSupFromIdeal J (0 : X) := + ⟨{0}, Set.singleton_nonempty 0, by rintro _ rfl; exact J.toSubmodule.zero_mem, + by rintro _ rfl; rfl, + isLUB_singleton⟩ + +private lemma IsPosSupFromIdeal.of_mem {J : OrderIdeal X} {x : X} + (hx0 : 0 ≤ x) (hxJ : x ∈ J) : IsPosSupFromIdeal J x := + ⟨{x}, Set.singleton_nonempty x, by rintro _ rfl; exact hxJ, by rintro _ rfl; exact hx0, + isLUB_singleton⟩ + +private lemma IsPosSupFromIdeal.mono {J : OrderIdeal X} {x y : X} + (hx : IsPosSupFromIdeal J x) (hy0 : 0 ≤ y) (hyx : y ≤ x) : + IsPosSupFromIdeal J y := by + obtain ⟨S, hSne, hSJ, hS0, hSx⟩ := hx + refine ⟨(fun s => y ⊓ s) '' S, hSne.image _, ?_, ?_, ?_⟩ + · rintro _ ⟨s, hs, rfl⟩ + exact J.solid (hSJ hs) (le_inf hy0 (hS0 s hs)) inf_le_right + · rintro _ ⟨s, hs, rfl⟩ + exact le_inf hy0 (hS0 s hs) + · simpa [inf_eq_left.mpr hyx] using isLUB_inf_const y hSx + +private lemma IsPosSupFromIdeal.add {J : OrderIdeal X} {x y : X} + (hx : IsPosSupFromIdeal J x) (hy : IsPosSupFromIdeal J y) : + IsPosSupFromIdeal J (x + y) := by + obtain ⟨S, hSne, hSJ, hS0, hSx⟩ := hx + obtain ⟨T, hTne, hTJ, hT0, hTy⟩ := hy + have hLUB : IsLUB ((fun p : X × X => p.1 + p.2) '' (S ×ˢ T)) (x + y) := by + refine ⟨?_, ?_⟩ + · rintro _ ⟨⟨s, t⟩, ⟨hs, ht⟩, rfl⟩ + exact add_le_add (hSx.1 hs) (hTy.1 ht) + · intro u hu + have hy_le_sub : ∀ s ∈ S, y ≤ u - s := by + intro s hs + apply hTy.2 + intro t ht + exact le_sub_iff_add_le.mpr (by + rw [add_comm] + exact hu ⟨(s, t), ⟨hs, ht⟩, rfl⟩) + exact le_sub_iff_add_le.mp <| hSx.2 fun s hs => + le_sub_iff_add_le.mpr <| by + rw [add_comm] + exact le_sub_iff_add_le.mp (hy_le_sub s hs) + refine ⟨(fun p : X × X => p.1 + p.2) '' (S ×ˢ T), hSne.prod hTne |>.image _, ?_, ?_, + hLUB⟩ + · rintro _ ⟨⟨s, t⟩, ⟨hs, ht⟩, rfl⟩ + exact J.toSubmodule.add_mem (hSJ hs) (hTJ ht) + · rintro _ ⟨⟨s, t⟩, ⟨hs, ht⟩, rfl⟩ + exact add_nonneg (hS0 s hs) (hT0 t ht) + +private lemma IsPosSupFromIdeal.smul_nonneg {J : OrderIdeal X} {x : X} {c : ℝ} + (hc : 0 ≤ c) (hx : IsPosSupFromIdeal J x) : + IsPosSupFromIdeal J (c • x) := by + obtain ⟨S, hSne, hSJ, hS0, hSx⟩ := hx + refine ⟨(fun s => c • s) '' S, hSne.image _, ?_, ?_, isLUB_smul_of_nonneg hc hSx⟩ + · rintro _ ⟨s, hs, rfl⟩ + exact J.toSubmodule.smul_mem c (hSJ hs) + · rintro _ ⟨s, hs, rfl⟩ + exact _root_.smul_nonneg hc (hS0 s hs) + +private lemma IsPosSupFromIdeal.sSup {J : OrderIdeal X} {S : Set X} {x : X} + (hSne : S.Nonempty) (hS : ∀ s ∈ S, IsPosSupFromIdeal J s) (hSx : IsLUB S x) : + IsPosSupFromIdeal J x := by + classical + refine ⟨{a | ∃ s, ∃ hs : s ∈ S, a ∈ (hS s hs).choose}, ?_, ?_, ?_, ?_⟩ + · obtain ⟨s, hs⟩ := hSne + exact ⟨(hS s hs).choose_spec.1.choose, s, hs, (hS s hs).choose_spec.1.choose_spec⟩ + · rintro a ⟨s, hs, ha⟩ + exact (hS s hs).choose_spec.2.1 ha + · rintro a ⟨s, hs, ha⟩ + exact (hS s hs).choose_spec.2.2.1 a ha + · refine ⟨?_, ?_⟩ + · rintro a ⟨s, hs, ha⟩ + exact (((hS s hs).choose_spec.2.2.2).1 ha).trans (hSx.1 hs) + · intro u hu + apply hSx.2 + intro s hs + exact ((hS s hs).choose_spec.2.2.2).2 (fun a ha => hu ⟨s, hs, ha⟩) + +private lemma isPosSupFromIdeal_of_mem_bandGenerated + (J : OrderIdeal X) {x : X} (hx0 : 0 ≤ x) + (hxG : x ∈ Band.generated (J : Set X)) : + IsPosSupFromIdeal J x := by + let M : Submodule ℝ X := + { carrier := {z : X | IsPosSupFromIdeal J |z|} + add_mem' := fun {a b} ha hb => + IsPosSupFromIdeal.mono (IsPosSupFromIdeal.add ha hb) (abs_nonneg _) + (abs_add_le a b) + zero_mem' := by simpa using IsPosSupFromIdeal.zero J + smul_mem' := fun c a ha => by + change IsPosSupFromIdeal J |c • a| + rw [abs_smul'] + exact IsPosSupFromIdeal.smul_nonneg (abs_nonneg c) ha } + let K : OrderIdeal X := OrderIdeal.ofSolid M fun _ b ha hba => + IsPosSupFromIdeal.mono ha (abs_nonneg b) hba + let B : Band X := Band.ofPosDirectedSSupMem K (by + intro S hSK hS0 _ hSne y hSy + change IsPosSupFromIdeal J |y| + have hy0 : 0 ≤ y := by + obtain ⟨s, hs⟩ := hSne + exact (hS0 s hs).trans (hSy.1 hs) + rw [abs_of_nonneg hy0] + refine IsPosSupFromIdeal.sSup (J := J) hSne ?_ hSy + intro s hs + have hsK : s ∈ K := hSK hs + change IsPosSupFromIdeal J |s| at hsK + simpa [abs_of_nonneg (hS0 s hs)] using hsK) + have hle : Band.generated (J : Set X) ≤ B := Band.generated_le (B := B) fun z hz => by + change IsPosSupFromIdeal J |z| + exact IsPosSupFromIdeal.of_mem (abs_nonneg z) (J.abs_mem hz) + have hxB : x ∈ B := hle hxG + change IsPosSupFromIdeal J |x| at hxB + simpa [abs_of_nonneg hx0] using hxB + +/-- A vector lattice with the Principal Projection Property is Archimedean. -/ +theorem isVLArchimedean_of_hasPrincipalProjectionProperty + [HasPrincipalProjectionProperty X] : IsVLArchimedean X := by + apply isVLArchimedean_of_eq_zero_of_nonneg_of_forall_nsmul_le + intro x y hx hxy + obtain ⟨P, hP⟩ := HasPrincipalProjectionProperty.exists_projectionBand x + have hy0 : 0 ≤ y := by simpa using hxy 0 + have hxP : x ∈ (P : Set X) := by + rw [hP] + exact Band.subset_generated _ rfl + have hPx : P.bandProjection x = x := + P.bandProjection_eq_of_mem hxP + have hmono : Monotone P.bandProjection := + Positive.monotone_iff.mpr (Positive.zero_le_iff.mp P.bandProjection_nonneg) + have hbound : ∀ n : ℕ, n • x ≤ P.bandProjection y := by + intro n + calc + n • x = P.bandProjection (n • x) := by + rw [map_nsmul, hPx] + _ ≤ P.bandProjection y := hmono (hxy n) + have hPy0 : 0 ≤ P.bandProjection y := + Positive.zero_le_iff.mp P.bandProjection_nonneg y hy0 + let J : OrderIdeal X := OrderIdeal.principal x + have hPy_mem_generated_principal : + P.bandProjection y ∈ Band.generated (J : Set X) := by + have hsub : Band.generated ({x} : Set X) ≤ Band.generated (J : Set X) := + Band.generated_le (B := Band.generated (J : Set X)) (by + intro z hz + rw [Set.mem_singleton_iff] at hz + subst z + exact Band.subset_generated _ (show x ∈ (J : Set X) from + OrderIdeal.self_mem_principal x)) + have hPy_gen_x : P.bandProjection y ∈ Band.generated ({x} : Set X) := by + change P.bandProjection y ∈ ((Band.generated ({x} : Set X)) : Set X) + rw [← hP] + exact P.bandProjection_mem y + exact hsub hPy_gen_x + obtain ⟨S, _hSne, hSJ, _hS0, hLUB⟩ := + isPosSupFromIdeal_of_mem_bandGenerated J hPy0 hPy_mem_generated_principal + have hupper : P.bandProjection y - x ∈ upperBounds S := by + intro s hs + have hsJ : s ∈ OrderIdeal.principal x := hSJ hs + obtain ⟨c, hc, hs_abs_le⟩ := OrderIdeal.mem_principal.mp hsJ + have hs_le_cx : s ≤ c • x := by + calc + s ≤ |s| := le_abs_self s + _ ≤ c • |x| := hs_abs_le + _ = c • x := by rw [abs_of_nonneg hx] + obtain ⟨n, hn⟩ := exists_nat_gt (c + 1) + refine le_sub_iff_add_le.mpr ?_ + calc + s + x ≤ c • x + x := by simpa [add_comm] using add_le_add_right hs_le_cx x + _ = (c + 1) • x := by rw [add_smul, one_smul] + _ ≤ (n : ℝ) • x := smul_le_smul_of_nonneg_right (le_of_lt hn) hx + _ = n • x := Nat.cast_smul_eq_nsmul ℝ n x + _ ≤ P.bandProjection y := hbound n + have hPy_le : P.bandProjection y ≤ P.bandProjection y - x := hLUB.2 hupper + have hx_nonpos : x ≤ 0 := by + have hle : P.bandProjection y + x ≤ P.bandProjection y := le_sub_iff_add_le.mp hPy_le + have hle' : P.bandProjection y + x ≤ P.bandProjection y + 0 := by simpa using hle + simpa using (add_le_add_iff_left (P.bandProjection y)).mp hle' + exact le_antisymm hx_nonpos hx + +/-- A vector lattice with the Projection Property is Archimedean. -/ +theorem isVLArchimedean_of_hasProjectionProperty + [HasProjectionProperty X] : IsVLArchimedean X := + isVLArchimedean_of_hasPrincipalProjectionProperty + +end Rest diff --git a/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/Projection.lean b/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/Projection.lean new file mode 100644 index 0000000000..3265f972f8 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/BanLat/Substructures/Band/Projection.lean @@ -0,0 +1,1062 @@ +/- +Copyright (c) 2026 David Muñoz-Lahoz. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Muñoz-Lahoz +-/ + +module + +/- +Authors: David Muñoz-Lahoz +-/ + +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.OrderClosures.BanLat.Substructures.Band.DisjointComplement +public import LeanPool.FBLOrderContinuity.BanLat.Substructures.Band.Lattice +public import LeanPool.FBLOrderContinuity.BanLat.Substructures.Band.Generated +public import LeanPool.OrderClosures.BanLat.Operators.Positive +public import LeanPool.OrderClosures.BanLat.Operators.Hom + + + +/-! +# Projection bands + +A band `B` in a vector lattice `X` is a **projection band** when every element +of `X` decomposes (uniquely) as a sum of an element of `B` and an element of +the disjoint complement `Bᵈ`. Equivalently, `X = B ⊕ Bᵈ` as a direct sum. + +The associated **band projection** is the linear map sending `x` to its +component in `B`; it is an idempotent positive operator dominated by the +identity, and a vector lattice homomorphism. A linear operator `T` arises as a +band projection iff `T² = T` and `0 ≤ T ≤ I`. +-/ + +@[expose] public section + +variable {X : Type*} [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [VectorLattice X] + +/-- A band `B` in a vector lattice is a **projection band** if every element +of `X` decomposes (uniquely) as a sum of an element of `B` and an element of +`Bᵈ`. Equivalently, `X = B ⊕ Bᵈ` as a direct sum. -/ +structure ProjectionBand (X : Type*) [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] + extends Band X where + decomposition' : ∀ x : X, ∃ y z : X, y ∈ carrier + ∧ z ∈ disjointComplement carrier ∧ x = y + z + +namespace ProjectionBand + +instance : SetLike (ProjectionBand X) X where + coe B := B.carrier + coe_injective p q h := by + cases p; cases q; congr + exact SetLike.ext' h + +variable (B : ProjectionBand X) + +/-- Every element of `X` decomposes as `y + z` with `y ∈ B` and `z ∈ Bᵈ`. -/ +theorem decomposition (x : X) : + ∃ y z : X, y ∈ B ∧ z ∈ disjointComplement (B : Set X) ∧ x = y + z := + B.decomposition' x + +/-- The decomposition in a projection band is unique. -/ +theorem decomposition_unique {x y₁ z₁ y₂ z₂ : X} + (hy₁ : y₁ ∈ B) (hz₁ : z₁ ∈ disjointComplement (B : Set X)) + (hy₂ : y₂ ∈ B) (hz₂ : z₂ ∈ disjointComplement (B : Set X)) + (h₁ : x = y₁ + z₁) (h₂ : x = y₂ + z₂) : + y₁ = y₂ ∧ z₁ = z₂ := by + -- y₁ - y₂ = z₂ - z₁, and this element lies in B ∩ Bᵈ ⊆ {0} + have heq : y₁ - y₂ = z₂ - z₁ := by + have h := h₁.symm.trans h₂ + calc y₁ - y₂ = (y₁ + z₁) - z₁ - y₂ := by abel + _ = (y₂ + z₂) - z₁ - y₂ := by rw [h] + _ = z₂ - z₁ := by abel + have hmem_B : y₁ - y₂ ∈ B := + B.toBand.toOrderIdeal.toSubmodule.sub_mem hy₁ hy₂ + have hmem_Bd : y₁ - y₂ ∈ disjointComplement (B : Set X) := by + rw [heq] + exact (Band.disjointComplement + (B : Set X)).toOrderIdeal.toSubmodule.sub_mem + (show z₂ ∈ (Band.disjointComplement (B : Set X)).toOrderIdeal.toSubmodule + from hz₂) hz₁ + have hmem_both : y₁ - y₂ ∈ (↑B) ∩ (↑B)ᵈ := ⟨hmem_B, hmem_Bd⟩ + have hzero : y₁ - y₂ = 0 := + Set.mem_singleton_iff.mp (disjointComplement_inter_eq_zero (↑B) hmem_both) + refine ⟨sub_eq_zero.mp hzero, ?_⟩ + have : z₂ - z₁ = 0 := heq ▸ hzero + exact eq_of_sub_eq_zero this |>.symm + +/-- The **band projection** onto a projection band: the linear map sending +`x` to its component in `B`. -/ +noncomputable def bandProjection : X →ₗ[ℝ] X where + toFun x := (B.decomposition x).choose + map_add' := fun x y => by + set yx := (B.decomposition x).choose + set zx := (B.decomposition x).choose_spec.choose + set yy := (B.decomposition y).choose + set zy := (B.decomposition y).choose_spec.choose + set yxy := (B.decomposition (x + y)).choose + set zxy := (B.decomposition (x + y)).choose_spec.choose + have hyx : yx ∈ B := (B.decomposition x).choose_spec.choose_spec.1 + have hzx : zx ∈ (↑B)ᵈ := (B.decomposition x).choose_spec.choose_spec.2.1 + have hx_eq : x = yx + zx := (B.decomposition x).choose_spec.choose_spec.2.2 + have hyy : yy ∈ B := (B.decomposition y).choose_spec.choose_spec.1 + have hzy : zy ∈ (↑B)ᵈ := (B.decomposition y).choose_spec.choose_spec.2.1 + have hy_eq : y = yy + zy := (B.decomposition y).choose_spec.choose_spec.2.2 + have hyxy : yxy ∈ B := (B.decomposition (x + y)).choose_spec.choose_spec.1 + have hzxy : zxy ∈ (↑B)ᵈ := + (B.decomposition (x + y)).choose_spec.choose_spec.2.1 + have hxy_eq : x + y = yxy + zxy := + (B.decomposition (x + y)).choose_spec.choose_spec.2.2 + have hsum_B : yx + yy ∈ B := B.toBand.toOrderIdeal.toSubmodule.add_mem hyx hyy + have hsum_Bd : zx + zy ∈ (↑B)ᵈ := + ((Band.disjointComplement (B : Set X)).toOrderIdeal).toSubmodule.add_mem + (show zx ∈ ((Band.disjointComplement (B : Set X)).toOrderIdeal).toSubmodule from hzx) + hzy + have hsum_eq : x + y = (yx + yy) + (zx + zy) := by rw [hx_eq, hy_eq]; abel + exact (B.decomposition_unique hyxy hzxy hsum_B hsum_Bd hxy_eq hsum_eq).1 + map_smul' := fun r x => by + set yx := (B.decomposition x).choose + set zx := (B.decomposition x).choose_spec.choose + set yr := (B.decomposition (r • x)).choose + set zr := (B.decomposition (r • x)).choose_spec.choose + have hyx : yx ∈ B := (B.decomposition x).choose_spec.choose_spec.1 + have hzx : zx ∈ (↑B)ᵈ := (B.decomposition x).choose_spec.choose_spec.2.1 + have hx_eq : x = yx + zx := (B.decomposition x).choose_spec.choose_spec.2.2 + have hyr : yr ∈ B := (B.decomposition (r • x)).choose_spec.choose_spec.1 + have hzr : zr ∈ (↑B)ᵈ := + (B.decomposition (r • x)).choose_spec.choose_spec.2.1 + have hr_eq : r • x = yr + zr := + (B.decomposition (r • x)).choose_spec.choose_spec.2.2 + have hscal_B : r • yx ∈ B := B.toBand.toOrderIdeal.toSubmodule.smul_mem r hyx + have hscal_Bd : r • zx ∈ (↑B)ᵈ := + ((Band.disjointComplement (B : Set X)).toOrderIdeal).toSubmodule.smul_mem r + (show zx ∈ ((Band.disjointComplement (B : Set X)).toOrderIdeal).toSubmodule from hzx) + have hscal_eq : r • x = r • yx + r • zx := by rw [hx_eq, smul_add] + simp only [RingHom.id_apply] + exact (B.decomposition_unique hyr hzr hscal_B hscal_Bd hr_eq hscal_eq).1 + +/-- The band projection is idempotent. -/ +theorem bandProjection_sq : + B.bandProjection ∘ₗ B.bandProjection = B.bandProjection := by + ext x + simp only [LinearMap.comp_apply] + -- Bx ∈ B, and Bx = Bx + 0 with 0 ∈ Bᵈ + have hBx_mem : B.bandProjection x ∈ B := + (B.decomposition x).choose_spec.choose_spec.1 + have hBBx_mem : B.bandProjection (B.bandProjection x) ∈ B := + (B.decomposition (B.bandProjection x)).choose_spec.choose_spec.1 + set z' := (B.decomposition (B.bandProjection x)).choose_spec.choose + have hz' : z' ∈ disjointComplement (B : Set X) := + (B.decomposition (B.bandProjection x)).choose_spec.choose_spec.2.1 + have hBx_dec : B.bandProjection x = + B.bandProjection (B.bandProjection x) + z' := + (B.decomposition (B.bandProjection x)).choose_spec.choose_spec.2.2 + have h0_mem : (0 : X) ∈ disjointComplement (B : Set X) := + ((Band.disjointComplement (B : Set X)).toOrderIdeal).toSubmodule.zero_mem + have hBx_eq : B.bandProjection x = B.bandProjection x + 0 := (add_zero _).symm + exact (B.decomposition_unique hBBx_mem hz' hBx_mem h0_mem hBx_dec hBx_eq).1 + +private theorem id_sub_bandProjection_mem' (x : X) : + x - B.bandProjection x ∈ disjointComplement (B : Set X) := by + have spec := (B.decomposition x).choose_spec.choose_spec + have heq : x = B.bandProjection x + (B.decomposition x).choose_spec.choose := + spec.2.2 + have : x - B.bandProjection x = (B.decomposition x).choose_spec.choose := + (eq_sub_of_add_eq' heq.symm).symm + rw [this]; exact spec.2.1 + +/-- The band projection is nonnegative as an operator: `0 ≤ B`. -/ +theorem bandProjection_nonneg : 0 ≤ B.bandProjection := by + rw [Positive.zero_le_iff] + intro x hx + set Bx := B.bandProjection x + set Qx := x - Bx with hQx_def + have hBx_mem : Bx ∈ B := (B.decomposition x).choose_spec.choose_spec.1 + have hQx_mem : Qx ∈ disjointComplement (B : Set X) := id_sub_bandProjection_mem' B x + have hBxneg_mem_B : Bx⁻ ∈ B := + B.toBand.toOrderIdeal.solid (B.toBand.abs_mem hBx_mem) + (negPart_nonneg Bx) (sup_le (neg_le_abs Bx) (abs_nonneg Bx)) + have hle_neg_Bx : -Bx ≤ Qx := by + rw [neg_le_sub_iff_le_add]; exact le_add_of_nonneg_left hx + have hle : Bx⁻ ≤ |Qx| := + le_trans (sup_le_sup_right hle_neg_Bx 0) + (sup_le (le_abs_self Qx) (abs_nonneg Qx)) + have hQx_abs_mem : |Qx| ∈ disjointComplement (B : Set X) := + ((Band.disjointComplement (B : Set X)).toOrderIdeal).abs_mem hQx_mem + have hBxneg_mem_Bd : Bx⁻ ∈ disjointComplement (B : Set X) := + ((Band.disjointComplement (B : Set X)).toOrderIdeal).solid + hQx_abs_mem (negPart_nonneg Bx) hle + have hzero : Bx⁻ = 0 := + Set.mem_singleton_iff.mp (disjointComplement_inter_eq_zero (↑B) + ⟨hBxneg_mem_B, hBxneg_mem_Bd⟩) + exact negPart_eq_zero.mp hzero + +/-- The band projection is dominated by the identity as an operator: `B ≤ I`. -/ +theorem bandProjection_le_id : B.bandProjection ≤ LinearMap.id := by + rw [Positive.le_iff] + intro x hx + rw [← sub_nonneg] + change 0 ≤ LinearMap.id x - B.bandProjection x + set Bx := B.bandProjection x + set Qx := x - Bx + have hBx_mem : Bx ∈ B := (B.decomposition x).choose_spec.choose_spec.1 + have hQx_mem : Qx ∈ disjointComplement (B : Set X) := + id_sub_bandProjection_mem' B x + have hQxneg_mem_Bd : Qx⁻ ∈ disjointComplement (B : Set X) := + ((Band.disjointComplement (B : Set X)).toOrderIdeal).solid + (((Band.disjointComplement (B : Set X)).toOrderIdeal).abs_mem hQx_mem) + (negPart_nonneg Qx) (sup_le (neg_le_abs Qx) (abs_nonneg Qx)) + have hle_neg_Qx : -Qx ≤ Bx := by + change -(x - Bx) ≤ Bx; rw [neg_sub]; exact sub_le_self Bx (by exact hx) + have hle : Qx⁻ ≤ |Bx| := + le_trans (sup_le_sup_right hle_neg_Qx 0) + (sup_le (le_abs_self Bx) (abs_nonneg Bx)) + have hQxneg_mem_B : Qx⁻ ∈ B := + B.toBand.toOrderIdeal.solid (B.toBand.abs_mem hBx_mem) (negPart_nonneg Qx) hle + have hzero : Qx⁻ = 0 := + Set.mem_singleton_iff.mp (disjointComplement_inter_eq_zero (↑B) + ⟨hQxneg_mem_B, hQxneg_mem_Bd⟩) + exact negPart_eq_zero.mp hzero + +/-- The band projection maps into the band. -/ +theorem bandProjection_mem (x : X) : + B.bandProjection x ∈ B := by + exact (B.decomposition x).choose_spec.choose_spec.1 + +/-- The complement `I - B` maps into the disjoint complement. -/ +theorem id_sub_bandProjection_mem (x : X) : + x - B.bandProjection x ∈ disjointComplement (B : Set X) := by + set y := (B.decomposition x).choose + set z := (B.decomposition x).choose_spec.choose + have hz : z ∈ disjointComplement (B : Set X) := + (B.decomposition x).choose_spec.choose_spec.2.1 + have hxyz : x = y + z := + (B.decomposition x).choose_spec.choose_spec.2.2 + have : x - B.bandProjection x = z := by + change x - y = z; rw [hxyz, add_sub_cancel_left] + rw [this]; exact hz + +/-- A band projection acts as the identity on elements already in the band. -/ +theorem bandProjection_eq_of_mem {x : X} (hx : x ∈ B) : + B.bandProjection x = x := by + have h0_mem : (0 : X) ∈ disjointComplement (B : Set X) := + ((Band.disjointComplement (B : Set X)).toOrderIdeal).toSubmodule.zero_mem + have hQx_mem : x - B.bandProjection x ∈ disjointComplement (B : Set X) := + id_sub_bandProjection_mem' B x + have hx_dec : x = B.bandProjection x + (x - B.bandProjection x) := by abel + exact (B.decomposition_unique (B.bandProjection_mem x) hQx_mem + hx h0_mem hx_dec (add_zero x).symm).1 + +/-- The range of the band projection is the band itself. -/ +theorem range_bandProjection : + Set.range B.bandProjection = (B : Set X) := by + ext x; constructor + · rintro ⟨y, rfl⟩; exact B.bandProjection_mem y + · intro hx; exact ⟨x, B.bandProjection_eq_of_mem hx⟩ + +/-- The band projection vanishes on elements of the disjoint complement. -/ +theorem bandProjection_eq_zero_of_mem_dc {x : X} + (hx : x ∈ disjointComplement (B : Set X)) : + B.bandProjection x = 0 := by + have h0_mem : (0 : X) ∈ (B : Set X) := B.toBand.toOrderIdeal.toSubmodule.zero_mem + have hdec : x = B.bandProjection x + (x - B.bandProjection x) := by abel + exact (B.decomposition_unique (B.bandProjection_mem x) + (B.id_sub_bandProjection_mem x) h0_mem hx hdec (zero_add x).symm).1 + +/-- The disjoint complement of a projection band is a projection band. -/ +def disjointComplementProjectionBand : ProjectionBand X where + toBand := Band.disjointComplement (B : Set X) + decomposition' := fun x => ⟨x - B.bandProjection x, B.bandProjection x, + (show x - B.bandProjection x ∈ ((B : Set X))ᵈ from B.id_sub_bandProjection_mem x), + (show B.bandProjection x ∈ ((B : Set X))ᵈᵈ from + subset_disjointComplement_disjointComplement (B : Set X) (B.bandProjection_mem x)), + by abel⟩ + +/-- An ideal `J` is a projection band iff `J + Jᵈ = X`. -/ +theorem projectionBand_iff_add_disjointComplement + (J : OrderIdeal X) : + (∃ B : ProjectionBand X, (B : Set X) = (J : Set X)) ↔ + ∀ x : X, ∃ y z : X, y ∈ (J : Set X) + ∧ z ∈ disjointComplement (J : Set X) ∧ x = y + z := by + constructor + · rintro ⟨B, hBJ⟩ x + obtain ⟨y, z, hy, hz, hxyz⟩ := B.decomposition x + exact ⟨y, z, hBJ ▸ hy, hBJ ▸ hz, hxyz⟩ + · intro hdecomp + have heq : ((J : Set X)ᵈ)ᵈ = (J : Set X) := by + apply Set.Subset.antisymm + · intro x hx + obtain ⟨y, z, hy, hz, hxyz⟩ := hdecomp x + have hy_dd : y ∈ ((J : Set X)ᵈ)ᵈ := + subset_disjointComplement_disjointComplement (J : Set X) hy + have hxmy_dd : x - y ∈ ((J : Set X)ᵈ)ᵈ := + ((Band.disjointComplement ((J : Set X)ᵈ)).toOrderIdeal).toSubmodule.sub_mem + hx hy_dd + have hxmy_both : x - y ∈ (J : Set X)ᵈ ∩ ((J : Set X)ᵈ)ᵈ := + ⟨(hxyz ▸ add_sub_cancel_left y z : x - y = z) ▸ hz, hxmy_dd⟩ + rwa [sub_eq_zero.mp (Set.mem_singleton_iff.mp + (disjointComplement_inter_eq_zero ((J : Set X)ᵈ) hxmy_both))] + · exact subset_disjointComplement_disjointComplement (J : Set X) + exact ⟨{ + toBand := Band.ofPosDirectedSSupMem J + (fun S hS _hpos _hdir hne x hx => by + have hS_dd : S ⊆ ((J : Set X)ᵈ)ᵈ := fun s hs => + subset_disjointComplement_disjointComplement (J : Set X) (hS hs) + have hx_dd := (Band.disjointComplement ((J : Set X)ᵈ)).sSup_mem + hS_dd hne hx + change x ∈ ((J : Set X)ᵈ)ᵈ at hx_dd + rw [heq] at hx_dd; exact hx_dd) + decomposition' := hdecomp }, rfl⟩ + +/-- If `X = J₁ ⊕ J₂` where `J₁` and `J₂` are ideals with `J₁ ⊥ J₂`, then +both are projection bands and `J₂ = J₁ᵈ`. -/ +theorem of_direct_sum_of_disjoint (J₁ J₂ : OrderIdeal X) + (hperp : ∀ x ∈ (J₁ : Set X), ∀ y ∈ (J₂ : Set X), IsVLDisjoint x y) + (hdecomp : ∀ x : X, ∃ y ∈ (J₁ : Set X), ∃ z ∈ (J₂ : Set X), + x = y + z) : + disjointComplement (J₁ : Set X) = (J₂ : Set X) + ∧ ∃ B : ProjectionBand X, (B : Set X) = (J₁ : Set X) := by + have hJ₂_sub : (J₂ : Set X) ⊆ ((J₁ : Set X))ᵈ := fun z hz a ha => + isVLDisjoint_comm.mpr (hperp a ha z hz) + have hJ₁d_sub : ((J₁ : Set X))ᵈ ⊆ (J₂ : Set X) := by + intro z hz + obtain ⟨y, hy, w, hw, hzyw⟩ := hdecomp z + have hw_d : w ∈ ((J₁ : Set X))ᵈ := hJ₂_sub hw + have hy_d : y ∈ ((J₁ : Set X))ᵈ := by + have : y = z - w := by rw [hzyw]; abel + rw [this] + exact ((Band.disjointComplement (J₁ : Set X)).toOrderIdeal).toSubmodule.sub_mem + (show z ∈ ((Band.disjointComplement (J₁ : Set X)).toOrderIdeal).toSubmodule + from hz) hw_d + have hy_zero : y = 0 := Set.mem_singleton_iff.mp + (disjointComplement_inter_eq_zero (J₁ : Set X) ⟨hy, hy_d⟩) + rw [hy_zero, zero_add] at hzyw; rwa [hzyw] + refine ⟨Set.Subset.antisymm hJ₁d_sub hJ₂_sub, ?_⟩ + have hdecomp' : ∀ x : X, ∃ y z : X, y ∈ (J₁ : Set X) + ∧ z ∈ disjointComplement (J₁ : Set X) ∧ x = y + z := fun x => by + obtain ⟨y, hy, z, hz, hxyz⟩ := hdecomp x + exact ⟨y, z, hy, hJ₂_sub hz, hxyz⟩ + exact (projectionBand_iff_add_disjointComplement J₁).mpr hdecomp' + +/-! ### Characterisation of band projections -/ + +private theorem bpi_monotone {T : X →ₗ[ℝ] X} + (hpos : ∀ x : X, 0 ≤ x → 0 ≤ T x) {x y : X} (hxy : x ≤ y) : + T x ≤ T y := by + have : 0 ≤ T (y - x) := hpos _ (sub_nonneg.mpr hxy) + rwa [map_sub, sub_nonneg] at this + +/-- Range and kernel have disjoint positive cones. -/ +private theorem bpi_pos_cone_disjoint {T : X →ₗ[ℝ] X} + (hpos : ∀ x : X, 0 ≤ x → 0 ≤ T x) + (hle : ∀ x : X, 0 ≤ x → T x ≤ x) + {y z : X} (hy : 0 ≤ y) (hz : 0 ≤ z) + (hTy : T y = y) (hTz : T z = 0) : + y ⊓ z = 0 := by + have hyz_nn : 0 ≤ y ⊓ z := le_inf hy hz + have hT_yz_le_z : T (y ⊓ z) ≤ T z := bpi_monotone hpos inf_le_right + rw [hTz] at hT_yz_le_z + have hT_yz_zero : T (y ⊓ z) = 0 := le_antisymm hT_yz_le_z (hpos _ hyz_nn) + -- Apply the same argument to `I - T`, which is positive and dominated by the identity. + have hIT_mono : ∀ {a b : X}, a ≤ b → a - T a ≤ b - T b := fun {a b} hab => by + have h1 : 0 ≤ (b - a) - T (b - a) := sub_nonneg.mpr + (hle (b - a) (sub_nonneg.mpr hab)) + rw [map_sub] at h1 + -- h1 : 0 ≤ (b - a) - (T b - T a) = (b - T b) - (a - T a) + rwa [show (b - a) - (T b - T a) = (b - T b) - (a - T a) by abel, + sub_nonneg] at h1 + have : y ⊓ z ≤ 0 := by + calc y ⊓ z = (y ⊓ z) - T (y ⊓ z) := by rw [hT_yz_zero, sub_zero] + _ ≤ y - T y := hIT_mono inf_le_left + _ = 0 := by rw [hTy, sub_self] + exact le_antisymm this hyz_nn + +/-- If `T w = w` then `T(w⁺) = w⁺` and `T(w⁻) = w⁻`. -/ +private theorem bpi_preserves_parts {T : X →ₗ[ℝ] X} + (hpos : ∀ x : X, 0 ≤ x → 0 ≤ T x) + (hle : ∀ x : X, 0 ≤ x → T x ≤ x) + {w : X} (hTw : T w = w) : + T w⁺ = w⁺ ∧ T w⁻ = w⁻ := by + have hTwp_le : T w⁺ ≤ w⁺ := hle w⁺ (posPart_nonneg w) + have hTwn_le : T w⁻ ≤ w⁻ := hle w⁻ (negPart_nonneg w) + have hdiff : T w⁺ - T w⁻ = w⁺ - w⁻ := by + rw [← map_sub, posPart_sub_negPart, hTw] + have hTdisj : T w⁺ ⊓ T w⁻ = 0 := + le_antisymm (le_trans (inf_le_inf hTwp_le hTwn_le) + (le_of_eq (posPart_inf_negPart_eq_zero w))) + (le_inf (hpos w⁺ (posPart_nonneg w)) (hpos w⁻ (negPart_nonneg w))) + exact isVLDisjoint_decomposition_unique + (hpos w⁺ (posPart_nonneg w)) (hpos w⁻ (negPart_nonneg w)) + (posPart_nonneg w) (negPart_nonneg w) + (isVLDisjoint_of_inf_eq_zero hTdisj) + (isVLDisjoint_of_inf_eq_zero (posPart_inf_negPart_eq_zero w)) + hdiff + +/-- If `T w = w` then `T |w| = |w|`. -/ +private theorem bpi_preserves_abs {T : X →ₗ[ℝ] X} + (hpos : ∀ x : X, 0 ≤ x → 0 ≤ T x) + (hle : ∀ x : X, 0 ≤ x → T x ≤ x) + {w : X} (hTw : T w = w) : T |w| = |w| := by + rw [show |w| = w⁺ + w⁻ from (posPart_add_negPart w).symm, map_add, + (bpi_preserves_parts hpos hle hTw).1, (bpi_preserves_parts hpos hle hTw).2] + +/-- Solidity of the range: if `T x = x`, `0 ≤ y ≤ x`, then `T y = y`. -/ +private theorem bpi_range_solid {T : X →ₗ[ℝ] X} + (hTT : T ∘ₗ T = T) (hpos : ∀ x : X, 0 ≤ x → 0 ≤ T x) + (hle : ∀ x : X, 0 ≤ x → T x ≤ x) + {x y : X} (hx_fixed : T x = x) (hy_nn : 0 ≤ y) (hyx : y ≤ x) : + T y = y := by + have hTy_le_y : T y ≤ y := hle y hy_nn + have hd_nn : 0 ≤ y - T y := sub_nonneg.mpr hTy_le_y + have hd_le_x : y - T y ≤ x := le_trans (sub_le_self y (hpos y hy_nn)) hyx + have hx_nn : 0 ≤ x := le_trans hy_nn hyx + have hres : T (y - T y) = 0 := by + have : T (T y) = T y := LinearMap.congr_fun hTT y + rw [map_sub, this, sub_self] + have hdisjoint := bpi_pos_cone_disjoint hpos hle hx_nn hd_nn hx_fixed hres + have hle_zero : y - T y ≤ 0 := by + calc y - T y ≤ x ⊓ (y - T y) := le_inf hd_le_x le_rfl + _ = 0 := hdisjoint + exact eq_of_sub_eq_zero (le_antisymm hle_zero hd_nn) |>.symm + +/-- The range `{x | T x = x}` is an `OrderIdeal`. -/ +private noncomputable def bpi_rangeIdeal {T : X →ₗ[ℝ] X} + (hTT : T ∘ₗ T = T) (hpos : ∀ x : X, 0 ≤ x → 0 ≤ T x) + (hle : ∀ x : X, 0 ≤ x → T x ≤ x) : OrderIdeal X := + OrderIdeal.ofSolid + { carrier := {x | T x = x} + add_mem' := fun {a b} (ha : T a = a) (hb : T b = b) => + show T (a + b) = a + b by rw [map_add, ha, hb] + zero_mem' := map_zero T + smul_mem' := fun r a (ha : T a = a) => + show T (r • a) = r • a by rw [map_smul, ha] } + (fun a b (ha : T a = a) hab => by + change T b = b + have ha_abs : T |a| = |a| := bpi_preserves_abs hpos hle ha + have hb_abs : T |b| = |b| := + bpi_range_solid hTT hpos hle ha_abs (abs_nonneg b) hab + have hTyp : T b⁺ = b⁺ := bpi_range_solid hTT hpos hle hb_abs + (posPart_nonneg b) (sup_le (le_abs_self b) (abs_nonneg b)) + have hTyn : T b⁻ = b⁻ := bpi_range_solid hTT hpos hle hb_abs + (negPart_nonneg b) (sup_le (neg_le_abs b) (abs_nonneg b)) + calc T b = T (b⁺ - b⁻) := by rw [posPart_sub_negPart] + _ = T b⁺ - T b⁻ := map_sub T b⁺ b⁻ + _ = b⁺ - b⁻ := by rw [hTyp, hTyn] + _ = b := posPart_sub_negPart b) + +/-- The kernel `{x | T x = 0}` is an `OrderIdeal`. -/ +private noncomputable def bpi_kernelIdeal {T : X →ₗ[ℝ] X} + (hpos : ∀ x : X, 0 ≤ x → 0 ≤ T x) + (hle : ∀ x : X, 0 ≤ x → T x ≤ x) : OrderIdeal X := + OrderIdeal.ofSolid + { carrier := {x | T x = 0} + add_mem' := fun {a b} (ha : T a = 0) (hb : T b = 0) => + show T (a + b) = 0 by rw [map_add, ha, hb, add_zero] + zero_mem' := map_zero T + smul_mem' := fun r a (ha : T a = 0) => + show T (r • a) = 0 by rw [map_smul, ha, smul_zero] } + (fun a b (ha : T a = 0) hab => by + change T b = 0 + -- From T a = 0 derive T|a| = 0 via T a⁺ = T a⁻ and disjointness + have hTxp_le : T a⁺ ≤ a⁺ := hle a⁺ (posPart_nonneg a) + have hTxn_le : T a⁻ ≤ a⁻ := hle a⁻ (negPart_nonneg a) + have hTdiff : T a⁺ - T a⁻ = 0 := by + rw [← map_sub, posPart_sub_negPart]; exact ha + have heq : T a⁺ = T a⁻ := sub_eq_zero.mp hTdiff + have hTxp_zero : T a⁺ = 0 := by + apply le_antisymm _ (hpos a⁺ (posPart_nonneg a)) + calc T a⁺ ≤ a⁺ ⊓ T a⁺ := le_inf hTxp_le le_rfl + _ ≤ a⁺ ⊓ a⁻ := inf_le_inf_left a⁺ (heq ▸ hTxn_le) + _ = 0 := posPart_inf_negPart_eq_zero a + have hTxn_zero : T a⁻ = 0 := heq ▸ hTxp_zero + have hTabsa : T |a| = 0 := by + rw [show |a| = a⁺ + a⁻ from (posPart_add_negPart a).symm, + map_add, hTxp_zero, hTxn_zero, add_zero] + -- T|b| ≤ T|a| = 0 by monotonicity + have hTabsb : T |b| = 0 := + le_antisymm (le_trans (bpi_monotone hpos hab) (le_of_eq hTabsa)) + (hpos |b| (abs_nonneg b)) + -- T b⁺, T b⁻ ≤ T|b| = 0 + have hTyp : T b⁺ = 0 := + le_antisymm (le_trans (bpi_monotone hpos + (sup_le (le_abs_self b) (abs_nonneg b))) (le_of_eq hTabsb)) + (hpos b⁺ (posPart_nonneg b)) + have hTyn : T b⁻ = 0 := + le_antisymm (le_trans (bpi_monotone hpos + (sup_le (neg_le_abs b) (abs_nonneg b))) (le_of_eq hTabsb)) + (hpos b⁻ (negPart_nonneg b)) + calc T b = T (b⁺ - b⁻) := by rw [posPart_sub_negPart] + _ = T b⁺ - T b⁻ := map_sub T b⁺ b⁻ + _ = 0 := by rw [hTyp, hTyn, sub_self]) + +/-- Range and kernel are VL-disjoint. -/ +private theorem bpi_range_kernel_disjoint {T : X →ₗ[ℝ] X} + (hTT : T ∘ₗ T = T) (hpos : ∀ x : X, 0 ≤ x → 0 ≤ T x) + (hle : ∀ x : X, 0 ≤ x → T x ≤ x) + (u : X) (hu : u ∈ (bpi_rangeIdeal hTT hpos hle : Set X)) + (v : X) (hv : v ∈ (bpi_kernelIdeal hpos hle : Set X)) : + IsVLDisjoint u v := by + change T u = u at hu; change T v = 0 at hv + have hu_abs : T |u| = |u| := bpi_preserves_abs hpos hle hu + have hv_abs : T |v| = 0 := + show |v| ∈ (bpi_kernelIdeal hpos hle : Set X) from + (bpi_kernelIdeal hpos hle).abs_mem hv + change |u| ⊓ |v| = 0 + exact bpi_pos_cone_disjoint (y := |u|) (z := |v|) hpos hle + (abs_nonneg u) (abs_nonneg v) hu_abs hv_abs + +/-- A linear operator is a band projection iff `T² = T` and `0 ≤ T ≤ id`. -/ +theorem bandProjection_iff (T : X →ₗ[ℝ] X) : + (∃ B : ProjectionBand X, B.bandProjection = T) ↔ + T ∘ₗ T = T ∧ 0 ≤ T ∧ T ≤ LinearMap.id := by + constructor + · rintro ⟨B, rfl⟩ + exact ⟨B.bandProjection_sq, B.bandProjection_nonneg, B.bandProjection_le_id⟩ + · -- The converse requires showing Range(T) is a projection band + rintro ⟨hTT, hpos₀, hle₀⟩ + have hpos : ∀ x : X, 0 ≤ x → 0 ≤ T x := Positive.zero_le_iff.mp hpos₀ + have hle : ∀ x : X, 0 ≤ x → T x ≤ x := fun x hx => Positive.le_iff.mp hle₀ x hx + set R := bpi_rangeIdeal hTT hpos hle + set K := bpi_kernelIdeal hpos hle + -- R and K are disjoint and decompose X + have hperp : ∀ u ∈ (R : Set X), ∀ v ∈ (K : Set X), + IsVLDisjoint u v := + bpi_range_kernel_disjoint hTT hpos hle + have hdecomp : ∀ x : X, ∃ y ∈ (R : Set X), ∃ z ∈ (K : Set X), + x = y + z := fun x => by + refine ⟨T x, ?_, x - T x, ?_, ?_⟩ + · change T (T x) = T x; exact LinearMap.congr_fun hTT x + · change T (x - T x) = 0 + have : T (T x) = T x := LinearMap.congr_fun hTT x + rw [map_sub, this, sub_self] + · abel + obtain ⟨hdc, B, hBset⟩ := of_direct_sum_of_disjoint R K hperp hdecomp + refine ⟨B, ?_⟩ + ext x + -- B.bandProjection x and T x are both the R-component of x + have hTx_B : T x ∈ (B : Set X) := by + rw [hBset]; change T (T x) = T x; exact LinearMap.congr_fun hTT x + have hQx_Bd : x - T x ∈ disjointComplement (B : Set X) := by + rw [hBset, hdc] + change T (x - T x) = 0 + have : T (T x) = T x := LinearMap.congr_fun hTT x + rw [map_sub, this, sub_self] + have hBx_dec : x = B.bandProjection x + (x - B.bandProjection x) := by + abel + have hTx_dec : x = T x + (x - T x) := by abel + exact (B.decomposition_unique (B.bandProjection_mem x) + (B.id_sub_bandProjection_mem x) hTx_B hQx_Bd hBx_dec hTx_dec).1 + +/-- A band projection is a lattice homomorphism. -/ +theorem bandProjection_isVecLatHom : + IsVecLatHom B.bandProjection.toFun := by + have hpos : Positive B.bandProjection := Positive.zero_le_iff.mp B.bandProjection_nonneg + have hle : ∀ x : X, 0 ≤ x → B.bandProjection x ≤ x := + fun x hx => Positive.le_iff.mp B.bandProjection_le_id x hx + apply IsVecLatHom.of_disjoint + · exact B.bandProjection.isLinear + · intro x y hxy + have hx : 0 ≤ x := hxy ▸ inf_le_left + have hy : 0 ≤ y := hxy ▸ inf_le_right + apply le_antisymm + · calc B.bandProjection x ⊓ B.bandProjection y + ≤ x ⊓ y := inf_le_inf (hle x hx) (hle y hy) + _ = 0 := hxy + · exact le_inf (hpos _ hx) (hpos _ hy) + +/-! ### Band projection lemmas -/ + +/-- A band projection sends every band to itself: for any band `J` and any +projection band `B`, if `x ∈ J` then `B.bandProjection x ∈ J`. -/ +private lemma bandProjection_mem_band (B : ProjectionBand X) (J : Band X) + {x : X} (hx : x ∈ J) : B.bandProjection x ∈ J := by + have hpos : ∀ y, 0 ≤ y → y ∈ J → B.bandProjection y ∈ J := fun y hy hyJ => + J.solid hyJ + (Positive.zero_le_iff.mp B.bandProjection_nonneg y hy) + (Positive.le_iff.mp B.bandProjection_le_id y hy) + have habs : |x| ∈ J := J.abs_mem hx + have hxp : x⁺ ∈ J := + J.solid habs (posPart_nonneg x) (sup_le (le_abs_self x) (abs_nonneg x)) + have hxn : x⁻ ∈ J := + J.solid habs (negPart_nonneg x) (sup_le (neg_le_abs x) (abs_nonneg x)) + have heq : B.bandProjection x = + B.bandProjection x⁺ - B.bandProjection x⁻ := by + rw [← map_sub, posPart_sub_negPart] + rw [heq] + exact J.toOrderIdeal.toSubmodule.sub_mem + (hpos _ (posPart_nonneg x) hxp) (hpos _ (negPart_nonneg x) hxn) + +/-- An element disjoint from two bands is disjoint from their supremum. -/ +private lemma mem_disjointComplement_band_sup {B₁ B₂ : Band X} {z : X} + (h₁ : z ∈ disjointComplement (B₁ : Set X)) + (h₂ : z ∈ disjointComplement (B₂ : Set X)) : + z ∈ disjointComplement ((B₁ ⊔ B₂ : Band X) : Set X) := by + intro a ha + have hle : B₁ ⊔ B₂ ≤ Band.disjointComplement {z} := + sup_le + (fun b hb c hc => by rcases hc with rfl; exact isVLDisjoint_comm.mp (h₁ b hb)) + (fun b hb c hc => by rcases hc with rfl; exact isVLDisjoint_comm.mp (h₂ b hb)) + exact isVLDisjoint_comm.mp (hle ha z rfl) + +/-! ### Lattice structure of projection bands + +Projection bands of `X`, ordered by inclusion, form a Boolean algebra. The +order, top, and bottom are inherited from the lattice of bands; binary infima +are given by intersection, binary suprema set-theoretically by the algebraic +sum `B₁ + B₂ = {y + z : y ∈ B₁, z ∈ B₂}`, and the complement is the disjoint +complement. -/ + +/-- Projection bands inherit the partial order by inclusion from `SetLike`. -/ +instance : PartialOrder (ProjectionBand X) := .ofSetLike (ProjectionBand X) + +/-- The whole space `X` is a projection band. -/ +instance : Top (ProjectionBand X) where + top := + { toBand := (⊤ : Band X) + decomposition' := fun x => ⟨x, 0, + show x ∈ ((⊤ : Band X) : Set X) from Band.mem_top, + fun a _ => isVLDisjoint_zero_left a, (add_zero x).symm⟩ } + +@[simp] theorem mem_top {x : X} : x ∈ (⊤ : ProjectionBand X) := + show x ∈ ((⊤ : Band X) : Set X) from Band.mem_top + +/-- The trivial band `{0}` is a projection band. -/ +instance : Bot (ProjectionBand X) where + bot := + { toBand := (⊥ : Band X) + decomposition' := fun x => ⟨0, x, + show (0 : X) ∈ ((⊥ : Band X) : Set X) from + (⊥ : Band X).toOrderIdeal.toSubmodule.zero_mem, + fun a ha => by + have ha0 : a = 0 := Band.mem_bot.mp ha + rw [ha0]; exact isVLDisjoint_zero_right x, + (zero_add x).symm⟩ } + +@[simp] theorem mem_bot {x : X} : x ∈ (⊥ : ProjectionBand X) ↔ x = 0 := + show x ∈ ((⊥ : Band X) : Set X) ↔ x = 0 from Band.mem_bot + +/-- The disjoint complement of a projection band, again a projection band. -/ +instance : Compl (ProjectionBand X) where + compl B := B.disjointComplementProjectionBand + +/-- The complement projection band has the expected underlying disjoint complement. -/ +theorem coe_compl (B : ProjectionBand X) : + ((Bᶜ : ProjectionBand X) : Set X) = ((B : Set X))ᵈ := rfl + +/-- Binary infimum of projection bands: the set-theoretic intersection. -/ +instance : Min (ProjectionBand X) where + min B₁ B₂ := + { toBand := B₁.toBand ⊓ B₂.toBand + decomposition' := fun x => by + refine ⟨B₂.bandProjection (B₁.bandProjection x), + x - B₂.bandProjection (B₁.bandProjection x), + ⟨bandProjection_mem_band B₂ B₁.toBand (B₁.bandProjection_mem x), + B₂.bandProjection_mem _⟩, ?_, by abel⟩ + intro a ha + have ha₁ : a ∈ (B₁ : Set X) := ha.1 + have ha₂ : a ∈ (B₂ : Set X) := ha.2 + have hsplit : x - B₂.bandProjection (B₁.bandProjection x) + = (x - B₁.bandProjection x) + + (B₁.bandProjection x - B₂.bandProjection (B₁.bandProjection x)) := by + abel + rw [hsplit] + exact (B₁.id_sub_bandProjection_mem x a ha₁).add_left + (B₂.id_sub_bandProjection_mem (B₁.bandProjection x) a ha₂) } + +/-- Binary supremum of projection bands: the algebraic sum +`{y + z : y ∈ B₁, z ∈ B₂}`. -/ +instance : Max (ProjectionBand X) where + max B₁ B₂ := + { toBand := B₁.toBand ⊔ B₂.toBand + decomposition' := fun x => by + set p := B₁.bandProjection x with hp_def + set q := B₂.bandProjection (x - p) with hq_def + refine ⟨p + q, x - (p + q), ?_, ?_, by abel⟩ + · -- p + q ∈ B₁.toBand ⊔ B₂.toBand + have hp : p ∈ ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := + (le_sup_left : B₁.toBand ≤ _) (B₁.bandProjection_mem x) + have hq : q ∈ ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := + (le_sup_right : B₂.toBand ≤ _) (B₂.bandProjection_mem _) + exact (B₁.toBand ⊔ B₂.toBand).toOrderIdeal.toSubmodule.add_mem hp hq + · -- x - (p + q) ∈ disjointComplement + have hxmp : x - p ∈ disjointComplement (B₁ : Set X) := + B₁.id_sub_bandProjection_mem x + have hq_B₁d : q ∈ disjointComplement (B₁ : Set X) := + bandProjection_mem_band B₂ + (Band.disjointComplement (B₁ : Set X)) hxmp + have hxpq_B₁d : x - (p + q) ∈ disjointComplement (B₁ : Set X) := by + have heq : x - (p + q) = (x - p) - q := by abel + rw [heq] + exact (Band.disjointComplement (B₁ : Set X)).toOrderIdeal.toSubmodule.sub_mem + hxmp hq_B₁d + have hxpq_B₂d : x - (p + q) ∈ disjointComplement (B₂ : Set X) := by + have heq : x - (p + q) = (x - p) - q := by abel + rw [heq] + exact B₂.id_sub_bandProjection_mem (x - p) + exact mem_disjointComplement_band_sup hxpq_B₁d hxpq_B₂d } + +@[simp] theorem inf_toBand (B₁ B₂ : ProjectionBand X) : + (B₁ ⊓ B₂).toBand = B₁.toBand ⊓ B₂.toBand := rfl + +@[simp] theorem sup_toBand (B₁ B₂ : ProjectionBand X) : + (B₁ ⊔ B₂).toBand = B₁.toBand ⊔ B₂.toBand := rfl + +/-- For two projection bands, the supremum of their underlying bands coincides +with the set of algebraic sums `{y + z : y ∈ B₁, z ∈ B₂}`. -/ +theorem coe_band_sup_eq_add (B₁ B₂ : ProjectionBand X) : + ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) + = {x | ∃ y ∈ (B₁ : Set X), ∃ z ∈ (B₂ : Set X), x = y + z} := by + ext x + refine ⟨fun hx => ?_, ?_⟩ + · set p := B₁.bandProjection x with hp_def + set q := B₂.bandProjection (x - p) with hq_def + refine ⟨p, B₁.bandProjection_mem x, q, B₂.bandProjection_mem _, ?_⟩ + have hxmp : x - p ∈ disjointComplement (B₁ : Set X) := + B₁.id_sub_bandProjection_mem x + have hq_B₁d : q ∈ disjointComplement (B₁ : Set X) := + bandProjection_mem_band B₂ + (Band.disjointComplement (B₁ : Set X)) hxmp + have hxpq_B₁d : x - (p + q) ∈ disjointComplement (B₁ : Set X) := by + have heq : x - (p + q) = (x - p) - q := by abel + rw [heq] + exact (Band.disjointComplement (B₁ : Set X)).toOrderIdeal.toSubmodule.sub_mem + hxmp hq_B₁d + have hxpq_B₂d : x - (p + q) ∈ disjointComplement (B₂ : Set X) := by + have heq : x - (p + q) = (x - p) - q := by abel + rw [heq] + exact B₂.id_sub_bandProjection_mem (x - p) + have hxpq_supd : x - (p + q) ∈ + disjointComplement ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := + mem_disjointComplement_band_sup hxpq_B₁d hxpq_B₂d + have hxpq_sup : x - (p + q) ∈ ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := by + have hp_sup : p ∈ ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := + (le_sup_left : B₁.toBand ≤ _) (B₁.bandProjection_mem x) + have hq_sup : q ∈ ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := + (le_sup_right : B₂.toBand ≤ _) (B₂.bandProjection_mem _) + exact (B₁.toBand ⊔ B₂.toBand).toOrderIdeal.toSubmodule.sub_mem hx + ((B₁.toBand ⊔ B₂.toBand).toOrderIdeal.toSubmodule.add_mem hp_sup hq_sup) + have hzero : x - (p + q) = 0 := + Set.mem_singleton_iff.mp + (disjointComplement_inter_eq_zero _ ⟨hxpq_sup, hxpq_supd⟩) + exact (sub_eq_zero.mp hzero) + · rintro ⟨y, hy, z, hz, rfl⟩ + have hy_sup : y ∈ ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := + (le_sup_left : B₁.toBand ≤ _) hy + have hz_sup : z ∈ ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := + (le_sup_right : B₂.toBand ≤ _) hz + exact (B₁.toBand ⊔ B₂.toBand).toOrderIdeal.toSubmodule.add_mem hy_sup hz_sup + +/-- Projection bands of `X`, ordered by inclusion, form a Boolean algebra. +The binary lattice operations are intersection and algebraic sum, top and +bottom are the whole space and the trivial band `{0}`, and the complement is +the disjoint complement. -/ +instance : BooleanAlgebra (ProjectionBand X) where + sup := (· ⊔ ·) + inf := (· ⊓ ·) + le_sup_left B₁ B₂ x hx := (le_sup_left : B₁.toBand ≤ B₁.toBand ⊔ B₂.toBand) hx + le_sup_right B₁ B₂ x hx := (le_sup_right : B₂.toBand ≤ B₁.toBand ⊔ B₂.toBand) hx + sup_le B₁ B₂ K h₁ h₂ x hx := + (sup_le (show B₁.toBand ≤ K.toBand from h₁) + (show B₂.toBand ≤ K.toBand from h₂)) hx + inf_le_left _ _ _ h := h.1 + inf_le_right _ _ _ h := h.2 + le_inf _ _ _ h₁ h₂ _ hx := ⟨h₁ hx, h₂ hx⟩ + le_sup_inf := fun B B₁ B₂ t ht => by + obtain ⟨ht_BB₁, ht_BB₂⟩ := ht + set p := B.bandProjection t with hp_def + have hp_B : p ∈ B := B.bandProjection_mem t + have hcomp : ∀ (J : ProjectionBand X), t ∈ ((B.toBand ⊔ J.toBand : Band X) : Set X) → + t - p ∈ J := fun J ht_BJ => by + rw [coe_band_sup_eq_add B J] at ht_BJ + obtain ⟨b, hbB, a, haJ, htba⟩ := ht_BJ + have hpa : p = b + B.bandProjection a := by + rw [hp_def, htba, map_add, B.bandProjection_eq_of_mem hbB] + have hq_eq : t - p = a - B.bandProjection a := by rw [htba, hpa]; abel + rw [hq_eq] + exact J.toBand.toOrderIdeal.toSubmodule.sub_mem haJ + (bandProjection_mem_band B J.toBand haJ) + have hq_B₁ : t - p ∈ B₁ := hcomp B₁ ht_BB₁ + have hq_B₂ : t - p ∈ B₂ := hcomp B₂ ht_BB₂ + change t ∈ ((B.toBand ⊔ (B₁.toBand ⊓ B₂.toBand) : Band X) : Set X) + rw [show (B₁.toBand ⊓ B₂.toBand : Band X) = (B₁ ⊓ B₂).toBand from rfl, + coe_band_sup_eq_add B (B₁ ⊓ B₂)] + exact ⟨p, hp_B, t - p, ⟨hq_B₁, hq_B₂⟩, by abel⟩ + top := ⊤ + bot := ⊥ + le_top _ _ _ := Submodule.mem_top + bot_le B x hx := by + rw [mem_bot.mp hx]; exact B.toBand.toOrderIdeal.toSubmodule.zero_mem + compl := (·ᶜ) + inf_compl_le_bot := fun B x hx => by + have hx0 : x = 0 := Set.mem_singleton_iff.mp + (disjointComplement_inter_eq_zero (B : Set X) ⟨hx.1, hx.2⟩) + exact mem_bot.mpr hx0 + top_le_sup_compl := fun B x _ => by + obtain ⟨y, z, hy, hz, heq⟩ := B.decomposition x + change x ∈ ((B.toBand ⊔ Bᶜ.toBand : Band X) : Set X) + rw [coe_band_sup_eq_add B Bᶜ] + exact ⟨y, hy, z, hz, heq⟩ + sdiff B₁ B₂ := B₁ ⊓ B₂ᶜ + himp B₁ B₂ := B₂ ⊔ B₁ᶜ + +/-! ### Band projections of associated lattice operations -/ + +/-- The band projection onto `B₁ ⊓ B₂` is the composition of the band +projections of `B₁` and `B₂`. -/ +theorem bandProjection_inf (B₁ B₂ : ProjectionBand X) : + (B₁ ⊓ B₂).bandProjection = B₁.bandProjection ∘ₗ B₂.bandProjection := by + ext x + change (B₁ ⊓ B₂).bandProjection x = B₁.bandProjection (B₂.bandProjection x) + set y := B₁.bandProjection (B₂.bandProjection x) + have hy_B₂ : y ∈ B₂ := + bandProjection_mem_band B₁ B₂.toBand (B₂.bandProjection_mem x) + have hy_B₁ : y ∈ B₁ := B₁.bandProjection_mem _ + have hy_inf : y ∈ ((B₁ ⊓ B₂ : ProjectionBand X) : Set X) := ⟨hy_B₁, hy_B₂⟩ + have hd : x - y ∈ disjointComplement ((B₁ ⊓ B₂ : ProjectionBand X) : Set X) := by + intro a ha + have ha₁ : a ∈ (B₁ : Set X) := ha.1 + have ha₂ : a ∈ (B₂ : Set X) := ha.2 + have hsplit : x - y = (x - B₂.bandProjection x) + + (B₂.bandProjection x - y) := by abel + rw [hsplit] + exact (B₂.id_sub_bandProjection_mem x a ha₂).add_left + (B₁.id_sub_bandProjection_mem (B₂.bandProjection x) a ha₁) + have heq₁ : x = (B₁ ⊓ B₂).bandProjection x + (x - (B₁ ⊓ B₂).bandProjection x) := + by abel + have heq₂ : x = y + (x - y) := by abel + exact ((B₁ ⊓ B₂).decomposition_unique + ((B₁ ⊓ B₂).bandProjection_mem x) + ((B₁ ⊓ B₂).id_sub_bandProjection_mem x) + hy_inf hd heq₁ heq₂).1 + +/-- Two band projections commute. -/ +theorem bandProjection_comm (B₁ B₂ : ProjectionBand X) : + B₁.bandProjection ∘ₗ B₂.bandProjection + = B₂.bandProjection ∘ₗ B₁.bandProjection := by + rw [← bandProjection_inf B₁ B₂, ← bandProjection_inf B₂ B₁, + show (B₁ ⊓ B₂ : ProjectionBand X) = B₂ ⊓ B₁ from inf_comm _ _] + +/-- The band projection onto `B₁ ⊔ B₂` equals `P₁ + P₂ - P₁ ∘ P₂`. -/ +theorem bandProjection_sup (B₁ B₂ : ProjectionBand X) : + (B₁ ⊔ B₂).bandProjection + = B₁.bandProjection + B₂.bandProjection + - B₁.bandProjection ∘ₗ B₂.bandProjection := by + ext x + change (B₁ ⊔ B₂).bandProjection x = + B₁.bandProjection x + B₂.bandProjection x - + B₁.bandProjection (B₂.bandProjection x) + set y := B₁.bandProjection x + B₂.bandProjection x - + B₁.bandProjection (B₂.bandProjection x) with hy_def + have hy_sup : y ∈ ((B₁ ⊔ B₂ : ProjectionBand X) : Set X) := by + change y ∈ ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) + have h1 : B₁.bandProjection x ∈ ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := + (le_sup_left : B₁.toBand ≤ _) (B₁.bandProjection_mem x) + have h2 : B₂.bandProjection x ∈ ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := + (le_sup_right : B₂.toBand ≤ _) (B₂.bandProjection_mem x) + have h3 : B₁.bandProjection (B₂.bandProjection x) ∈ + ((B₁.toBand ⊔ B₂.toBand : Band X) : Set X) := + (le_sup_left : B₁.toBand ≤ _) (B₁.bandProjection_mem _) + exact (B₁.toBand ⊔ B₂.toBand).toOrderIdeal.toSubmodule.sub_mem + ((B₁.toBand ⊔ B₂.toBand).toOrderIdeal.toSubmodule.add_mem h1 h2) h3 + have hxy_B₁d : x - y ∈ disjointComplement (B₁ : Set X) := by + have heq : x - y = (x - B₁.bandProjection x) - + (B₂.bandProjection x - B₁.bandProjection (B₂.bandProjection x)) := by + rw [hy_def]; abel + rw [heq] + exact (Band.disjointComplement (B₁ : Set X)).toOrderIdeal.toSubmodule.sub_mem + (B₁.id_sub_bandProjection_mem x) + (B₁.id_sub_bandProjection_mem (B₂.bandProjection x)) + have hxy_B₂d : x - y ∈ disjointComplement (B₂ : Set X) := by + have heq : x - y = (x - B₂.bandProjection x) - + B₁.bandProjection (x - B₂.bandProjection x) := by + rw [hy_def, map_sub]; abel + rw [heq] + exact (Band.disjointComplement (B₂ : Set X)).toOrderIdeal.toSubmodule.sub_mem + (B₂.id_sub_bandProjection_mem x) + (bandProjection_mem_band B₁ (Band.disjointComplement (B₂ : Set X)) + (B₂.id_sub_bandProjection_mem x)) + have hxy_supd : x - y ∈ + disjointComplement ((B₁ ⊔ B₂ : ProjectionBand X) : Set X) := + mem_disjointComplement_band_sup hxy_B₁d hxy_B₂d + have heq₁ : x = (B₁ ⊔ B₂).bandProjection x + (x - (B₁ ⊔ B₂).bandProjection x) := + by abel + have heq₂ : x = y + (x - y) := by abel + exact ((B₁ ⊔ B₂).decomposition_unique + ((B₁ ⊔ B₂).bandProjection_mem x) + ((B₁ ⊔ B₂).id_sub_bandProjection_mem x) + hy_sup hxy_supd heq₁ heq₂).1 + +/-- The band projection onto the complement equals `id - P`. -/ +theorem bandProjection_compl (B : ProjectionBand X) : + Bᶜ.bandProjection = LinearMap.id - B.bandProjection := by + ext x + simp only [LinearMap.sub_apply, LinearMap.id_apply] + have hy_comp : x - B.bandProjection x ∈ ((Bᶜ : ProjectionBand X) : Set X) := + B.id_sub_bandProjection_mem x + have hz_compd : B.bandProjection x ∈ + disjointComplement ((Bᶜ : ProjectionBand X) : Set X) := fun a ha => + isVLDisjoint_comm.mp (ha _ (B.bandProjection_mem x)) + have heq₁ : x = Bᶜ.bandProjection x + (x - Bᶜ.bandProjection x) := by abel + have heq₂ : x = (x - B.bandProjection x) + B.bandProjection x := by abel + exact (Bᶜ.decomposition_unique + (Bᶜ.bandProjection_mem x) + (Bᶜ.id_sub_bandProjection_mem x) + hy_comp hz_compd heq₁ heq₂).1 + +/-! ### Characterisation via order interval suprema -/ + +/-- For a non-negative element, the existence of `IsLUB (B ∩ [0, x])` yields a +disjoint decomposition `x = y + z` with `y ∈ B`, `z ∈ Bᵈ`. -/ +private lemma exists_decomposition_of_isLUB_pos {B : Band X} + (hLUB : ∀ x : X, 0 ≤ x → ∃ s, IsLUB ((B : Set X) ∩ Set.Icc 0 x) s) + {x : X} (hx_nn : 0 ≤ x) : + ∃ y z : X, y ∈ (B : Set X) ∧ z ∈ disjointComplement (B : Set X) ∧ x = y + z := by + obtain ⟨sp, hsp⟩ := hLUB x hx_nn + have hzero_in_S : (0 : X) ∈ (B : Set X) ∩ Set.Icc 0 x := + ⟨B.toOrderIdeal.toSubmodule.zero_mem, le_refl 0, hx_nn⟩ + have hsp_mem : sp ∈ B := B.sSup_mem (fun y hy => hy.1) ⟨0, hzero_in_S⟩ hsp + have hsp_nn : 0 ≤ sp := hsp.1 hzero_in_S + have hsp_le : sp ≤ x := hsp.2 (fun y hy => hy.2.2) + refine ⟨sp, x - sp, hsp_mem, ?_, by abel⟩ + intro a ha + set d := x - sp with hd_def + have hd_nn : 0 ≤ d := sub_nonneg.mpr hsp_le + have hda_nn : 0 ≤ d ⊓ |a| := le_inf hd_nn (abs_nonneg _) + have habs_B : |a| ∈ B := B.abs_mem ha + have hda_B : d ⊓ |a| ∈ B := B.solid habs_B hda_nn inf_le_right + have hsum_B : sp + d ⊓ |a| ∈ B := + B.toOrderIdeal.toSubmodule.add_mem hsp_mem hda_B + have hsum_le : sp + d ⊓ |a| ≤ x := by + have h1 : sp + d ⊓ |a| ≤ sp + d := by gcongr; exact inf_le_left + have h2 : sp + d = x := by rw [hd_def]; abel + exact h2 ▸ h1 + have hub : sp + d ⊓ |a| ≤ sp := + hsp.1 ⟨hsum_B, add_nonneg hsp_nn hda_nn, hsum_le⟩ + have hda_zero : d ⊓ |a| ≤ 0 := by + have h1 : sp + d ⊓ |a| - sp ≤ sp - sp := sub_le_sub_right hub _ + rw [add_sub_cancel_left, sub_self] at h1; exact h1 + have hda_eq : d ⊓ |a| = 0 := le_antisymm hda_zero hda_nn + change |x - sp| ⊓ |a| = 0 + rw [abs_of_nonneg hd_nn]; exact hda_eq + +/-- For a projection band `B` and `x ∈ X₊`, the band projection of `x` is the +supremum of `B ∩ [0, x]`. -/ +theorem isLUB_inter_Icc_bandProjection (B : ProjectionBand X) {x : X} (hx : 0 ≤ x) : + IsLUB ((B : Set X) ∩ Set.Icc 0 x) (B.bandProjection x) := by + have hBx_nn : 0 ≤ B.bandProjection x := + Positive.zero_le_iff.mp B.bandProjection_nonneg x hx + have hBx_le : B.bandProjection x ≤ x := + Positive.le_iff.mp B.bandProjection_le_id x hx + have hBx_mem : B.bandProjection x ∈ B := B.bandProjection_mem x + refine ⟨?_, fun u hu => hu ⟨hBx_mem, hBx_nn, hBx_le⟩⟩ + rintro y ⟨hyB, _, hyx⟩ + have hPy : B.bandProjection y = y := B.bandProjection_eq_of_mem hyB + have h := Positive.zero_le_iff.mp B.bandProjection_nonneg (x - y) + (sub_nonneg.mpr hyx) + rw [map_sub] at h + have hmono : B.bandProjection y ≤ B.bandProjection x := sub_nonneg.mp h + exact hPy ▸ hmono + +/-- A band `B` is a projection band iff for every `x ∈ X₊` the set +`B ∩ [0, x]` admits a supremum. -/ +theorem projectionBand_iff_isLUB_inter_Icc (B : Band X) : + (∃ P : ProjectionBand X, (P : Set X) = (B : Set X)) + ↔ ∀ x : X, 0 ≤ x → ∃ s, IsLUB ((B : Set X) ∩ Set.Icc 0 x) s := by + refine ⟨fun ⟨P, hPB⟩ x hx => ⟨P.bandProjection x, ?_⟩, fun hLUB => ?_⟩ + · have h := isLUB_inter_Icc_bandProjection P hx + rw [hPB] at h; exact h + · have hadd : ∀ x : X, ∃ y z : X, y ∈ (B : Set X) + ∧ z ∈ disjointComplement (B : Set X) ∧ x = y + z := by + intro x + obtain ⟨yp, zp, hyp, hzp, hxp⟩ := + exists_decomposition_of_isLUB_pos hLUB (posPart_nonneg x) + obtain ⟨yn, zn, hyn, hzn, hxn⟩ := + exists_decomposition_of_isLUB_pos hLUB (negPart_nonneg x) + refine ⟨yp - yn, zp - zn, + B.toOrderIdeal.toSubmodule.sub_mem hyp hyn, + (Band.disjointComplement (B : Set X)).toOrderIdeal.toSubmodule.sub_mem hzp hzn, + ?_⟩ + calc x = x⁺ - x⁻ := (posPart_sub_negPart x).symm + _ = (yp + zp) - (yn + zn) := by rw [← hxp, ← hxn] + _ = (yp - yn) + (zp - zn) := by abel + exact (projectionBand_iff_add_disjointComplement B.toOrderIdeal).mpr hadd + +/-- If a projection band `B` has the same underlying set as the principal band +generated by `a ∈ X₊`, then for every `x ∈ X₊` the band projection of `x` +equals the supremum of `(x ⊓ n • a)_{n ∈ ℕ}`. -/ +theorem isLUB_range_bandProjection_of_principalBand [IsVLArchimedean X] + {a : X} (ha : 0 ≤ a) + (B : ProjectionBand X) (hB : (B : Set X) = (Band.generated {a} : Set X)) + {x : X} (hx : 0 ≤ x) : + IsLUB (Set.range fun n : ℕ => x ⊓ (n : ℕ) • a) (B.bandProjection x) := by + have hBx_nn : 0 ≤ B.bandProjection x := + Positive.zero_le_iff.mp B.bandProjection_nonneg x hx + have hBx_le : B.bandProjection x ≤ x := + Positive.le_iff.mp B.bandProjection_le_id x hx + have hBx_in : B.bandProjection x ∈ B := B.bandProjection_mem x + have ha_in : a ∈ B := by + have : a ∈ (B : Set X) := by rw [hB]; exact Band.subset_generated _ rfl + exact this + have hin : ∀ n : ℕ, x ⊓ n • a ∈ B := by + intro n + have hna_in : n • a ∈ B := + B.toBand.toOrderIdeal.toSubmodule.nsmul_mem ha_in n + exact B.toBand.solid hna_in (le_inf hx (nsmul_nonneg ha n)) inf_le_right + refine ⟨?_, ?_⟩ + · rintro _ ⟨n, rfl⟩ + have h := isLUB_inter_Icc_bandProjection B hx + exact h.1 ⟨hin n, le_inf hx (nsmul_nonneg ha n), inf_le_left⟩ + · intro u hu + have hBx_gen : B.bandProjection x ∈ Band.generated ({a} : Set X) := by + have : B.bandProjection x ∈ (B : Set X) := hBx_in + rw [hB] at this; exact this + have hLUB := (Band.mem_generated_singleton_iff_isLUB_inf_nsmul ha hBx_nn).mp hBx_gen + apply hLUB.2 + rintro _ ⟨n, rfl⟩ + calc B.bandProjection x ⊓ n • a + ≤ x ⊓ n • a := inf_le_inf_right _ hBx_le + _ ≤ u := hu ⟨n, rfl⟩ + +/-- The principal band generated by `a ∈ X₊` is a projection band iff for every +`x ∈ X₊` the family `(x ⊓ n • a)_{n ∈ ℕ}` admits a supremum. -/ +theorem principalBand_projectionBand_iff_isLUB_range [IsVLArchimedean X] + {a : X} (ha : 0 ≤ a) : + (∃ P : ProjectionBand X, (P : Set X) = (Band.generated {a} : Set X)) + ↔ ∀ x : X, 0 ≤ x → + ∃ s, IsLUB (Set.range fun n : ℕ => x ⊓ (n : ℕ) • a) s := by + refine ⟨fun ⟨P, hPB⟩ x hx => ⟨P.bandProjection x, + isLUB_range_bandProjection_of_principalBand ha P hPB hx⟩, fun hLUB => ?_⟩ + apply (projectionBand_iff_isLUB_inter_Icc (Band.generated {a})).mpr + intro x hx + obtain ⟨s, hs⟩ := hLUB x hx + have hin : ∀ n : ℕ, x ⊓ n • a ∈ Band.generated ({a} : Set X) := by + intro n + have ha_in : a ∈ Band.generated ({a} : Set X) := Band.subset_generated _ rfl + have hna_in : n • a ∈ Band.generated ({a} : Set X) := + (Band.generated _).toOrderIdeal.toSubmodule.nsmul_mem ha_in n + exact (Band.generated _).solid hna_in + (le_inf hx (nsmul_nonneg ha n)) inf_le_right + have h0_eq : (fun n : ℕ => x ⊓ n • a) 0 = 0 := by + change x ⊓ (0 : ℕ) • a = 0 + rw [zero_nsmul]; exact inf_of_le_right hx + have hs_nn : 0 ≤ s := by + have := hs.1 ⟨0, rfl⟩ + rw [h0_eq] at this; exact this + have hs_le_x : s ≤ x := hs.2 (by rintro _ ⟨n, rfl⟩; exact inf_le_left) + refine ⟨s, ?_, fun u hu => ?_⟩ + · rintro y ⟨hy_gen, hy_nn, hy_le_x⟩ + have hLUB_y := + (Band.mem_generated_singleton_iff_isLUB_inf_nsmul ha hy_nn).mp hy_gen + apply hLUB_y.2 + rintro _ ⟨n, rfl⟩ + calc y ⊓ n • a + ≤ x ⊓ n • a := inf_le_inf_right _ hy_le_x + _ ≤ s := hs.1 ⟨n, rfl⟩ + · apply hs.2 + rintro _ ⟨n, rfl⟩ + exact hu ⟨hin n, le_inf hx (nsmul_nonneg ha n), inf_le_left⟩ + +end ProjectionBand diff --git a/LeanPool/FBLOrderContinuity/ConvexityBound.lean b/LeanPool/FBLOrderContinuity/ConvexityBound.lean new file mode 100644 index 0000000000..296a1a2b84 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/ConvexityBound.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + +module + +public import LeanPool.FBLOrderContinuity.EuclideanFamilies +public import Mathlib.Analysis.SpecialFunctions.Pow.Asymptotics + + + +/-! +# The exponent obstruction from Euclidean dual families + +For an infinite-dimensional space and finite p ≥ 2, `dual_euclidean_family` gives +a lower bound of order n^(1/p) for suitable lattice q-sums of generators. A +q-convexity constant C gives the upper bound 4 C n^(1/q). Growth as n tends to +infinity rules out q > p, including q = infinity, where the reciprocal exponent is +interpreted as zero. + +`parameter_bound_ge_two` is the resulting obstruction. `Parameters.lean` extends +it to arbitrary finite p by passing through the intermediate exponent max(2,p). +-/ + +@[expose] public section + +noncomputable section +open scoped BigOperators ENNReal NNReal Topology +open Filter Set + +namespace FBLOrderContinuousLH +namespace ConvexityBound + +/-- For a nonempty family of n ones, the scalar p-sum is `n^(p.toReal⁻¹)`. +At ∞, `ENNReal.toReal ∞ = 0` makes the exponent zero and the value is one. -/ +private theorem scalarPSum_ones (p : Exponent) {n : ℕ} (hn : 0 < n) : + scalarPSum p (fun _ : Fin n => (1 : ℝ)) = (n : ℝ) ^ p.1.toReal⁻¹ := by + let : NeZero n := ⟨Nat.ne_of_gt hn⟩ + by_cases ht : p.1 = ⊤ + · simp only [scalarPSum, ht, ↓reduceIte, abs_one, ENNReal.toReal_top, inv_zero, Real.rpow_zero] + change ((Finset.univ.sup (fun _ : Fin n => (1 : ℝ≥0)) : ℝ≥0) : ℝ) = 1 + rw [Finset.sup_const Finset.univ_nonempty] + rfl + · simp [scalarPSum, ht, one_div] + +/-- A q-convexity constant C for `Free p E` on an infinite-dimensional space, +with p ≥ 2, forces `n^(1/p) ≤ 4 C n^(1/q)` for every positive integer n. Evaluate +lattice q-sums of unit-ball generators on the Euclidean dual family for the lower +bound and use q-convexity for the upper bound. -/ +private theorem convexity_growth_bound {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + (hE : ¬ FiniteDimensional ℝ E) (p q : Exponent) (h2p : Exponent.two ≤ p) + {C : ℝ} (hC : ConvexWith q C (Free p E)) (n : ℕ) (hn : 0 < n) : + (n : ℝ) ^ p.1.toReal⁻¹ ≤ 4 * C * (n : ℝ) ^ q.1.toReal⁻¹ := by + obtain ⟨φ, hφ, hnormφ⟩ := EuclideanFamilies.dual_euclidean_family hE n + have hφp : NormAdmissible p φ := fun x hx => + (scalarPSum_mono_exponent h2p _).trans (hφ x hx) + choose x hx hxφ using fun i => (φ i).exists_lt_apply_of_lt_opNorm (hnormφ i) + let f : Free p E := latticePSum q (fun i => delta p (x i)) + have hf (i : Fin n) : (1 / 4 : ℝ) ≤ |f (φ i)| := by + have hcoord : |φ i (x i)| ≤ scalarPSum q (fun j => φ i (x j)) := by + rw [scalarPSum_eq_piLp_norm] + exact PiLp.norm_apply_le (WithLp.toLp q.1 (fun j => φ i (x j))) i + have heq : f (φ i) = scalarPSum q (fun j => φ i (x j)) := by + rw [show f = latticePSum q (fun j => delta p (x j)) from rfl, latticePSum_apply] + simp only [(model_evaluation p (x _) (0 : FVL E) (φ i)).1] + rw [heq, abs_of_nonneg (scalarPSum_nonneg _ _)] + exact (show (1 / 4 : ℝ) < |φ i (x i)| by + simpa only [Real.norm_eq_abs] using hxφ i).le.trans hcoord + have hconst : scalarPSum p (fun _ : Fin n => (1 / 4 : ℝ)) = + (1 / 4 : ℝ) * (n : ℝ) ^ p.1.toReal⁻¹ := by + simpa only [mul_one, abs_of_pos (by norm_num : (0 : ℝ) < 1 / 4), scalarPSum_ones p hn] using + scalarPSum_smul p (1 / 4 : ℝ) (fun _ : Fin n => (1 : ℝ)) + have hlower : (1 / 4 : ℝ) * (n : ℝ) ^ p.1.toReal⁻¹ ≤ ‖f‖ := by + rw [← hconst] + exact (scalarPSum_mono_abs p _ _ (fun i => by + simpa only [abs_of_pos (by norm_num : (0 : ℝ) < 1 / 4)] using hf i)).trans + (freeNorm_family_le p f φ hφp) + have hscalar : scalarPSum q (fun i => ‖delta p (x i)‖) ≤ + scalarPSum q (fun _ : Fin n => (1 : ℝ)) := by + apply scalarPSum_mono_abs + intro i + simpa only [abs_norm, abs_one, LinearIsometry.norm_map] using (hx i).le + have hupper : ‖f‖ ≤ C * (n : ℝ) ^ q.1.toReal⁻¹ := by + rw [← scalarPSum_ones q hn] + exact (hC.2 n (fun i => delta p (x i))).trans + (mul_le_mul_of_nonneg_left hscalar (zero_le_one.trans hC.1)) + linarith + +/-- For an infinite-dimensional real normed space and finite p ≥ 2, q-convexity +of `Free p E` implies q ≤ p. If q were larger, `convexity_growth_bound` would bound +a positive power of n uniformly as n tends to infinity. The argument also excludes +the target exponent ∞ and requires no completeness assumption on E. -/ +theorem parameter_bound_ge_two {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + (hE : ¬ FiniteDimensional ℝ E) (p q : Exponent) (hp : p.IsFinite) + (h2p : Exponent.two ≤ p) (h : IsPConvex q (Free p E)) : q ≤ p := by + by_contra! hpq + obtain ⟨C, hC⟩ := h + have hp0 : 0 < p.1.toReal := + ENNReal.toReal_pos_iff.mpr ⟨lt_of_lt_of_le zero_lt_one p.2, hp⟩ + have hinv : q.1.toReal⁻¹ < p.1.toReal⁻¹ := by + by_cases hq : q.1 = ⊤ + · simpa only [hq, ENNReal.toReal_top, inv_zero] using inv_pos.mpr hp0 + · have hq0 : 0 < q.1.toReal := + ENNReal.toReal_pos_iff.mpr ⟨lt_of_lt_of_le zero_lt_one q.2, lt_top_iff_ne_top.mpr hq⟩ + exact (inv_lt_inv₀ hq0 hp0).mpr ((ENNReal.toReal_lt_toReal hp.ne hq).mpr hpq) + have ht : Tendsto (fun n : ℕ => (n : ℝ) ^ (p.1.toReal⁻¹ - q.1.toReal⁻¹)) atTop atTop := + (tendsto_rpow_atTop (sub_pos.mpr hinv)).comp tendsto_natCast_atTop_atTop + have hbound (n : ℕ) (hn : 0 < n) : + (n : ℝ) ^ (p.1.toReal⁻¹ - q.1.toReal⁻¹) ≤ 4 * C := by + have hn' : 0 < (n : ℝ) := by exact_mod_cast hn + rw [Real.rpow_sub hn'] + exact (div_le_iff₀ (Real.rpow_pos_of_pos hn' _)).mpr + (convexity_growth_bound hE p q h2p hC n hn) + obtain ⟨n, hn, hnC⟩ := + ((eventually_gt_atTop (0 : ℕ)).and (ht.eventually (eventually_gt_atTop (4 * C)))).exists + exact (not_le_of_gt hnC) (hbound n hn) + +end ConvexityBound +end FBLOrderContinuousLH diff --git a/LeanPool/FBLOrderContinuity/EuclideanFamilies.lean b/LeanPool/FBLOrderContinuity/EuclideanFamilies.lean new file mode 100644 index 0000000000..bbd1e89d22 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/EuclideanFamilies.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + +module + +public import LeanPool.FBLOrderContinuity.Model +public import Mathlib.Analysis.Normed.Module.DoubleDual +public import Mathlib.Analysis.InnerProductSpace.PiL2 + + + +/-! +# Finite Euclidean families in an infinite-dimensional dual + +This module proves the geometric estimate needed for the convexity obstruction. +`dual_euclidean_family` produces n dual functionals with weak ell-two norm at most +one and with every individual norm greater than 1/4. + +The proof maximizes a determinant on a finite-dimensional operator unit ball. +Scaling an orthogonal subspace by 1/2 and its complement by 2 forces a maximizing +operator to be large on enough orthogonal directions. Applying this construction +in a 2n-dimensional subspace of the dual gives the family. Infinite-dimensionality +of the dual follows from the isometric embedding into the bidual. This direct +Dvoretzky–Rogers argument does not require completeness of the original space. +-/ + +@[expose] public section + +noncomputable section +open scoped BigOperators Topology +open Filter Set Module + +namespace FBLOrderContinuousLH +namespace EuclideanFamilies + +/-- For isomorphic finite-dimensional normed spaces H and B, choose a contraction T +maximizing the absolute determinant in fixed coordinates. Any endomorphism A for +which T composed with A is still a contraction then has absolute determinant at most one. -/ +private theorem volume_maximizer {H B : Type*} [NormedAddCommGroup H] [NormedSpace ℝ H] + [FiniteDimensional ℝ H] [NormedAddCommGroup B] [NormedSpace ℝ B] + [FiniteDimensional ℝ B] (e : H ≃L[ℝ] B) : + ∃ T : H →L[ℝ] B, ‖T‖ ≤ 1 ∧ + ∀ A : H →L[ℝ] H, ‖T.comp A‖ ≤ 1 → |A.det| ≤ 1 := by + let D (T : H →L[ℝ] B) := |(e.symm.toContinuousLinearMap.comp T).det| + have hD : Continuous D := + (ContinuousLinearMap.continuous_det.comp (continuous_const.clm_comp continuous_id)).abs + let c : ℝ := (1 + ‖e.toContinuousLinearMap‖)⁻¹ + have hc : 0 < c := inv_pos.mpr (by positivity) + have hcnorm : ‖c • e.toContinuousLinearMap‖ ≤ 1 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos hc] + change (1 + ‖e.toContinuousLinearMap‖)⁻¹ * ‖e.toContinuousLinearMap‖ ≤ 1 + rw [inv_mul_eq_div] + exact (div_le_one (by positivity)).mpr (by linarith) + have hcomp : e.symm.toContinuousLinearMap.comp (c • e.toContinuousLinearMap) = + c • ContinuousLinearMap.id ℝ H := by + ext x + simp + have hDpos : 0 < D (c • e.toContinuousLinearMap) := by + dsimp only [D] + rw [hcomp] + change 0 < |LinearMap.det (c • LinearMap.id)| + rw [LinearMap.det_smul, LinearMap.det_id, mul_one, abs_of_pos (pow_pos hc _)] + exact pow_pos hc _ + obtain ⟨T, hT, hmax⟩ := (isCompact_closedBall (0 : H →L[ℝ] B) 1).exists_isMaxOn + ⟨0, by simp⟩ hD.continuousOn + have hDT : 0 < D T := hDpos.trans_le (hmax (by simpa using hcnorm)) + refine ⟨T, by simpa using hT, fun A hA => ?_⟩ + have hh : D (T.comp A) ≤ D T := hmax (by simpa using hA) + have hprod : D (T.comp A) = D T * |A.det| := by + change |LinearMap.det ((e.symm.toLinearMap.comp T.toLinearMap).comp A.toLinearMap)| = _ + rw [LinearMap.det_comp, abs_mul] + rfl + rw [hprod] at hh + exact le_of_mul_le_mul_left (by simpa only [mul_one] using hh) hDT + +/-- Scaling a subspace S by a and its orthogonal complement by b has determinant +`a^(dim S) * b^(dim Sᗮ)`. The proof conjugates the sum of the orthogonal projections +to the corresponding product of scalar identity maps. -/ +private theorem det_orthogonal_scaling {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℝ H] [FiniteDimensional ℝ H] (S : Submodule ℝ H) (a b : ℝ) : + ((a • S.starProjection + b • Sᗮ.starProjection).det) = + a ^ finrank ℝ S * b ^ finrank ℝ Sᗮ := by + let e := S.prodEquivOfIsCompl Sᗮ S.isCompl_orthogonal + let L : (S × Sᗮ) →ₗ[ℝ] (S × Sᗮ) := LinearMap.prodMap + (a • LinearMap.id) (b • LinearMap.id) + have hzero₂ (y : Sᗮ) : S.starProjection y = 0 := + S.starProjection_apply_eq_zero_iff.mpr y.property + have heq : (a • S.starProjection + b • Sᗮ.starProjection).toLinearMap = + e.toLinearMap.comp (L.comp e.symm.toLinearMap) := by + apply LinearMap.ext + intro z + obtain ⟨⟨x, y⟩, rfl⟩ := e.surjective z + simp [e, L, Submodule.coe_prodEquivOfIsCompl', hzero₂] + change LinearMap.det _ = _ + rw [heq, LinearMap.det_conj, LinearMap.det_prodMap, LinearMap.det_smul, + LinearMap.det_smul, LinearMap.det_id, LinearMap.det_id, mul_one, mul_one] + +/-- A determinant-maximizing contraction is larger than 1/4 on some unit vector in +Sᗮ whenever that complement has greater dimension than S. Otherwise scaling S by +1/2 and Sᗮ by 2 would preserve the contraction bound while increasing the determinant. -/ +private theorem large_on_orthogonal {H B : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℝ H] [FiniteDimensional ℝ H] + [NormedAddCommGroup B] [NormedSpace ℝ B] + (T : H →L[ℝ] B) (hT : ‖T‖ ≤ 1) + (hmax : ∀ A : H →L[ℝ] H, ‖T.comp A‖ ≤ 1 → |A.det| ≤ 1) + (S : Submodule ℝ H) (hdim : finrank ℝ S < finrank ℝ Sᗮ) : + ∃ x : Sᗮ, ‖x‖ = 1 ∧ (1 / 4 : ℝ) < ‖T x‖ := by + by_contra! hsmall + have hp : ‖T.comp Sᗮ.subtypeL‖ ≤ (1 / 4 : ℝ) := + (T.comp Sᗮ.subtypeL).opNorm_le_of_unit_norm (by norm_num) hsmall + have hp₁ : ‖T.comp S.starProjection‖ ≤ 1 := by + exact (ContinuousLinearMap.opNorm_comp_le _ _).trans + (by simpa using mul_le_mul hT S.starProjection_norm_le (norm_nonneg _) zero_le_one) + have hp₂ : ‖T.comp Sᗮ.starProjection‖ ≤ (1 / 4 : ℝ) := by + change ‖(T.comp Sᗮ.subtypeL).comp Sᗮ.orthogonalProjectionOnto‖ ≤ _ + exact (ContinuousLinearMap.opNorm_comp_le _ _).trans + (by + simpa using mul_le_mul hp Sᗮ.orthogonalProjectionOnto_norm_le + (norm_nonneg Sᗮ.orthogonalProjectionOnto) (by norm_num : (0 : ℝ) ≤ 1 / 4)) + let A : H →L[ℝ] H := (1 / 2 : ℝ) • S.starProjection + (2 : ℝ) • Sᗮ.starProjection + have hA : ‖T.comp A‖ ≤ 1 := by + calc + _ = ‖(1 / 2 : ℝ) • T.comp S.starProjection + (2 : ℝ) • T.comp Sᗮ.starProjection‖ := by + congr 1 + ext x + simp [A] + _ ≤ ‖(1 / 2 : ℝ) • T.comp S.starProjection‖ + ‖(2 : ℝ) • T.comp Sᗮ.starProjection‖ := + norm_add_le _ _ + _ ≤ 1 := by + rw [norm_smul, norm_smul] + norm_num + linarith + have hh := hmax A hA + rw [det_orthogonal_scaling] at hh + rw [abs_of_nonneg (by positivity), one_div, inv_pow, inv_mul_eq_div] at hh + have hpow : (2 : ℝ) ^ finrank ℝ S < 2 ^ finrank ℝ Sᗮ := + pow_lt_pow_right₀ (by norm_num) hdim + exact (not_le_of_gt hpow) ((div_le_one (by positivity)).mp hh) + +/-- A determinant-maximizing contraction from a space of dimension at least 2n +has norm greater than 1/4 on n orthonormal vectors. Inductively apply +`large_on_orthogonal` to the span of the vectors already chosen. -/ +private theorem orthonormal_large_family {H B : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℝ H] [FiniteDimensional ℝ H] + [NormedAddCommGroup B] [NormedSpace ℝ B] + (T : H →L[ℝ] B) (hT : ‖T‖ ≤ 1) + (hmax : ∀ A : H →L[ℝ] H, ‖T.comp A‖ ≤ 1 → |A.det| ≤ 1) + (n : ℕ) (hn : 2 * n ≤ finrank ℝ H) : + ∃ v : Fin n → H, Orthonormal ℝ v ∧ ∀ i, (1 / 4 : ℝ) < ‖T (v i)‖ := by + classical + induction n with + | zero => + exact ⟨Fin.elim0, by simp [Orthonormal], by simp⟩ + | succ n ih => + obtain ⟨v, hv, hlarge⟩ := ih (by omega) + let S := Submodule.span ℝ (Set.range v) + have hS : finrank ℝ S = n := by + simpa using finrank_span_eq_card hv.linearIndependent + have hdim := S.finrank_add_finrank_orthogonal + obtain ⟨x, hx, hTx⟩ := large_on_orthogonal T hT hmax S (by omega) + have horth (i : Fin n) : inner ℝ (v i) (x : H) = 0 := + (S.mem_orthogonal x).mp x.property (v i) (Submodule.subset_span (Set.mem_range_self i)) + have horth' (i : Fin n) : inner ℝ (x : H) (v i) = 0 := by + rw [real_inner_comm] + exact horth i + refine ⟨Fin.cons (x : H) v, ?_, ?_⟩ + · rw [orthonormal_iff_ite] + intro i j + refine Fin.cases ?_ (fun i => ?_) i <;> refine Fin.cases ?_ (fun j => ?_) j + · simp [show ‖(x : H)‖ = 1 from hx] + · simp [horth', eq_comm] + · simp [horth] + · simpa using (orthonormal_iff_ite.mp hv) _ _ + · exact Fin.forall_fin_succ.mpr ⟨hTx, hlarge⟩ + +/-- For every n, an infinite-dimensional real normed space has n continuous dual +functionals with weak ell-two norm at most one and individual operator norms greater +than 1/4. Apply the determinant-maximization argument in a 2n-dimensional subspace +of the dual. The uniform lower bound drives the free-norm growth obstruction; +completeness of E is unnecessary. -/ +theorem dual_euclidean_family {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + (hE : ¬ FiniteDimensional ℝ E) (n : ℕ) : + ∃ φ : Fin n → Dual E, NormAdmissible Exponent.two φ ∧ + ∀ i, (1 / 4 : ℝ) < ‖φ i‖ := by + classical + have hdual : ¬ FiniteDimensional ℝ (Dual E) := by + intro h + let := h + exact hE (FiniteDimensional.of_injective + (NormedSpace.inclusionInDoubleDualLi ℝ (E := E)).toLinearMap + (NormedSpace.inclusionInDoubleDualLi ℝ (E := E)).injective) + have hrank : (2 * n : ℕ) ≤ Module.rank ℝ (Dual E) := + Cardinal.natCast_lt_aleph0.le.trans + (not_lt.mp (fun h => hdual (Module.rank_lt_aleph0_iff.mp h))) + obtain ⟨b, hb⟩ := exists_linearIndependent_of_le_rank hrank + let B := Submodule.span ℝ (Set.range b) + let : FiniteDimensional ℝ B := FiniteDimensional.span_of_finite (K := ℝ) (Set.finite_range b) + let : Module.Free ℝ B := Module.Free.of_divisionRing ℝ B + let H := EuclideanSpace ℝ (Fin (2 * n)) + have hdim : finrank ℝ H = finrank ℝ B := by + simp only [H, finrank_euclideanSpace, Fintype.card_fin, B, finrank_span_eq_card hb] + let e : H ≃L[ℝ] B := LinearEquiv.toContinuousLinearEquiv (𝕜 := ℝ) (E := H) (F := B) + (LinearEquiv.ofFinrankEq (R := ℝ) H B hdim) + obtain ⟨T, hT, hmax⟩ := volume_maximizer (H := H) (B := B) e + obtain ⟨v, hv, hlarge⟩ := orthonormal_large_family T hT hmax n (by simp [H]) + let φ (i : Fin n) : Dual E := T (v i) + have hsum (a : Fin n → ℝ) : ‖∑ i, a i • φ i‖ ≤ Real.sqrt (∑ i, a i ^ 2) := by + have hvnorm : ‖∑ i, a i • v i‖ = Real.sqrt (∑ i, a i ^ 2) := by + rw [← Real.sqrt_sq (norm_nonneg _), ← real_inner_self_eq_norm_sq, hv.inner_sum] + simp [sq] + calc + _ = ‖T (∑ i, a i • v i)‖ := by + simp only [map_sum, map_smul] + change ‖∑ i, a i • φ i‖ = ‖((∑ i, a i • T (v i) : B) : Dual E)‖ + simp [φ] + _ ≤ ‖∑ i, a i • v i‖ := + (T.le_opNorm _).trans (mul_le_of_le_one_left (norm_nonneg _) hT) + _ = _ := hvnorm + refine ⟨φ, ?_, hlarge⟩ + intro x hx + have hnonneg : 0 ≤ ∑ i, (φ i x) ^ 2 := Finset.sum_nonneg (fun i _ => sq_nonneg _) + have heval : (∑ i, (φ i x) • φ i) x = ∑ i, (φ i x) ^ 2 := by + simp [sum_apply, smul_apply, smul_eq_mul, sq] + have hh := (∑ i, (φ i x) • φ i).le_opNorm x + simp only [heval, Real.norm_eq_abs, abs_of_nonneg hnonneg] at hh + have hupper : ∑ i, (φ i x) ^ 2 ≤ Real.sqrt (∑ i, (φ i x) ^ 2) := + hh.trans ((mul_le_mul_of_nonneg_right (hsum (fun i => φ i x)) (norm_nonneg x)).trans + (mul_le_of_le_one_right (Real.sqrt_nonneg _) hx)) + have hsqrt : Real.sqrt (∑ i, (φ i x) ^ 2) ≤ 1 := by + nlinarith [Real.sq_sqrt hnonneg] + simpa [scalarPSum, Exponent.two, Real.sqrt_eq_rpow, sq_abs] using hsqrt + +end EuclideanFamilies +end FBLOrderContinuousLH diff --git a/LeanPool/FBLOrderContinuity/Extension.lean b/LeanPool/FBLOrderContinuity/Extension.lean new file mode 100644 index 0000000000..634e92fe51 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/Extension.lean @@ -0,0 +1,1527 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + +module + +public import LeanPool.FBLOrderContinuity.Support +public import Mathlib.Topology.ContinuousMap.ZeroAtInfty +public import LeanPool.FBLOrderContinuity.LpExtension +public import Mathlib.Topology.Algebra.Module.Complement +public import Mathlib.Topology.Algebra.Module.Equiv.Submodule +public import Mathlib.Topology.PartitionOfUnity + + + +/-! +# Operator extension and order continuity + +This module proves the operator-extension characterizations in Sections 1 and 4 of +the paper. `POEWith p E M C` asserts that M is closed in E and uses one extension +constant for every dimension and every operator from M into finite-dimensional ell-p. +`HasPOE p E M` allows any such constant for the same ambient-space/subspace pair. + +For finite p, `poe_inclusion` identifies order continuity, sequential order continuity, +a lower free-norm bound, and POE for a closed subspace. Failure gives an explicit +`FVLFailureWitness`. `intro_poe` and `all_parameter_characterization` pass from +subspace inclusions to arbitrary operators; the latter includes p = infinity. + +Applications cover complemented and locally complemented subspaces, the canonical +bidual embedding, embeddings of C(K), the uncomplemented inclusion of c0 into ell-infinity, +and separably injective spaces. `LpExtension` supplies the sharp finite-target +Hahn–Banach argument, while `Support` supplies compact geometric witnesses. +-/ + +@[expose] public section + +noncomputable section +open scoped BigOperators ENNReal Topology +open Filter Set +universe u v w +namespace FBLOrderContinuousLH + +variable {E : Type u} {F : Type v} + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + +/-- Finite-dimensional ell_p, using Mathlib's actual p-norm. -/ +abbrev FiniteLp (p : Exponent) (n : ℕ) := PiLp p.1 (fun _ : Fin n => ℝ) + +/-- The quantitative POE-p property for the explicit pair E and M ⊆ E. The subspace M +is closed in E, and one constant C ≥ 1 bounds extensions to E of every operator from M +into any finite-dimensional ell-p space, with norm at most C times the original norm. -/ +def POEWith (p : Exponent) (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] + (M : Submodule ℝ E) (C : ℝ) : Prop := + IsClosed (M : Set E) ∧ 1 ≤ C ∧ ∀ (n : ℕ) (R : M →L[ℝ] FiniteLp p n), + ∃ S : E →L[ℝ] FiniteLp p n, S.comp M.subtypeL = R ∧ ‖S‖ ≤ C * ‖R‖ + +/-- The POE-p property for the explicit pair E and M ⊆ E: M is closed in E and some +constant C ≥ 1 works for all finite-dimensional ell-p targets, as specified by `POEWith`. -/ +def HasPOE (p : Exponent) (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] + (M : Submodule ℝ E) : Prop := ∃ C, POEWith p E M C + +/-- The subspace in a quantitative POE pair is closed in the specified ambient space. -/ +theorem POEWith.isClosed {p : Exponent} {M : Submodule ℝ E} {C : ℝ} + (h : POEWith p E M C) : IsClosed (M : Set E) := h.1 + +/-- The subspace in a POE pair is closed in the specified ambient space. -/ +theorem HasPOE.isClosed {p : Exponent} {M : Submodule ℝ E} + (h : HasPOE p E M) : IsClosed (M : Set E) := h.choose_spec.isClosed + +/-- An explicit obstruction to sequential order continuity: positive algebraic elements +decrease to zero in the source, but their images converge in norm to a strictly positive +target element G. Every image also dominates G, so the image sequence cannot decrease +to zero in order. Used in Theorem 4.1 and Propositions 4.12 and 5.2. -/ +def FVLFailureWitness (p q : Exponent) (T : LatticeOperator (Free p F) (Free q E)) : Prop := + ∃ f : ℕ → FVL F, (∀ n, 0 ≤ f n) ∧ + DecreasesToZero (fun n => ofFVL p (f n)) ∧ + ∃ G : Free q E, 0 < G ∧ + Tendsto (fun n => T (ofFVL p (f n))) atTop (𝓝 G) ∧ + ∀ n, G ≤ T (ofFVL p (f n)) + +/-- Section 4: regularity of a specified vector sublattice. -/ +def IsRegularSublattice {X : Type u} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [VectorLattice X] (Y : VectorSublattice X) : Prop := + IsOrderContinuousOp Y.subtype.toLinearMap + +/-- The algebraic range sublattice of an induced map, before taking any norm closure. -/ +def inducedRange (p : Exponent) (T : F →L[ℝ] E) : VectorSublattice (Free p E) where + toSubmodule := (induced p T).toContinuousLinearMap.toLinearMap.range + sup_mem' := by + rintro _ _ ⟨f, rfl⟩ ⟨g, rfl⟩ + exact ⟨f ⊔ g, (induced p T).map_sup' f g⟩ + +private theorem poe_norm_bound (p : Exponent) (M : Submodule ℝ E) (C : ℝ) + (h : POEWith p E M C) (f : Free p M) : + ‖f‖ ≤ C * ‖induced p M.subtypeL f‖ := by + obtain ⟨_, h⟩ := h + have hC : 0 < C := zero_lt_one.trans_le h.1 + apply (ENNReal.ofReal_le_ofReal_iff (mul_nonneg hC.le (norm_nonneg _))).mp + rw [← freeNormExt_eq_norm p f, freeNormExt] + split_ifs with htop + · refine iSup_le fun ψ => iSup_le fun hψ => ?_ + obtain ⟨φ, hφ, hφnorm⟩ := exists_extension_norm_eq M ψ + have hcomp : φ.comp M.subtypeL = ψ := ContinuousLinearMap.ext hφ + calc + ENNReal.ofReal |f ψ| ≤ freeNormExt p (induced p M.subtypeL f) := by + rw [freeNormExt, ite_eq_left htop] + exact le_iSup_of_le φ (le_iSup_of_le (hφnorm ▸ hψ) + (by rw [canonical_map_formulas, hcomp])) + _ ≤ ENNReal.ofReal (C * ‖induced p M.subtypeL f‖) := by + rw [freeNormExt_eq_norm] + exact ENNReal.ofReal_le_ofReal + (by simpa only [one_mul] using + mul_le_mul_of_nonneg_right h.1 (norm_nonneg (induced p M.subtypeL f))) + · refine iSup_le fun n => iSup_le fun ψ => iSup_le fun hψ => ?_ + let R : M →L[ℝ] FiniteLp p n := + (PiLp.continuousLinearEquiv p.1 ℝ (fun _ : Fin n => ℝ)).symm.toContinuousLinearMap.comp + (ContinuousLinearMap.pi ψ) + have hR : ‖R‖ ≤ 1 := by + apply R.opNorm_le_bound zero_le_one + intro x + change ‖WithLp.toLp p.1 (fun i => ψ i x)‖ ≤ 1 * ‖x‖ + simpa only [one_mul, scalarPSum_eq_piLp_norm] using + normAdmissible_eval_le_norm p ψ hψ x + obtain ⟨S, hS, hSnorm⟩ := h.2 n R + let φ (i : Fin n) : Dual E := (PiLp.proj p.1 (fun _ : Fin n => ℝ) i).comp S + have hφ (i : Fin n) : (φ i).comp M.subtypeL = ψ i := by + apply ContinuousLinearMap.ext + intro x + exact congrArg (fun L : M →L[ℝ] FiniteLp p n => (L x) i) hS + have hSnorm' : ‖S‖ ≤ C := + hSnorm.trans (by simpa only [mul_one] using mul_le_mul_of_nonneg_left hR hC.le) + have hb := freeNorm_scaled_family_le p (induced p M.subtypeL f) φ hC (by + intro x hx + rw [scalarPSum_eq_piLp_norm] + change ‖S x‖ ≤ C + exact (S.le_opNorm x).trans + ((mul_le_mul hSnorm' hx (norm_nonneg x) hC.le).trans_eq (mul_one C))) + simp only [canonical_map_formulas, hφ] at hb + exact ENNReal.ofReal_le_ofReal hb + +private theorem boundedBelow_of_poe (p : Exponent) (M : Submodule ℝ E) + (h : HasPOE p E M) : BoundedBelow (induced p M.subtypeL) := by + obtain ⟨C, hC⟩ := h + have hpos : 0 < C := zero_lt_one.trans_le hC.2.1 + refine ⟨C⁻¹, inv_pos.mpr hpos, fun f => ?_⟩ + have hh := mul_le_mul_of_nonneg_left (poe_norm_bound p M C hC f) (inv_nonneg.mpr hpos.le) + simpa only [← mul_assoc, inv_mul_cancel₀ hpos.ne', one_mul] using hh + +private theorem isometry_of_poe_one (p : Exponent) (M : Submodule ℝ E) + (h : POEWith p E M 1) : Isometry (induced p M.subtypeL) := by + apply AddMonoidHomClass.isometry_of_norm (induced p M.subtypeL).toContinuousLinearMap + intro f + apply le_antisymm + · have hnorm : ‖M.subtypeL‖ ≤ 1 := M.subtypeL.opNorm_le_bound zero_le_one + (fun x => by simp) + exact ((induced p M.subtypeL).toContinuousLinearMap.le_opNorm f).trans (by + rw [(induced_norm_generators p M.subtypeL).1] + simpa only [one_mul] using mul_le_mul_of_nonneg_right hnorm (norm_nonneg f)) + · simpa only [one_mul] using poe_norm_bound p M 1 h f + +/-- At exponent ∞, coordinatewise Hahn–Banach extension gives POE with constant one. +Each coordinate extends without increasing its norm, and the target maximum norm +combines the extensions. Closedness of M supplies the closed-pair requirement in POE. -/ +theorem poe_infinity_one (M : Submodule ℝ E) + (hM : IsClosed (M : Set E)) : POEWith Exponent.infinity E M 1 := by + classical + refine ⟨hM, le_rfl, fun n R => ?_⟩ + let Rcoord (i : Fin n) : Dual M := (PiLp.proj ⊤ (fun _ : Fin n => ℝ) i).comp R + choose φ hφ hnorm using fun i => exists_extension_norm_eq M (Rcoord i) + let S : E →L[ℝ] FiniteLp Exponent.infinity n := + (PiLp.continuousLinearEquiv ⊤ ℝ (fun _ : Fin n => ℝ)).symm.toContinuousLinearMap.comp + (ContinuousLinearMap.pi φ) + refine ⟨S, ?_, ?_⟩ + · apply ContinuousLinearMap.ext + intro x + apply WithLp.ofLp_injective ⊤ + exact funext fun i => hφ i x + · rw [one_mul] + apply S.opNorm_le_bound (norm_nonneg R) + intro x + change ‖WithLp.toLp ⊤ (fun i => φ i x)‖ ≤ ‖R‖ * ‖x‖ + rw [PiLp.norm_toLp] + apply (pi_norm_le_iff_of_nonneg (mul_nonneg (norm_nonneg R) (norm_nonneg x))).mpr + intro i + have hi : ‖Rcoord i‖ ≤ ‖R‖ := by + apply (Rcoord i).opNorm_le_bound (norm_nonneg R) + intro y + exact (PiLp.norm_apply_le (R y) i).trans (R.le_opNorm y) + exact ((φ i).le_opNorm x).trans + (mul_le_mul_of_nonneg_right (by simpa only [hnorm] using hi) (norm_nonneg x)) + +/-- For a closed subspace of a Banach space, POE at p is equivalent to a positive +lower norm bound for the induced free-lattice inclusion. Finite exponents use the +tensor-gauge extension theorem; the endpoint uses coordinatewise Hahn–Banach. -/ +theorem poe_iff_boundedBelow (p : Exponent) + (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) : + HasPOE p E M ↔ BoundedBelow (induced p M.subtypeL) := by + constructor + · exact boundedBelow_of_poe p M + · intro hb + rcases lt_or_eq_of_le (le_top : p.1 ≤ ⊤) with hp | hp + · obtain ⟨c, hc, hb⟩ := hb + refine ⟨max 1 c⁻¹, hM, le_max_left _ _, fun n R => ?_⟩ + apply FiniteLpExtension.extend_of_free_norm_bound p hp M + (zero_lt_one.trans_le (le_max_left _ _)) ?_ n R + intro f + have hh := mul_le_mul_of_nonneg_left (hb f) (inv_nonneg.mpr hc.le) + have hf : ‖f‖ ≤ c⁻¹ * ‖induced p M.subtypeL f‖ := by + simpa only [← mul_assoc, inv_mul_cancel₀ hc.ne', one_mul] using hh + exact hf.trans (mul_le_mul_of_nonneg_right (le_max_right _ _) (norm_nonneg _)) + · have heq : p = Exponent.infinity := Subtype.ext hp + subst p + exact ⟨1, poe_infinity_one M hM⟩ + +/-- The sharp version of `poe_iff_boundedBelow`: the pair has extension constant one +exactly when the canonical free-lattice inclusion is isometric. This applies to every +exponent and is used for Banach-space ideals and the canonical bidual pair. -/ +theorem poe_one_iff_isometry (p : Exponent) + (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) : + POEWith p E M 1 ↔ Isometry (induced p M.subtypeL) := by + constructor + · exact isometry_of_poe_one p M + · intro hi + rcases lt_or_eq_of_le (le_top : p.1 ≤ ⊤) with hp | hp + · refine ⟨hM, le_rfl, fun n R => + FiniteLpExtension.extend_of_free_norm_bound p hp M zero_lt_one ?_ n R⟩ + intro f + rw [one_mul, hi.norm_map_of_map_zero (map_zero (induced p M.subtypeL).toContinuousLinearMap)] + · have heq : p = Exponent.infinity := Subtype.ext hp + subst p + exact poe_infinity_one M hM + +private theorem section_support_inFree [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (M : Submodule ℝ E) (_hM : IsClosed (M : Set E)) + (hb : BoundedBelow (induced p M.subtypeL)) (K : Set E) (hK : IsPCompactDisk p K) : + InFree p (support {x : M | (x : E) ∈ K}) := by + obtain ⟨s, hs, hgen, _⟩ := subsets_summable_disk p hp (K ∩ (M : Set E)) K + ⟨0, (summable_disk_compact p K hK).2.1.1.zero_mem (summable_disk_compact p K hK).1, + M.zero_mem⟩ Set.inter_subset_left hK + have hsub : VectorSublattice.generated (delta p '' (K ∩ (M : Set E))) ≤ + inducedRange p M.subtypeL := + VectorSublattice.generated_le (by + rintro _ ⟨x, hx, rfl⟩ + exact ⟨delta p (⟨x, hx.2⟩ : M), (induced_norm_generators p M.subtypeL).2 _⟩) + obtain ⟨l, hl⟩ := VectorSublattice.topologicalClosure_minimal hsub + ((embedding_iff (induced p M.subtypeL).toContinuousLinearMap).mp hb).2 hgen + refine ⟨l, fun ψ => ?_⟩ + obtain ⟨φ, hφ, _⟩ := exists_extension_norm_eq M ψ + calc + l ψ = s φ := by + rw [← hl] + change l ψ = l (φ.comp M.subtypeL) + exact congrArg l (ContinuousLinearMap.ext hφ).symm + _ = support (K ∩ (M : Set E)) φ := hs φ + _ = support {x : M | (x : E) ∈ K} ψ := by + unfold support compactSupport + congr 1 + ext r + constructor + · rintro ⟨x, hx, rfl⟩ + exact ⟨⟨x, hx.2⟩, hx.1, congrArg abs (hφ ⟨x, hx.2⟩).symm⟩ + · rintro ⟨x, hx, rfl⟩ + exact ⟨x, ⟨hx, x.2⟩, congrArg abs (hφ x)⟩ + +/-- Proposition 4.9 (`prop:poe-sufficiency`): a lower norm bound for a closed-subspace +free p-convex Banach lattices inclusion implies order continuity at finite p. +Compact support sections +and positive patches provide the order-theoretic consequence of the norm bound. -/ +theorem poe_sufficiency [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) + (hb : BoundedBelow (induced p M.subtypeL)) : + IsOrderContinuousOp (induced p M.subtypeL).toContinuousLinearMap.toLinearMap := by + let : CompleteSpace M := hM.isComplete.completeSpace_coe + apply (orderContinuous_iff_decreasing (induced p M.subtypeL).toContinuousLinearMap.toLinearMap + (fun _ h => (induced p M.subtypeL).toVecLatHom.map_nonneg h)).mpr + intro ι _ _ _ f hf + apply (positive_patches_net p (fun i => induced p M.subtypeL (f i)) + ((induced p M.subtypeL).toVecLatHom.monotone.comp_antitone hf.1) + (fun i => (induced p M.subtypeL).toVecLatHom.map_nonneg + (hf.2.1 (Set.mem_range_self i)))).mpr + rintro ⟨φ₀, ε, K, hε, hK, hpatch⟩ + obtain ⟨l, hl⟩ := section_support_inFree p hp M hM hb K hK + obtain ⟨L, hL, hdom⟩ := summable_global_domination p l + apply (positive_patches_net p f hf.1 (fun i => hf.2.1 (Set.mem_range_self i))).mp hf + refine ⟨φ₀.comp M.subtypeL, ε, L, hε, hL, ?_⟩ + rintro _ ⟨i, rfl⟩ ψ hψ + have hmem : ψ - φ₀.comp M.subtypeL ∈ + closure ((fun φ : Dual E => φ.comp M.subtypeL) '' {φ | support K φ < 1}) := by + rw [restriction_polar M hM K (summable_disk_compact p K hK).1 + (summable_disk_compact p K hK).2.1 (summable_disk_compact p K hK).2.2] + exact ((show support {x : M | (x : E) ∈ K} (ψ - φ₀.comp M.subtypeL) ≤ + |l (ψ - φ₀.comp M.subtypeL)| by rw [← hl]; exact le_abs_self _).trans + (hdom _)).trans hψ.le + have hclosed : IsClosed {θ : Dual M | ε ≤ f i (θ + φ₀.comp M.subtypeL)} := + isClosed_le continuous_const + ((free_function_norm_continuous p (f i)).comp (continuous_id.add continuous_const)) + have hbound : ∀ θ ∈ (fun φ : Dual E => φ.comp M.subtypeL) '' {φ | support K φ < 1}, + ε ≤ f i (θ + φ₀.comp M.subtypeL) := by + rintro _ ⟨φ, hφ, rfl⟩ + have hh := hpatch _ (Set.mem_range_self i) (φ + φ₀) + (by simpa only [Set.mem_ofPred_eq, add_sub_cancel_right] using hφ) + change ε ≤ f i ((φ + φ₀).comp M.subtypeL) at hh + simpa only [ContinuousLinearMap.add_comp] using hh + have hh : ε ≤ f i ((ψ - φ₀.comp M.subtypeL) + φ₀.comp M.subtypeL) := + (closure_minimal hbound hclosed) hmem + simpa only [sub_add_cancel] using hh + +private theorem finiteSupport_nonneg (A : Finset E) : 0 ≤ finiteSupport A := by + classical + by_cases hA : A.Nonempty + · obtain ⟨a, ha⟩ := hA + exact (abs_nonneg (FVLv.of a)).trans (by + simpa only [finiteSupport, dite_eq_left (show A.Nonempty from ⟨a, ha⟩)] using + Finset.le_sup' (fun a : E => |FVLv.of a|) ha) + · simp [finiteSupport, hA] + +private theorem finiteSupport_generator_bound (p : Exponent) (M : Submodule ℝ E) + (A : Finset M) (a : M) (ha : a ∈ A) : + ‖a‖ ≤ ‖induced p M.subtypeL (ofFVL p (finiteSupport A))‖ := by + classical + have hA : A.Nonempty := ⟨a, ha⟩ + have hle : |FVLv.of a| ≤ finiteSupport A := by + simpa only [finiteSupport, dite_eq_left hA] using Finset.le_sup' (fun x : M => |FVLv.of x|) ha + have hfree : |delta p a| ≤ ofFVL p (finiteSupport A) := by + simpa only [VecLatHom.map_abs, ofFVL_of] using (ofFVL p).monotone hle + have himage : |induced p M.subtypeL (delta p a)| ≤ + induced p M.subtypeL (ofFVL p (finiteSupport A)) := by + change |(induced p M.subtypeL).toVecLatHom (delta p a)| ≤ + (induced p M.subtypeL).toVecLatHom (ofFVL p (finiteSupport A)) + rw [← VecLatHom.map_abs] + exact (induced p M.subtypeL).toVecLatHom.monotone hfree + have hn := norm_le_norm_of_abs_le_abs (himage.trans (le_abs_self _)) + rw [(induced_norm_generators p M.subtypeL).2, (delta p).norm_map] at hn + exact hn + +private theorem finiteSupport_compact_disk [CompleteSpace E] (p : Exponent) + (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) (A : Finset M) (hA : A.Nonempty) : + ∃ K : Set M, K.Nonempty ∧ AbsConvex ℝ K ∧ IsCompact K ∧ + (∀ ψ, support K ψ = fvlFunction (finiteSupport A) ψ) ∧ + ∀ x ∈ K, ‖x‖ ≤ ‖induced p M.subtypeL (ofFVL p (finiteSupport A))‖ := by + let : CompleteSpace M := hM.isComplete.completeSpace_coe + have hhull := compact_support_closedAbsConvexHull (A : Set M) hA.to_set A.finite_toSet.isCompact + obtain ⟨hne, hac, hc⟩ := (isPCompactDisk_infinity_iff _).mp hhull.1 + refine ⟨closedAbsConvexHull ℝ (A : Set M), hne, hac, hc, + fun ψ => (hhull.2 ψ).trans (finiteSupport_support A hA ψ).symm, ?_⟩ + have hsub : (A : Set M) ⊆ Metric.closedBall 0 + ‖induced p M.subtypeL (ofFVL p (finiteSupport A))‖ := by + intro x hx + simpa only [Metric.mem_closedBall, dist_zero_right] using + finiteSupport_generator_bound p M A x hx + simpa only [Set.subset_def, Metric.mem_closedBall, dist_zero_right] using + closedAbsConvexHull_min hsub + ⟨balanced_closedBall_zero, convex_closedBall (0 : M) _⟩ Metric.isClosed_closedBall + +private theorem fvl_norm_separation (p : Exponent) (T : F →L[ℝ] E) + (hb : ¬ BoundedBelow (induced p T)) (a b : ℝ) (ha : 0 < a) (hbpos : 0 < b) : + ∃ v : FVL F, ‖ofFVL p v‖ = a ∧ ‖induced p T (ofFVL p v)‖ < b := by + have hbad : ∃ v : FVL F, ‖induced p T (ofFVL p v)‖ < (b / a) * ‖ofFVL p v‖ := by + by_contra! h + exact hb ⟨b / a, div_pos hbpos ha, fun f => + (denseRange_ofFVL p).induction_on f + (isClosed_le (continuous_const.mul continuous_norm) + (induced p T).toContinuousLinearMap.continuous.norm) h⟩ + obtain ⟨v, hv⟩ := hbad + have hvpos : 0 < ‖ofFVL p v‖ := + (mul_pos_iff_of_pos_left (div_pos hbpos ha)).mp ((norm_nonneg _).trans_lt hv) + refine ⟨(a / ‖ofFVL p v‖) • v, ?_, ?_⟩ + · rw [map_smul, norm_smul, Real.norm_of_nonneg (div_pos ha hvpos).le] + exact div_mul_cancel₀ a hvpos.ne' + · rw [map_smul, map_smul, norm_smul, Real.norm_of_nonneg (div_pos ha hvpos).le] + have h := mul_lt_mul_of_pos_left hv (div_pos ha hvpos) + calc + _ < (a / ‖ofFVL p v‖) * ((b / a) * ‖ofFVL p v‖) := h + _ = b := by field_simp + +private theorem finiteSupport_norm_separation [CompleteSpace E] (p : Exponent) + (hp : p.IsFinite) (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) + (hb : ¬ BoundedBelow (induced p M.subtypeL)) (a b : ℝ) (ha : 0 < a) (hbpos : 0 < b) : + ∃ A : Finset M, A.Nonempty ∧ a ≤ ‖ofFVL p (finiteSupport A)‖ ∧ + ‖induced p M.subtypeL (ofFVL p (finiteSupport A))‖ < b := by + obtain ⟨v, hv, hsmall⟩ := fvl_norm_separation p M.subtypeL hb a (b / 2) ha (half_pos hbpos) + obtain ⟨A, hA, hnorm⟩ := finite_support_majorant p hp M hM v (b / 2) (half_pos hbpos) + have hmajor : ‖ofFVL p v‖ ≤ ‖ofFVL p (finiteSupport A)‖ := + norm_le_norm_of_abs_le_abs ((free_le_iff p _ _).mpr fun ψ => (hA ψ).trans (le_abs_self _)) + refine ⟨A, ?_, hv ▸ hmajor, by linarith⟩ + by_contra hne + have hz : finiteSupport A = 0 := by simp [finiteSupport, hne] + rw [hz, map_zero, norm_zero, hv] at hmajor + exact ha.not_ge hmajor + +private theorem ofFVL_positive_difference (p : Exponent) (e : E) (q : FVL E) : + ofFVL p ((|FVLv.of e| - q) ⊔ 0) = (|delta p e| - ofFVL p q) ⊔ 0 := by + simp only [SupHomClass.map_sup, map_sub, VecLatHom.map_abs, ofFVL_of, map_zero] + +private theorem induced_positive_difference (p : Exponent) (M : Submodule ℝ E) + (e : M) (q : FVL M) : + induced p M.subtypeL (ofFVL p ((|FVLv.of e| - q) ⊔ 0)) = + (|delta p (e : E)| - induced p M.subtypeL (ofFVL p q)) ⊔ 0 := by + rw [ofFVL_positive_difference] + change (induced p M.subtypeL).toVecLatHom _ = _ + simp only [SupHomClass.map_sup, map_sub, VecLatHom.map_abs, map_zero] + rw [show (induced p M.subtypeL).toVecLatHom (delta p e) = delta p (e : E) from + (induced_norm_generators p M.subtypeL).2 e] + rfl + +private theorem positive_difference_pos {X : Type*} [NormedAddCommGroup X] + [Lattice X] [IsOrderedAddMonoid X] [NormedVectorLattice X] + (x Q : X) (h : ‖Q‖ < ‖x‖) : 0 < (|x| - Q) ⊔ 0 := by + apply lt_iff_le_not_ge.mpr + refine ⟨le_sup_right, fun hG => ?_⟩ + have hle : |x| ≤ Q := sub_nonpos.mp (sup_le_iff.mp hG).1 + have hn := norm_le_norm_of_abs_le_abs (hle.trans (le_abs_self Q)) + exact h.not_ge hn + +private theorem compact_support_algebraic_order_null [CompleteSpace E] (p : Exponent) + (hp : p.IsFinite) (K : Set E) (hne : K.Nonempty) (hac : AbsConvex ℝ K) + (hc : IsCompact K) (hinf : freeNormExt p (support K) = ⊤) (q : ℕ → FVL E) + (hq : ∀ n, 0 ≤ q n) (hmono : Monotone (fun n => ofFVL p (q n))) + (hpoint : ∀ ψ, IsLUB (Set.range fun n => fvlFunction (q n) ψ) (support K ψ)) + (e : E) : DecreasesToZero (fun n => ofFVL p ((|FVLv.of e| - q n) ⊔ 0)) := by + have hpos (n : ℕ) : (0 : Free p E) ≤ ofFVL p (q n) := (ofFVL p).map_nonneg (hq n) + have hpoint' (ψ : Dual E) : + IsLUB (Set.range fun n => ofFVL p (q n) ψ) (support K ψ) := by + simpa only [(model_evaluation p (0 : E) _ _).2] using hpoint ψ + have hnull := compact_support_order_null p hp K hne hac hc hinf + (fun n => ofFVL p (q n)) hpos hmono hpoint' e + simpa only [ofFVL_positive_difference] using hnull + +private theorem failure_witness_of_compact_support [CompleteSpace E] (p : Exponent) + (hp : p.IsFinite) (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) + (K : Set M) (hne : K.Nonempty) (hac : AbsConvex ℝ K) (hc : IsCompact K) + (hinf : freeNormExt p (support K) = ⊤) (q : ℕ → FVL M) + (hq : ∀ n, 0 ≤ q n) (hmono : Monotone (fun n => ofFVL p (q n))) + (hpoint : ∀ ψ, IsLUB (Set.range fun n => fvlFunction (q n) ψ) (support K ψ)) + (Q : Free p E) (hlim : Tendsto (fun n => induced p M.subtypeL (ofFVL p (q n))) atTop (𝓝 Q)) + (hupper : ∀ n, induced p M.subtypeL (ofFVL p (q n)) ≤ Q) + (e : M) (he : ‖Q‖ < ‖e‖) : FVLFailureWitness p p (induced p M.subtypeL) := by + let : CompleteSpace M := hM.isComplete.completeSpace_coe + let f (n : ℕ) : FVL M := (|FVLv.of e| - q n) ⊔ 0 + let G : Free p E := (|delta p (e : E)| - Q) ⊔ 0 + have himage (n : ℕ) : induced p M.subtypeL (ofFVL p (f n)) = + (|delta p (e : E)| - induced p M.subtypeL (ofFVL p (q n))) ⊔ 0 := + induced_positive_difference p M e (q n) + refine ⟨f, fun _ => le_sup_right, ?_, G, ?_, ?_, ?_⟩ + · exact compact_support_algebraic_order_null p hp K hne hac hc hinf q hq hmono hpoint e + · apply positive_difference_pos + simpa only [(delta p).norm_map, Submodule.norm_coe] using he + · simp_rw [himage] + exact (tendsto_const_nhds.sub hlim).sup_nhds tendsto_const_nhds + · intro n + rw [himage] + exact sup_le_sup (sub_le_sub_left (hupper n) _) le_rfl + +/-- Proposition 4.12 (`prop:poe-necessity`): failure of a lower norm bound produces +an explicit positive algebraic sequence decreasing to zero whose images converge in +norm to a strictly positive lower bound. Thus the inclusion fails even sequential +order continuity. The full witness is recorded by `FVLFailureWitness`. -/ +theorem poe_necessity [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) + (hb : ¬ BoundedBelow (induced p M.subtypeL)) : + FVLFailureWitness p p (induced p M.subtypeL) ∧ + ¬ SigmaOrderContinuous (induced p M.subtypeL) := by + classical + let : CompleteSpace M := hM.isComplete.completeSpace_coe + choose A hA hlarge hsmall using fun n : ℕ => + finiteSupport_norm_separation p hp M hM hb (n + 1) ((1 / 2 : ℝ) ^ n) + (by positivity) (by positivity) + choose K hne hac hc hsupport hbound using fun n => + finiteSupport_compact_disk p M hM (A n) (hA n) + have hbound' (n : ℕ) (x : M) (hx : x ∈ K n) : ‖x‖ ≤ (1 / 2 : ℝ) ^ n := + (hbound n x hx).trans (hsmall n).le + obtain ⟨hDne, hDac, hDc, hDsupport⟩ := seriesDisk_properties K + (fun n => (1 / 2 : ℝ) ^ n) (fun _ => by positivity) summable_geometric_two + (fun n => ⟨hne n, hac n, hc n⟩) hbound' + have hspos (ψ : Dual M) (n : ℕ) : 0 ≤ support (K n) ψ := + apply_nonneg (supportSeminorm _ (hne n) (hc n).isBounded) ψ + have hsum (ψ : Dual M) : Summable (fun n => support (K n) ψ) := by + apply Summable.of_nonneg_of_le (hspos ψ) _ (summable_geometric_two.mul_left ‖ψ‖) + intro n + apply csSup_le ((hne n).image _) + rintro _ ⟨x, hx, rfl⟩ + exact (ψ.le_opNorm x).trans + (mul_le_mul_of_nonneg_left (hbound' n x hx) (norm_nonneg _)) + have hinf : freeNormExt p (support (seriesDisk K)) = ⊤ := by + by_contra hfin + obtain ⟨n, hn⟩ := exists_nat_gt (freeNormExt p (support (seriesDisk K))).toReal + have hnorm : freeNormExt p (ofFVL p (finiteSupport (A n))) ≤ + freeNormExt p (support (seriesDisk K)) := by + apply freeNormExt_mono_abs + intro ψ + rw [(model_evaluation p (0 : M) _ _).2, ← hsupport, hDsupport, + abs_of_nonneg (hspos ψ n), abs_of_nonneg (tsum_nonneg (hspos ψ))] + exact (hsum ψ).le_tsum n (fun j _ => hspos ψ j) + rw [freeNormExt_eq_norm] at hnorm + have h := ENNReal.toReal_mono hfin hnorm + rw [ENNReal.toReal_ofReal (norm_nonneg _)] at h + have := hlarge n + linarith + let q (n : ℕ) : FVL M := ∑ k ∈ Finset.range n, finiteSupport (A k) + have hq (n : ℕ) : 0 ≤ q n := + Finset.sum_nonneg (fun k _ => finiteSupport_nonneg (A k)) + have hqmono : Monotone (fun n => ofFVL p (q n)) := by + apply (ofFVL p).monotone.comp + apply monotone_nat_of_le_succ + intro n + simpa only [q, Finset.sum_range_succ, le_add_iff_nonneg_right] using + finiteSupport_nonneg (A n) + have hqeval (n : ℕ) (ψ : Dual M) : + fvlFunction (q n) ψ = ∑ k ∈ Finset.range n, support (K k) ψ := by + rw [← (model_evaluation p (0 : M) (q n) ψ).2] + simp only [q, map_sum] + let ev : Free p M →ₗ[ℝ] ℝ := + { toFun := fun f => f ψ + map_add' := fun _ _ => rfl + map_smul' := fun _ _ => rfl } + exact (map_sum ev _ _).trans + (Finset.sum_congr rfl fun k _ => (hsupport k ψ).symm) + have hpoint (ψ : Dual M) : + IsLUB (Set.range fun n => fvlFunction (q n) ψ) (support (seriesDisk K) ψ) := by + simp_rw [hqeval, hDsupport] + apply isLUB_of_tendsto_atTop _ (hsum ψ).hasSum.tendsto_sum_nat + exact monotone_nat_of_le_succ fun n => by + simpa only [Finset.sum_range_succ, le_add_iff_nonneg_right] using hspos ψ n + let r (n : ℕ) := induced p M.subtypeL (ofFVL p (finiteSupport (A n))) + have hrsum : Summable r := + Summable.of_norm (Summable.of_nonneg_of_le (fun n => norm_nonneg _) + (fun n => (hsmall n).le) summable_geometric_two) + have hrpos (n : ℕ) : 0 ≤ r n := + (induced p M.subtypeL).toVecLatHom.map_nonneg + ((ofFVL p).map_nonneg (finiteSupport_nonneg (A n))) + have hqimage (n : ℕ) : + induced p M.subtypeL (ofFVL p (q n)) = ∑ k ∈ Finset.range n, r k := by + simp only [q, r, map_sum] + have hlim : Tendsto (fun n => induced p M.subtypeL (ofFVL p (q n))) atTop (𝓝 (∑' n, r n)) := by + simpa only [hqimage] using hrsum.hasSum.tendsto_sum_nat + have hupper (n : ℕ) : induced p M.subtypeL (ofFVL p (q n)) ≤ ∑' k, r k := by + rw [hqimage] + exact hrsum.sum_le_tsum _ (fun k _ => hrpos k) + have : Nontrivial M := by + by_contra h + have : Subsingleton M := not_nontrivial_iff_subsingleton.mp h + have hz : support (seriesDisk K) = (fun _ : Dual M => 0) := by + funext ψ + have himage : (fun x : M => |ψ x|) '' seriesDisk K = {0} := by + ext t + constructor + · rintro ⟨x, _, rfl⟩ + simp [Subsingleton.elim x 0] + · rintro rfl + exact ⟨0, hDac.1.zero_mem hDne, by simp⟩ + simp only [support, compactSupport, himage, csSup_singleton] + rw [hz, freeNormExt_zero] at hinf + exact ENNReal.zero_ne_top hinf + obtain ⟨e, he⟩ := exists_norm_eq M (c := ‖∑' n, r n‖ + 1) (by positivity) + have hw := failure_witness_of_compact_support p hp M hM (seriesDisk K) hDne hDac hDc + hinf q hq hqmono hpoint (∑' n, r n) hlim hupper e (by rw [he]; linarith) + refine ⟨hw, ?_⟩ + intro hsigma + obtain ⟨f, _, hf, G, hG, _, hGlower⟩ := hw + exact hG.not_ge ((hsigma _ hf).2.2 (by rintro _ ⟨n, rfl⟩; exact hGlower n)) + +/-- Theorem 4.1 (`thm:poe-inclusion`): for finite p and a closed subspace M, order +continuity, sequential order continuity, a lower free-norm bound, and POE-p are +equivalent. Failure of POE-p additionally yields the explicit decreasing-sequence +witness `FVLFailureWitness`. -/ +theorem poe_inclusion [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) : + List.TFAE [ + IsOrderContinuousOp (induced p M.subtypeL).toContinuousLinearMap.toLinearMap, + SigmaOrderContinuous (induced p M.subtypeL), + BoundedBelow (induced p M.subtypeL), HasPOE p E M] ∧ + (¬ HasPOE p E M → FVLFailureWitness p p (induced p M.subtypeL)) := by + constructor + · tfae_have 1 → 2 := orderContinuous_sigmaOrderContinuous + (induced p M.subtypeL).toContinuousLinearMap.toLinearMap + (fun _ h => (induced p M.subtypeL).toVecLatHom.map_nonneg h) + tfae_have 2 → 3 := fun h => by + by_contra hb + exact (poe_necessity p hp M hM hb).2 h + tfae_have 3 → 1 := poe_sufficiency p hp M hM + tfae_have 4 ↔ 3 := poe_iff_boundedBelow p M hM + tfae_finish + · intro h + exact (poe_necessity p hp M hM (fun hb => h ((poe_iff_boundedBelow p M hM).mpr hb))).1 + +/-- The regularity/closedness reformulation announced at the start of Section 4. -/ +theorem regular_range_iff_closed [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) : + IsRegularSublattice (inducedRange p M.subtypeL) ↔ + IsClosed (inducedRange p M.subtypeL : Set (Free p E)) := by + classical + let : CompleteSpace M := hM.isComplete.completeSpace_coe + let J := induced p M.subtypeL + have hJ : Function.Injective J := + (induced_basic_properties p M.subtypeL).2.1.mpr Subtype.val_injective + let e : Free p M ≃o inducedRange p M.subtypeL := + OrderIso.ofSurjective + { toFun := fun f => ⟨J f, ⟨f, rfl⟩⟩ + inj' := fun _ _ h => hJ (congrArg Subtype.val h) + map_rel_iff' := ⟨J.toVecLatHom.le_of_map_le hJ, fun h => J.toVecLatHom.monotone h⟩ } + (by rintro ⟨_, f, rfl⟩; exact ⟨f, rfl⟩) + have hezero : e 0 = 0 := Subtype.ext (map_zero J.toContinuousLinearMap) + have hinvzero : e.symm 0 = 0 := by rw [← hezero, e.symm_apply_apply] + have hreg : IsRegularSublattice (inducedRange p M.subtypeL) ↔ + IsOrderContinuousOp J.toContinuousLinearMap.toLinearMap := by + rw [IsRegularSublattice, orderContinuous_iff_decreasing _ (fun _ h => h), + orderContinuous_iff_decreasing J.toContinuousLinearMap.toLinearMap + (fun _ h => J.toVecLatHom.map_nonneg h)] + constructor + · intro h ι _ _ _ f hf + apply h ι (fun i => e (f i)) + refine ⟨e.monotone.comp_antitone hf.1, ?_⟩ + rw [Set.range_comp', e.isGLB_image, hinvzero] + exact hf.2 + · intro h ι _ _ _ f hf + have hh := h ι (fun i => e.symm (f i)) + ⟨e.symm.monotone.comp_antitone hf.1, by + rw [Set.range_comp', e.symm.isGLB_image, OrderIso.symm_symm, hezero]; exact hf.2⟩ + have he (x : inducedRange p M.subtypeL) : J (e.symm x) = x := + congrArg Subtype.val (e.apply_symm_apply x) + change DecreasesToZero (fun i => J (e.symm (f i))) at hh + have heq : (fun i => J (e.symm (f i))) = + (fun i => (inducedRange p M.subtypeL).subtype.toLinearMap (f i)) := + funext fun i => he (f i) + rw [heq] at hh + exact hh + rw [hreg] + constructor + · intro h + have hbb : BoundedBelow J := by + by_contra hb + exact (poe_necessity p hp M hM hb).2 + (orderContinuous_sigmaOrderContinuous J.toContinuousLinearMap.toLinearMap + (fun _ h => J.toVecLatHom.map_nonneg h) h) + exact ((embedding_iff J.toContinuousLinearMap).mp hbb).2 + · intro hclosed + exact poe_sufficiency p hp M hM + ((embedding_iff J.toContinuousLinearMap).mpr ⟨hJ, hclosed⟩) + +private theorem decreasesToZero_map_bijective {X : Type u} {Y : Type v} + [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [VectorLattice X] + [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + (S : VecLatHom X Y) (hS : Function.Bijective S) (f : ℕ → X) + (hf : DecreasesToZero f) : DecreasesToZero (fun n => S (f n)) := by + refine ⟨S.monotone.comp_antitone hf.1, ⟨?_, ?_⟩⟩ + · rintro _ ⟨n, rfl⟩ + exact S.map_nonneg (hf.2.1 (Set.mem_range_self n)) + · intro b hb + obtain ⟨a, rfl⟩ := hS.2 b + have ha : a ≤ 0 := hf.2.2 (by + rintro _ ⟨n, rfl⟩ + exact S.le_of_map_le hS.1 (hb (Set.mem_range_self n))) + simpa only [map_zero] using S.monotone ha + +private theorem induced_range_reduction [CompleteSpace E] [CompleteSpace F] + (p : Exponent) (T : F →L[ℝ] E) (hT : BoundedBelow T) : + (BoundedBelow (induced p T) ↔ BoundedBelow (induced p T.range.subtypeL)) ∧ + (IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap ↔ + IsOrderContinuousOp (induced p T.range.subtypeL).toContinuousLinearMap.toLinearMap) := by + classical + obtain ⟨hTi, hTc⟩ := (embedding_iff T).mp hT + let : CompleteSpace T.range := hTc.isComplete.completeSpace_coe + let U := induced p T.rangeRestrict + have hUi : Function.Injective U := + induced_injective_of p T.rangeRestrict (fun _ _ h => hTi (congrArg Subtype.val h)) + have hUs : Function.Surjective U := + induced_surjective_of p T.rangeRestrict (by rintro ⟨_, x, rfl⟩; exact ⟨x, rfl⟩) + let e : Free p F ≃o Free p T.range := + OrderIso.ofSurjective + { toFun := U + inj' := hUi + map_rel_iff' := ⟨U.toVecLatHom.le_of_map_le hUi, fun h => U.toVecLatHom.monotone h⟩ } hUs + have hzero : e 0 = 0 := map_zero U.toContinuousLinearMap + have hinvzero : e.symm 0 = 0 := by rw [← hzero, e.symm_apply_apply] + have hfactor (f : Free p F) : + induced p T.range.subtypeL (U f) = induced p T f := by + have h := induced_comp p T.range.subtypeL T.rangeRestrict + exact (congrArg (fun L : Free p F →L[ℝ] Free p E => L f) h).symm + have hJi : Function.Injective (induced p T) := induced_injective_of p T hTi + have hIi : Function.Injective (induced p T.range.subtypeL) := + induced_injective_of p T.range.subtypeL Subtype.val_injective + constructor + · rw [embedding_iff, embedding_iff] + have hrange : Set.range (induced p T) = Set.range (induced p T.range.subtypeL) := by + rw [← hUs.range_comp (induced p T.range.subtypeL)] + congr 1 + simp only [hJi, hIi, true_and, hrange] + · rw [sigma_order_continuity p (induced p T).toContinuousLinearMap.toLinearMap + (fun _ h => (induced p T).toVecLatHom.map_nonneg h), + sigma_order_continuity p (induced p T.range.subtypeL).toContinuousLinearMap.toLinearMap + (fun _ h => (induced p T.range.subtypeL).toVecLatHom.map_nonneg h)] + constructor + · intro h f hf + have hnull : DecreasesToZero (fun n => e.symm (f n)) := by + refine ⟨e.symm.monotone.comp_antitone hf.1, ?_⟩ + rw [Set.range_comp', e.symm.isGLB_image, OrderIso.symm_symm, hzero] + exact hf.2 + have hh := h _ hnull + have heq : (fun n => induced p T (e.symm (f n))) = + (fun n => induced p T.range.subtypeL (f n)) := by + funext n + rw [← hfactor] + change induced p T.range.subtypeL (e (e.symm (f n))) = _ + rw [e.apply_symm_apply] + change DecreasesToZero (fun n => induced p T (e.symm (f n))) at hh + rw [heq] at hh + exact hh + · intro h f hf + have hh := h _ (decreasesToZero_map_bijective U.toVecLatHom ⟨hUi, hUs⟩ f hf) + change DecreasesToZero (fun n => induced p T.range.subtypeL (U (f n))) at hh + simp_rw [hfactor] at hh + exact hh + +private theorem induced_boundedBelow_imp (p : Exponent) (T : F →L[ℝ] E) + (h : BoundedBelow (induced p T)) : BoundedBelow T := by + obtain ⟨c, hc, h⟩ := h + refine ⟨c, hc, fun x => ?_⟩ + simpa only [(delta p).norm_map, (induced_norm_generators p T).2] using h (delta p x) + +private theorem latticeEmbedding_of_boundedBelow (p : Exponent) (T : F →L[ℝ] E) + (h : BoundedBelow (induced p T)) : IsLatticeEmbedding (induced p T) := by + have hi := ((embedding_iff (induced p T).toContinuousLinearMap).mp h).1 + exact ⟨h, hi, fun _ _ => + ⟨(induced p T).toVecLatHom.le_of_map_le hi, fun h => (induced p T).toVecLatHom.monotone h⟩⟩ + +private theorem induced_orderContinuous_of_boundedBelow [CompleteSpace E] [CompleteSpace F] + (p : Exponent) (hp : p.IsFinite) (T : F →L[ℝ] E) + (h : BoundedBelow (induced p T)) : + IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap := by + have hT := induced_boundedBelow_imp p T h + have hclosed := ((embedding_iff T).mp hT).2 + have hinc : IsOrderContinuousOp + (induced p T.range.subtypeL).toContinuousLinearMap.toLinearMap := + poe_sufficiency p hp T.range hclosed ((induced_range_reduction p T hT).1.mp h) + apply (induced_range_reduction p T hT).2.mpr + exact hinc + +private theorem induced_zero_orderContinuous (p : Exponent) (T : F →L[ℝ] E) (hT : T = 0) : + IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap := by + have hz := (induced_eq_zero_iff p T).mpr hT + intro ι _ _ _ x a _ + change OrderConvergesTo + (fun i => (induced p T).toContinuousLinearMap (x i)) ((induced p T).toContinuousLinearMap a) + simpa only [hz, zero_apply] using + (orderConvergesTo_const (ι := ι) (0 : Free p E)) + +/-- Section 1's cited characterization of isomorphic lattice embeddings. -/ +theorem induced_embedding_iff [CompleteSpace E] [CompleteSpace F] + (p : Exponent) (T : F →L[ℝ] E) : + IsLatticeEmbedding (induced p T) ↔ BoundedBelow T ∧ HasPOE p E T.toLinearMap.range := by + constructor + · intro h + have hT := induced_boundedBelow_imp p T h.1 + exact ⟨hT, (poe_iff_boundedBelow p T.range ((embedding_iff T).mp hT).2).mpr + ((induced_range_reduction p T hT).1.mp h.1)⟩ + · rintro ⟨hT, hpoe⟩ + exact latticeEmbedding_of_boundedBelow p T ((induced_range_reduction p T hT).1.mpr + ((poe_iff_boundedBelow p T.range ((embedding_iff T).mp hT).2).mp hpoe)) + +/-- Theorem 1.3 (`thm:intro-poe`): for finite p, an induced map is order continuous +exactly when the original operator is zero or is bounded below with a range having POE. +Equivalently, the induced map itself is zero or an isomorphic lattice embedding. +The proof factors the original operator through its closed range. -/ +theorem intro_poe [CompleteSpace E] [CompleteSpace F] + (p : Exponent) (hp : p.IsFinite) (T : F →L[ℝ] E) : + (IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap ↔ + T = 0 ∨ (BoundedBelow T ∧ HasPOE p E T.toLinearMap.range)) ∧ + (IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap ↔ + (induced p T).toContinuousLinearMap = 0 ∨ IsLatticeEmbedding (induced p T)) := by + have hfirst : IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap ↔ + T = 0 ∨ (BoundedBelow T ∧ HasPOE p E T.toLinearMap.range) := by + constructor + · intro h + rcases necessary p T h with hz | hT + · exact Or.inl hz + · right + have hc := ((embedding_iff T).mp hT).2 + have hinc : IsOrderContinuousOp + (induced p T.range.subtypeL).toContinuousLinearMap.toLinearMap := by + apply (induced_range_reduction p T hT).2.mp + exact h + have hbb : BoundedBelow (induced p T.range.subtypeL) := by + by_contra hb + exact (poe_necessity p hp T.range hc hb).2 + (orderContinuous_sigmaOrderContinuous + (induced p T.range.subtypeL).toContinuousLinearMap.toLinearMap + (fun _ h => (induced p T.range.subtypeL).toVecLatHom.map_nonneg h) hinc) + exact ⟨hT, (poe_iff_boundedBelow p T.range hc).mpr hbb⟩ + · rintro (hz | h) + · exact induced_zero_orderContinuous p T hz + · exact induced_orderContinuous_of_boundedBelow p hp T + ((induced_embedding_iff p T).mpr h).1 + refine ⟨hfirst, ?_⟩ + rw [hfirst, induced_eq_zero_iff, induced_embedding_iff] + +/-- For every exponent, including ∞, the induced map is order continuous exactly +when the original operator is zero or bounded below with a range having POE. This +combines the finite-parameter theorem with the endpoint criterion `intro_infty`. -/ +theorem all_parameter_characterization [CompleteSpace E] [CompleteSpace F] + (p : Exponent) (T : F →L[ℝ] E) : + IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap ↔ + T = 0 ∨ (BoundedBelow T ∧ HasPOE p E T.toLinearMap.range) := by + rcases lt_or_eq_of_le (le_top : p.1 ≤ ⊤) with hp | hp + · exact (intro_poe p hp T).1 + · have heq : p = Exponent.infinity := Subtype.ext hp + subst p + rw [intro_infty] + constructor + · rintro (hz | hT) + · exact Or.inl hz + · exact Or.inr ⟨hT, 1, poe_infinity_one T.range ((embedding_iff T).mp hT).2⟩ + · rintro (hz | ⟨hT, _⟩) + · exact Or.inl hz + · exact Or.inr hT + +/-- An inclusion of a closed complemented subspace induces an order-continuous map +at every exponent: a bounded projection supplies the operator-extension property. +This is the assertion cited in Sections 1–3 as OikhbergEtAl2026, Theorem 3.4. -/ +theorem complemented_orderContinuous [CompleteSpace E] (p : Exponent) + (M : Submodule ℝ E) (hM : M.ClosedComplemented) : + IsOrderContinuousOp (induced p M.subtypeL).toContinuousLinearMap.toLinearMap := by + let : CompleteSpace M := hM.isClosed.isComplete.completeSpace_coe + obtain ⟨P, hP⟩ := hM + have hcomp : P.comp M.subtypeL = ContinuousLinearMap.id ℝ M := + ContinuousLinearMap.ext hP + have hleft : Function.LeftInverse (induced p P) (induced p M.subtypeL) := by + intro f + have hh := induced_comp p P M.subtypeL + rw [hcomp, induced_id] at hh + exact (congrArg (fun L : Free p M →L[ℝ] Free p M => L f) hh).symm + rcases lt_or_eq_of_le (le_top : p.1 ≤ ⊤) with hp | hp + · apply poe_sufficiency p hp M (show M.ClosedComplemented from ⟨P, hP⟩).isClosed + apply (embedding_iff (induced p M.subtypeL).toContinuousLinearMap).mpr + exact ⟨hleft.injective, + ((induced p M.subtypeL).toContinuousLinearMap.closedComplemented_range_of_leftInverse + (induced p P).toContinuousLinearMap hleft).isClosed⟩ + · have heq : p = Exponent.infinity := + Subtype.ext hp + subst p + apply (intro_infty M.subtypeL).mpr + exact Or.inr ⟨1, zero_lt_one, fun x => by simp⟩ + +/-- Local complementation by uniformly bounded retractions on finite-dimensional subspaces. -/ +def IsLocallyComplemented (M : Submodule ℝ E) : Prop := + IsClosed (M : Set E) ∧ ∃ C : ℝ, 1 ≤ C ∧ + ∀ V : Submodule ℝ E, FiniteDimensional ℝ V → + ∃ P : V →L[ℝ] M, ‖P‖ ≤ C ∧ ∀ x : V, (x : E) ∈ M → (P x : E) = x + +/-- Uniformly bounded retractions on finite-dimensional subspaces yield POE by +taking a limit of local extensions. The statement retains the finite-exponent +hypothesis from Section 4.4; the construction itself works for the finite-dimensional +target at every exponent. -/ +theorem locallyComplemented_poe (p : Exponent) (_hp : p.IsFinite) + (M : Submodule ℝ E) (hM : IsLocallyComplemented M) : HasPOE p E M := by + classical + obtain ⟨hclosed, C, hC, hlocal⟩ := hM + refine ⟨C, hclosed, hC, fun n R => ?_⟩ + let V (A : Finset E) := Submodule.span ℝ (A : Set E) + choose P hP hfix using fun A : Finset E => + hlocal (V A) (FiniteDimensional.span_of_finite ℝ A.finite_toSet) + let s (A : Finset E) (x : E) : FiniteLp p n := + if hx : x ∈ V A then R (P A ⟨x, hx⟩) else 0 + have hs (A : Finset E) (x : E) : ‖s A x‖ ≤ C * ‖R‖ * ‖x‖ := by + dsimp [s] + split_ifs with hx + · have h := (R.le_opNorm (P A ⟨x, hx⟩)).trans + (mul_le_mul_of_nonneg_left ((P A).le_opNorm ⟨x, hx⟩) (norm_nonneg R)) + have h' := mul_le_mul_of_nonneg_left + (mul_le_mul_of_nonneg_right (hP A) (norm_nonneg x)) (norm_nonneg R) + change ‖R (P A ⟨x, hx⟩)‖ ≤ ‖R‖ * (‖P A‖ * ‖x‖) at h + exact h.trans (by simpa only [mul_left_comm, mul_assoc] using h') + · simp only [norm_zero] + exact mul_nonneg (mul_nonneg (zero_le_one.trans hC) (norm_nonneg R)) (norm_nonneg x) + let B (x : E) := Metric.closedBall (0 : FiniteLp p n) (C * ‖R‖ * ‖x‖) + let (x : E) : CompactSpace (B x) := isCompact_iff_compactSpace.mp (isCompact_closedBall _ _) + let z (A : Finset E) : ∀ x : E, B x := + fun x => ⟨s A x, by simpa only [B, Metric.mem_closedBall, dist_zero_right] using hs A x⟩ + let U : Ultrafilter (Finset E) := Ultrafilter.of atTop + let g : ∀ x : E, B x := (U.map z).lim + have hg : Tendsto z (U : Filter (Finset E)) (𝓝 g) := (U.map z).le_nhds_lim + have hpoint (x : E) : Tendsto (fun A => s A x) (U : Filter (Finset E)) (𝓝 (g x : FiniteLp p n)) := + continuous_subtype_val.continuousAt.tendsto.comp ((tendsto_pi_nhds.mp hg) x) + have hmem (x : E) : ∀ᶠ A in (U : Filter (Finset E)), x ∈ V A := by + apply Filter.Eventually.filter_mono (Ultrafilter.of_le atTop) + filter_upwards [eventually_ge_atTop ({x} : Finset E)] with A hA + exact Submodule.subset_span (hA (Finset.mem_singleton_self x)) + have hadd (x y : E) : (g (x + y) : FiniteLp p n) = g x + g y := by + have heq : ∀ᶠ A in (U : Filter (Finset E)), s A (x + y) = s A x + s A y := by + filter_upwards [hmem x, hmem y] with A hx hy + simp only [s, dite_eq_left hx, dite_eq_left hy, dite_eq_left ((V A).add_mem hx hy)] + change R (P A (⟨x, hx⟩ + ⟨y, hy⟩)) = _ + simp only [map_add] + exact tendsto_nhds_unique ((hpoint (x + y)).congr' heq) ((hpoint x).add (hpoint y)) + have hsmul (a : ℝ) (x : E) : (g (a • x) : FiniteLp p n) = a • (g x : FiniteLp p n) := by + have heq : ∀ᶠ A in (U : Filter (Finset E)), s A (a • x) = a • s A x := by + filter_upwards [hmem x] with A hx + simp only [s, dite_eq_left hx, dite_eq_left ((V A).smul_mem a hx)] + change R (P A (a • ⟨x, hx⟩)) = _ + simp only [map_smul] + exact tendsto_nhds_unique ((hpoint (a • x)).congr' heq) ((hpoint x).const_smul a) + let L : E →ₗ[ℝ] FiniteLp p n := + { toFun := fun x => g x + map_add' := hadd + map_smul' := hsmul } + have hL (x : E) : ‖L x‖ ≤ C * ‖R‖ * ‖x‖ := + (mem_closedBall_zero_iff).mp (g x).2 + let S := L.mkContinuous (C * ‖R‖) hL + refine ⟨S, ?_, L.mkContinuous_norm_le (mul_nonneg (zero_le_one.trans hC) (norm_nonneg R)) hL⟩ + apply ContinuousLinearMap.ext + intro x + have heq : ∀ᶠ A in (U : Filter (Finset E)), s A (x : E) = R x := by + filter_upwards [hmem (x : E)] with A hx + simp only [s, dite_eq_left hx] + exact congrArg R (Subtype.ext (hfix A ⟨x, hx⟩ x.2)) + exact tendsto_nhds_unique ((hpoint (x : E)).congr' heq) tendsto_const_nhds + +/-- Section 4.4: order continuity for locally complemented subspaces. -/ +theorem locallyComplemented_orderContinuous [CompleteSpace E] (p : Exponent) + (M : Submodule ℝ E) (hM : IsLocallyComplemented M) : + IsOrderContinuousOp (induced p M.subtypeL).toContinuousLinearMap.toLinearMap := by + rcases lt_or_eq_of_le (le_top : p.1 ≤ ⊤) with hp | hp + · exact poe_sufficiency p hp M hM.1 + (boundedBelow_of_poe p M (locallyComplemented_poe p hp M hM)) + · have heq : p = Exponent.infinity := Subtype.ext hp + subst p + let : CompleteSpace M := hM.1.isComplete.completeSpace_coe + apply (intro_infty M.subtypeL).mpr + exact Or.inr ⟨1, zero_lt_one, fun x => by simp⟩ + +private theorem continuousMap_approximate_retraction + {K : Type v} [TopologicalSpace K] [CompactSpace K] [T2Space K] + (T : C(K, ℝ) →L[ℝ] E) (φ : K → Dual E) (D : ℝ) (hD : 0 ≤ D) + (hφ : ∀ x, ‖φ x‖ ≤ D) (heval : ∀ f x, φ x (T f) = f x) + (A : Finset C(K, ℝ)) (ε : ℝ) (hε : 0 < ε) : + ∃ P : E →L[ℝ] C(K, ℝ), ‖P‖ ≤ D ∧ ∀ f ∈ A, ‖P (T f) - f‖ ≤ ε := by + classical + let U (x : K) : Set K := ⋂ f ∈ A, {y | dist (f y) (f x) < ε} + have ho (x : K) : IsOpen (U x) := + isOpen_biInter_finset fun f _ => isOpen_lt (f.continuous.dist continuous_const) continuous_const + obtain ⟨t, ht⟩ := isCompact_univ.elim_finite_subcover U ho (by + intro x _ + refine Set.mem_iUnion.mpr ⟨x, ?_⟩ + simp only [U, Set.mem_iInter, Set.mem_ofPred_eq, dist_self] + exact fun _ _ => hε) + obtain ⟨ρ, hρ⟩ := PartitionOfUnity.exists_isSubordinate_of_locallyFinite + isClosed_univ (fun i : t => U i) (fun i => ho i) (locallyFinite_of_finite _) (by + intro y hy + obtain ⟨x, hx⟩ := Set.mem_iUnion.mp (ht hy) + obtain ⟨hxt, hxy⟩ := Set.mem_iUnion.mp hx + exact Set.mem_iUnion.mpr ⟨⟨x, hxt⟩, hxy⟩) + have hsum (y : K) : ∑ i : t, ρ i y = 1 := by + simpa only [finsum_eq_sum_of_fintype] using ρ.sum_eq_one (Set.mem_univ y) + let P : E →L[ℝ] C(K, ℝ) := ∑ i : t, (φ i).smulRight (ρ i) + have hPval (z : E) (y : K) : P z y = ∑ i : t, ρ i y * φ i z := by + simp [P, mul_comm] + refine ⟨P, ?_, ?_⟩ + · apply P.opNorm_le_bound hD + intro z + apply ((P z).norm_le (mul_nonneg hD (norm_nonneg z))).mpr + intro y + rw [Real.norm_eq_abs, hPval] + calc + |∑ i : t, ρ i y * φ i z| ≤ ∑ i : t, |ρ i y * φ i z| := Finset.abs_sum_le_sum_abs _ _ + _ ≤ ∑ i : t, ρ i y * (D * ‖z‖) := by + apply Finset.sum_le_sum + intro i _ + rw [abs_mul, abs_of_nonneg (ρ.nonneg i y)] + exact mul_le_mul_of_nonneg_left + (((φ i).le_opNorm z).trans (mul_le_mul_of_nonneg_right (hφ i) (norm_nonneg z))) + (ρ.nonneg i y) + _ = D * ‖z‖ := by rw [← Finset.sum_mul, hsum, one_mul] + · intro f hf + apply ((P (T f) - f).norm_le hε.le).mpr + intro y + have heq : (P (T f) - f) y = ∑ i : t, ρ i y * (f i - f y) := by + simp only [ContinuousMap.sub_apply, hPval, heval] + simp only [mul_sub, Finset.sum_sub_distrib, ← Finset.sum_mul, hsum, one_mul] + rw [Real.norm_eq_abs, heq] + calc + |∑ i : t, ρ i y * (f i - f y)| ≤ ∑ i : t, |ρ i y * (f i - f y)| := + Finset.abs_sum_le_sum_abs _ _ + _ ≤ ∑ i : t, ρ i y * ε := by + apply Finset.sum_le_sum + intro i _ + rw [abs_mul, abs_of_nonneg (ρ.nonneg i y)] + by_cases hi : ρ i y = 0 + · simp only [hi, zero_mul, le_refl] + · have hy : y ∈ U i := hρ i (subset_tsupport (ρ i) hi) + have hd : dist (f y) (f i) < ε := Set.mem_iInter.mp (Set.mem_iInter.mp hy f) hf + apply mul_le_mul_of_nonneg_left _ (ρ.nonneg i y) + simpa only [Real.dist_eq, abs_sub_comm] using hd.le + _ = ε := by rw [← Finset.sum_mul, hsum, one_mul] + +/-- Corollary 4.13 (`cor:bidual-order-continuity`): the canonical isometric embedding +of a Banach space into its bidual induces an order-continuous isometric lattice +embedding at every exponent. The canonical embedding of the dual into its bidual +extends dual functionals isometrically; this gives the free-norm bound and hence +order continuity. -/ +theorem bidual_order_continuity [CompleteSpace E] (p : Exponent) : + IsOrderContinuousOp (induced (F := E) (E := Dual (Dual E)) p + (NormedSpace.inclusionInDoubleDual ℝ E)).toContinuousLinearMap.toLinearMap ∧ + Isometry (induced (F := E) (E := Dual (Dual E)) p (NormedSpace.inclusionInDoubleDual ℝ E)) ∧ + IsLatticeEmbedding (induced (F := E) (E := Dual (Dual E)) p + (NormedSpace.inclusionInDoubleDual ℝ E)) := by + let T : E →L[ℝ] Dual (Dual E) := NormedSpace.inclusionInDoubleDual ℝ E + have hiso : Isometry (induced p T) := by + apply induced_isometry_of_dual_extension (E := Dual (Dual E)) (F := E) + p T (NormedSpace.inclusionInDoubleDual_norm_le ℝ E) + (NormedSpace.inclusionInDoubleDualLi (E := Dual E) ℝ) + intro ψ + apply ContinuousLinearMap.ext + intro x + rfl + have hbb : BoundedBelow (induced p T) := + ⟨1, zero_lt_one, fun f => by + simpa only [one_mul] using (hiso.norm_map_of_map_zero + (map_zero (induced p T).toContinuousLinearMap) f).ge⟩ + refine ⟨?_, hiso, latticeEmbedding_of_boundedBelow p T hbb⟩ + rcases lt_or_eq_of_le (le_top : p.1 ≤ ⊤) with hp | hp + · exact induced_orderContinuous_of_boundedBelow p hp T hbb + · have heq : p = Exponent.infinity := Subtype.ext hp + subst p + apply (intro_infty T).mpr + exact Or.inr (induced_boundedBelow_imp Exponent.infinity T hbb) + +private theorem finiteLp_extension_of_dual_extension (p : Exponent) + (T : F →L[ℝ] E) (Φ : Dual F →ₗᵢ[ℝ] Dual E) (hext : ∀ ψ, (Φ ψ).comp T = ψ) + (n : ℕ) (R : F →L[ℝ] FiniteLp p n) : + ∃ S : E →L[ℝ] FiniteLp p n, S.comp T = R ∧ ‖S‖ ≤ ‖R‖ := by + let ψ (i : Fin n) : Dual F := (PiLp.proj p.1 (fun _ : Fin n => ℝ) i).comp R + let S : E →L[ℝ] FiniteLp p n := + (PiLp.continuousLinearEquiv p.1 ℝ (fun _ : Fin n => ℝ)).symm.toContinuousLinearMap.comp + (ContinuousLinearMap.pi (fun i => Φ (ψ i))) + refine ⟨S, ?_, ?_⟩ + · apply ContinuousLinearMap.ext + intro x + apply WithLp.ofLp_injective p.1 + funext i + exact congrArg (fun l : Dual F => l x) (hext (ψ i)) + · apply S.opNorm_le_bound (norm_nonneg R) + intro x + obtain ⟨l, hl, hlx⟩ := exists_dual_vector'' ℝ (S x) + change l (S x) = ‖S x‖ at hlx + let a (i : Fin n) : ℝ := l (PiLp.single p.1 i 1) + have hlin (z : FiniteLp p n) : ∑ i, a i * z i = l z := by + have hz := (PiLp.basisFun p.1 ℝ (Fin n)).sum_repr z + simpa [a, map_sum, map_smul, smul_eq_mul, mul_comm] using congrArg l hz + let θ : Dual F := ∑ i, a i • ψ i + have hθ : ‖θ‖ ≤ ‖R‖ := by + apply θ.opNorm_le_bound (norm_nonneg R) + intro y + change ‖(∑ i, a i • ψ i) y‖ ≤ ‖R‖ * ‖y‖ + simp only [sum_apply, smul_apply, smul_eq_mul] + change ‖∑ i, a i * (R y) i‖ ≤ _ + rw [hlin] + exact (l.le_opNorm _).trans + ((mul_le_mul_of_nonneg_right hl (norm_nonneg _)).trans (by + simpa only [one_mul] using R.le_opNorm y)) + have heval : Φ θ x = l (S x) := by + simp only [θ, map_sum, map_smul, sum_apply, smul_apply, smul_eq_mul] + exact hlin (S x) + have hh := (Φ θ).le_opNorm x + rw [heval, hlx, Real.norm_of_nonneg (norm_nonneg _), Φ.norm_map] at hh + exact hh.trans (mul_le_mul_of_nonneg_right hθ (norm_nonneg _)) + +/-- The canonical copy of a Banach space in its bidual has POE with constant one +at every exponent. This follows from the isometric free-lattice inclusion and +`poe_one_iff_isometry`. -/ +theorem bidual_poe_one [CompleteSpace E] (p : Exponent) : + POEWith p (Dual (Dual E)) (NormedSpace.inclusionInDoubleDual ℝ E).toLinearMap.range 1 := by + let T : E →L[ℝ] Dual (Dual E) := NormedSpace.inclusionInDoubleDual ℝ E + have hclosed := Isometry.isClosedEmbedding (f := T) + (NormedSpace.inclusionInDoubleDualLi (E := E) ℝ).isometry + refine ⟨hclosed.isClosed_range, le_rfl, fun n R => ?_⟩ + obtain ⟨S, hS, hnorm⟩ := finiteLp_extension_of_dual_extension p T + (NormedSpace.inclusionInDoubleDualLi (E := Dual E) ℝ) + (fun ψ => ContinuousLinearMap.ext (fun _ => rfl)) n (R.comp T.rangeRestrict) + refine ⟨S, ?_, ?_⟩ + · apply ContinuousLinearMap.ext + rintro ⟨_, x, rfl⟩ + exact congrArg (fun L : E →L[ℝ] FiniteLp p n => L x) hS + · rw [one_mul] + apply hnorm.trans + apply (R.comp T.rangeRestrict).opNorm_le_bound (norm_nonneg R) + intro x + exact (R.le_opNorm (T.rangeRestrict x)).trans + (mul_le_mul_of_nonneg_left (NormedSpace.double_dual_bound ℝ E x) (norm_nonneg R)) + +private theorem finiteLp_extension_of_approximations {ι : Type w} + (p : Exponent) (n : ℕ) (l : Filter ι) [l.NeBot] + (T : F →L[ℝ] E) (R : F →L[ℝ] FiniteLp p n) (C : ℝ) (hC : 0 ≤ C) + (S : ι → E →L[ℝ] FiniteLp p n) (hS : ∀ k, ‖S k‖ ≤ C) + (hlim : ∀ x, Tendsto (fun k => S k (T x)) l (𝓝 (R x))) : + ∃ A : E →L[ℝ] FiniteLp p n, A.comp T = R ∧ ‖A‖ ≤ C := by + let B (x : E) := Metric.closedBall (0 : FiniteLp p n) (C * ‖x‖) + let (x : E) : CompactSpace (B x) := isCompact_iff_compactSpace.mp (isCompact_closedBall _ _) + let z (k : ι) : ∀ x : E, B x := fun x => ⟨S k x, by + apply mem_closedBall_zero_iff.mpr + exact ((S k).le_opNorm x).trans (mul_le_mul_of_nonneg_right (hS k) (norm_nonneg x))⟩ + let U : Ultrafilter ι := Ultrafilter.of l + let g : ∀ x : E, B x := (U.map z).lim + have hg : Tendsto z (U : Filter ι) (𝓝 g) := (U.map z).le_nhds_lim + have hpoint (x : E) : Tendsto (fun k => S k x) (U : Filter ι) (𝓝 (g x : FiniteLp p n)) := + continuous_subtype_val.continuousAt.tendsto.comp ((tendsto_pi_nhds.mp hg) x) + let L : E →ₗ[ℝ] FiniteLp p n := + { toFun := fun x => g x + map_add' := fun x y => tendsto_nhds_unique + ((hpoint (x + y)).congr' (Filter.Eventually.of_forall fun k => map_add (S k) x y)) + ((hpoint x).add (hpoint y)) + map_smul' := fun a x => tendsto_nhds_unique + ((hpoint (a • x)).congr' (Filter.Eventually.of_forall fun k => map_smul (S k) a x)) + ((hpoint x).const_smul a) } + have hL (x : E) : ‖L x‖ ≤ C * ‖x‖ := mem_closedBall_zero_iff.mp (g x).2 + refine ⟨L.mkContinuous C hL, ?_, L.mkContinuous_norm_le hC hL⟩ + apply ContinuousLinearMap.ext + intro x + exact tendsto_nhds_unique (hpoint (T x)) ((hlim x).mono_left (Ultrafilter.of_le l)) + +private theorem continuousMap_extension_data [CompleteSpace E] + {K : Type v} [TopologicalSpace K] [CompactSpace K] [T2Space K] + (T : C(K, ℝ) →L[ℝ] E) (hT : BoundedBelow T) : + ∃ D : ℝ, 0 < D ∧ ∃ φ : K → Dual E, + (∀ x, ‖φ x‖ ≤ D) ∧ ∀ f x, φ x (T f) = f x := by + obtain ⟨hi, hc⟩ := (embedding_iff T).mp hT + obtain ⟨c, hcpos, hbound⟩ := hT + let e := T.equivRange hi hc + have hinv (y : T.range) : ‖e.symm y‖ ≤ c⁻¹ * ‖y‖ := by + obtain ⟨y, f, rfl⟩ := y + change ‖e.symm ⟨T f, ⟨f, rfl⟩⟩‖ ≤ c⁻¹ * ‖T f‖ + rw [show e.symm ⟨T f, ⟨f, rfl⟩⟩ = f from T.equivRange_symm_apply hi hc f] + have hh := mul_le_mul_of_nonneg_left (hbound f) (inv_nonneg.mpr hcpos.le) + simpa only [← mul_assoc, inv_mul_cancel₀ hcpos.ne', one_mul] using hh + let ψ (x : K) : Dual T.range := (ContinuousMap.evalCLM ℝ x).comp e.symm.toContinuousLinearMap + have hψ (x : K) : ‖ψ x‖ ≤ c⁻¹ := by + apply (ψ x).opNorm_le_bound (inv_nonneg.mpr hcpos.le) + intro y + exact ((e.symm y).norm_coe_le_norm x).trans (hinv y) + choose φ hφ hnorm using fun x => exists_extension_norm_eq T.range (ψ x) + refine ⟨c⁻¹, inv_pos.mpr hcpos, φ, fun x => (hnorm x).trans_le (hψ x), ?_⟩ + intro f x + rw [hφ x ⟨T f, ⟨f, rfl⟩⟩] + change e.symm ⟨T f, ⟨f, rfl⟩⟩ x = f x + rw [show e.symm ⟨T f, ⟨f, rfl⟩⟩ = f from T.equivRange_symm_apply hi hc f] + +/-- Section 4.4: any embedding of a C(K) space has order-continuous extension. -/ +theorem continuousMap_embedding_orderContinuous [CompleteSpace E] (p : Exponent) + {K : Type v} [TopologicalSpace K] [CompactSpace K] [T2Space K] + (T : C(K, ℝ) →L[ℝ] E) (hT : BoundedBelow T) : + IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap := by + classical + obtain ⟨D, hD, φ, hφ, heval⟩ := continuousMap_extension_data T hT + choose P hP happrox using fun (A : Finset C(K, ℝ)) (k : ℕ) => + continuousMap_approximate_retraction T φ D hD.le hφ heval A (1 / (k + 1)) (by positivity) + have hlim (f : C(K, ℝ)) : + Tendsto (fun i : Finset C(K, ℝ) × ℕ => P i.1 i.2 (T f)) atTop (𝓝 f) := by + rw [Metric.tendsto_atTop] + intro ε hε + obtain ⟨N, hN⟩ := exists_nat_gt (1 / ε) + have hsmall : 1 / ((N : ℝ) + 1) < ε := by + rw [div_lt_iff₀ (by positivity)] + have hh := (div_lt_iff₀ hε).mp hN + nlinarith + refine ⟨({f}, N), fun i hi => ?_⟩ + rw [dist_eq_norm] + apply (happrox i.1 i.2 f (hi.1 (Finset.mem_singleton_self f))).trans_lt + apply lt_of_le_of_lt _ hsmall + apply one_div_le_one_div_of_le (by positivity) + exact_mod_cast Nat.add_le_add_right hi.2 1 + have hpoe : HasPOE p E T.range := by + let C := max 1 (D * ‖T‖) + refine ⟨C, ((embedding_iff T).mp hT).2, le_max_left _ _, fun n R => ?_⟩ + let R' : C(K, ℝ) →L[ℝ] FiniteLp p n := R.comp T.rangeRestrict + have hR' : ‖R'‖ ≤ ‖R‖ * ‖T‖ := by + apply R'.opNorm_le_bound (mul_nonneg (norm_nonneg R) (norm_nonneg T)) + intro x + exact (R.le_opNorm (T.rangeRestrict x)).trans (by + change ‖R‖ * ‖T x‖ ≤ (‖R‖ * ‖T‖) * ‖x‖ + simpa only [mul_assoc] using mul_le_mul_of_nonneg_left (T.le_opNorm x) (norm_nonneg R)) + let S (i : Finset C(K, ℝ) × ℕ) : E →L[ℝ] FiniteLp p n := R'.comp (P i.1 i.2) + have hS (i : Finset C(K, ℝ) × ℕ) : ‖S i‖ ≤ C * ‖R‖ := by + calc + ‖S i‖ ≤ ‖R'‖ * ‖P i.1 i.2‖ := R'.opNorm_comp_le _ + _ ≤ (‖R‖ * ‖T‖) * D := + mul_le_mul hR' (hP i.1 i.2) (norm_nonneg (P i.1 i.2)) + (mul_nonneg (norm_nonneg R) (norm_nonneg T)) + _ = (D * ‖T‖) * ‖R‖ := by ring + _ ≤ C * ‖R‖ := mul_le_mul_of_nonneg_right (le_max_right _ _) (norm_nonneg R) + obtain ⟨B, hB, hBnorm⟩ := finiteLp_extension_of_approximations p n atTop T R' + (C * ‖R‖) (mul_nonneg (zero_le_one.trans (le_max_left _ _)) (norm_nonneg R)) + S hS (fun f => (R'.continuous.tendsto f).comp (hlim f)) + refine ⟨B, ?_, hBnorm⟩ + apply ContinuousLinearMap.ext + rintro ⟨_, f, rfl⟩ + exact congrArg (fun L : C(K, ℝ) →L[ℝ] FiniteLp p n => L f) hB + rcases lt_or_eq_of_le (le_top : p.1 ≤ ⊤) with hp | hp + · apply induced_orderContinuous_of_boundedBelow p hp T + exact (induced_range_reduction p T hT).1.mpr (boundedBelow_of_poe p T.range hpoe) + · have heq : p = Exponent.infinity := Subtype.ext hp + subst p + apply (intro_infty T).mpr + exact Or.inr hT + +/-- The real Banach space c0 of null sequences, realized as continuous functions on the +discrete natural numbers that vanish at infinity, with the supremum norm. -/ +abbrev CZero := ZeroAtInftyContinuousMap ℕ ℝ +/-- The real Banach space of bounded sequences, modeled by Mathlib’s `lp` at exponent ∞. -/ +abbrev LInfinity : Type := lp (fun _ : ℕ => ℝ) ⊤ + +/-- The canonical bounded linear inclusion of real null sequences into bounded sequences. +It preserves each coordinate; `c0_isometry_uncomplemented` proves that it is isometric +and that its range is not complemented. -/ +def c0Inclusion : CZero →L[ℝ] LInfinity := by + let L : CZero →ₗ[ℝ] LInfinity := + { toFun := fun f => ⟨fun n => f n, memℓp_infty + ⟨‖f‖, by + rintro _ ⟨n, rfl⟩ + exact f.toBCF.norm_coe_le_norm n⟩⟩ + map_add' := fun _ _ => rfl + map_smul' := fun _ _ => rfl } + exact L.mkContinuous 1 fun f => by + rw [one_mul] + exact lp.norm_le_of_forall_le (norm_nonneg f) (fun n => f.toBCF.norm_coe_le_norm n) + +private theorem c0Inclusion_isometry : Isometry c0Inclusion := by + apply AddMonoidHomClass.isometry_of_norm c0Inclusion + intro f + apply le_antisymm + · exact lp.norm_le_of_forall_le (norm_nonneg f) (fun n => f.toBCF.norm_coe_le_norm n) + · change ‖f.toBCF‖ ≤ ‖c0Inclusion f‖ + apply (BoundedContinuousFunction.norm_le (norm_nonneg _)).mpr + intro n + exact lp.norm_apply_le_norm ENNReal.top_ne_zero (c0Inclusion f) n + +private theorem c0Inclusion_boundedBelow : BoundedBelow c0Inclusion := + ⟨1, zero_lt_one, fun f => by + simpa only [one_mul] using + (c0Inclusion_isometry.norm_map_of_map_zero (map_zero c0Inclusion) f).ge⟩ + +/-- Truncate a bounded sequence to its first `k` coordinates as an element of `c₀`. -/ +def c0Truncation (k : ℕ) : LInfinity →L[ℝ] CZero := by + let L : LInfinity →ₗ[ℝ] CZero := + { toFun := fun x => + { toFun := fun i => if i < k then x i else 0 + continuous_toFun := continuous_of_discreteTopology + zero_at_infty' := by + rw [cocompact_eq_cofinite, Nat.cofinite_eq_atTop] + apply tendsto_const_nhds.congr' + filter_upwards [eventually_ge_atTop k] with i hi + simp only [ite_eq_right (not_lt.mpr hi)] } + map_add' := fun x y => by + ext i + change (if i < k then x i + y i else 0) = + (if i < k then x i else 0) + (if i < k then y i else 0) + split_ifs <;> simp + map_smul' := fun a x => by + ext i + change (if i < k then a • x i else 0) = a • (if i < k then x i else 0) + split_ifs <;> simp } + exact L.mkContinuous 1 fun x => by + rw [one_mul] + change ‖(L x).toBCF‖ ≤ ‖x‖ + apply (BoundedContinuousFunction.norm_le (norm_nonneg x)).mpr + intro i + change ‖if i < k then x i else 0‖ ≤ ‖x‖ + split_ifs + · exact lp.norm_apply_le_norm ENNReal.top_ne_zero x i + · simpa only [norm_zero] using norm_nonneg x + +private theorem c0Truncation_norm_le (k : ℕ) (x : LInfinity) : + ‖c0Truncation k x‖ ≤ ‖x‖ := by + change ‖(c0Truncation k x).toBCF‖ ≤ ‖x‖ + apply (BoundedContinuousFunction.norm_le (norm_nonneg x)).mpr + intro i + change ‖if i < k then x i else 0‖ ≤ ‖x‖ + split_ifs + · exact lp.norm_apply_le_norm ENNReal.top_ne_zero x i + · simpa only [norm_zero] using norm_nonneg x + +private theorem c0Truncation_tendsto (x : CZero) : + Tendsto (fun k => c0Truncation k (c0Inclusion x)) atTop (𝓝 x) := by + have hx : Tendsto x atTop (𝓝 0) := by + simpa only [cocompact_eq_cofinite, Nat.cofinite_eq_atTop] using zero_at_infty x + rw [Metric.tendsto_atTop] + intro ε hε + obtain ⟨N, hN⟩ := (Metric.tendsto_atTop.mp hx) (ε / 2) (half_pos hε) + refine ⟨N, fun k hk => ?_⟩ + apply lt_of_le_of_lt _ (half_lt_self hε) + rw [dist_eq_norm] + change ‖(c0Truncation k (c0Inclusion x) - x).toBCF‖ ≤ ε / 2 + apply (BoundedContinuousFunction.norm_le (half_pos hε).le).mpr + intro i + change ‖(if i < k then x i else 0) - x i‖ ≤ ε / 2 + split_ifs with hi + · simpa only [sub_self, norm_zero] using (half_pos hε).le + · simpa only [zero_sub, norm_neg, dist_zero_right] using (hN i (hk.trans (not_lt.mp hi))).le + +/-- The known POE assertion about the c0 pair, cited before Theorem 1.3. -/ +theorem c0_poe (p : Exponent) : HasPOE p LInfinity c0Inclusion.toLinearMap.range := by + refine ⟨1, ((embedding_iff c0Inclusion).mp c0Inclusion_boundedBelow).2, + le_rfl, fun n R => ?_⟩ + let R' : CZero →L[ℝ] FiniteLp p n := R.comp c0Inclusion.rangeRestrict + let S (k : ℕ) : LInfinity →L[ℝ] FiniteLp p n := R'.comp (c0Truncation k) + have hR (x : CZero) : ‖R' x‖ ≤ ‖R‖ * ‖x‖ := by + have h := R.le_opNorm (c0Inclusion.rangeRestrict x) + change ‖R' x‖ ≤ ‖R‖ * ‖c0Inclusion x‖ at h + rwa [c0Inclusion_isometry.norm_map_of_map_zero (map_zero c0Inclusion)] at h + have hS (k : ℕ) : ‖S k‖ ≤ ‖R‖ := by + apply (S k).opNorm_le_bound (norm_nonneg R) + intro x + exact (hR (c0Truncation k x)).trans + (mul_le_mul_of_nonneg_left (c0Truncation_norm_le k x) (norm_nonneg R)) + obtain ⟨A, hA, hAnorm⟩ := finiteLp_extension_of_approximations p n atTop c0Inclusion R' + ‖R‖ (norm_nonneg R) S hS (fun x => + (R'.continuous.tendsto x).comp (c0Truncation_tendsto x)) + refine ⟨A, ?_, by simpa only [one_mul] using hAnorm⟩ + apply ContinuousLinearMap.ext + rintro ⟨_, x, rfl⟩ + exact congrArg (fun L : CZero →L[ℝ] FiniteLp p n => L x) hA + +/-- Corollary 3.3 (`cor:c0`): the canonical inclusion of null sequences into bounded +sequences induces an order-continuous free-lattice map at every exponent. Together +with `c0_isometry_uncomplemented`, this exhibits order continuity for an uncomplemented pair. -/ +theorem c0 (p : Exponent) : + IsOrderContinuousOp (induced p c0Inclusion).toContinuousLinearMap.toLinearMap := by + rcases lt_or_eq_of_le (le_top : p.1 ≤ ⊤) with hp | hp + · apply induced_orderContinuous_of_boundedBelow p hp c0Inclusion + exact (induced_range_reduction p c0Inclusion c0Inclusion_boundedBelow).1.mpr + (boundedBelow_of_poe p c0Inclusion.range (c0_poe p)) + · have heq : p = Exponent.infinity := Subtype.ext hp + subst p + apply (intro_infty c0Inclusion).mpr + exact Or.inr c0Inclusion_boundedBelow + +private theorem c0_annihilator_bound (φ : Dual LInfinity) + (hφ : ∀ x : CZero, φ (c0Inclusion x) = 0) (x : LInfinity) + (C : ℝ) (hC : 0 ≤ C) (hx : ∀ᶠ i in atTop, ‖x i‖ ≤ C) : + ‖φ x‖ ≤ ‖φ‖ * C := by + obtain ⟨N, hN⟩ := eventually_atTop.mp hx + have hy : ‖x - c0Inclusion (c0Truncation N x)‖ ≤ C := by + apply lp.norm_le_of_forall_le hC + intro i + change ‖x i - (if i < N then x i else 0)‖ ≤ C + split_ifs with hi + · simpa only [sub_self, norm_zero] using hC + · simpa only [sub_zero] using hN i (not_lt.mp hi) + have h := (φ.le_opNorm (x - c0Inclusion (c0Truncation N x))).trans + (mul_le_mul_of_nonneg_left hy (norm_nonneg φ)) + simpa only [map_sub, hφ, sub_zero] using h + +/-- The bounded zero-one indicator sequence of a set of natural numbers. -/ +def boundedIndicator (A : Set ℕ) : LInfinity := by + classical + exact ⟨fun i => if i ∈ A then 1 else 0, memℓp_infty ⟨1, by + rintro _ ⟨i, rfl⟩ + dsimp only + split_ifs <;> norm_num⟩⟩ + +private theorem annihilator_countable_support {ι : Type*} (A : ι → Set ℕ) + (hA : ∀ r s, r ≠ s → (A r ∩ A s).Finite) (φ : Dual LInfinity) + (hφ : ∀ x : CZero, φ (c0Inclusion x) = 0) : + (Function.support (fun r => φ (boundedIndicator (A r)))).Countable := by + classical + have hs : Summable (fun r => |φ (boundedIndicator (A r))|) := by + apply summable_of_sum_le (fun _ => abs_nonneg _) (c := ‖φ‖) + intro t + let σ (r : ι) : ℝ := if 0 ≤ φ (boundedIndicator (A r)) then 1 else -1 + let x : LInfinity := ∑ r ∈ t, σ r • boundedIndicator (A r) + have hdis : ∀ᶠ i in atTop, ∀ r ∈ t, ∀ s ∈ t, + r ≠ s → ¬ (i ∈ A r ∧ i ∈ A s) := by + simp only [eventually_all_finset] + intro r hr s hs + by_cases hrs : r = s + · simp [hrs] + · exact ((Nat.cofinite_eq_atTop ▸ (hA r s hrs).eventually_cofinite_notMem)).mono + (fun _ hi _ => hi) + have hx : ∀ᶠ i in atTop, ‖x i‖ ≤ 1 := by + filter_upwards [hdis] with i hi + change ‖(lp.evalₗ (𝕜 := ℝ) (fun _ : ℕ => ℝ) ⊤ i) x‖ ≤ 1 + simp only [x, map_sum, map_smul, lp.evalₗ_apply] + by_cases hex : ∃ r ∈ t, i ∈ A r + · obtain ⟨r, hr, hir⟩ := hex + rw [Finset.sum_eq_single r (fun s hs hsr => by + have his : i ∉ A s := fun his => hi s hs r hr hsr ⟨his, hir⟩ + simp [boundedIndicator, his]) (fun hr' => (hr' hr).elim)] + simp only [boundedIndicator, ite_eq_left hir, smul_eq_mul, mul_one] + dsimp only [σ] + split_ifs <;> norm_num + · have hz (r : ι) (hr : r ∈ t) : i ∉ A r := fun hir => hex ⟨r, hr, hir⟩ + rw [Finset.sum_eq_zero (fun r hr => by simp [boundedIndicator, hz r hr])] + norm_num + have heq : φ x = ∑ r ∈ t, |φ (boundedIndicator (A r))| := by + simp only [x, map_sum, map_smul, smul_eq_mul] + apply Finset.sum_congr rfl + intro r hr + dsimp only [σ] + split_ifs with hrpos + · simp [abs_of_nonneg hrpos] + · simp [abs_of_neg (lt_of_not_ge hrpos)] + have hb := c0_annihilator_bound φ hφ x 1 zero_le_one hx + rw [heq, Real.norm_eq_abs, abs_of_nonneg (Finset.sum_nonneg (fun _ _ => abs_nonneg _)), + mul_one] at hb + exact hb + exact hs.countable_support.mono (fun r hr => abs_ne_zero.mpr hr) + +/-- Encode the first `n` bits of a Boolean sequence as a natural number. -/ +def prefixCode (r : ℕ → Bool) (n : ℕ) : ℕ := + Encodable.encode (List.ofFn (fun i : Fin n => r i)) + +private theorem prefixCode_eq {r s : ℕ → Bool} {n m : ℕ} + (h : prefixCode r n = prefixCode s m) : + n = m ∧ ∀ i < n, r i = s i := by + have hl := Encodable.encode_injective h + have hn : n = m := by simpa only [List.length_ofFn] using congrArg List.length hl + subst m + refine ⟨rfl, ?_⟩ + exact fun i hi => congrFun (List.ofFn_inj.mp hl) ⟨i, hi⟩ + +/-- Distinct infinite binary branches have only finitely many common prefixes. -/ +private theorem prefixCode_finite_inter {r s : ℕ → Bool} (hrs : r ≠ s) : + (Set.range (prefixCode r) ∩ Set.range (prefixCode s)).Finite := by + obtain ⟨d, hd⟩ := Function.ne_iff.mp hrs + apply ((Set.finite_Iic d).image (prefixCode r)).subset + rintro x ⟨⟨n, rfl⟩, m, hm⟩ + refine ⟨n, ?_, rfl⟩ + exact le_of_not_gt (fun hn => hd ((prefixCode_eq hm.symm).2 d hn)) + +private theorem binaryBranch_uncountable : Uncountable (ℕ → Bool) := by + apply uncountable_iff_forall_not_surjective.mpr + intro f hf + obtain ⟨n, hn⟩ := hf (fun i => !(f i i)) + have hd := congrFun hn n + cases h : f n n <;> simp [h] at hd + +/-- The uncomplemented-range observation introducing Corollary 3.3. -/ +theorem c0_isometry_uncomplemented : + Isometry c0Inclusion ∧ ¬ c0Inclusion.toLinearMap.range.ClosedComplemented := by + classical + refine ⟨c0Inclusion_isometry, ?_⟩ + rintro ⟨P, hP⟩ + let Q : LInfinity →L[ℝ] LInfinity := + ContinuousLinearMap.id ℝ LInfinity - c0Inclusion.range.subtypeL.comp P + have hQ (x : CZero) : Q (c0Inclusion x) = 0 := by + change c0Inclusion x - (P (c0Inclusion x) : LInfinity) = 0 + exact sub_eq_zero.mpr (congrArg Subtype.val (hP (c0Inclusion.rangeRestrict x))).symm + let φ (n : ℕ) : Dual LInfinity := (lp.evalCLM ℝ (fun _ : ℕ => ℝ) ⊤ n).comp Q + let A (r : ℕ → Bool) : Set ℕ := Set.range (prefixCode r) + have hc : (⋃ n, Function.support (fun r => φ n (boundedIndicator (A r)))).Countable := + Set.countable_iUnion (fun n => annihilator_countable_support A + (fun _ _ hrs => prefixCode_finite_inter hrs) (φ n) (fun x => by + change (Q (c0Inclusion x)) n = 0 + rw [hQ] + rfl)) + have hex : ∃ r, r ∉ ⋃ n, Function.support (fun r => φ n (boundedIndicator (A r))) := by + let := binaryBranch_uncountable + by_contra hn + push Not at hn + exact Set.not_countable_univ ((Set.eq_univ_iff_forall.mpr hn) ▸ hc) + obtain ⟨r, hr⟩ := hex + have hz : Q (boundedIndicator (A r)) = 0 := by + apply lp.ext + funext n + exact not_ne_iff.mp (fun hn => hr (Set.mem_iUnion.mpr ⟨n, hn⟩)) + have heq : boundedIndicator (A r) = (P (boundedIndicator (A r)) : LInfinity) := + sub_eq_zero.mp hz + obtain ⟨x, hx⟩ := (P (boundedIndicator (A r))).property + have hx' : c0Inclusion x = boundedIndicator (A r) := hx.trans heq.symm + have htail : Tendsto x atTop (𝓝 0) := by + simpa only [cocompact_eq_cofinite, Nat.cofinite_eq_atTop] using zero_at_infty x + obtain ⟨N, hN⟩ := (Metric.tendsto_atTop.mp htail) (1 / 2) (by norm_num) + have hinf : (A r).Infinite := + Set.infinite_range_of_injective (fun _ _ h => (prefixCode_eq h).1) + obtain ⟨i, hi, hiN⟩ := hinf.exists_notMem_finset (Finset.range N) + have hsmall := hN i (by simpa only [Finset.mem_range, not_lt] using hiN) + have hxi : x i = 1 := by + have hh := congrArg (fun z : LInfinity => z i) hx' + change x i = (if i ∈ A r then 1 else 0) at hh + simpa only [ite_eq_left hi] using hh + norm_num [hxi] at hsmall + +/-- Section 3: separable injectivity, with arbitrary closed subspaces of separable superspaces. -/ +def SeparablyInjective (F : Type v) [NormedAddCommGroup F] [NormedSpace ℝ F] : Prop := + ∀ (X : Type u) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X] + [TopologicalSpace.SeparableSpace X] (M : Submodule ℝ X), IsClosed (M : Set X) → + ∀ T : M →L[ℝ] F, ∃ S : X →L[ℝ] F, S.comp M.subtypeL = T + +/-- The unnumbered generalization after Corollary 3.3: an isomorphic embedding of a +separable, separably injective Banach space induces an order-continuous map at every +exponent. Separable reduction makes it possible to use injectivity on a separable +ambient subspace even when the original target is not separable. -/ +theorem separably_injective_embedding [CompleteSpace E] [CompleteSpace F] + [TopologicalSpace.SeparableSpace F] (p : Exponent) + (hF : SeparablyInjective.{u, v} F) (T : F →L[ℝ] E) (hT : BoundedBelow T) : + IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap := by + by_contra hnot + obtain ⟨M, N, h, hM, hN, hMs, hNs, hMtop, hbad⟩ := separable_reduction p T hnot + have htop := hMtop inferInstance + subst M + let : CompleteSpace (⊤ : Submodule ℝ F) := hM.1.isComplete.completeSpace_coe + let : CompleteSpace N := hN.1.isComplete.completeSpace_coe + let : TopologicalSpace.SeparableSpace N := hNs + let R := restrictOperator T ⊤ N h + have hR : BoundedBelow R := by + obtain ⟨c, hc, hbound⟩ := hT + exact ⟨c, hc, fun x => hbound x⟩ + obtain ⟨hi, hc⟩ := (embedding_iff R).mp hR + let e := R.equivRange hi hc + let U : R.range →L[ℝ] F := (⊤ : Submodule ℝ F).subtypeL.comp e.symm.toContinuousLinearMap + obtain ⟨S, hS⟩ := hF N R.range hc U + let Q : N →L[ℝ] (⊤ : Submodule ℝ F) := + (Submodule.topContEquiv (R := ℝ) (M := F)).symm.toContinuousLinearMap.comp S + have hleft : Function.LeftInverse Q R := by + intro x + apply Subtype.ext + have hh := congrArg (fun L : R.range →L[ℝ] F => L ⟨R x, ⟨x, rfl⟩⟩) hS + change S (R x) = (e.symm ⟨R x, ⟨x, rfl⟩⟩ : F) at hh + change S (R x) = (x : F) + rw [hh] + exact congrArg Subtype.val (R.equivRange_symm_apply hi hc x) + have hcompl := R.closedComplemented_range_of_leftInverse Q hleft + apply hbad + apply (induced_range_reduction p R hR).2.mpr + exact complemented_orderContinuous p R.range hcompl + +end FBLOrderContinuousLH diff --git a/LeanPool/FBLOrderContinuity/HilbertComparison.lean b/LeanPool/FBLOrderContinuity/HilbertComparison.lean new file mode 100644 index 0000000000..7f6f4132be --- /dev/null +++ b/LeanPool/FBLOrderContinuity/HilbertComparison.lean @@ -0,0 +1,406 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + +module + +public import LeanPool.FBLOrderContinuity.Model +public import Mathlib.Algebra.Order.BigOperators.Expect +public import Mathlib.Analysis.InnerProductSpace.Basic +public import Mathlib.Analysis.SpecialFunctions.Sqrt + + + +/-! +# A uniform comparison of the free norms on a real Hilbert space + +Finite averages over all sign choices give a scalar lower Khintchine estimate and +a Hilbert-space second-moment estimate. `finite_hilbert_estimate` combines them with +weak one-summability. Maximizing a regularized square-root sum on a compact convex +set yields the positive weights in `hilbert_dual_weights`. + +`hilbert_dual_factorization` factors a weakly one-summable dual family through a +weakly two-summable family with coefficient ell-two norm at most 3. Homogeneity and +Cauchy–Schwarz give `hilbert_free_norm_comparison`: the one-free norm is at most +three times the two-free norm. This explicit estimate proves the Hilbert example +in Remark 5.4; the constant is sufficient for norm equivalence and is not claimed +optimal. Completeness of the real inner-product space is unnecessary. +-/ + +@[expose] public section + +noncomputable section +open scoped BigOperators ENNReal Topology +open Filter Set + +namespace FBLOrderContinuousLH +namespace HilbertComparison + +/-- Finite sign choices for n coordinates, encoded recursively as Boolean products. +The uniform finite average over this type supplies all expectations in the moment estimates. -/ +abbrev Signs : ℕ → Type + | 0 => Unit + | n + 1 => Bool × Signs n + +private instance signsFintype : (n : ℕ) → Fintype (Signs n) + | 0 => inferInstanceAs (Fintype Unit) + | n + 1 => letI := signsFintype n; inferInstanceAs (Fintype (Bool × Signs n)) + +private instance signsNonempty : (n : ℕ) → Nonempty (Signs n) + | 0 => inferInstanceAs (Nonempty Unit) + | n + 1 => letI := signsNonempty n; inferInstanceAs (Nonempty (Bool × Signs n)) + +/-- Sum a finite family with the signs encoded by `Signs n`: true contributes a vector +and false its negative. The empty signed sum is zero. -/ +def signedSum {H : Type*} [AddCommGroup H] : + {n : ℕ} → (Fin n → H) → Signs n → H + | 0, _, _ => 0 + | _ + 1, x, ε => (if ε.1 then x 0 else -x 0) + signedSum (fun i => x i.succ) ε.2 + +/-- Split a uniform finite average over one sign and the remaining choices into the +mean of the positive and negative branches. -/ +private theorem expect_bool_prod {ι : Type*} [Fintype ι] (f : Bool × ι → ℝ) : + (𝔼 ε, f ε) = 𝔼 ε : ι, (f (true, ε) + f (false, ε)) / 2 := by + simp [Finset.expect, NNRat.smul_def, Fintype.sum_prod_type, ← Finset.sum_div, + Finset.sum_add_distrib] + ring + +/-- The average squared norm of a signed sum in a real inner-product space equals +the sum of the squared norms. The induction step is the parallelogram identity. -/ +private theorem signedSum_second_moment {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℝ H] {n : ℕ} (x : Fin n → H) : + (𝔼 ε, ‖signedSum x ε‖ ^ 2) = ∑ i, ‖x i‖ ^ 2 := by + induction n with + | zero => simp [signedSum] + | succ n ih => + rw [expect_bool_prod] + have hpar (ε : Signs n) : + (‖signedSum x (true, ε)‖ ^ 2 + ‖signedSum x (false, ε)‖ ^ 2) / 2 = + ‖x 0‖ ^ 2 + ‖signedSum (fun i => x i.succ) ε‖ ^ 2 := by + simpa [signedSum, neg_add_eq_sub, norm_sub_rev] using + congrArg (fun t : ℝ => t / 2) + (parallelogram_law_with_norm ℝ (x 0) (signedSum (fun i => x i.succ) ε)) + simp only [hpar, Finset.expect_add_distrib, Fintype.expect_const, ih, Fin.sum_univ_succ] + +/-- The fourth moment of a scalar signed sum is at most three times the square +of its second moment. Expanding the two signs cancels the odd terms. -/ +private theorem signedSum_fourth_moment {n : ℕ} (a : Fin n → ℝ) : + (𝔼 ε, (signedSum a ε) ^ 4) ≤ 3 * (∑ i, a i ^ 2) ^ 2 := by + induction n with + | zero => simp [signedSum] + | succ n ih => + rw [expect_bool_prod] + have hpoly (ε : Signs n) : + (signedSum a (true, ε) ^ 4 + signedSum a (false, ε) ^ 4) / 2 = + a 0 ^ 4 + 6 * a 0 ^ 2 * (signedSum (fun i => a i.succ) ε) ^ 2 + + (signedSum (fun i => a i.succ) ε) ^ 4 := by + simp only [signedSum, Bool.false_eq_true, ↓reduceIte] + ring + simp only [hpoly, Finset.expect_add_distrib, Fintype.expect_const, ← Finset.mul_expect, + Fin.sum_univ_succ] + have hsecond : (𝔼 ε, (signedSum (fun i : Fin n => a i.succ) ε) ^ 2) = + ∑ i : Fin n, a i.succ ^ 2 := by + simpa only [Real.norm_eq_abs, sq_abs] using signedSum_second_moment (fun i => a i.succ) + rw [hsecond] + nlinarith [ih (fun i => a i.succ), sq_nonneg (a 0 ^ 2)] + +/-- A finite scalar Khintchine lower bound: the ell-two norm of the coefficients +is at most √3 times the mean absolute signed sum. Two Cauchy–Schwarz estimates +combine the exact second moment with the fourth-moment bound. -/ +private theorem signedSum_abs_lower {n : ℕ} (a : Fin n → ℝ) : + Real.sqrt (∑ i, a i ^ 2) ≤ Real.sqrt 3 * (𝔼 ε, |signedSum a ε|) := by + let X : Signs n → ℝ := signedSum a + have hsecond : (𝔼 ε, X ε ^ 2) = ∑ i, a i ^ 2 := by + simpa only [Real.norm_eq_abs, sq_abs] using signedSum_second_moment a + have hcs₁ := Finset.expect_mul_sq_le_sq_mul_sq Finset.univ + (fun ε => Real.sqrt |X ε|) (fun ε => Real.sqrt |X ε| * |X ε|) + simp only [← mul_assoc, ← sq, sq_abs, mul_pow, Real.sq_sqrt (abs_nonneg _)] at hcs₁ + have hcs₂ := Finset.expect_mul_sq_le_sq_mul_sq Finset.univ + (fun ε => |X ε|) (fun ε => X ε ^ 2) + simp only [sq_abs, ← pow_mul, Nat.reduceMul] at hcs₂ + have hfourth : (𝔼 ε, X ε ^ 4) ≤ 3 * (∑ i, a i ^ 2) ^ 2 := signedSum_fourth_moment a + have hv : 0 ≤ ∑ i, a i ^ 2 := Finset.sum_nonneg (fun _ _ => sq_nonneg _) + have hA : 0 ≤ 𝔼 ε, |X ε| := Finset.expect_nonneg (fun _ _ => abs_nonneg _) + rw [hsecond] at hcs₁ hcs₂ + have hbound : ∑ i, a i ^ 2 ≤ 3 * (𝔼 ε, |X ε|) ^ 2 := by + rcases hv.eq_or_lt with hz | hp + · rw [← hz]; positivity + have h₁ := mul_self_le_mul_self (sq_nonneg _) hcs₁ + have h₂ := mul_le_mul_of_nonneg_left + (hcs₂.trans (mul_le_mul_of_nonneg_left hfourth hv)) (sq_nonneg (𝔼 ε, |X ε|)) + have hh : (∑ i, a i ^ 2) * (∑ i, a i ^ 2) ^ 3 ≤ + (3 * (𝔼 ε, |X ε|) ^ 2) * (∑ i, a i ^ 2) ^ 3 := by + nlinarith only [h₁, h₂] + exact le_of_mul_le_mul_right hh (pow_pos hp 3) + apply Real.sqrt_le_iff.mpr + exact ⟨mul_nonneg (Real.sqrt_nonneg _) hA, + by simpa only [mul_pow, Real.sq_sqrt (by norm_num : (0 : ℝ) ≤ 3)] using hbound⟩ + +/-- A continuous linear functional commutes with the finite signed sum. -/ +private theorem map_signedSum {H : Type*} [NormedAddCommGroup H] [NormedSpace ℝ H] + {n : ℕ} (φ : Dual H) (x : Fin n → H) (ε : Signs n) : + φ (signedSum x ε) = signedSum (fun i => φ (x i)) ε := by + induction n with + | zero => simp [signedSum] + | succ n ih => + simp only [signedSum, map_add, apply_ite φ, map_neg, ih] + +/-- The mean norm of a Hilbert-space signed sum is bounded by the ell-two sum +of the vector norms, by Cauchy–Schwarz and the second-moment identity. -/ +private theorem signedSum_norm_upper {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℝ H] {n : ℕ} (x : Fin n → H) : + (𝔼 ε, ‖signedSum x ε‖) ≤ Real.sqrt (∑ i, ‖x i‖ ^ 2) := by + have hcs := Finset.expect_mul_sq_le_sq_mul_sq Finset.univ + (fun ε => ‖signedSum x ε‖) (fun _ => (1 : ℝ)) + simp only [mul_one, one_pow, Fintype.expect_const, signedSum_second_moment] at hcs + exact Real.le_sqrt_of_sq_le hcs + +/-- For a weakly one-summable dual family with bound one, the sum over functionals +of the Euclidean norms of their values on a vector family is at most √3 times the +Euclidean sum of the vector norms. Scalar signed-sum lower bounds and the Hilbert +second-moment estimate provide the factorization estimate without a dimension factor. -/ +theorem finite_hilbert_estimate {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℝ H] {n m : ℕ} (φ : Fin n → Dual H) + (hφ : NormAdmissible Exponent.one φ) (x : Fin m → H) : + ∑ i, Real.sqrt (∑ j, (φ i (x j)) ^ 2) ≤ + Real.sqrt 3 * Real.sqrt (∑ j, ‖x j‖ ^ 2) := by + have hbound (ε : Signs m) : ∑ i, |φ i (signedSum x ε)| ≤ ‖signedSum x ε‖ := by + simpa [scalarPSum, Exponent.one] using + normAdmissible_eval_le_norm Exponent.one φ hφ (signedSum x ε) + calc + _ ≤ ∑ i, Real.sqrt 3 * (𝔼 ε, |signedSum (fun j => φ i (x j)) ε|) := + Finset.sum_le_sum (fun i _ => signedSum_abs_lower (fun j => φ i (x j))) + _ = Real.sqrt 3 * (𝔼 ε, ∑ i, |φ i (signedSum x ε)|) := by + simp only [← Finset.mul_sum, Finset.expect_sum_comm, map_signedSum] + _ ≤ Real.sqrt 3 * (𝔼 ε, ‖signedSum x ε‖) := + mul_le_mul_of_nonneg_left (Finset.expect_le_expect (fun ε _ => hbound ε)) + (Real.sqrt_nonneg _) + _ ≤ _ := mul_le_mul_of_nonneg_left (signedSum_norm_upper x) (Real.sqrt_nonneg _) + +/-- If a compact convex set of nonnegative coordinate vectors has square-root sums +bounded by C, positive weights of total mass one bound every weighted coordinate sum +by `(C + 1)^2`. Maximize `∑ i, sqrt (a i + δ)` with `δ = (1/n)^2` and differentiate +along feasible segments to obtain the supporting inequality. -/ +private theorem positive_weights_of_compact_convex {n : ℕ} (hn : 0 < n) + (K : Set (Fin n → ℝ)) (hne : K.Nonempty) (hc : IsCompact K) (hconv : Convex ℝ K) + (hpos : ∀ a ∈ K, ∀ i, 0 ≤ a i) (C : ℝ) + (hbound : ∀ a ∈ K, ∑ i, Real.sqrt (a i) ≤ C) : + ∃ w : Fin n → ℝ, (∀ i, 0 < w i) ∧ ∑ i, w i = 1 ∧ + ∀ b ∈ K, ∑ i, b i / w i ≤ (C + 1) ^ 2 := by + let : NeZero n := ⟨Nat.ne_of_gt hn⟩ + let δ : ℝ := (1 / (n : ℝ)) ^ 2 + have hn' : 0 < (n : ℝ) := by exact_mod_cast hn + have hδ : 0 < δ := sq_pos_of_pos (one_div_pos.mpr hn') + let F (a : Fin n → ℝ) : ℝ := ∑ i, Real.sqrt (a i + δ) + have hF : Continuous F := continuous_finsetSum _ (fun i _ => + Real.continuous_sqrt.comp ((continuous_apply i).add continuous_const)) + obtain ⟨a, ha, hmax⟩ := hc.exists_isMaxOn hne hF.continuousOn + let r (i : Fin n) := Real.sqrt (a i + δ) + have hr (i : Fin n) : 0 < r i := Real.sqrt_pos.mpr (lt_add_of_le_of_pos (hpos a ha i) hδ) + have hd : HasFDerivAt F + (∑ i, (1 / (2 * r i)) • (ContinuousLinearMap.proj i : (Fin n → ℝ) →L[ℝ] ℝ)) a := + HasFDerivAt.fun_sum (fun i _ => + ((hasFDerivAt_apply i a).add_const δ).sqrt (ne_of_gt (lt_add_of_le_of_pos (hpos a ha i) hδ))) + have hderiv (b : Fin n → ℝ) (hb : b ∈ K) : + ∑ i, (b i - a i) / (2 * r i) ≤ 0 := by + have hh := hmax.isLocalMaxOn.hasFDerivWithinAt_nonpos hd.hasFDerivWithinAt + (sub_mem_posTangentConeAt_of_segment_subset (hconv.segment_subset ha hb)) + simpa only [sum_apply, smul_apply, + ContinuousLinearMap.proj_apply, Pi.sub_apply, smul_eq_mul, one_div, div_eq_mul_inv, + mul_comm, one_mul] using hh + let S : ℝ := ∑ i, r i + have hS : 0 < S := Finset.sum_pos (fun i _ => hr i) Finset.univ_nonempty + have hSbound : S ≤ C + 1 := by + have hi (i : Fin n) : r i ≤ Real.sqrt (a i) + 1 / (n : ℝ) := by + apply Real.sqrt_le_iff.mpr + refine ⟨add_nonneg (Real.sqrt_nonneg _) (one_div_nonneg.mpr hn'.le), ?_⟩ + have hs := Real.sq_sqrt (hpos a ha i) + have hm := mul_nonneg (Real.sqrt_nonneg (a i)) (one_div_nonneg.mpr hn'.le) + dsimp [δ] + nlinarith + have hh := Finset.sum_le_sum (s := Finset.univ) (fun i _ => hi i) + simp only [Finset.sum_add_distrib, Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul, mul_one_div_cancel hn'.ne'] at hh + exact hh.trans (add_le_add (hbound a ha) le_rfl) + have hlinear (b : Fin n → ℝ) (hb : b ∈ K) : ∑ i, b i / r i ≤ S := by + have hh := mul_le_mul_of_nonneg_right (hderiv b hb) (by norm_num : (0 : ℝ) ≤ 2) + rw [Finset.sum_mul, zero_mul] at hh + have hi (i : Fin n) : (b i - a i) / (2 * r i) * 2 = b i / r i - a i / r i := by + field_simp + simp only [hi, Finset.sum_sub_distrib] at hh + have hdiag : ∑ i, a i / r i ≤ S := by + apply Finset.sum_le_sum + intro i _ + apply (div_le_iff₀ (hr i)).mpr + have hs : r i ^ 2 = a i + δ := Real.sq_sqrt (add_nonneg (hpos a ha i) hδ.le) + nlinarith + linarith + refine ⟨fun i => r i / S, fun i => div_pos (hr i) hS, ?_, fun b hb => ?_⟩ + · rw [← Finset.sum_div, show ∑ i, r i = S from rfl, div_self hS.ne'] + · calc + ∑ i, b i / (r i / S) = (∑ i, b i / r i) * S := by + simp only [Finset.sum_mul, div_div_eq_mul_div, div_mul_eq_mul_div] + _ ≤ S * S := mul_le_mul_of_nonneg_right (hlinear b hb) hS.le + _ ≤ (C + 1) ^ 2 := by + simpa only [sq] using mul_self_le_mul_self hS.le hSbound + +/-- The set of squared evaluation vectors `(φ i x)^2` as x runs over the closed +unit ball. Its closed convex hull is the domain for the weight-selection argument. -/ +def quadraticImage {H : Type*} [NormedAddCommGroup H] [NormedSpace ℝ H] + {n : ℕ} (φ : Fin n → Dual H) : Set (Fin n → ℝ) := + {a | ∃ x : H, ‖x‖ ≤ 1 ∧ ∀ i, a i = (φ i x) ^ 2} + +/-- The finite Hilbert estimate bounds the sum of square roots by √3 on the convex +hull of squared evaluation vectors. Convex coefficients are absorbed into the vectors +through their square roots. -/ +private theorem quadratic_convexHull_bound {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℝ H] {n : ℕ} (φ : Fin n → Dual H) + (hφ : NormAdmissible Exponent.one φ) {a : Fin n → ℝ} + (ha : a ∈ convexHull ℝ (quadraticImage φ)) : + (∀ i, 0 ≤ a i) ∧ ∑ i, Real.sqrt (a i) ≤ Real.sqrt 3 := by + classical + obtain ⟨ι, hι, w, z, hw, hws, hz, hza⟩ := mem_convexHull_iff_exists_fintype.mp ha + choose x hx hzx using hz + let e := (Fintype.equivFin ι).symm + have hreindex (g : ι → ℝ) : ∑ j : Fin (Fintype.card ι), g (e j) = ∑ j, g j := + e.sum_comp g + have hai (i : Fin n) : a i = ∑ j, w j * (φ i (x j)) ^ 2 := by + rw [← hza] + simp only [Finset.sum_apply, Pi.smul_apply, smul_eq_mul, hzx] + have hnonneg (i : Fin n) : 0 ≤ a i := by + rw [hai] + exact Finset.sum_nonneg (fun j _ => mul_nonneg (hw j) (sq_nonneg _)) + refine ⟨hnonneg, ?_⟩ + let y (j : Fin (Fintype.card ι)) := Real.sqrt (w (e j)) • x (e j) + have hy (i : Fin n) : ∑ j, (φ i (y j)) ^ 2 = a i := by + simp only [y, map_smul, smul_eq_mul, mul_pow, Real.sq_sqrt (hw _), hai] + exact hreindex (fun j => w j * (φ i (x j)) ^ 2) + have hynorm : ∑ j, ‖y j‖ ^ 2 ≤ 1 := by + simp only [y, norm_smul, Real.norm_eq_abs, abs_of_nonneg (Real.sqrt_nonneg _), + mul_pow, Real.sq_sqrt (hw _)] + rw [hreindex (fun j => w j * ‖x j‖ ^ 2)] + calc + ∑ j, w j * ‖x j‖ ^ 2 ≤ ∑ j, w j * 1 := + Finset.sum_le_sum (fun j _ => mul_le_mul_of_nonneg_left + (by nlinarith [hx j, norm_nonneg (x j)]) (hw j)) + _ = 1 := by simpa only [mul_one] using hws + have hh := finite_hilbert_estimate φ hφ y + simp only [hy] at hh + exact hh.trans (by simpa using + mul_le_mul_of_nonneg_left (Real.sqrt_le_sqrt hynorm) (Real.sqrt_nonneg 3)) + +/-- A weakly one-summable family on a real inner-product space has positive weights +with total mass at most one such that `∑ i, (φ i x)^2 / w i ≤ 9` on the unit ball. +The empty family is included. The weights come from a compact-convex maximization +argument and are used to construct `hilbert_dual_factorization`. -/ +theorem hilbert_dual_weights {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℝ H] + {n : ℕ} (φ : Fin n → Dual H) (hφ : NormAdmissible Exponent.one φ) : + ∃ w : Fin n → ℝ, (∀ i, 0 < w i) ∧ ∑ i, w i ≤ 1 ∧ + ∀ x : H, ‖x‖ ≤ 1 → ∑ i, (φ i x) ^ 2 / w i ≤ 9 := by + classical + rcases Nat.eq_zero_or_pos n with rfl | hn + · exact ⟨fun _ => 0, by simp, by simp, by simp⟩ + let K := closure (convexHull ℝ (quadraticImage φ)) + have hpos (a : Fin n → ℝ) (ha : a ∈ K) (i : Fin n) : 0 ≤ a i := + closure_minimal (fun b hb => (quadratic_convexHull_bound φ hφ hb).1 i) + (isClosed_le continuous_const (continuous_apply i)) ha + have hbound (a : Fin n → ℝ) (ha : a ∈ K) : ∑ i, Real.sqrt (a i) ≤ Real.sqrt 3 := + closure_minimal (fun b hb => (quadratic_convexHull_bound φ hφ hb).2) + (isClosed_le (continuous_finsetSum _ (fun i _ => + Real.continuous_sqrt.comp (continuous_apply i))) continuous_const) ha + have hbounded : Bornology.IsBounded (convexHull ℝ (quadraticImage φ)) := by + apply isBounded_iff_forall_norm_le.mpr + refine ⟨3, fun a ha => (pi_norm_le_iff_of_nonneg (by norm_num)).mpr (fun i => ?_)⟩ + obtain ⟨hpos, hbound⟩ := quadratic_convexHull_bound φ hφ ha + have hi : Real.sqrt (a i) ≤ Real.sqrt 3 := + (Finset.single_le_sum (fun j _ => Real.sqrt_nonneg (a j)) (Finset.mem_univ i)).trans hbound + have hh := mul_self_le_mul_self (Real.sqrt_nonneg _) hi + simpa only [Real.norm_eq_abs, abs_of_nonneg (hpos i), ← sq, + Real.sq_sqrt (hpos i), Real.sq_sqrt (by norm_num : (0 : ℝ) ≤ 3)] using hh + have hne : K.Nonempty := + ⟨0, subset_closure (subset_convexHull ℝ (quadraticImage φ) + ⟨0, by simp, by simp⟩)⟩ + obtain ⟨w, hw, hws, hwb⟩ := positive_weights_of_compact_convex hn K hne + hbounded.isCompact_closure (convex_convexHull ℝ _).closure hpos (Real.sqrt 3) hbound + refine ⟨w, hw, hws.le, fun x hx => ?_⟩ + have hh := hwb (fun i => (φ i x) ^ 2) + (subset_closure (subset_convexHull ℝ (quadraticImage φ) ⟨x, hx, fun _ => rfl⟩)) + have hs : Real.sqrt 3 ≤ 2 := Real.sqrt_le_iff.mpr ⟨by norm_num, by norm_num⟩ + nlinarith [Real.sq_sqrt (by norm_num : (0 : ℝ) ≤ 3)] + +/-- At exponent 2, the scalar p-sum is the square root of the sum of squares. -/ +private theorem scalarPSum_two_eq_sqrt {n : ℕ} (a : Fin n → ℝ) : + scalarPSum Exponent.two a = Real.sqrt (∑ i, a i ^ 2) := by + simp [scalarPSum, Exponent.two, Real.sqrt_eq_rpow, sq_abs] + +/-- Factor an admissible one-family as `φ i = c i • ψ i`, where every coefficient +is positive, the sum of their squares is at most 9, and ψ is an admissible two-family. +This converts one-free-norm tests to two-free-norm tests with a uniform factor 3. -/ +theorem hilbert_dual_factorization {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℝ H] {n : ℕ} (φ : Fin n → Dual H) + (hφ : NormAdmissible Exponent.one φ) : + ∃ (c : Fin n → ℝ) (ψ : Fin n → Dual H), (∀ i, 0 < c i) ∧ + (∑ i, c i ^ 2) ≤ 9 ∧ NormAdmissible Exponent.two ψ ∧ ∀ i, φ i = c i • ψ i := by + obtain ⟨w, hw, hws, hwb⟩ := hilbert_dual_weights φ hφ + let c (i : Fin n) := 3 * Real.sqrt (w i) + let ψ (i : Fin n) : Dual H := (c i)⁻¹ • φ i + have hc (i : Fin n) : 0 < c i := mul_pos (by norm_num) (Real.sqrt_pos.mpr (hw i)) + have hcs : ∑ i, c i ^ 2 ≤ 9 := by + simp only [c, mul_pow, Real.sq_sqrt (hw _).le, ← Finset.mul_sum] + nlinarith [hws] + refine ⟨c, ψ, hc, hcs, ?_, fun i => ?_⟩ + · intro x hx + rw [scalarPSum_two_eq_sqrt, Real.sqrt_le_iff] + refine ⟨zero_le_one, ?_⟩ + have hi (i : Fin n) : (ψ i x) ^ 2 = ((φ i x) ^ 2 / w i) / 9 := by + simp only [ψ, c, smul_apply, smul_eq_mul, mul_pow, inv_pow, + Real.sq_sqrt (hw i).le] + norm_num + ring + simp only [hi, ← Finset.sum_div, one_pow] + exact (div_le_one (by norm_num)).mpr (hwb x hx) + · simp only [ψ, smul_smul, mul_inv_cancel₀ (hc i).ne', one_smul] + +/-- Each admissible one-family evaluates an algebraic free function with sum of +absolute values at most three times its two-free norm. Apply positive homogeneity +to the factorization and then Cauchy–Schwarz. -/ +private theorem hilbert_family_bound {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℝ H] {n : ℕ} (φ : Fin n → Dual H) + (hφ : NormAdmissible Exponent.one φ) (f : Free Exponent.two H) : + ∑ i, |f (φ i)| ≤ 3 * ‖f‖ := by + obtain ⟨c, ψ, hc, hcs, hψ, hfac⟩ := hilbert_dual_factorization φ hφ + have hi (i : Fin n) : |f (φ i)| = c i * |f (ψ i)| := by + rw [hfac i, f.1.2.1 (c i) (hc i).le (ψ i), abs_mul, abs_of_pos (hc i)] + have hnorm : Real.sqrt (∑ i, |f (ψ i)| ^ 2) ≤ ‖f‖ := by + simpa only [scalarPSum_two_eq_sqrt, sq_abs] using + freeNorm_family_le Exponent.two f ψ hψ + calc + ∑ i, |f (φ i)| = ∑ i, c i * |f (ψ i)| := by simp only [hi] + _ ≤ Real.sqrt (∑ i, c i ^ 2) * Real.sqrt (∑ i, |f (ψ i)| ^ 2) := + Real.sum_mul_le_sqrt_mul_sqrt _ _ _ + _ ≤ 3 * ‖f‖ := mul_le_mul + (Real.sqrt_le_iff.mpr ⟨by norm_num, by norm_num; exact hcs⟩) hnorm + (Real.sqrt_nonneg _) (by norm_num) + +/-- On every real inner-product space, the one-free norm of an algebraic free-lattice +element is at most three times its two-free norm. Taking the supremum over admissible +one-families in `hilbert_family_bound` proves the estimate. It gives the norm equivalence +used in Remark 5.4; neither completeness nor finite dimensionality is assumed. -/ +theorem hilbert_free_norm_comparison {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℝ H] (v : FVL H) : + ‖ofFVL Exponent.one v‖ ≤ 3 * ‖ofFVL Exponent.two v‖ := by + apply (ENNReal.ofReal_le_ofReal_iff (by positivity)).mp + rw [← freeNormExt_eq_norm] + change (⨆ n, ⨆ φ : Fin n → Dual H, ⨆ (_ : NormAdmissible Exponent.one φ), + ENNReal.ofReal (scalarPSum Exponent.one (fun i => ofFVL Exponent.one v (φ i)))) ≤ _ + refine iSup_le fun n => iSup_le fun φ => iSup_le fun hφ => ENNReal.ofReal_le_ofReal ?_ + have hsum (a : Fin n → ℝ) : scalarPSum Exponent.one a = ∑ i, |a i| := by + simp [scalarPSum, Exponent.one] + simpa only [hsum, (model_evaluation Exponent.one (0 : H) v _).2, + (model_evaluation Exponent.two (0 : H) v _).2] using + hilbert_family_bound φ hφ (ofFVL Exponent.two v) + +end HilbertComparison +end FBLOrderContinuousLH diff --git a/LeanPool/FBLOrderContinuity/Imports.lean b/LeanPool/FBLOrderContinuity/Imports.lean new file mode 100644 index 0000000000..e3f3912fca --- /dev/null +++ b/LeanPool/FBLOrderContinuity/Imports.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Lean Pool contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Lean Pool contributors +-/ +module -- shake: keep-all --deprecated_module: ignore + +-- Generated project imports; run `lake exe mk_all`. +public import LeanPool.FBLOrderContinuity +public import LeanPool.FBLOrderContinuity.BanLat.AMSpace.Basic +public import LeanPool.FBLOrderContinuity.BanLat.AMSpace.Characters +public import LeanPool.FBLOrderContinuity.BanLat.AMSpace.Kakutani +public import LeanPool.FBLOrderContinuity.BanLat.AMSpace.Maximal +public import LeanPool.FBLOrderContinuity.BanLat.Convergences.Uniform +public import LeanPool.FBLOrderContinuity.BanLat.Dual +public import LeanPool.FBLOrderContinuity.BanLat.Free.FBL +public import LeanPool.FBLOrderContinuity.BanLat.Free.FVL +public import LeanPool.FBLOrderContinuity.BanLat.Free.FVLv +public import LeanPool.FBLOrderContinuity.BanLat.FunctionalCalculus +public import LeanPool.FBLOrderContinuity.BanLat.NormedWeak +public import LeanPool.FBLOrderContinuity.BanLat.Operators.OrderBounded +public import LeanPool.FBLOrderContinuity.BanLat.Operators.OrderContinuous +public import LeanPool.FBLOrderContinuity.BanLat.Operators.Regular +public import LeanPool.FBLOrderContinuity.BanLat.Operators.RieszKantorovich +public import LeanPool.FBLOrderContinuity.BanLat.OrderDense +public import LeanPool.FBLOrderContinuity.BanLat.Pi +public import LeanPool.FBLOrderContinuity.BanLat.Quotient +public import LeanPool.FBLOrderContinuity.BanLat.RieszDec +public import LeanPool.FBLOrderContinuity.BanLat.Sublattice +public import LeanPool.FBLOrderContinuity.BanLat.Substructures.Band.Generated +public import LeanPool.FBLOrderContinuity.BanLat.Substructures.Band.Lattice +public import LeanPool.FBLOrderContinuity.BanLat.Substructures.Band.PPP +public import LeanPool.FBLOrderContinuity.BanLat.Substructures.Band.Projection +public import LeanPool.FBLOrderContinuity.ConvexityBound +public import LeanPool.FBLOrderContinuity.EuclideanFamilies +public import LeanPool.FBLOrderContinuity.Extension +public import LeanPool.FBLOrderContinuity.HilbertComparison +public import LeanPool.FBLOrderContinuity.LpExtension +public import LeanPool.FBLOrderContinuity.Model +public import LeanPool.FBLOrderContinuity.Order +public import LeanPool.FBLOrderContinuity.ParameterWitness +public import LeanPool.FBLOrderContinuity.Parameters +public import LeanPool.FBLOrderContinuity.Support diff --git a/LeanPool/FBLOrderContinuity/LpExtension.lean b/LeanPool/FBLOrderContinuity/LpExtension.lean new file mode 100644 index 0000000000..9afde7abb5 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/LpExtension.lean @@ -0,0 +1,603 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + +module + +public import LeanPool.FBLOrderContinuity.Model +public import Mathlib.Analysis.Convex.Gauge + + + +/-! +# Finite-dimensional operator extension from a free-norm bound + +The finite-coordinate tensor gauge in Pisier's regular-operator extension argument +turns a lower bound for a lattice embedding into an extension estimate. `tensorBall` +consists of families dominated by a positive free element and nonnegative scalar +coefficients with bounded conjugate-exponent norm. + +The proof combines scalar p-sum estimates, the gauge of the convex hull of this ball, +and Hahn–Banach. `extend_latticeOperator` extends finite-dimensional lattice-valued +data to a bounded linear map. `extend_of_free_norm_bound` restricts that extension to +the generators and gives the finite-ell-p operator-extension property with the same +constant. These results supply the converse implications in `Extension.lean`. +-/ + +@[expose] public section + +noncomputable section +open scoped BigOperators ENNReal NNReal Topology +open Set +universe u v +namespace FBLOrderContinuousLH.FiniteLpExtension + +variable {E : Type u} [NormedAddCommGroup E] [NormedSpace ℝ E] + +/-- The elementary finite-coordinate tensor ball: each coordinate is dominated by +a nonnegative scalar multiple of one positive free element of norm at most one, +and the scalars have q-sum at most one. In the extension argument q is conjugate +to p; the gauge of the convex hull gives the required domination estimate. -/ +def tensorBall (p q : Exponent) (n : ℕ) : Set (Fin n → Free p E) := + {x | ∃ a : Fin n → ℝ, (∀ i, 0 ≤ a i) ∧ scalarPSum q a ≤ 1 ∧ + ∃ z : Free p E, 0 ≤ z ∧ ‖z‖ ≤ 1 ∧ ∀ i, |x i| ≤ a i • z} + +private theorem scalarPSum_rpow (p : Exponent) (hp : p.IsFinite) + {n : ℕ} (a : Fin n → ℝ) : + (scalarPSum p a) ^ p.1.toReal = ∑ i, |a i| ^ p.1.toReal := by + rw [scalarPSum, ite_eq_right (ne_of_lt hp), one_div] + exact Real.rpow_inv_rpow (Finset.sum_nonneg (fun _ _ => Real.rpow_nonneg (abs_nonneg _) _)) + (ENNReal.toReal_pos_iff.mpr ⟨zero_lt_one.trans_le p.2, hp⟩).ne' + +private theorem scalarPSum_exchange (p : Exponent) (hp : p.IsFinite) + {m n : ℕ} (a : Fin m → Fin n → ℝ) : + scalarPSum p (fun i => scalarPSum p (a i)) = + scalarPSum p (fun j => scalarPSum p (fun i => a i j)) := by + apply (Real.rpow_left_inj (scalarPSum_nonneg _ _) (scalarPSum_nonneg _ _) + (ENNReal.toReal_pos_iff.mpr ⟨zero_lt_one.trans_le p.2, hp⟩).ne').mp + simp_rw [scalarPSum_rpow p hp, abs_of_nonneg (scalarPSum_nonneg _ _), + scalarPSum_rpow p hp] + exact Finset.sum_comm + +private theorem scalarPSum_weighted_two (p : Exponent) (hp : p.IsFinite) + {a b t s : ℝ} (ha : |a| ≤ 1) (hb : |b| ≤ 1) + (ht : 0 ≤ t) (hs : 0 ≤ s) (hts : t + s = 1) : + scalarPSum p ![t ^ (1 / p.1.toReal) * a, s ^ (1 / p.1.toReal) * b] ≤ 1 := by + have hp0 : 0 < p.1.toReal := + ENNReal.toReal_pos_iff.mpr ⟨zero_lt_one.trans_le p.2, hp⟩ + apply (Real.rpow_le_rpow_iff (scalarPSum_nonneg _ _) zero_le_one hp0).mp + rw [scalarPSum_rpow p hp, Real.one_rpow] + have hpow (r : ℝ) (hr : 0 ≤ r) : + (r ^ (1 / p.1.toReal)) ^ p.1.toReal = r := by + simpa only [one_div] using Real.rpow_inv_rpow hr hp0.ne' + simp only [Fin.sum_univ_two, Matrix.cons_val_zero, Matrix.cons_val_one, + abs_mul, abs_of_nonneg (Real.rpow_nonneg ht _), + abs_of_nonneg (Real.rpow_nonneg hs _), + Real.mul_rpow (Real.rpow_nonneg ht _) (abs_nonneg a), + Real.mul_rpow (Real.rpow_nonneg hs _) (abs_nonneg b), hpow t ht, hpow s hs] + have hap : |a| ^ p.1.toReal ≤ 1 := by + simpa only [Real.one_rpow] using Real.rpow_le_rpow (abs_nonneg a) ha hp0.le + have hbp : |b| ^ p.1.toReal ≤ 1 := by + simpa only [Real.one_rpow] using Real.rpow_le_rpow (abs_nonneg b) hb hp0.le + nlinarith [mul_le_mul_of_nonneg_left hap ht, mul_le_mul_of_nonneg_left hbp hs] + +private theorem weighted_holder (p q : Exponent) (hp : p.IsFinite) (hq : q.IsFinite) + (hpq : p.1.toReal.HolderConjugate q.1.toReal) + {t s a b c d : ℝ} (ht : 0 ≤ t) (hs : 0 ≤ s) : + t * a * c + s * b * d ≤ + scalarPSum q ![t ^ (1 / q.1.toReal) * a, s ^ (1 / q.1.toReal) * b] * + scalarPSum p ![t ^ (1 / p.1.toReal) * c, s ^ (1 / p.1.toReal) * d] := by + have hinv : 1 / q.1.toReal + 1 / p.1.toReal = 1 := by + simpa only [one_div] using hpq.symm.inv_add_inv_eq_one + have hprod (r : ℝ) (hr : 0 ≤ r) : + r ^ (1 / q.1.toReal) * r ^ (1 / p.1.toReal) = r := by + rw [← Real.rpow_add' hr (by rw [hinv]; exact one_ne_zero), hinv, Real.rpow_one] + have h := Real.inner_le_Lp_mul_Lq Finset.univ + ![t ^ (1 / q.1.toReal) * a, s ^ (1 / q.1.toReal) * b] + ![t ^ (1 / p.1.toReal) * c, s ^ (1 / p.1.toReal) * d] hpq.symm + have hpair (r : ℝ) (hr : 0 ≤ r) (a b : ℝ) : + (r ^ (1 / q.1.toReal) * a) * (r ^ (1 / p.1.toReal) * b) = r * a * b := by + calc + _ = (r ^ (1 / q.1.toReal) * r ^ (1 / p.1.toReal)) * (a * b) := by ring + _ = r * a * b := by rw [hprod r hr]; ring + simpa only [scalarPSum, ite_eq_right (ne_of_lt hp), ite_eq_right (ne_of_lt hq), + Fin.sum_univ_two, Matrix.cons_val_zero, Matrix.cons_val_one, hpair t ht, hpair s hs] using h + +private theorem tensorBall_convex_finite (p q : Exponent) (hp : p.IsFinite) + (hq : q.IsFinite) (hpq : p.1.toReal.HolderConjugate q.1.toReal) (n : ℕ) : + Convex ℝ (tensorBall (E := E) p q n) := by + rintro x ⟨a, ha, hanorm, z, hz, hznorm, hx⟩ + y ⟨b, hb, hbnorm, w, hw, hwnorm, hy⟩ t s ht hs hts + let c (i : Fin n) := scalarPSum q + ![t ^ (1 / q.1.toReal) * a i, s ^ (1 / q.1.toReal) * b i] + let v : Free p E := latticePSum p + ![t ^ (1 / p.1.toReal) • z, s ^ (1 / p.1.toReal) • w] + refine ⟨c, fun i => scalarPSum_nonneg _ _, ?_, v, ?_, ?_, ?_⟩ + · have heq : scalarPSum q c = scalarPSum q + ![t ^ (1 / q.1.toReal) * scalarPSum q a, + s ^ (1 / q.1.toReal) * scalarPSum q b] := by + refine (scalarPSum_exchange q hq (fun i => + ![t ^ (1 / q.1.toReal) * a i, s ^ (1 / q.1.toReal) * b i])).trans ?_ + congr 1 + funext j + fin_cases j <;> simp [scalarPSum_smul, abs_of_nonneg (Real.rpow_nonneg ht _), + abs_of_nonneg (Real.rpow_nonneg hs _)] + rw [heq] + exact scalarPSum_weighted_two q hq + (by simpa only [abs_of_nonneg (scalarPSum_nonneg q a)] using hanorm) + (by simpa only [abs_of_nonneg (scalarPSum_nonneg q b)] using hbnorm) ht hs hts + · intro φ + change 0 ≤ v φ + exact (latticePSum_apply p p _ φ).symm ▸ scalarPSum_nonneg _ _ + · have h := (free_pConvex (E := E) p).2 2 + ![t ^ (1 / p.1.toReal) • z, s ^ (1 / p.1.toReal) • w] + have heq : (fun i => ‖![t ^ (1 / p.1.toReal) • z, + s ^ (1 / p.1.toReal) • w] i‖) = + ![t ^ (1 / p.1.toReal) * ‖z‖, s ^ (1 / p.1.toReal) * ‖w‖] := by + funext i + fin_cases i <;> simp [norm_smul, Real.norm_eq_abs, + abs_of_nonneg (Real.rpow_nonneg ht _), abs_of_nonneg (Real.rpow_nonneg hs _)] + rw [one_mul, heq] at h + exact h.trans (scalarPSum_weighted_two p hp + (by simpa only [abs_of_nonneg (norm_nonneg z)] using hznorm) + (by simpa only [abs_of_nonneg (norm_nonneg w)] using hwnorm) ht hs hts) + · intro i φ + change |t * x i φ + s * y i φ| ≤ c i * v φ + have hxi : |x i φ| ≤ a i * z φ := hx i φ + have hyi : |y i φ| ≤ b i * w φ := hy i φ + calc + |t * x i φ + s * y i φ| ≤ t * |x i φ| + s * |y i φ| := by + simpa only [abs_mul, abs_of_nonneg ht, abs_of_nonneg hs] using + abs_add_le (t * x i φ) (s * y i φ) + _ ≤ t * (a i * z φ) + s * (b i * w φ) := + add_le_add (mul_le_mul_of_nonneg_left hxi ht) (mul_le_mul_of_nonneg_left hyi hs) + _ ≤ c i * v φ := by + have hh := weighted_holder p q hp hq hpq (a := a i) (b := b i) + (c := z φ) (d := w φ) ht hs + have hv : v φ = scalarPSum p + ![t ^ (1 / p.1.toReal) * z φ, s ^ (1 / p.1.toReal) * w φ] := by + exact (latticePSum_apply p p _ φ).trans + (congrArg (scalarPSum p) (by funext j; fin_cases j <;> rfl)) + calc + t * (a i * z φ) + s * (b i * w φ) = + t * a i * z φ + s * b i * w φ := by ring + _ ≤ _ := hh + _ = c i * v φ := congrArg (c i * ·) hv.symm + +private theorem scalarPSum_coord_le (p : Exponent) {n : ℕ} (a : Fin n → ℝ) (i : Fin n) : + |a i| ≤ scalarPSum p a := by + rw [scalarPSum_eq_piLp_norm] + exact PiLp.norm_apply_le (WithLp.toLp p.1 a) i + +private theorem scalarPSum_infinity_one_le (n : ℕ) : + scalarPSum Exponent.infinity (fun _ : Fin n => (1 : ℝ)) ≤ 1 := by + rw [scalarPSum_eq_piLp_norm] + change ‖WithLp.toLp ⊤ (fun _ : Fin n => (1 : ℝ))‖ ≤ 1 + rw [PiLp.norm_toLp] + exact (pi_norm_le_iff_of_nonneg zero_le_one).mpr (fun _ => by norm_num) + +private theorem tensorBall_convex_infinity (p : Exponent) (n : ℕ) : + Convex ℝ (tensorBall (E := E) p Exponent.infinity n) := by + rintro x ⟨a, ha, hanorm, z, hz, hznorm, hx⟩ + y ⟨b, hb, hbnorm, w, hw, hwnorm, hy⟩ t s ht hs hts + refine ⟨fun _ => 1, fun _ => zero_le_one, scalarPSum_infinity_one_le n, + t • z + s • w, add_nonneg (smul_nonneg ht hz) (smul_nonneg hs hw), ?_, ?_⟩ + · calc + ‖t • z + s • w‖ ≤ ‖t • z‖ + ‖s • w‖ := norm_add_le _ _ + _ = t * ‖z‖ + s * ‖w‖ := by + simp only [norm_smul, Real.norm_eq_abs, abs_of_nonneg ht, abs_of_nonneg hs] + _ ≤ t + s := add_le_add (mul_le_of_le_one_right ht hznorm) + (mul_le_of_le_one_right hs hwnorm) + _ = 1 := hts + · intro i φ + have hai := (le_abs_self (a i)).trans ((scalarPSum_coord_le _ a i).trans hanorm) + have hbi := (le_abs_self (b i)).trans ((scalarPSum_coord_le _ b i).trans hbnorm) + have hx' : |x i φ| ≤ z φ := (hx i φ).trans (mul_le_of_le_one_left (hz φ) hai) + have hy' : |y i φ| ≤ w φ := (hy i φ).trans (mul_le_of_le_one_left (hw φ) hbi) + change |t * x i φ + s * y i φ| ≤ 1 * (t * z φ + s * w φ) + rw [one_mul] + calc + _ ≤ t * |x i φ| + s * |y i φ| := by + simpa only [abs_mul, abs_of_nonneg ht, abs_of_nonneg hs] using + abs_add_le (t * x i φ) (s * y i φ) + _ ≤ _ := add_le_add (mul_le_mul_of_nonneg_left hx' ht) + (mul_le_mul_of_nonneg_left hy' hs) + +private theorem tensorBall_smul_mem (p q : Exponent) {n : ℕ} + {x : Fin n → Free p E} (hx : x ∈ tensorBall p q n) {r : ℝ} (hr : |r| ≤ 1) : + r • x ∈ tensorBall p q n := by + obtain ⟨a, ha, hanorm, z, hz, hznorm, hx⟩ := hx + refine ⟨a, ha, hanorm, z, hz, hznorm, fun i φ => ?_⟩ + change |r * x i φ| ≤ a i * z φ + rw [abs_mul] + exact (mul_le_of_le_one_left (abs_nonneg _) hr).trans (hx i φ) + +private theorem tensorBall_normalize (p q : Exponent) {n : ℕ} + (x : Fin n → Free p E) (a : Fin n → ℝ) (z : Free p E) + (ha : ∀ i, 0 ≤ a i) (hz : 0 ≤ z) (hx : ∀ i, |x i| ≤ a i • z) + {A D : ℝ} (hA : 0 < A) (hD : 0 < D) + (hanorm : scalarPSum q a ≤ A) (hznorm : ‖z‖ ≤ D) : + (A * D)⁻¹ • x ∈ tensorBall p q n := by + refine ⟨fun i => A⁻¹ * a i, fun i => mul_nonneg (inv_nonneg.mpr hA.le) (ha i), + ?_, D⁻¹ • z, smul_nonneg (inv_nonneg.mpr hD.le) hz, ?_, ?_⟩ + · rw [scalarPSum_smul, abs_of_pos (inv_pos.mpr hA)] + exact (mul_le_mul_of_nonneg_left hanorm (inv_nonneg.mpr hA.le)).trans_eq + (inv_mul_cancel₀ hA.ne') + · rw [norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hD)] + exact (mul_le_mul_of_nonneg_left hznorm (inv_nonneg.mpr hD.le)).trans_eq + (inv_mul_cancel₀ hD.ne') + · intro i φ + change |(A * D)⁻¹ * x i φ| ≤ (A⁻¹ * a i) * (D⁻¹ * z φ) + rw [abs_mul, abs_of_pos (inv_pos.mpr (mul_pos hA hD))] + calc + _ ≤ (A * D)⁻¹ * (a i * z φ) := + mul_le_mul_of_nonneg_left (hx i φ) (inv_nonneg.mpr (mul_pos hA hD).le) + _ = _ := by rw [mul_inv]; ring + +private theorem tensorBall_absorbent (p q : Exponent) (n : ℕ) : + Absorbent ℝ (tensorBall (E := E) p q n) := by + intro x + let z : Free p E := ∑ i, |x i| + have hz : 0 ≤ z := Finset.sum_nonneg (fun _ _ => abs_nonneg _) + have hx (i : Fin n) : |x i| ≤ (1 : ℝ) • z := by + simpa only [one_smul] using Finset.single_le_sum + (fun j _ => abs_nonneg (x j)) (Finset.mem_univ i) + let A := scalarPSum q (fun _ : Fin n => (1 : ℝ)) + 1 + let D := ‖z‖ + 1 + have hA : 0 < A := add_pos_of_nonneg_of_pos (scalarPSum_nonneg _ _) zero_lt_one + have hD : 0 < D := add_pos_of_nonneg_of_pos (norm_nonneg _) zero_lt_one + have hm := tensorBall_normalize p q x (fun _ => 1) z (fun _ => zero_le_one) hz hx hA hD + (le_add_of_nonneg_right zero_le_one) (le_add_of_nonneg_right zero_le_one) + apply Absorbs.of_norm + refine ⟨A * D, fun r hr => ?_⟩ + intro y hy + have hy' : y = x := Set.mem_singleton_iff.mp hy + subst y + have hr0 : r ≠ 0 := norm_pos_iff.mp ((mul_pos hA hD).trans_le hr) + refine ⟨r⁻¹ • x, ?_, by simp [hr0]⟩ + have hscale : |(A * D) / r| ≤ 1 := by + rw [abs_div, abs_of_pos (mul_pos hA hD)] + exact (div_le_one (abs_pos.mpr hr0)).mpr hr + have hh := tensorBall_smul_mem p q hm hscale + have heq : (A * D / r) * (A * D)⁻¹ = r⁻¹ := by + field_simp + simpa only [smul_smul, heq] using hh + +private theorem tensorGauge_le (p q : Exponent) {n : ℕ} + (x : Fin n → Free p E) (a : Fin n → ℝ) (z : Free p E) + (ha : ∀ i, 0 ≤ a i) (hz : 0 ≤ z) (hx : ∀ i, |x i| ≤ a i • z) : + gauge (tensorBall p q n) x ≤ scalarPSum q a * ‖z‖ := by + have happrox (ε : ℝ) (hε : 0 < ε) : + gauge (tensorBall p q n) x ≤ (scalarPSum q a + ε) * (‖z‖ + ε) := by + have hA := add_pos_of_nonneg_of_pos (scalarPSum_nonneg q a) hε + have hD := add_pos_of_nonneg_of_pos (norm_nonneg z) hε + apply gauge_le_of_mem (mul_pos hA hD).le + exact ⟨_, tensorBall_normalize p q x a z ha hz hx hA hD + (le_add_of_nonneg_right hε.le) (le_add_of_nonneg_right hε.le), + by simp only [smul_smul, mul_inv_cancel₀ (mul_pos hA hD).ne', one_smul]⟩ + have hlim : Filter.Tendsto (fun ε : ℝ => (scalarPSum q a + ε) * (‖z‖ + ε)) + (𝓝[>] 0) (𝓝 (scalarPSum q a * ‖z‖)) := by + have hc : Continuous (fun ε : ℝ => (scalarPSum q a + ε) * (‖z‖ + ε)) := by fun_prop + simpa only [add_zero] using (hc.tendsto 0).mono_left nhdsWithin_le_nhds + apply ge_of_tendsto hlim + filter_upwards [self_mem_nhdsWithin] with ε hε + exact happrox ε hε + +private theorem tensorGauge_rankOne (p q : Exponent) {n : ℕ} + (a : Fin n → ℝ) (z : Free p E) : + gauge (tensorBall p q n) (fun i => a i • z) ≤ scalarPSum q a * ‖z‖ := by + have h := tensorGauge_le p q (fun i => a i • z) (fun i => |a i|) |z| + (fun i => abs_nonneg _) (abs_nonneg _) (fun i => by + intro φ + change |a i * z φ| ≤ |a i| * |z φ| + exact (abs_mul _ _).le) + simpa only [scalarPSum_abs, norm_abs_eq_norm] using h + +private theorem extend_tensorGauge (p q : Exponent) {n : ℕ} + (hc : Convex ℝ (tensorBall (E := E) p q n)) + (W : Submodule ℝ (Fin n → Free p E)) (l : W →ₗ[ℝ] ℝ) {D : ℝ} (hD : 0 < D) + (hl : ∀ x : W, (x : Fin n → Free p E) ∈ tensorBall p q n → l x ≤ D) : + ∃ G : (Fin n → Free p E) →ₗ[ℝ] ℝ, + (∀ x : W, G x = l x) ∧ ∀ x, G x ≤ D * gauge (tensorBall p q n) x := by + have hbound (x : W) : l x ≤ D * gauge (tensorBall p q n) (x : Fin n → Free p E) := by + suffices h : l x / D ≤ gauge (tensorBall p q n) (x : Fin n → Free p E) by + simpa only [mul_comm] using (div_le_iff₀ hD).mp h + rw [gauge_def] + apply le_csInf ((tensorBall_absorbent p q n).gauge_set_nonempty) + rintro r ⟨hr, hxr⟩ + have hh := hl (r⁻¹ • x) ((mem_smul_set_iff_inv_smul_mem₀ hr.ne' _ _).mp hxr) + rw [map_smul, smul_eq_mul] at hh + apply (div_le_iff₀ hD).mpr + have hh' := mul_le_mul_of_nonneg_left hh hr.le + simpa only [← mul_assoc, mul_inv_cancel₀ hr.ne', one_mul] using hh' + apply exists_extension_of_le_sublinear (⟨W, l⟩ : (Fin n → Free p E) →ₗ.[ℝ] ℝ) + (fun x => D * gauge (tensorBall p q n) x) + · intro r hr x + rw [gauge_smul_of_nonneg hr.le, smul_eq_mul] + ring + · intro x y + exact (mul_le_mul_of_nonneg_left + (gauge_add_le hc (tensorBall_absorbent p q n) x y) hD.le).trans_eq (mul_add ..) + · exact hbound + +/-- Hölder conjugacy of convexity exponents, including the pair one and infinity. -/ +def Conjugate (p q : Exponent) : Prop := + (p = Exponent.one ∧ q = Exponent.infinity) ∨ + (p.IsFinite ∧ q.IsFinite ∧ p.1.toReal.HolderConjugate q.1.toReal) + +private theorem exists_conjugate (p : Exponent) (hp : p.IsFinite) : + ∃ q, Conjugate p q := by + by_cases h : p = Exponent.one + · exact ⟨Exponent.infinity, Or.inl ⟨h, rfl⟩⟩ + have hp1 : 1 < p.1 := lt_of_le_of_ne p.2 (fun heq => h (Subtype.ext heq.symm)) + have hp1' : 1 < p.1.toReal := by + simpa only [ENNReal.toReal_one] using + (ENNReal.toReal_lt_toReal ENNReal.one_ne_top (ne_of_lt hp)).mpr hp1 + have hc := Real.HolderConjugate.conjExponent hp1' + let q : Exponent := ⟨ENNReal.ofReal p.1.toReal.conjExponent, + ENNReal.one_le_ofReal.mpr (Real.holderConjugate_iff.mp hc.symm).1.le⟩ + refine ⟨q, Or.inr ⟨hp, ENNReal.ofReal_lt_top, ?_⟩⟩ + simpa only [q, ENNReal.toReal_ofReal hc.symm.nonneg] using hc + +private theorem tensorBall_convex (p q : Exponent) (hpq : Conjugate p q) (n : ℕ) : + Convex ℝ (tensorBall (E := E) p q n) := by + rcases hpq with ⟨rfl, rfl⟩ | ⟨hp, hq, hpq⟩ + · exact tensorBall_convex_infinity _ _ + · exact tensorBall_convex_finite p q hp hq hpq n + +private theorem sum_mul_le (p q : Exponent) (hpq : Conjugate p q) + {n : ℕ} (a b : Fin n → ℝ) : + ∑ i, a i * b i ≤ scalarPSum q a * scalarPSum p b := by + rcases hpq with ⟨rfl, rfl⟩ | ⟨hp, hq, hpq⟩ + · calc + _ ≤ ∑ i, scalarPSum Exponent.infinity a * |b i| := by + apply Finset.sum_le_sum + intro i _ + exact (le_abs_self _).trans ((abs_mul _ _).le.trans + (mul_le_mul_of_nonneg_right (scalarPSum_coord_le _ _ i) (abs_nonneg _))) + _ = _ := by simp [scalarPSum, Exponent.one, Finset.mul_sum] + · simpa only [scalarPSum, ite_eq_right (ne_of_lt hp), ite_eq_right (ne_of_lt hq)] using + Real.inner_le_Lp_mul_Lq Finset.univ a b hpq.symm + +private theorem exists_norming (p q : Exponent) (hpq : Conjugate p q) + {n : ℕ} (b : Fin n → ℝ) : + ∃ a : Fin n → ℝ, scalarPSum q a ≤ 1 ∧ ∑ i, a i * b i = scalarPSum p b := by + classical + rcases hpq with ⟨rfl, rfl⟩ | ⟨hp, hq, hpq⟩ + · refine ⟨fun i => if 0 ≤ b i then 1 else -1, ?_, ?_⟩ + · apply (scalarPSum_mono_abs _ _ (fun _ => 1) (fun i => ?_)).trans + (scalarPSum_infinity_one_le n) + split_ifs <;> norm_num + · simp only [scalarPSum, Exponent.one] + norm_num only [ENNReal.one_ne_top, ite_false, ENNReal.toReal_one, div_one, Real.rpow_one] + apply Finset.sum_congr rfl + intro i _ + split_ifs with hi + · simp [abs_of_nonneg hi] + · simp [abs_of_neg (lt_of_not_ge hi)] + · obtain ⟨g, hg, heq⟩ := (NNReal.isGreatest_Lp Finset.univ + (fun i => (⟨|b i|, abs_nonneg _⟩ : ℝ≥0)) hpq).1 + have habs (i : Fin n) : + |if 0 ≤ b i then (g i : ℝ) else -(g i : ℝ)| = g i := by + split_ifs <;> simp only [abs_neg, abs_of_nonneg (g i).coe_nonneg] + refine ⟨fun i => if 0 ≤ b i then (g i : ℝ) else -(g i : ℝ), ?_, ?_⟩ + · apply (Real.rpow_le_rpow_iff (scalarPSum_nonneg _ _) zero_le_one hpq.symm.pos).mp + rw [scalarPSum_rpow q hq, Real.one_rpow] + simp_rw [habs] + exact_mod_cast hg + · have heq' : ∑ i, |b i| * (g i : ℝ) = scalarPSum p b := by + have hh := congrArg ((↑) : ℝ≥0 → ℝ) heq + simp only [NNReal.coe_sum, NNReal.coe_rpow] at hh + rw [scalarPSum, ite_eq_right (ne_of_lt hp)] + exact hh + rw [← heq'] + apply Finset.sum_congr rfl + intro i _ + dsimp only + split_ifs with hi + · simp [abs_of_nonneg hi, mul_comm] + · simp [abs_of_neg (lt_of_not_ge hi), mul_comm] + +variable {F : Type v} [NormedAddCommGroup F] [NormedSpace ℝ F] + +private theorem sum_lift_le_of_mem_tensorBall (p q : Exponent) (hpq : Conjugate p q) + (J : LatticeOperator (Free p F) (Free p E)) (hJ : Function.Injective J) + {C : ℝ} (hC : 0 ≤ C) (hbound : ∀ f, ‖f‖ ≤ C * ‖J f‖) + {n : ℕ} (T : LatticeOperator (Free p F) (PiLp p.1 (fun _ : Fin (n + 1) => ℝ))) + (f : Fin (n + 1) → Free p F) + (hf : (fun i => J (f i)) ∈ tensorBall p q (n + 1)) : + ∑ i, T (f i) i ≤ C * ‖T.toContinuousLinearMap‖ := by + classical + obtain ⟨a, ha, hanorm, z, hz, hznorm, hf⟩ := hf + let ρ : Free p F := Finset.univ.sup' Finset.univ_nonempty (fun i => (a i)⁻¹ • |f i|) + have hρpos : 0 ≤ ρ := (smul_nonneg (inv_nonneg.mpr (ha 0)) (abs_nonneg (f 0))).trans + (Finset.le_sup' (fun i => (a i)⁻¹ • |f i|) (Finset.mem_univ 0)) + have hJρ : J ρ ≤ z := by + change J.toVecLatHom ρ ≤ z + dsimp only [ρ] + rw [map_finset_sup'] + apply Finset.sup'_le + intro i _ + simp only [Function.comp_apply, map_smul, VecLatHom.map_abs] + intro φ + change (a i)⁻¹ * |J (f i) φ| ≤ z φ + by_cases hai : a i = 0 + · simp only [hai, inv_zero, zero_mul] + exact hz φ + · have hh0 : |J (f i) φ| ≤ a i * z φ := hf i φ + have hh := mul_le_mul_of_nonneg_left hh0 (inv_nonneg.mpr (ha i)) + simpa only [← mul_assoc, inv_mul_cancel₀ hai, one_mul] using hh + have hρnorm : ‖ρ‖ ≤ C := by + have hjpos : 0 ≤ J ρ := J.toVecLatHom.map_nonneg hρpos + have hjnorm : ‖J ρ‖ ≤ ‖z‖ := norm_le_norm_of_abs_le_abs (by + rw [abs_of_nonneg hjpos, abs_of_nonneg hz] + exact hJρ) + exact (hbound ρ).trans ((mul_le_mul_of_nonneg_left (hjnorm.trans hznorm) hC).trans_eq + (mul_one C)) + have hfi (i : Fin (n + 1)) : |f i| ≤ a i • ρ := by + by_cases hai : a i = 0 + · apply J.toVecLatHom.le_of_map_le hJ + rw [map_smul, VecLatHom.map_abs, hai, zero_smul] + have hh : |J (f i)| ≤ 0 := by simpa only [hai, zero_smul] using hf i + exact hh + · intro ψ + have hh : (a i)⁻¹ * |f i ψ| ≤ ρ ψ := + (Finset.le_sup' (fun i => (a i)⁻¹ • |f i|) (Finset.mem_univ i)) ψ + have hh' := mul_le_mul_of_nonneg_left hh (ha i) + change |f i ψ| ≤ a i * ρ ψ + simpa only [← mul_assoc, mul_inv_cancel₀ hai, one_mul] using hh' + calc + _ ≤ ∑ i, a i * T ρ i := by + apply Finset.sum_le_sum + intro i _ + have hh := T.toVecLatHom.monotone ((le_abs_self (f i)).trans (hfi i)) + rw [map_smul] at hh + exact hh i + _ ≤ scalarPSum q a * scalarPSum p (fun i => T ρ i) := sum_mul_le p q hpq _ _ + _ = scalarPSum q a * ‖T ρ‖ := by rw [scalarPSum_eq_piLp_norm p] + _ ≤ ‖T ρ‖ := mul_le_of_le_one_left (norm_nonneg _) hanorm + _ ≤ ‖T.toContinuousLinearMap‖ * ‖ρ‖ := T.toContinuousLinearMap.le_opNorm ρ + _ ≤ ‖T.toContinuousLinearMap‖ * C := mul_le_mul_of_nonneg_left hρnorm (norm_nonneg _) + _ = C * ‖T.toContinuousLinearMap‖ := mul_comm _ _ + +private theorem extend_latticeOperator_succ (p q : Exponent) (hpq : Conjugate p q) + (J : LatticeOperator (Free p F) (Free p E)) (hJ : Function.Injective J) + {C : ℝ} (hC : 0 < C) (hbound : ∀ f, ‖f‖ ≤ C * ‖J f‖) + {n : ℕ} (T : LatticeOperator (Free p F) (PiLp p.1 (fun _ : Fin (n + 1) => ℝ))) : + ∃ S : Free p E →L[ℝ] PiLp p.1 (fun _ : Fin (n + 1) => ℝ), + S.comp J.toContinuousLinearMap = T.toContinuousLinearMap ∧ + ‖S‖ ≤ C * ‖T.toContinuousLinearMap‖ := by + classical + by_cases hT : T.toContinuousLinearMap = 0 + · exact ⟨0, by simp [hT], by simp [hT]⟩ + let B : (Fin (n + 1) → Free p F) →ₗ[ℝ] (Fin (n + 1) → Free p E) := + LinearMap.pi (fun i => J.toContinuousLinearMap.toLinearMap.comp (LinearMap.proj i)) + have hB : Function.Injective B := by + intro f g hfg + funext i + exact hJ (congrFun hfg i) + let e := LinearEquiv.ofInjective B hB + let τ : (Fin (n + 1) → Free p F) →ₗ[ℝ] ℝ := + ∑ i, (PiLp.proj p.1 (fun _ : Fin (n + 1) => ℝ) i).toLinearMap.comp + (T.toContinuousLinearMap.toLinearMap.comp (LinearMap.proj i)) + have hτ (f : Fin (n + 1) → Free p F) : τ f = ∑ i, T (f i) i := by + simp [τ] + let l : B.range →ₗ[ℝ] ℝ := τ.comp e.symm.toLinearMap + have hD : 0 < C * ‖T.toContinuousLinearMap‖ := mul_pos hC (norm_pos_iff.mpr hT) + obtain ⟨G, hG, hGbound⟩ := extend_tensorGauge p q (tensorBall_convex p q hpq (n + 1)) + B.range l hD (by + intro x hx + have heq : B (e.symm x) = (x : Fin (n + 1) → Free p E) := + congrArg Subtype.val (e.apply_symm_apply x) + have hmem : (fun i => J (e.symm x i)) ∈ tensorBall p q (n + 1) := by + change B (e.symm x) ∈ _ + rw [heq] + exact hx + change τ (e.symm x) ≤ _ + rw [hτ] + exact sum_lift_le_of_mem_tensorBall p q hpq J hJ hC.le hbound T (e.symm x) hmem) + let S₀ : Free p E →ₗ[ℝ] PiLp p.1 (fun _ : Fin (n + 1) => ℝ) := + (WithLp.linearEquiv p.1 ℝ (Fin (n + 1) → ℝ)).symm.toLinearMap.comp + (LinearMap.pi (fun i => G.comp (LinearMap.single ℝ (fun _ : Fin (n + 1) => Free p E) i))) + have hsum (a : Fin (n + 1) → ℝ) (x : Free p E) : + ∑ i, a i * G (Pi.single i x) = G (fun i => a i • x) := by + calc + _ = G (∑ i, a i • Pi.single i x) := by simp [map_sum, map_smul, smul_eq_mul] + _ = _ := congrArg G (by + simp_rw [← Pi.single_smul] + exact Finset.univ_sum_single _) + have hnorm (x : Free p E) : ‖S₀ x‖ ≤ C * ‖T.toContinuousLinearMap‖ * ‖x‖ := by + obtain ⟨a, ha, heq⟩ := exists_norming p q hpq (fun i => G (Pi.single i x)) + calc + _ = scalarPSum p (fun i => G (Pi.single i x)) := (scalarPSum_eq_piLp_norm p _).symm + _ = G (fun i => a i • x) := heq.symm.trans (hsum a x) + _ ≤ C * ‖T.toContinuousLinearMap‖ * gauge (tensorBall p q (n + 1)) (fun i => a i • x) := + hGbound _ + _ ≤ C * ‖T.toContinuousLinearMap‖ * (scalarPSum q a * ‖x‖) := + mul_le_mul_of_nonneg_left (tensorGauge_rankOne p q a x) hD.le + _ ≤ C * ‖T.toContinuousLinearMap‖ * ‖x‖ := + mul_le_mul_of_nonneg_left (mul_le_of_le_one_left (norm_nonneg x) ha) hD.le + let S := S₀.mkContinuous (C * ‖T.toContinuousLinearMap‖) hnorm + refine ⟨S, ?_, S.opNorm_le_bound hD.le hnorm⟩ + apply ContinuousLinearMap.ext + intro f + apply PiLp.ext + intro i + change G (Pi.single i (J f)) = T f i + have hh := hG (e (Pi.single i f)) + change G (B (Pi.single i f)) = τ (e.symm (e (Pi.single i f))) at hh + rw [e.symm_apply_apply, hτ] at hh + have hsingle : B (Pi.single i f) = Pi.single i (J f) := by + ext j + by_cases hji : j = i + · subst j + simp [B] + · simp [B, Pi.single_eq_of_ne hji] + rw [hsingle] at hh + convert hh using 1 + rw [Finset.sum_eq_single i] + · simp + · intro j _ hji + simp [Pi.single_eq_of_ne hji] + · simp + +/-- Extend a lattice homomorphism into finite-dimensional ell-p across a bounded +lattice operator J with inverse norm bound C. The extension is a continuous linear +map on the ambient free lattice, agrees with the original map along J, and has +norm at most C times the original norm. The tensor gauge and Hahn–Banach prove +this for every finite p, including p = 1. -/ +theorem extend_latticeOperator (p : Exponent) (hp : p.IsFinite) + (J : LatticeOperator (Free p F) (Free p E)) + {C : ℝ} (hC : 0 < C) (hbound : ∀ f, ‖f‖ ≤ C * ‖J f‖) + (n : ℕ) (T : LatticeOperator (Free p F) (PiLp p.1 (fun _ : Fin n => ℝ))) : + ∃ S : Free p E →L[ℝ] PiLp p.1 (fun _ : Fin n => ℝ), + S.comp J.toContinuousLinearMap = T.toContinuousLinearMap ∧ + ‖S‖ ≤ C * ‖T.toContinuousLinearMap‖ := by + have hJ : Function.Injective J := + (injective_iff_map_eq_zero J.toContinuousLinearMap).mpr (by + intro f hf + apply norm_eq_zero.mp + have hh := hbound f + rw [hf, norm_zero, mul_zero] at hh + exact le_antisymm hh (norm_nonneg f)) + cases n with + | zero => + exact ⟨0, Subsingleton.elim _ _, by simp [mul_nonneg hC.le (norm_nonneg _)]⟩ + | succ n => + obtain ⟨q, hpq⟩ := exists_conjugate p hp + exact extend_latticeOperator_succ p q hpq J hJ hC hbound T + +/-- A lower bound `‖f‖ ≤ C * ‖induced p M.subtypeL f‖` extends every bounded linear +map from M into a finite-dimensional ell-p space to E with norm at most C times +its original norm. Lift to the free lattice, apply `extend_latticeOperator`, and +restrict to the evaluation generators. The same constant works for every dimension. -/ +theorem extend_of_free_norm_bound (p : Exponent) (hp : p.IsFinite) (M : Submodule ℝ E) + {C : ℝ} (hC : 0 < C) + (hbound : ∀ f : Free p M, ‖f‖ ≤ C * ‖induced p M.subtypeL f‖) + (n : ℕ) (R : M →L[ℝ] PiLp p.1 (fun _ : Fin n => ℝ)) : + ∃ S : E →L[ℝ] PiLp p.1 (fun _ : Fin n => ℝ), + S.comp M.subtypeL = R ∧ ‖S‖ ≤ C * ‖R‖ := by + obtain ⟨T, hT, hTnorm, _⟩ := universal_property_piLp p n R + obtain ⟨A, hA, hAnorm⟩ := extend_latticeOperator p hp (induced p M.subtypeL) hC hbound n T + let S : E →L[ℝ] PiLp p.1 (fun _ : Fin n => ℝ) := + A.comp (delta p).toContinuousLinearMap + refine ⟨S, ?_, ?_⟩ + · apply ContinuousLinearMap.ext + intro x + change A (delta p (M.subtypeL x)) = R x + rw [← (induced_norm_generators p M.subtypeL).2 x] + exact (congrArg (fun L : Free p M →L[ℝ] PiLp p.1 (fun _ : Fin n => ℝ) => + L (delta p x)) hA).trans (hT x) + · apply S.opNorm_le_bound (mul_nonneg hC.le (norm_nonneg R)) + intro x + calc + ‖S x‖ ≤ ‖A‖ * ‖delta p x‖ := A.le_opNorm _ + _ ≤ (C * ‖T.toContinuousLinearMap‖) * ‖x‖ := by + rw [(delta p).norm_map] + exact mul_le_mul_of_nonneg_right hAnorm (norm_nonneg x) + _ ≤ (C * ‖R‖) * ‖x‖ := + mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left hTnorm hC.le) (norm_nonneg x) + +end FBLOrderContinuousLH.FiniteLpExtension diff --git a/LeanPool/FBLOrderContinuity/Model.lean b/LeanPool/FBLOrderContinuity/Model.lean new file mode 100644 index 0000000000..de8eed93ba --- /dev/null +++ b/LeanPool/FBLOrderContinuity/Model.lean @@ -0,0 +1,4781 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + +module + +public import Mathlib.Analysis.MeanInequalitiesPow +public import Mathlib.Analysis.SpecialFunctions.Pow.Deriv +public import LeanPool.FBLOrderContinuity.BanLat.Pi +public import Mathlib.Analysis.Calculus.LocalExtr.Basic +public import LeanPool.FBLOrderContinuity.BanLat.Free.FBL +public import LeanPool.FBLOrderContinuity.BanLat.FunctionalCalculus +public import LeanPool.FBLOrderContinuity.BanLat.Quotient +public import Mathlib.Analysis.Normed.Operator.Banach +public import Mathlib.Analysis.LocallyConvex.AbsConvex +public import Mathlib.Analysis.LocallyConvex.Separation +public import Mathlib.Topology.Algebra.Module.ContinuousLinearMap.Quotient +public import Mathlib.Topology.Algebra.Module.FiniteDimension +public import Mathlib.Topology.Algebra.Module.Spaces.CompactConvergenceCLM +public import Mathlib.Topology.ContinuousMap.StoneWeierstrass +public import Mathlib.Topology.Compactness.CompactlyGeneratedSpace + + + +/-! +# Concrete models of free p-convex Banach lattices + +This module constructs the spaces from Sections 1 and 2 of `main_20_10_26.tex`. +`Exponent` ranges over `[1, ∞]`. Positively homogeneous functions on the continuous dual +carry the extended norm `freeNormExt`; its finite part is the Banach lattice `HP p E`. +The norm-closed sublattice generated by evaluations is `Free p E`. + +The main interfaces are `delta` (the evaluation isometry), `ofFVL` (the dense algebraic +core), `induced` (composition with an adjoint), and `inclusion` (change of exponent). +`universal_property` gives the unique bounded lattice extension into a p-convex target. +`infinity_representation` identifies the endpoint with homogeneous functions continuous +on the weak-star dual unit ball. `banlat_fbl_identification` connects p = 1 to BanLat. + +Order is pointwise, whereas the norm topology is specified by the free norm. The type +synonym `HP` keeps these topologies distinct. Scalar and lattice p-sums include the +empty family and the infinity endpoint. +-/ + +@[expose] public section + +noncomputable section +open scoped BigOperators ENNReal NNReal Topology +open Filter Set +universe u v w + +namespace FBLOrderContinuousLH + +/-- Convexity parameters, including the endpoint infinity. -/ +abbrev Exponent := {p : ℝ≥0∞ // 1 ≤ p} + +namespace Exponent +/-- The exponent 1, giving the ordinary free Banach lattice. -/ +def one : Exponent := ⟨1, le_rfl⟩ +/-- The endpoint exponent ∞, whose free norm is the supremum on the dual unit ball. -/ +def infinity : Exponent := ⟨⊤, le_top⟩ +/-- Every convexity exponent is bounded by the infinity endpoint. -/ +theorem le_infinity (p : Exponent) : p ≤ infinity := + (show p.1 ≤ (⊤ : ℝ≥0∞) from le_top) +/-- The exponent 2, used for Euclidean admissibility and the Hilbert comparison. -/ +def two : Exponent := ⟨2, by norm_num⟩ +/-- The condition that a convexity exponent is strictly below ∞. Together with membership +in `Exponent`, it ensures that `p.1.toReal` is a real number at least one. -/ +def IsFinite (p : Exponent) : Prop := p.1 < ⊤ +instance (p : Exponent) : Fact (1 ≤ p.1) := ⟨p.2⟩ +end Exponent + +/-- The continuous real dual of E, equipped with its operator norm. Weak-star statements +use the corresponding `WeakDual` type explicitly. -/ +abbrev Dual (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] := StrongDual ℝ E + +variable {E : Type u} {F : Type v} + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + +/-- Positive homogeneity on the full dual: scaling an argument by any nonnegative real +scales the value by the same number. Including scalar zero forces the function to vanish at zero. -/ +def PosHomogeneous (f : Dual E → ℝ) : Prop := + ∀ (a : ℝ), 0 ≤ a → ∀ φ, f (a • φ) = a * f φ + +/-- Section 2: the vector lattice H[E], with pointwise operations. -/ +def homogeneousSublattice (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] : + VectorSublattice (Dual E → ℝ) where + toSubmodule := { + carrier := {f | PosHomogeneous f} + zero_mem' := by simp [PosHomogeneous] + add_mem' := by + intro f g hf hg a ha φ + simp only [Pi.add_apply, hf a ha φ, hg a ha φ, mul_add] + smul_mem' := by + intro c f hf a ha φ + simp [Pi.smul_apply, hf a ha φ, mul_left_comm] } + sup_mem' := by + intro f g hf hg a ha φ + simpa only [Pi.sup_apply, hf a ha φ, hg a ha φ] using + (mul_max_of_nonneg (f φ) (g φ) ha).symm + +/-- The real vector lattice of positively homogeneous functions on the full continuous +dual of E. Addition, scalar multiplication, and lattice operations are pointwise. -/ +abbrev Homogeneous (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] : Type u := + homogeneousSublattice E + +/-- The scalar finite p-sum; at infinity it is the finite maximum, with empty value zero. -/ +def scalarPSum (p : Exponent) {n : ℕ} (a : Fin n → ℝ) : ℝ := + if p.1 = ⊤ then (Finset.univ.sup fun i => (⟨|a i|, abs_nonneg _⟩ : ℝ≥0) : ℝ≥0) + else (∑ i, |a i| ^ p.1.toReal) ^ (1 / p.1.toReal) + +/-- The scalar formula is Mathlib's finite `ℓᵖ` norm. -/ +theorem scalarPSum_eq_piLp_norm (p : Exponent) {n : ℕ} (a : Fin n → ℝ) : + scalarPSum p a = ‖WithLp.toLp p.1 a‖ := by + by_cases h : p.1 = ⊤ + · rw [scalarPSum, ite_eq_left h, h] + exact congrArg (fun r : ℝ≥0 => (r : ℝ)) (PiLp.nnnorm_toLp a).symm + · have hp : 0 < p.1.toReal := ENNReal.toReal_pos_iff.mpr + ⟨lt_of_lt_of_le zero_lt_one p.2, lt_top_iff_ne_top.mpr h⟩ + simp [scalarPSum, h, PiLp.norm_eq_sum hp] + +/-- A finite scalar p-sum is nonnegative, including the empty family and p = ∞. -/ +theorem scalarPSum_nonneg (p : Exponent) {n : ℕ} (a : Fin n → ℝ) : + 0 ≤ scalarPSum p a := by + rw [scalarPSum_eq_piLp_norm] + exact norm_nonneg _ + +/-- Minkowski inequality for finite scalar p-sums, valid also for the maximum norm. -/ +theorem scalarPSum_add_le (p : Exponent) {n : ℕ} (a b : Fin n → ℝ) : + scalarPSum p (fun i => a i + b i) ≤ scalarPSum p a + scalarPSum p b := by + simp only [scalarPSum_eq_piLp_norm] + exact norm_add_le (WithLp.toLp p.1 a) (WithLp.toLp p.1 b) + +/-- Scaling a finite scalar family multiplies its p-sum by the absolute value of the scalar. -/ +theorem scalarPSum_smul (p : Exponent) {n : ℕ} (c : ℝ) (a : Fin n → ℝ) : + scalarPSum p (fun i => c * a i) = |c| * scalarPSum p a := by + simp only [scalarPSum_eq_piLp_norm] + exact norm_smul c (WithLp.toLp p.1 a) + +/-- Coordinatewise domination in absolute value implies domination of scalar p-sums. -/ +theorem scalarPSum_mono_abs (p : Exponent) {n : ℕ} (a b : Fin n → ℝ) + (h : ∀ i, |a i| ≤ |b i|) : scalarPSum p a ≤ scalarPSum p b := by + by_cases htop : p.1 = ⊤ + · simp only [scalarPSum, htop, ↓reduceIte] + exact NNReal.coe_le_coe.mpr (Finset.sup_mono_fun (fun i _ => h i)) + · simp only [scalarPSum, htop, ↓reduceIte] + apply Real.rpow_le_rpow + · exact Finset.sum_nonneg fun i hi => Real.rpow_nonneg (abs_nonneg _) _ + · apply Finset.sum_le_sum + intro i hi + exact Real.rpow_le_rpow (abs_nonneg _) (h i) ENNReal.toReal_nonneg + · exact one_div_nonneg.mpr ENNReal.toReal_nonneg + +/-- Taking coordinatewise absolute values leaves the scalar p-sum unchanged. -/ +theorem scalarPSum_abs (p : Exponent) {n : ℕ} (a : Fin n → ℝ) : + scalarPSum p (fun i => |a i|) = scalarPSum p a := by + by_cases htop : p.1 = ⊤ <;> simp [scalarPSum, htop] + +/-- For every exponent, the p-sum of a singleton is the absolute value of its entry. -/ +theorem scalarPSum_fin1 (p : Exponent) (r : ℝ) : + scalarPSum p (fun _ : Fin 1 => r) = |r| := by + rw [scalarPSum_eq_piLp_norm] + have hsingle : (WithLp.toLp p.1 (fun _ : Fin 1 => r) : + PiLp p.1 (fun _ : Fin 1 => ℝ)) = PiLp.single p.1 0 r := by + ext i + fin_cases i + simp + rw [hsingle, PiLp.norm_single, Real.norm_eq_abs] + +private theorem scalarPSum_one_eq_sum {n : ℕ} (a : Fin n → ℝ) : + scalarPSum Exponent.one a = ∑ i, |a i| := by + simp [scalarPSum, Exponent.one] + +/-- The scalar p-sum is continuous on a fixed finite product of real lines. This +provides the continuity needed for the homogeneous functional calculus. -/ +theorem continuous_scalarPSum (p : Exponent) {n : ℕ} : + Continuous (scalarPSum p : (Fin n → ℝ) → ℝ) := by + convert (continuous_norm.comp + (PiLp.continuous_toLp p.1 (fun _ : Fin n => ℝ))) using 1 + ext a + exact scalarPSum_eq_piLp_norm p a + +private theorem sum_rpow_le_rpow_sum {ι : Type*} (s : Finset ι) (f : ι → ℝ) + (hf : ∀ i ∈ s, 0 ≤ f i) {r : ℝ} (hr : 1 ≤ r) : + (∑ i ∈ s, f i ^ r) ≤ (∑ i ∈ s, f i) ^ r := by + classical + induction s using Finset.induction_on with + | empty => simpa using Real.rpow_nonneg (le_refl (0 : ℝ)) r + | @insert i s his ih => + have hfi : 0 ≤ f i := hf i (Finset.mem_insert_self ..) + have hfs : ∀ j ∈ s, 0 ≤ f j := by + intro j hj + exact hf j (Finset.mem_insert_of_mem hj) + rw [Finset.sum_insert his, Finset.sum_insert his] + calc + f i ^ r + ∑ j ∈ s, f j ^ r ≤ f i ^ r + (∑ j ∈ s, f j) ^ r := by + gcongr + exact ih hfs + _ ≤ (f i + ∑ j ∈ s, f j) ^ r := + Real.add_rpow_le_rpow_add hfi (Finset.sum_nonneg hfs) hr + +private theorem realPSum_mono {n : ℕ} {p q : ℝ} (hp : 0 < p) (hpq : p ≤ q) + (a : Fin n → ℝ) : + (∑ i, |a i| ^ q) ^ (1 / q) ≤ (∑ i, |a i| ^ p) ^ (1 / p) := by + have hq : 0 < q := lt_of_lt_of_le hp hpq + have hr : 1 ≤ q / p := (one_le_div hp).mpr hpq + have hsum : (∑ i, (|a i| ^ p) ^ (q / p)) ≤ + (∑ i, |a i| ^ p) ^ (q / p) := by + apply sum_rpow_le_rpow_sum Finset.univ (fun i => |a i| ^ p) (by + intro i hi + exact Real.rpow_nonneg (abs_nonneg _) _) hr + have hsum_nonneg : 0 ≤ ∑ i, |a i| ^ p := + Finset.sum_nonneg fun i hi => Real.rpow_nonneg (abs_nonneg _) _ + have hsumleft_nonneg : 0 ≤ ∑ i, (|a i| ^ p) ^ (q / p) := + Finset.sum_nonneg fun i hi => Real.rpow_nonneg (Real.rpow_nonneg (abs_nonneg _) _) _ + calc + (∑ i, |a i| ^ q) ^ (1 / q) = + (∑ i, (|a i| ^ p) ^ (q / p)) ^ (1 / q) := by + congr 1 + apply Finset.sum_congr rfl + intro i hi + rw [← Real.rpow_mul (abs_nonneg _)] + congr 1 + field_simp + _ ≤ ((∑ i, |a i| ^ p) ^ (q / p)) ^ (1 / q) := + Real.rpow_le_rpow hsumleft_nonneg hsum (one_div_nonneg.mpr hq.le) + _ = (∑ i, |a i| ^ p) ^ (1 / p) := by + rw [← Real.rpow_mul hsum_nonneg] + congr 1 + field_simp + +/-- Finite scalar p-sums decrease as the exponent increases. -/ +theorem scalarPSum_mono_exponent {p q : Exponent} (hpq : p ≤ q) {n : ℕ} + (a : Fin n → ℝ) : scalarPSum q a ≤ scalarPSum p a := by + by_cases hn : n = 0 + · subst n + have hzero (r : Exponent) : scalarPSum r a = 0 := by + rw [scalarPSum_eq_piLp_norm] + have hz : (WithLp.toLp r.1 a : PiLp r.1 (fun _ : Fin 0 => ℝ)) = 0 := + Subsingleton.elim _ _ + rw [hz, norm_zero] + rw [hzero p, hzero q] + have : Nonempty (Fin n) := ⟨⟨0, Nat.pos_of_ne_zero hn⟩⟩ + by_cases hq : q.1 = ⊤ + · rw [scalarPSum_eq_piLp_norm, scalarPSum_eq_piLp_norm, hq, PiLp.norm_eq_ciSup] + refine ciSup_le fun i => ?_ + simpa only [Real.norm_eq_abs] using PiLp.norm_apply_le (WithLp.toLp p.1 a) i + · have hp : p.1 ≠ ⊤ := by + intro h + have h' : q.1 = ⊤ := top_le_iff.mp (h ▸ hpq) + exact hq h' + have hpReal : 0 < p.1.toReal := ENNReal.toReal_pos_iff.mpr + ⟨lt_of_lt_of_le zero_lt_one p.2, lt_top_iff_ne_top.mpr hp⟩ + have hpqReal : p.1.toReal ≤ q.1.toReal := ENNReal.toReal_mono hq hpq + simpa [scalarPSum, hp, hq] using realPSum_mono hpReal hpqReal a + +/-- A finite dual family has weak p-norm at most one if its evaluations have scalar +p-sum at most one on the closed unit ball of E. This is the admissibility condition in +equation (2.1), stated without a conditional supremum. -/ +def NormAdmissible (p : Exponent) {n : ℕ} (φ : Fin n → Dual E) : Prop := + ∀ x : E, ‖x‖ ≤ 1 → scalarPSum p (fun i => φ i x) ≤ 1 + +/-- A dual family admissible at p remains admissible at every q ≥ p, since finite +scalar q-sums are bounded by the corresponding p-sums. -/ +theorem normAdmissible_mono {p q : Exponent} (hpq : p ≤ q) {n : ℕ} + (φ : Fin n → Dual E) (hφ : NormAdmissible p φ) : NormAdmissible q φ := by + intro x hx + exact (scalarPSum_mono_exponent hpq fun i => φ i x).trans (hφ x hx) + +private theorem realPSum_mul_le {n : ℕ} {p q r : ℝ} + (hpqr : p.HolderTriple q r) (a b : Fin n → ℝ) : + (∑ i, |a i * b i| ^ r) ^ (1 / r) ≤ + (∑ i, |a i| ^ p) ^ (1 / p) * (∑ i, |b i| ^ q) ^ (1 / q) := by + let A : Fin n → ℝ≥0 := fun i => ⟨|a i|, abs_nonneg _⟩ + let B : Fin n → ℝ≥0 := fun i => ⟨|b i|, abs_nonneg _⟩ + have h := NNReal.Lr_le_Lp_mul_Lq Finset.univ A B hpqr + have hReal := NNReal.coe_le_coe.mpr h + have hA (i : Fin n) : (A i : ℝ) = |a i| := rfl + have hB (i : Fin n) : (B i : ℝ) = |b i| := rfl + simpa only [NNReal.coe_mul, NNReal.coe_rpow, NNReal.coe_sum, hA, hB, + abs_mul] using hReal + +private theorem holderTriple_of_lt {p q : ℝ} (hp : 0 < p) (hpq : p < q) : + q.HolderTriple (p * q / (q - p)) p := by + have hq : 0 < q := lt_trans hp hpq + have hdiff : 0 < q - p := sub_pos.mpr hpq + have hr : 0 < p * q / (q - p) := by positivity + refine ⟨?_, hq, hr⟩ + field_simp + ring + +private theorem normAdmissible_weighted {p q : Exponent} (hpq : p < q) + (hp : p.IsFinite) (hq : q.IsFinite) {n : ℕ} + (φ : Fin n → Dual E) (hφ : NormAdmissible q φ) (w : Fin n → ℝ) + (hw : (∑ i, |w i| ^ (p.1.toReal * q.1.toReal / + (q.1.toReal - p.1.toReal))) ^ + (1 / (p.1.toReal * q.1.toReal / (q.1.toReal - p.1.toReal))) ≤ 1) : + NormAdmissible p (fun i => w i • φ i) := by + have hpReal : 0 < p.1.toReal := ENNReal.toReal_pos_iff.mpr + ⟨lt_of_lt_of_le zero_lt_one p.2, hp⟩ + have hpqReal : p.1.toReal < q.1.toReal := + (ENNReal.toReal_lt_toReal (ne_of_lt hp) (ne_of_lt hq)).mpr hpq + let r : ℝ := p.1.toReal * q.1.toReal / (q.1.toReal - p.1.toReal) + have hholder : q.1.toReal.HolderTriple r p.1.toReal := + holderTriple_of_lt hpReal hpqReal + intro x hx + have hqbound : (∑ i, |φ i x| ^ q.1.toReal) ^ (1 / q.1.toReal) ≤ 1 := by + simpa [NormAdmissible, scalarPSum, ne_of_lt hq] using hφ x hx + have hwnonneg : 0 ≤ (∑ i, |w i| ^ r) ^ (1 / r) := by + apply Real.rpow_nonneg + exact Finset.sum_nonneg fun i hi => Real.rpow_nonneg (abs_nonneg _) _ + have hmain := realPSum_mul_le hholder (fun i => φ i x) w + change scalarPSum p (fun i => (w i • φ i) x) ≤ 1 + rw [scalarPSum, ite_eq_right (ne_of_lt hp)] + have hpoint (i : Fin n) : (w i • φ i) x = w i * φ i x := rfl + simp_rw [hpoint] + calc + (∑ i, |w i * φ i x| ^ p.1.toReal) ^ (1 / p.1.toReal) ≤ + (∑ i, |φ i x| ^ q.1.toReal) ^ (1 / q.1.toReal) * + (∑ i, |w i| ^ r) ^ (1 / r) := by + simpa only [mul_comm] using hmain + _ ≤ 1 := by + have hw' : (∑ i, |w i| ^ r) ^ (1 / r) ≤ 1 := hw + calc + _ ≤ 1 * (∑ i, |w i| ^ r) ^ (1 / r) := + mul_le_mul_of_nonneg_right hqbound hwnonneg + _ ≤ 1 * 1 := mul_le_mul_of_nonneg_left hw' zero_le_one + _ = 1 := one_mul _ + +private theorem realPSum_weighted_exists {n : ℕ} {p q : ℝ} (hp : 0 < p) + (hpq : p < q) (a : Fin n → ℝ) : + ∃ w : Fin n → ℝ, + (∀ i, 0 ≤ w i) ∧ + (∑ i, |w i| ^ (p * q / (q - p))) ^ (1 / (p * q / (q - p))) ≤ 1 ∧ + (∑ i, |w i * a i| ^ p) ^ (1 / p) = + (∑ i, |a i| ^ q) ^ (1 / q) := by + let r : ℝ := p * q / (q - p) + have hholder : q.HolderTriple r p := holderTriple_of_lt hp hpq + let f : Fin n → ℝ≥0 := fun i => ⟨|a i| ^ p, Real.rpow_nonneg (abs_nonneg _) _⟩ + obtain ⟨g, hg, heq⟩ := (NNReal.isGreatest_Lp Finset.univ f + hholder.holderConjugate_div_div).1 + let w : Fin n → ℝ := fun i => (g i : ℝ) ^ (1 / p) + refine ⟨w, (fun i => Real.rpow_nonneg (NNReal.coe_nonneg _) _), ?_, ?_⟩ + · have hr : 0 < r := hholder.right_pos + have hgle : (∑ i, (g i : ℝ) ^ (r / p)) ≤ 1 := by + have h := NNReal.coe_le_coe.mpr hg + simpa only [NNReal.coe_sum, NNReal.coe_rpow, NNReal.coe_one] using h + have hterm (i : Fin n) : |w i| ^ r = (g i : ℝ) ^ (r / p) := by + rw [abs_of_nonneg (Real.rpow_nonneg (NNReal.coe_nonneg _) _)] + rw [← Real.rpow_mul (NNReal.coe_nonneg _)] + congr 1 + field_simp + change (∑ i, |w i| ^ r) ^ (1 / r) ≤ 1 + simp_rw [hterm] + calc + (∑ i, (g i : ℝ) ^ (r / p)) ^ (1 / r) ≤ 1 ^ (1 / r) := + Real.rpow_le_rpow + (Finset.sum_nonneg fun i hi => Real.rpow_nonneg (NNReal.coe_nonneg _) _) + hgle (one_div_nonneg.mpr hr.le) + _ = 1 := by simp + · have heqR : (∑ i, (f i : ℝ) * (g i : ℝ)) = + (∑ i, (f i : ℝ) ^ (q / p)) ^ (1 / (q / p)) := by + have h := congrArg (fun z : ℝ≥0 => (z : ℝ)) heq + simpa only [NNReal.coe_sum, NNReal.coe_mul, NNReal.coe_rpow] using h + have hweighted : (∑ i, |w i * a i| ^ p) = + ∑ i, (f i : ℝ) * (g i : ℝ) := by + apply Finset.sum_congr rfl + intro i hi + rw [abs_mul, abs_of_nonneg (Real.rpow_nonneg (NNReal.coe_nonneg _) _)] + rw [Real.mul_rpow (Real.rpow_nonneg (NNReal.coe_nonneg _) _) (abs_nonneg _)] + rw [← Real.rpow_mul (NNReal.coe_nonneg _)] + have hmul : 1 / p * p = 1 := by field_simp + rw [hmul, Real.rpow_one] + change (g i : ℝ) * |a i| ^ p = |a i| ^ p * (g i : ℝ) + ring + have hsum : (∑ i, (f i : ℝ) ^ (q / p)) = ∑ i, |a i| ^ q := by + apply Finset.sum_congr rfl + intro i hi + change (|a i| ^ p) ^ (q / p) = _ + rw [← Real.rpow_mul (abs_nonneg _)] + congr 1 + field_simp + have hsum_nonneg : 0 ≤ ∑ i, (f i : ℝ) ^ (q / p) := + Finset.sum_nonneg fun i hi => Real.rpow_nonneg (NNReal.coe_nonneg _) _ + calc + (∑ i, |w i * a i| ^ p) ^ (1 / p) = + ((∑ i, (f i : ℝ) ^ (q / p)) ^ (1 / (q / p))) ^ (1 / p) := by + rw [hweighted, heqR] + _ = (∑ i, (f i : ℝ) ^ (q / p)) ^ (1 / q) := by + rw [← Real.rpow_mul hsum_nonneg] + congr 1 + field_simp + _ = (∑ i, |a i| ^ q) ^ (1 / q) := by rw [hsum] + +/-- Every dual functional of operator norm at most one is a singleton admissible +family at every exponent. -/ +theorem normAdmissible_singleton (p : Exponent) (φ : Dual E) (hφ : ‖φ‖ ≤ 1) : + NormAdmissible p (fun _ : Fin 1 => φ) := by + intro x hx + rw [scalarPSum_fin1] + calc + |φ x| = ‖φ x‖ := (Real.norm_eq_abs _).symm + _ ≤ ‖φ‖ * ‖x‖ := φ.le_opNorm x + _ ≤ 1 := by nlinarith [norm_nonneg φ, norm_nonneg x] + +/-- The unit-ball condition in `NormAdmissible` scales to a bound at every x: +the p-sum of the family evaluated at x is at most the norm of x. -/ +theorem normAdmissible_eval_le_norm (p : Exponent) {n : ℕ} + (φ : Fin n → Dual E) (hφ : NormAdmissible p φ) (x : E) : + scalarPSum p (fun i => φ i x) ≤ ‖x‖ := by + by_cases hx : x = 0 + · subst x + simp [scalarPSum_eq_piLp_norm] + rfl + · have hnormpos : 0 < ‖x‖ := norm_pos_iff.mpr hx + have hunit : ‖‖x‖⁻¹ • x‖ ≤ 1 := + mem_closedBall_zero_iff.mp (inv_norm_smul_mem_unitClosedBall x) + have hvalue := hφ (‖x‖⁻¹ • x) hunit + have hfun : (fun i => φ i (‖x‖⁻¹ • x)) = + (fun i => ‖x‖⁻¹ * φ i x) := by + funext i + simp + rw [hfun, scalarPSum_smul, abs_of_pos (inv_pos.mpr hnormpos)] at hvalue + calc + scalarPSum p (fun i => φ i x) = + ‖x‖ * (‖x‖⁻¹ * scalarPSum p (fun i => φ i x)) := by + rw [← mul_assoc, mul_inv_cancel₀ hnormpos.ne', one_mul] + _ ≤ ‖x‖ * 1 := mul_le_mul_of_nonneg_left hvalue (le_of_lt hnormpos) + _ = ‖x‖ := mul_one _ + +private theorem normAdmissible_comp_scaled (p : Exponent) {n : ℕ} + (T : F →L[ℝ] E) (hT : 0 < ‖T‖) (φ : Fin n → Dual E) + (hφ : NormAdmissible p φ) : + NormAdmissible p (fun i => ‖T‖⁻¹ • (φ i).comp T) := by + intro x hx + have hfun : (fun i => (‖T‖⁻¹ • (φ i).comp T) x) = + (fun i => ‖T‖⁻¹ * φ i (T x)) := by + funext i + rfl + rw [hfun, scalarPSum_smul, abs_of_pos (inv_pos.mpr hT)] + have hadm := normAdmissible_eval_le_norm p φ hφ (T x) + have hop := T.le_opNorm x + have hle : ‖T x‖ ≤ ‖T‖ := by + calc + ‖T x‖ ≤ ‖T‖ * ‖x‖ := hop + _ ≤ ‖T‖ * 1 := mul_le_mul_of_nonneg_left hx (norm_nonneg T) + _ = ‖T‖ := mul_one _ + calc + ‖T‖⁻¹ * scalarPSum p (fun i => φ i (T x)) ≤ ‖T‖⁻¹ * ‖T x‖ := + mul_le_mul_of_nonneg_left hadm (le_of_lt (inv_pos.mpr hT)) + _ ≤ ‖T‖⁻¹ * ‖T‖ := mul_le_mul_of_nonneg_left hle (le_of_lt (inv_pos.mpr hT)) + _ = 1 := inv_mul_cancel₀ hT.ne' + +/-- The extended free p-norm of a real function on the full dual (equations (2.1)–(2.2)). +For finite p, take the supremum of scalar p-sums over all admissible finite dual families. +At ∞, take the supremum of absolute values on the dual unit ball. Values lie in `ℝ≥0∞` +so that functions outside the finite-norm model retain their infinite norm. -/ +def freeNormExt (p : Exponent) (f : Dual E → ℝ) : ℝ≥0∞ := + if p.1 = ⊤ then ⨆ (φ : Dual E) (_ : ‖φ‖ ≤ 1), ENNReal.ofReal |f φ| + else ⨆ (n : ℕ) (φ : Fin n → Dual E) (_ : NormAdmissible p φ), + ENNReal.ofReal (scalarPSum p (fun i => f (φ i))) + +/-- The extended free norm of evaluation at x is bounded by the norm of x. +The matching lower bound is supplied by Hahn–Banach in `freeNormExt_eval_eq`. -/ +theorem freeNormExt_eval_le (p : Exponent) (x : E) : + freeNormExt p (fun φ : Dual E => φ x) ≤ ENNReal.ofReal ‖x‖ := by + by_cases htop : p.1 = ⊤ + · rw [freeNormExt, ite_eq_left htop] + refine iSup_le fun φ => iSup_le fun hφ => ?_ + apply ENNReal.ofReal_le_ofReal + calc + |φ x| = ‖φ x‖ := (Real.norm_eq_abs _).symm + _ ≤ ‖φ‖ * ‖x‖ := φ.le_opNorm x + _ ≤ ‖x‖ := by nlinarith [norm_nonneg x] + · rw [freeNormExt, ite_eq_right htop] + refine iSup_le fun n => iSup_le fun φ => iSup_le fun hφ => ?_ + exact ENNReal.ofReal_le_ofReal (normAdmissible_eval_le_norm p φ hφ x) + +/-- Evaluation at a dual functional in the unit ball is bounded by the extended +free norm, with no homogeneity or finiteness assumption on the function. -/ +theorem ofReal_abs_le_freeNormExt (p : Exponent) (f : Dual E → ℝ) + (φ : Dual E) (hφ : ‖φ‖ ≤ 1) : + ENNReal.ofReal |f φ| ≤ freeNormExt p f := by + by_cases htop : p.1 = ⊤ + · rw [freeNormExt, ite_eq_left htop] + exact le_iSup_of_le φ (le_iSup_of_le hφ le_rfl) + · rw [freeNormExt, ite_eq_right htop] + have hsingleton := normAdmissible_singleton p φ hφ + have hle : ENNReal.ofReal (scalarPSum p (fun _ : Fin 1 => f φ)) ≤ + ⨆ (n : ℕ) (ψ : Fin n → Dual E) (_ : NormAdmissible p ψ), + ENNReal.ofReal (scalarPSum p (fun i => f (ψ i))) := by + exact le_iSup_of_le (1 : ℕ) (le_iSup_of_le (fun _ : Fin 1 => φ) + (le_iSup_of_le hsingleton le_rfl)) + simpa only [scalarPSum_fin1] using hle + +/-- The endpoint supremum norm is bounded by every free p-norm. -/ +theorem freeNormExt_infinity_le (p : Exponent) (f : Dual E → ℝ) : + freeNormExt Exponent.infinity f ≤ freeNormExt p f := by + rw [freeNormExt, ite_eq_left (show (Exponent.infinity : Exponent).1 = ⊤ by rfl)] + exact iSup_le fun φ => iSup_le fun hφ => ofReal_abs_le_freeNormExt p f φ hφ + +/-- Strict finite-parameter comparison of the free norms on homogeneous functions. -/ +theorem freeNormExt_mono_finite {p q : Exponent} (hpq : p < q) (hq : q.IsFinite) + (f : Dual E → ℝ) (hf : PosHomogeneous f) : freeNormExt q f ≤ freeNormExt p f := by + have hp : p.IsFinite := lt_trans hpq hq + have hpReal : 0 < p.1.toReal := ENNReal.toReal_pos_iff.mpr + ⟨lt_of_lt_of_le zero_lt_one p.2, hp⟩ + have hpqReal : p.1.toReal < q.1.toReal := + (ENNReal.toReal_lt_toReal (ne_of_lt hp) (ne_of_lt hq)).mpr hpq + rw [freeNormExt, ite_eq_right (ne_of_lt hq)] + refine iSup_le fun n => iSup_le fun φ => iSup_le fun hφ => ?_ + obtain ⟨w, hwpos, hw, heq⟩ := realPSum_weighted_exists hpReal hpqReal + (fun i : Fin n => f (φ i)) + have hψ : NormAdmissible p (fun i => w i • φ i) := + normAdmissible_weighted hpq hp hq φ hφ w hw + have hvalue : scalarPSum q (fun i => f (φ i)) = + scalarPSum p (fun i => f (w i • φ i)) := by + have hpoint (i : Fin n) : f (w i • φ i) = w i * f (φ i) := hf (w i) (hwpos i) (φ i) + simp_rw [hpoint] + simp only [scalarPSum, ite_eq_right (ne_of_lt hp), ite_eq_right (ne_of_lt hq)] + simpa only [mul_comm] using heq.symm + rw [hvalue] + rw [freeNormExt, ite_eq_right (ne_of_lt hp)] + exact le_iSup_of_le n (le_iSup_of_le (fun i => w i • φ i) + (le_iSup_of_le hψ le_rfl)) + +/-- The free norms of homogeneous functions decrease with the exponent. -/ +theorem freeNormExt_mono {p q : Exponent} (hpq : p ≤ q) + (f : Dual E → ℝ) (hf : PosHomogeneous f) : freeNormExt q f ≤ freeNormExt p f := by + by_cases heq : p = q + · subst q + exact le_rfl + by_cases htop : q.1 = ⊤ + · have hq : q = Exponent.infinity := Subtype.ext htop + subst q + exact freeNormExt_infinity_le p f + · have hq : q.IsFinite := lt_top_iff_ne_top.mpr htop + have hlt : p < q := lt_of_le_of_ne hpq heq + exact freeNormExt_mono_finite hlt hq f hf + +/-- Evaluation at x has extended free norm exactly equal to the norm of x. +This is the norm identity underlying the canonical isometry `delta`. -/ +theorem freeNormExt_eval_eq (p : Exponent) (x : E) : + freeNormExt p (fun φ : Dual E => φ x) = ENNReal.ofReal ‖x‖ := by + apply le_antisymm (freeNormExt_eval_le p x) + obtain ⟨φ, hφnorm, hφx⟩ := exists_dual_vector'' ℝ x + have hle := ofReal_abs_le_freeNormExt p (fun ψ : Dual E => ψ x) φ hφnorm + simpa [hφx, Real.norm_eq_abs, abs_of_nonneg (norm_nonneg x)] using hle + +/-- The zero function has zero extended free norm at every exponent. -/ +theorem freeNormExt_zero (p : Exponent) : + freeNormExt p (fun _ : Dual E => 0) = 0 := by + unfold freeNormExt + split_ifs + · simp + · simp only [ENNReal.iSup_eq_zero, ENNReal.ofReal_eq_zero] + intro n φ hφ + change scalarPSum p (0 : Fin n → ℝ) ≤ 0 + rw [scalarPSum_eq_piLp_norm] + exact le_of_eq (norm_zero) + +/-- The extended free norm is absolutely homogeneous, with multiplication in `ℝ≥0∞`. +The formula includes the zero scalar and functions of infinite free norm. -/ +theorem freeNormExt_smul (p : Exponent) (c : ℝ) (f : Dual E → ℝ) : + freeNormExt p (c • f) = ENNReal.ofReal |c| * freeNormExt p f := by + by_cases htop : p.1 = ⊤ + · simp only [freeNormExt, htop, ↓reduceIte] + rw [ENNReal.mul_iSup] + congr with φ + rw [ENNReal.mul_iSup] + congr with hφ + simp [Pi.smul_apply, smul_eq_mul, abs_mul, + ENNReal.ofReal_mul (abs_nonneg c)] + · simp only [freeNormExt, htop, ↓reduceIte] + rw [ENNReal.mul_iSup] + congr with n + rw [ENNReal.mul_iSup] + congr with φ + rw [ENNReal.mul_iSup] + congr with hφ + simp [Pi.smul_apply, smul_eq_mul, scalarPSum_smul, + ENNReal.ofReal_mul (abs_nonneg c)] + +/-- The extended free norm satisfies the triangle inequality for arbitrary dual functions. -/ +theorem freeNormExt_add_le (p : Exponent) (f g : Dual E → ℝ) : + freeNormExt p (f + g) ≤ freeNormExt p f + freeNormExt p g := by + by_cases htop : p.1 = ⊤ + · rw [freeNormExt, ite_eq_left htop] + refine iSup_le fun φ => iSup_le fun hφ => ?_ + calc + ENNReal.ofReal |(f + g) φ| ≤ ENNReal.ofReal (|f φ| + |g φ|) := by + apply ENNReal.ofReal_le_ofReal + simpa using abs_add_le (f φ) (g φ) + _ = ENNReal.ofReal |f φ| + ENNReal.ofReal |g φ| := by + rw [ENNReal.ofReal_add (abs_nonneg _) (abs_nonneg _)] + _ ≤ freeNormExt p f + freeNormExt p g := by + apply add_le_add + all_goals rw [freeNormExt, ite_eq_left htop] + all_goals exact le_iSup_of_le φ (le_iSup_of_le hφ le_rfl) + · rw [freeNormExt, ite_eq_right htop] + refine iSup_le fun n => iSup_le fun φ => iSup_le fun hφ => ?_ + calc + ENNReal.ofReal (scalarPSum p (fun i => (f + g) (φ i))) ≤ + ENNReal.ofReal (scalarPSum p (fun i => f (φ i)) + + scalarPSum p (fun i => g (φ i))) := by + apply ENNReal.ofReal_le_ofReal + simpa only [Pi.add_apply] using + scalarPSum_add_le p (fun i => f (φ i)) (fun i => g (φ i)) + _ = ENNReal.ofReal (scalarPSum p (fun i => f (φ i))) + + ENNReal.ofReal (scalarPSum p (fun i => g (φ i))) := by + rw [ENNReal.ofReal_add (scalarPSum_nonneg ..) (scalarPSum_nonneg ..)] + _ ≤ freeNormExt p f + freeNormExt p g := by + apply add_le_add + all_goals rw [freeNormExt, ite_eq_right htop] + all_goals exact le_iSup_of_le n (le_iSup_of_le φ (le_iSup_of_le hφ le_rfl)) + +/-- Pointwise domination in absolute value implies domination of extended free norms. -/ +theorem freeNormExt_mono_abs (p : Exponent) {f g : Dual E → ℝ} + (h : ∀ φ, |f φ| ≤ |g φ|) : freeNormExt p f ≤ freeNormExt p g := by + by_cases htop : p.1 = ⊤ + · rw [freeNormExt, ite_eq_left htop, freeNormExt, ite_eq_left htop] + refine iSup_le fun φ => iSup_le fun hφ => ?_ + exact (ENNReal.ofReal_le_ofReal (h φ)).trans + (le_iSup_of_le φ (le_iSup_of_le hφ le_rfl)) + · rw [freeNormExt, ite_eq_right htop, freeNormExt, ite_eq_right htop] + refine iSup_le fun n => iSup_le fun φ => iSup_le fun hφ => ?_ + exact (ENNReal.ofReal_le_ofReal + (scalarPSum_mono_abs p (fun i => f (φ i)) (fun i => g (φ i)) + (fun i => h (φ i)))).trans + (le_iSup_of_le n (le_iSup_of_le φ (le_iSup_of_le hφ le_rfl))) + +/-- Taking the pointwise absolute value leaves the extended free norm unchanged. -/ +theorem freeNormExt_abs (p : Exponent) (f : Dual E → ℝ) : + freeNormExt p (fun φ => |f φ|) = freeNormExt p f := by + apply le_antisymm + · apply freeNormExt_mono_abs + intro φ + simp + · apply freeNormExt_mono_abs + intro φ + simp + +/-- The free norm of a pointwise supremum is bounded by the sum of the two free norms. +This ensures that finite-norm homogeneous functions form a vector sublattice. -/ +theorem freeNormExt_sup_le (p : Exponent) (f g : Dual E → ℝ) : + freeNormExt p (f ⊔ g) ≤ freeNormExt p f + freeNormExt p g := by + calc + freeNormExt p (f ⊔ g) ≤ freeNormExt p (fun φ => |f φ| + |g φ|) := by + apply freeNormExt_mono_abs + intro φ + simpa [Pi.sup_apply, abs_of_nonneg + (add_nonneg (abs_nonneg (f φ)) (abs_nonneg (g φ)))] using + FVLv.abs_sup_le_add_abs (f φ) (g φ) + _ ≤ freeNormExt p (fun φ => |f φ|) + freeNormExt p (fun φ => |g φ|) := + freeNormExt_add_le p (fun φ => |f φ|) (fun φ => |g φ|) + _ = freeNormExt p f + freeNormExt p g := by + rw [freeNormExt_abs, freeNormExt_abs] +/-- Section 2: H_p[E] is the actual finite-norm part of H[E]. -/ +def finiteNormSublattice (p : Exponent) (E : Type u) + [NormedAddCommGroup E] [NormedSpace ℝ E] : VectorSublattice (Dual E → ℝ) where + toSubmodule := { + carrier := {f | PosHomogeneous f ∧ freeNormExt p f < ⊤} + zero_mem' := by + refine ⟨?_, ?_⟩ + · simp [PosHomogeneous] + · change freeNormExt p (fun _ : Dual E => 0) < ⊤ + rw [freeNormExt_zero] + norm_num + add_mem' := by + intro f g hf hg + refine ⟨(homogeneousSublattice E).add_mem hf.1 hg.1, ?_⟩ + exact (freeNormExt_add_le p f g).trans_lt + (lt_top_iff_ne_top.mpr + (ENNReal.add_ne_top.mpr ⟨ne_of_lt hf.2, ne_of_lt hg.2⟩)) + smul_mem' := by + intro c f hf + refine ⟨(homogeneousSublattice E).smul_mem c hf.1, ?_⟩ + rw [freeNormExt_smul] + exact ENNReal.mul_lt_top ENNReal.ofReal_lt_top hf.2 } + sup_mem' := by + intro f g hf hg + refine ⟨(homogeneousSublattice E).sup_mem hf.1 hg.1, ?_⟩ + exact (freeNormExt_sup_le p f g).trans_lt + (lt_top_iff_ne_top.mpr + (ENNReal.add_ne_top.mpr ⟨ne_of_lt hf.2, ne_of_lt hg.2⟩)) + +/-- The Banach lattice H_p[E] of positively homogeneous functions with finite free norm. +This type synonym carries the free norm topology, independently of the product topology +on all dual functions. Its underlying carrier is `finiteNormSublattice p E`. -/ +def HP (p : Exponent) (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] : Type u := + finiteNormSublattice p E + +instance (p : Exponent) : AddCommGroup (HP p E) := + inferInstanceAs (AddCommGroup (finiteNormSublattice p E)) +instance (p : Exponent) : Module ℝ (HP p E) := + inferInstanceAs (Module ℝ (finiteNormSublattice p E)) +instance (p : Exponent) : Lattice (HP p E) := + inferInstanceAs (Lattice (finiteNormSublattice p E)) +instance (p : Exponent) : IsOrderedAddMonoid (HP p E) := + inferInstanceAs (IsOrderedAddMonoid (finiteNormSublattice p E)) +instance (p : Exponent) : VectorLattice (HP p E) := + inferInstanceAs (VectorLattice (finiteNormSublattice p E)) + +instance (p : Exponent) : CoeFun (HP p E) (fun _ => Dual E → ℝ) := ⟨fun f => f.1⟩ +instance (p : Exponent) : Norm (HP p E) := ⟨fun f => (freeNormExt p f.1).toReal⟩ + +-- Opaque norm proofs keep the instance value small during later type-class normalization. +private theorem hp_norm_smul (p : Exponent) (c : ℝ) (f : HP p E) : + ‖c • f‖ = ‖c‖ * ‖f‖ := by + change (freeNormExt p (c • (f : Dual E → ℝ))).toReal = + ‖c‖ * (freeNormExt p f.1).toReal + rw [freeNormExt_smul, ENNReal.toReal_mul, + ENNReal.toReal_ofReal (abs_nonneg c), Real.norm_eq_abs] + +private theorem hp_norm_triangle (p : Exponent) (f g : HP p E) : + ‖f + g‖ ≤ ‖f‖ + ‖g‖ := by + change (freeNormExt p (f.1 + g.1)).toReal ≤ + (freeNormExt p f.1).toReal + (freeNormExt p g.1).toReal + calc + (freeNormExt p (f.1 + g.1)).toReal ≤ + (freeNormExt p f.1 + freeNormExt p g.1).toReal := by + apply ENNReal.toReal_mono + · exact ENNReal.add_ne_top.mpr ⟨ne_of_lt f.2.2, ne_of_lt g.2.2⟩ + · exact freeNormExt_add_le p f.1 g.1 + _ ≤ (freeNormExt p f.1).toReal + (freeNormExt p g.1).toReal := + ENNReal.toReal_add_le + +private theorem hp_norm_eq_zero_iff (p : Exponent) (f : HP p E) : + ‖f‖ = 0 ↔ f = 0 := by + constructor + · intro hnorm + have hzero : freeNormExt p f.1 = 0 := by + have hfin : freeNormExt p f.1 ≠ ⊤ := ne_of_lt f.2.2 + exact (ENNReal.toReal_eq_zero_iff _).mp hnorm |>.resolve_right hfin + apply Subtype.ext + funext φ + change f.1 φ = 0 + let ψ : Dual E := ‖φ‖⁻¹ • φ + have hψnorm : ‖ψ‖ ≤ 1 := by + change ‖‖φ‖⁻¹ • φ‖ ≤ 1 + exact mem_closedBall_zero_iff.mp (inv_norm_smul_mem_unitClosedBall φ) + have hψval : f.1 ψ = 0 := by + have hle := ofReal_abs_le_freeNormExt p f.1 ψ hψnorm + rw [hzero] at hle + have habs : |f.1 ψ| ≤ 0 := + (ENNReal.ofReal_eq_zero.mp (le_zero_iff.mp hle)) + exact abs_eq_zero.mp (le_antisymm habs (abs_nonneg _)) + by_cases hφ : φ = 0 + · subst φ + have hz := f.2.1 0 (le_refl 0) (0 : Dual E) + simpa using hz + · have hφnorm : ‖φ‖ ≠ 0 := norm_ne_zero_iff.mpr hφ + have hsmul : ‖φ‖ • ψ = φ := by + dsimp [ψ] + rw [smul_smul, mul_inv_cancel₀ hφnorm, one_smul] + rw [← hsmul, f.2.1 ‖φ‖ (norm_nonneg _) ψ, hψval, mul_zero] + · intro hf + subst f + change (freeNormExt p (fun _ : Dual E => 0)).toReal = 0 + rw [freeNormExt_zero] + rfl + +instance hpNormedAddCommGroup (p : Exponent) : NormedAddCommGroup (HP p E) := + NormedAddCommGroup.ofCore (𝕜 := ℝ) { + norm_nonneg := fun _ => ENNReal.toReal_nonneg + norm_smul := by exact hp_norm_smul p + norm_triangle := by exact hp_norm_triangle p + norm_eq_zero_iff := by exact hp_norm_eq_zero_iff p } + +instance hpNormedVectorLattice (p : Exponent) : NormedVectorLattice (HP p E) where + toVectorLattice := inferInstance + solid := by + intro f g hfg + change (freeNormExt p f.1).toReal ≤ (freeNormExt p g.1).toReal + exact ENNReal.toReal_mono (ne_of_lt g.2.2) + (freeNormExt_mono_abs p (fun φ => hfg φ)) + norm_smul := by exact hp_norm_smul p + +private theorem hp_unit_eval_le (p : Exponent) (f : HP p E) (φ : Dual E) + (hφ : ‖φ‖ ≤ 1) : |f φ| ≤ ‖f‖ := by + change |f.1 φ| ≤ (freeNormExt p f.1).toReal + exact (ENNReal.ofReal_le_iff_le_toReal (ne_of_lt f.2.2)).mp + (ofReal_abs_le_freeNormExt p f.1 φ hφ) + +/-- Evaluation of a finite-free-norm function at φ is bounded by the product of the +operator norm of φ and the free norm of the function. In particular, evaluation is continuous. -/ +theorem hp_apply_abs_le (p : Exponent) (f : HP p E) (φ : Dual E) : + |f φ| ≤ ‖φ‖ * ‖f‖ := by + let ψ : Dual E := ‖φ‖⁻¹ • φ + have hψ : ‖ψ‖ ≤ 1 := by + change ‖‖φ‖⁻¹ • φ‖ ≤ 1 + exact mem_closedBall_zero_iff.mp (inv_norm_smul_mem_unitClosedBall φ) + by_cases hφ : φ = 0 + · subst φ + have hz := f.2.1 0 (le_refl 0) (0 : Dual E) + simpa using hz + · have hφnorm : ‖φ‖ ≠ 0 := norm_ne_zero_iff.mpr hφ + have hsmul : ‖φ‖ • ψ = φ := by + dsimp [ψ] + rw [smul_smul, mul_inv_cancel₀ hφnorm, one_smul] + have hfun : f φ = ‖φ‖ * f ψ := by + calc + f φ = f (‖φ‖ • ψ) := congrArg f hsmul.symm + _ = ‖φ‖ * f ψ := f.2.1 ‖φ‖ (norm_nonneg _) ψ + calc + |f φ| = |‖φ‖ * f ψ| := by rw [hfun] + _ = ‖φ‖ * |f ψ| := by rw [abs_mul, abs_of_nonneg (norm_nonneg φ)] + _ ≤ ‖φ‖ * ‖f‖ := mul_le_mul_of_nonneg_left (hp_unit_eval_le p f ψ hψ) + (norm_nonneg φ) + +/-- Continuous evaluation of a finite-free-norm homogeneous function at a dual vector. -/ +def hpEvaluation (p : Exponent) (φ : Dual E) : HP p E →L[ℝ] ℝ := + ({ toFun := fun f : HP p E => f φ + map_add' := by intros; rfl + map_smul' := by intros; rfl } : HP p E →ₗ[ℝ] ℝ).mkContinuous + ‖φ‖ (by + intro f + change |f φ| ≤ ‖φ‖ * ‖f‖ + exact hp_apply_abs_le p f φ) + +private theorem hp_admissible_eval_le (p : Exponent) (hptop : p.1 ≠ ⊤) + (f : HP p E) {n : ℕ} (φ : Fin n → Dual E) (hφ : NormAdmissible p φ) : + scalarPSum p (fun i => f (φ i)) ≤ ‖f‖ := by + have hle : ENNReal.ofReal (scalarPSum p (fun i => f (φ i))) ≤ freeNormExt p f.1 := by + rw [freeNormExt, ite_eq_right hptop] + exact le_iSup_of_le n (le_iSup_of_le φ (le_iSup_of_le hφ le_rfl)) + exact (ENNReal.ofReal_le_iff_le_toReal (ne_of_lt f.2.2)).mp hle + +private theorem hp_limit_sub_bound (p : Exponent) (u : ℕ → HP p E) + (g : Dual E → ℝ) (hg : ∀ φ, Filter.Tendsto (fun m => u m φ) atTop (𝓝 (g φ))) + (N : ℕ) (r : ℝ) (hN : ∀ᶠ m in atTop, ‖u m - u N‖ ≤ r) : + freeNormExt p (g - (u N : Dual E → ℝ)) ≤ ENNReal.ofReal r := by + by_cases hptop : p.1 = ⊤ + · rw [freeNormExt, ite_eq_left hptop] + refine iSup_le fun φ => iSup_le fun hφ => ?_ + apply ENNReal.ofReal_le_ofReal + have ht : Filter.Tendsto (fun m => |(u m - u N) φ|) atTop + (𝓝 |g φ - u N φ|) := by + have hd : Filter.Tendsto (fun m => (u m - u N) φ) atTop + (𝓝 (g φ - u N φ)) := by + convert (hg φ).sub tendsto_const_nhds using 1 + funext m + rfl + exact (continuous_abs.tendsto _).comp hd + have hbound : ∀ᶠ m in atTop, |(u m - u N) φ| ≤ r := by + filter_upwards [hN] with m hm + exact (hp_unit_eval_le p (u m - u N) φ hφ).trans hm + exact le_of_tendsto ht hbound + · rw [freeNormExt, ite_eq_right hptop] + refine iSup_le fun n => iSup_le fun φ => iSup_le fun hφ => ?_ + apply ENNReal.ofReal_le_ofReal + have hcoords : Filter.Tendsto + (fun m : ℕ => fun i : Fin n => (u m - u N) (φ i)) atTop + (𝓝 (fun i : Fin n => g (φ i) - u N (φ i))) := by + apply tendsto_pi_nhds.mpr + intro i + convert (hg (φ i)).sub tendsto_const_nhds using 1 + funext m + rfl + have ht : Filter.Tendsto + (fun m => scalarPSum p (fun i : Fin n => (u m - u N) (φ i))) atTop + (𝓝 (scalarPSum p (fun i : Fin n => g (φ i) - u N (φ i)))) := + ((continuous_scalarPSum p).tendsto _).comp hcoords + have hbound : ∀ᶠ m in atTop, + scalarPSum p (fun i : Fin n => (u m - u N) (φ i)) ≤ r := by + filter_upwards [hN] with m hm + exact (hp_admissible_eval_le p hptop (u m - u N) φ hφ).trans hm + exact le_of_tendsto ht hbound + +instance hpCompleteSpace (p : Exponent) : CompleteSpace (HP p E) := by + refine Metric.complete_of_cauchySeq_tendsto fun u hu => ?_ + have hpoint : ∀ φ : Dual E, CauchySeq (fun n => u n φ) := by + intro φ + have hc := (hpEvaluation p φ).uniformContinuous.comp_cauchySeq hu + change CauchySeq (fun n => u n φ) at hc + exact hc + choose g hg using fun φ => cauchySeq_tendsto_of_complete (hpoint φ) + have hg_pos : PosHomogeneous g := by + intro a ha φ + have ht : Filter.Tendsto (fun n => u n (a • φ)) atTop (𝓝 (a * g φ)) := by + convert tendsto_const_nhds.mul (hg φ) using 1 + funext n + exact (u n).2.1 a ha φ + exact tendsto_nhds_unique (hg (a • φ)) ht + have huMetric := Metric.cauchySeq_iff.mp hu + have hg_fin : freeNormExt p g < ⊤ := by + obtain ⟨N, hN⟩ := huMetric 1 zero_lt_one + have htail : ∀ᶠ m in atTop, ‖u m - u N‖ ≤ (1 : ℝ) := by + filter_upwards [Filter.eventually_atTop.2 ⟨N, fun m hm => hm⟩] with m hm + exact le_of_lt (by simpa [dist_eq_norm] using hN m hm N le_rfl) + have hdiff : freeNormExt p (g - (u N : Dual E → ℝ)) ≤ ENNReal.ofReal 1 := + hp_limit_sub_bound p u g hg N 1 htail + have hdiff_lt : freeNormExt p (g - (u N : Dual E → ℝ)) < ⊤ := + lt_of_le_of_lt hdiff (lt_top_iff_ne_top.mpr ENNReal.ofReal_ne_top) + have hg_le : freeNormExt p g ≤ + freeNormExt p (g - (u N : Dual E → ℝ)) + + freeNormExt p (u N : Dual E → ℝ) := by + simpa [sub_add_cancel] using + freeNormExt_add_le p (g - (u N : Dual E → ℝ)) (u N : Dual E → ℝ) + exact lt_of_le_of_lt hg_le + (lt_top_iff_ne_top.mpr + (ENNReal.add_ne_top.mpr ⟨ne_of_lt hdiff_lt, ne_of_lt (u N).2.2⟩)) + let gHP : HP p E := ⟨g, hg_pos, hg_fin⟩ + refine ⟨gHP, ?_⟩ + rw [Metric.tendsto_atTop] + intro ε hε + obtain ⟨N, hN⟩ := huMetric (ε / 2) (by linarith) + refine ⟨N, fun n hn => ?_⟩ + rw [dist_eq_norm] + have htail : ∀ᶠ m in atTop, ‖u m - u n‖ ≤ ε / 2 := by + filter_upwards [Filter.eventually_atTop.2 ⟨N, fun m hm => hm⟩] with m hm + exact le_of_lt (by simpa [dist_eq_norm] using hN m hm n hn) + have hdiff : freeNormExt p (g - (u n : Dual E → ℝ)) ≤ ENNReal.ofReal (ε / 2) := + hp_limit_sub_bound p u g hg n (ε / 2) htail + have hnorm : ‖gHP - u n‖ ≤ ε / 2 := by + change (freeNormExt p ((gHP - u n : HP p E) : Dual E → ℝ)).toReal ≤ ε / 2 + have hcoe : ((gHP - u n : HP p E) : Dual E → ℝ) = + g - (u n : Dual E → ℝ) := rfl + rw [hcoe] + exact ENNReal.toReal_le_of_le_ofReal (by linarith) hdiff + rw [norm_sub_rev] + linarith +instance hpBanachLattice (p : Exponent) : BanachLattice (HP p E) where + toNormedVectorLattice := hpNormedVectorLattice p + toCompleteSpace := hpCompleteSpace p + +/-- Section 2: evaluation in the ambient finite-norm space. -/ +def hpEval (p : Exponent) (x : E) : HP p E := ⟨fun φ => φ x, by + refine ⟨?_, ?_⟩ + · intro a ha φ + simp + · exact (freeNormExt_eval_le p x).trans_lt ENNReal.ofReal_lt_top⟩ + +/-- The norm closure of the vector sublattice generated by evaluations inside `HP p E`. +Its subtype is `Free p E`; closure is taken for the free norm. -/ +def freeSublattice (p : Exponent) (E : Type u) + [NormedAddCommGroup E] [NormedSpace ℝ E] : VectorSublattice (HP p E) := + (VectorSublattice.generated (Set.range (hpEval p : E → HP p E))).topologicalClosure + +/-- The free p-convex Banach lattice over E, realized as the norm-closed vector sublattice +of `HP p E` generated by evaluations. The canonical embedding of E is `delta p`. -/ +abbrev Free (p : Exponent) (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] : Type u := + freeSublattice p E + +instance (p : Exponent) : CoeFun (Free p E) (fun _ => Dual E → ℝ) := + ⟨fun f => f.1.1⟩ + +instance freeBanachLattice (p : Exponent) : BanachLattice (Free p E) := + VectorSublattice.banachLatticeCoe _ + (VectorSublattice.isClosed_topologicalClosure _) + +/-- Evaluation is bounded by the dual norm times the free-lattice norm. -/ +theorem free_apply_abs_le (p : Exponent) (f : Free p E) (φ : Dual E) : + |f φ| ≤ ‖φ‖ * ‖f‖ := hp_apply_abs_le p f.1 φ + +/-- Free homogeneous functions vanish at the zero dual vector. -/ +theorem free_apply_zero (p : Exponent) (f : Free p E) : f (0 : Dual E) = 0 := by + have h := f.1.2.1 0 (le_refl 0) (0 : Dual E) + simpa only [zero_smul, zero_mul] using h + +/-- Membership in the free lattice for a full-dual function, including its homogeneity. -/ +def InFree (p : Exponent) (f : Dual E → ℝ) : Prop := + ∃ g : Free p E, ∀ φ, g φ = f φ + +/-- Section 2: the canonical evaluation isometry; its function is explicitly evaluation. -/ +def delta (p : Exponent) : E →ₗᵢ[ℝ] Free p E where + toFun x := ⟨hpEval p x, by + exact (VectorSublattice.le_topologicalClosure _) + (VectorSublattice.subset_generated _ (Set.mem_range_self x))⟩ + map_add' := by + intro x y + apply Subtype.ext + apply Subtype.ext + funext φ + exact map_add φ x y + map_smul' := by + intro c x + apply Subtype.ext + apply Subtype.ext + funext φ + exact map_smul φ c x + norm_map' := by + intro x + change (freeNormExt p (fun φ : Dual E => φ x)).toReal = ‖x‖ + rw [freeNormExt_eval_eq, ENNReal.toReal_ofReal (norm_nonneg x)] + +/-- Use BanLat's existing free vector lattice over a normed space. -/ +abbrev FVL (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] := FVLv E + +/-- Normalize a functional into BanLat's weak-star dual unit ball. -/ +def normalizedDual (φ : Dual E) : FVLv.dualUnitBall E := + ⟨StrongDual.toWeakDual (‖φ‖⁻¹ • φ), by + change ‖φ‖⁻¹ • φ ∈ Metric.closedBall (0 : Dual E) 1 + exact inv_norm_smul_mem_unitClosedBall φ⟩ + +/-- Radial extension of BanLat's unit-ball model to the full dual. -/ +def fvlFunction (v : FVL E) (φ : Dual E) : ℝ := ‖φ‖ * v (normalizedDual φ) + +/-- Evaluation on the algebraic free lattice after radial extension to the full dual. -/ +def radialEval (φ : Dual E) : VecLatHom (FVL E) ℝ where + toFun v := fvlFunction v φ + map_add' := by + intro v w + simp [fvlFunction, mul_add] + map_smul' := by + intro c v + simp [fvlFunction, mul_left_comm] + map_sup' := by + intro v w + simp [fvlFunction, mul_max_of_nonneg, norm_nonneg] + map_inf' := by + intro v w + simp [fvlFunction, mul_min_of_nonneg, norm_nonneg] + +private theorem radialEval_of (φ : Dual E) (x : E) : + radialEval φ (FVLv.of x) = φ x := by + change ‖φ‖ * (FVLv.of x) (normalizedDual φ) = φ x + rw [FVLv.of_apply] + change ‖φ‖ * (‖φ‖⁻¹ • φ) x = φ x + change ‖φ‖ * (‖φ‖⁻¹ * φ x) = φ x + by_cases hφ : φ = 0 + · subst φ + simp + · rw [← mul_assoc, mul_inv_cancel₀ (norm_ne_zero_iff.mpr hφ), one_mul] + +/-- The algebraic lift of the canonical evaluation isometry into the free Banach lattice. -/ +def liftToFree (p : Exponent) : VecLatHom (FVL E) (Free p E) := + FVLv.lift (delta p).toLinearMap + +/-- Evaluation on the free lattice as a real lattice homomorphism. -/ +def evalVecLatHom (p : Exponent) (φ : Dual E) : VecLatHom (Free p E) ℝ where + toFun f := f φ + map_add' := by intros; rfl + map_smul' := by intros; rfl + map_sup' := by intros; rfl + map_inf' := by intros; rfl + +/-- Evaluation of the algebraic free lattice on the dual unit ball. -/ +abbrev evalFVLv (ψ : FVLv.dualUnitBall E) : VecLatHom (FVL E) ℝ := + FVLv.evalHom ψ + +theorem radialEval_eq_liftToFree (p : Exponent) (φ : Dual E) (v : FVL E) : + fvlFunction v φ = liftToFree p v φ := by + let ev := evalVecLatHom p φ + have hleft : radialEval φ = FVLv.lift (φ : E →ₗ[ℝ] ℝ) := by + apply FVLv.lift_unique + intro x + exact radialEval_of φ x + have hright : ev.comp (liftToFree p) = FVLv.lift (φ : E →ₗ[ℝ] ℝ) := by + apply FVLv.lift_unique + intro x + change liftToFree p (FVLv.of x) φ = φ x + rw [liftToFree, FVLv.lift_of] + rfl + have h := DFunLike.congr_fun (hleft.trans hright.symm) v + exact h + +/-- Radial extension of an algebraic free element has finite free norm. -/ +theorem fvlFunction_mem_finiteNormSublattice (p : Exponent) (v : FVL E) : + fvlFunction v ∈ finiteNormSublattice p E := by + have hfun : fvlFunction v = (liftToFree p v).1.1 := + funext fun φ => radialEval_eq_liftToFree p φ v + rw [hfun] + exact (liftToFree p v).1.2 + +/-- The radial model of an algebraic free element belongs to the closed generated lattice. -/ +theorem fvlFunction_mem_freeSublattice (p : Exponent) (v : FVL E) : + (⟨fvlFunction v, fvlFunction_mem_finiteNormSublattice p v⟩ : HP p E) ∈ + freeSublattice p E := by + have heq : (⟨fvlFunction v, fvlFunction_mem_finiteNormSublattice p v⟩ : HP p E) = + (liftToFree p v).1 := by + apply Subtype.ext + exact funext fun φ => radialEval_eq_liftToFree p φ v + rw [heq] + exact (liftToFree p v).2 + +/-- Embed BanLat’s algebraic free vector lattice into `Free p E` by radial extension from +the dual unit ball. The embedding preserves lattice operations, agrees with `delta` on +generators, and has norm-dense range. -/ +def ofFVL (p : Exponent) : VecLatHom (FVL E) (Free p E) where + toFun v := ⟨⟨fvlFunction v, fvlFunction_mem_finiteNormSublattice p v⟩, + fvlFunction_mem_freeSublattice p v⟩ + map_add' := by + intro v w + apply Subtype.ext + apply Subtype.ext + funext φ + change fvlFunction (v + w) φ = fvlFunction v φ + fvlFunction w φ + simp [fvlFunction, mul_add] + map_smul' := by + intro c v + apply Subtype.ext + apply Subtype.ext + funext φ + change fvlFunction (c • v) φ = c * fvlFunction v φ + simp [fvlFunction, mul_left_comm] + map_sup' := by + intro v w + apply Subtype.ext + apply Subtype.ext + funext φ + change fvlFunction (v ⊔ w) φ = max (fvlFunction v φ) (fvlFunction w φ) + simp [fvlFunction, mul_max_of_nonneg, norm_nonneg] + map_inf' := by + intro v w + apply Subtype.ext + apply Subtype.ext + funext φ + change fvlFunction (v ⊓ w) φ = min (fvlFunction v φ) (fvlFunction w φ) + simp [fvlFunction, mul_min_of_nonneg, norm_nonneg] + +private theorem ofFVL_eq_liftToFree (p : Exponent) : + (ofFVL p (E := E)) = liftToFree p := by + apply DFunLike.ext + intro v + apply Subtype.ext + apply Subtype.ext + funext φ + exact radialEval_eq_liftToFree p φ v + +/-- The algebraic generator at x maps to the canonical evaluation `delta p x`. -/ +theorem ofFVL_of (p : Exponent) (x : E) : + ofFVL p (FVLv.of x) = delta p x := by + rw [ofFVL_eq_liftToFree] + exact FVLv.lift_of (delta p).toLinearMap x + +private theorem ofFVL_apply_ball (p : Exponent) (v : FVL E) + (ψ : FVLv.dualUnitBall E) : + ofFVL p v (WeakDual.toStrongDual ψ.1) = v ψ := by + let φ : Dual E := WeakDual.toStrongDual ψ.1 + have hleft : (evalVecLatHom p φ).comp (ofFVL p) = + FVLv.lift (φ : E →ₗ[ℝ] ℝ) := by + apply FVLv.lift_unique + intro x + rw [VecLatHom.comp_apply, ofFVL_of] + rfl + have hright : evalFVLv ψ = FVLv.lift (φ : E →ₗ[ℝ] ℝ) := by + apply FVLv.lift_unique + intro x + change (FVLv.of x) ψ = φ x + rw [FVLv.of_apply] + rfl + exact DFunLike.congr_fun (hleft.trans hright.symm) v + +private theorem continuous_llExpr_dual_eval {n : ℕ} (x : Fin n → E) (e : LLexpr n) : + Continuous (fun φ : Dual E => LLexpr.eval (fun i => φ (x i)) e) := by + induction e with + | zero => exact continuous_const + | var i => exact (ContinuousLinearMap.apply ℝ ℝ (x i)).continuous + | add e₁ e₂ h₁ h₂ => exact h₁.add h₂ + | smul c e h => exact continuous_const.mul h + | sup e₁ e₂ h₁ h₂ => exact h₁.sup h₂ + | inf e₁ e₂ h₁ h₂ => exact h₁.inf h₂ + +private theorem continuous_llExpr_weak_eval {n : ℕ} (x : Fin n → E) (e : LLexpr n) : + Continuous (fun φ : WeakDual ℝ E => LLexpr.eval (fun i => φ (x i)) e) := by + induction e with + | zero => exact continuous_const + | var i => exact WeakDual.eval_continuous (x i) + | add e₁ e₂ h₁ h₂ => exact h₁.add h₂ + | smul c e h => exact continuous_const.mul h + | sup e₁ e₂ h₁ h₂ => exact h₁.sup h₂ + | inf e₁ e₂ h₁ h₂ => exact h₁.inf h₂ + +private theorem ofFVL_expr_apply (p : Exponent) {n : ℕ} (x : Fin n → E) + (e : LLexpr n) (φ : Dual E) : + ofFVL p (LLexpr.eval (fun i => FVLv.of (x i)) e) φ = + LLexpr.eval (fun i => φ (x i)) e := by + have hmap := LLexpr.map_eval ((evalVecLatHom p φ).comp (ofFVL p)) + (fun i => FVLv.of (x i)) e + change ofFVL p (LLexpr.eval (fun i => FVLv.of (x i)) e) φ = + LLexpr.eval (fun i => ofFVL p (FVLv.of (x i)) φ) e at hmap + simpa [ofFVL_of, delta, hpEval] using hmap + +private theorem ofFVL_norm_continuous (p : Exponent) (v : FVL E) : + Continuous (fun φ : Dual E => ofFVL p v φ) := by + obtain ⟨n, x, e, he⟩ := FVLv.exists_eval_of_eq v + rw [← he] + have hfun : (fun φ : Dual E => + ofFVL p (LLexpr.eval (fun i => FVLv.of (x i)) e) φ) = + (fun φ : Dual E => LLexpr.eval (fun i => φ (x i)) e) := by + funext φ + exact ofFVL_expr_apply p x e φ + rw [hfun] + exact continuous_llExpr_dual_eval x e + +private theorem ofFVL_weakstar_continuous (p : Exponent) (v : FVL E) : + Continuous (fun φ : WeakDual ℝ E => ofFVL p v (WeakDual.toStrongDual φ)) := by + obtain ⟨n, x, e, he⟩ := FVLv.exists_eval_of_eq v + rw [← he] + have hfun : (fun φ : WeakDual ℝ E => + ofFVL p (LLexpr.eval (fun i => FVLv.of (x i)) e) + (WeakDual.toStrongDual φ)) = + (fun φ : WeakDual ℝ E => LLexpr.eval (fun i => φ (x i)) e) := by + funext φ + simpa only [WeakDual.toStrongDual_apply] using + ofFVL_expr_apply p x e (WeakDual.toStrongDual φ) + rw [hfun] + exact continuous_llExpr_weak_eval x e + +private theorem free_apply_sub_le (p : Exponent) (f g : Free p E) (φ : Dual E) : + |f φ - g φ| ≤ ‖φ‖ * ‖f - g‖ := by + have h := hp_apply_abs_le p (f.1 - g.1) φ + change |f φ - g φ| ≤ ‖φ‖ * ‖f - g‖ at h + exact h + +/-- Section 2: explicit evaluation and radial-extension bridges. -/ +theorem model_evaluation (p : Exponent) (x : E) (v : FVL E) (φ : Dual E) : + delta p x φ = φ x ∧ ofFVL p v φ = fvlFunction v φ := by + exact ⟨rfl, rfl⟩ + +/-- Section 2: pointwise order in the full-dual representation. -/ +theorem free_le_iff (p : Exponent) (f g : Free p E) : + f ≤ g ↔ ∀ φ, f φ ≤ g φ := by rfl + +/-- Compatibility of the norm with its ENNReal formula. -/ +theorem freeNormExt_eq_norm (p : Exponent) (f : Free p E) : + freeNormExt p f = ENNReal.ofReal ‖f‖ := by + exact (ENNReal.ofReal_toReal (ne_of_lt f.1.2.2)).symm + +/-- The free vector lattice is embedded faithfully and its generators agree. -/ +theorem ofFVL_embedding (p : Exponent) : Function.Injective (ofFVL p (E := E)) ∧ + ∀ x : E, ofFVL p (FVLv.of x) = delta p x := by + refine ⟨?_, ofFVL_of p⟩ + intro v w h + apply Subtype.ext + apply ContinuousMap.ext + intro ψ + have heq := congrArg (fun f : Free p E => f (WeakDual.toStrongDual ψ.1)) h + simpa only [ofFVL_apply_ball] using heq + +/-- Section 2: norm density of the specified copy of FVL. -/ +theorem denseRange_ofFVL (p : Exponent) : DenseRange (ofFVL p (E := E)) := by + let G := VectorSublattice.generated (Set.range (hpEval p : E → HP p E)) + let C := freeSublattice p E + have hGC : G ≤ C := (VectorSublattice.generated + (Set.range (hpEval p : E → HP p E))).le_topologicalClosure + let ι : G → Free p E := Set.inclusion hGC + have hι_dense : DenseRange ι := by + change DenseRange (Set.inclusion hGC) + exact (denseRange_inclusion_iff hGC).2 (by + change (G.topologicalClosure : Set (HP p E)) ⊆ _ + rw [VectorSublattice.topologicalClosure_coe]) + have hι_range : Set.range ι ⊆ Set.range (ofFVL p (E := E)) := by + intro z hz + rcases hz with ⟨y, rfl⟩ + have hy : (y : HP p E) ∈ G := y.2 + change (y : HP p E) ∈ + (VectorSublattice.generated (Set.range (hpEval p : E → HP p E)) : + Set (HP p E)) at hy + rw [LLexpr.generated_eq_iUnion_combinations + (Set.range (hpEval p : E → HP p E))] at hy + simp only [Set.mem_iUnion, LLexpr.combinations, Set.mem_range] at hy + obtain ⟨n, z, e, hz⟩ := hy + choose x hx using fun i : Fin n => (z i).2 + refine ⟨LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e, ?_⟩ + apply Subtype.ext + have hmap : ofFVL p (LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e) = + LLexpr.eval (fun i : Fin n => delta p (x i)) e := by + simpa only [ofFVL_of] using + LLexpr.map_eval (ofFVL p) (fun i : Fin n => FVLv.of (x i)) e + calc + ((ofFVL p (LLexpr.eval (fun i : Fin n => FVLv.of (x i)) e) : Free p E) : HP p E) = + ((LLexpr.eval (fun i : Fin n => delta p (x i)) e : Free p E) : HP p E) := by + rw [hmap] + _ = LLexpr.eval (fun i : Fin n => ((delta p (x i) : Free p E) : HP p E)) e := + LLexpr.coe_eval_vectorSublattice (freeSublattice p E) + (fun i : Fin n => delta p (x i)) e + _ = LLexpr.eval (fun i : Fin n => hpEval p (x i)) e := by + congr + _ = LLexpr.eval (fun i : Fin n => (z i : HP p E)) e := by + congr + funext i + rw [hx i] + _ = (y : HP p E) := hz + apply denseRange_iff_closure_range.mpr + ext z + constructor + · intro _; trivial + · intro _ + have hz : z ∈ closure (Set.range ι) := by + rw [hι_dense.closure_range] + trivial + exact closure_mono hι_range hz + +/-- The norm of an algebraic element is the concrete extended norm’s real part. -/ +theorem norm_ofFVL_eq_toReal (p : Exponent) (v : FVL E) : + ‖ofFVL p v‖ = (freeNormExt p (fvlFunction v)).toReal := rfl + +/-- The endpoint free norm is contractive on the common algebraic free lattice. -/ +theorem norm_ofFVL_infinity_le (p : Exponent) (v : FVL E) : + ‖ofFVL Exponent.infinity v‖ ≤ ‖ofFVL p v‖ := by + rw [norm_ofFVL_eq_toReal, norm_ofFVL_eq_toReal] + exact ENNReal.toReal_mono (ne_of_lt (ofFVL p v).1.2.2) + (freeNormExt_infinity_le p (fvlFunction v)) + +/-- On the common algebraic free lattice, increasing the convexity exponent can only +decrease the free norm. This includes the target endpoint ∞. -/ +theorem norm_ofFVL_mono {p q : Exponent} (hpq : p ≤ q) (v : FVL E) : + ‖ofFVL q v‖ ≤ ‖ofFVL p v‖ := by + rw [norm_ofFVL_eq_toReal, norm_ofFVL_eq_toReal] + exact ENNReal.toReal_mono (ne_of_lt (ofFVL p v).1.2.2) + (freeNormExt_mono hpq (fvlFunction v) (ofFVL p v).1.2.1) + +/-- Evaluation on BanLat’s free Banach lattice as a real lattice homomorphism. -/ +abbrev banlatEval (ψ : FVLv.dualUnitBall E) : VecLatHom (_root_.FBL E) ℝ := + _root_.FBL.evalAtFBL ψ + +private theorem normAdmissible_one_iff_ball {n : ℕ} + (ψ : Fin n → FVLv.dualUnitBall E) : + NormAdmissible Exponent.one (fun i => WeakDual.toStrongDual (ψ i).1) ↔ + _root_.FBL.NormAdmissible E ψ := by + simp only [NormAdmissible, _root_.FBL.NormAdmissible, scalarPSum_one_eq_sum, + WeakDual.toStrongDual_apply] + +private theorem normAdmissible_one_component_norm_le {n : ℕ} + (φ : Fin n → Dual E) (hφ : NormAdmissible Exponent.one φ) (i : Fin n) : + ‖φ i‖ ≤ 1 := by + apply (φ i).opNorm_le_bound zero_le_one + intro x + rw [one_mul] + have hsum := normAdmissible_eval_le_norm Exponent.one φ hφ x + rw [scalarPSum_one_eq_sum] at hsum + have hi : |φ i x| ≤ ∑ j, |φ j x| := + Finset.single_le_sum (f := fun j : Fin n => |φ j x|) + (fun j _ => abs_nonneg _) (Finset.mem_univ i) + simpa [Real.norm_eq_abs] using hi.trans hsum + +-- Compare the plain functions before specializing to completed free-lattice elements. +private theorem freeNormExt_one_eq_of_restriction (f : Dual E → ℝ) + (g : C(FVLv.dualUnitBall E, ℝ)) + (hfg : ∀ ψ, f (WeakDual.toStrongDual ψ.1) = g ψ) : + freeNormExt Exponent.one f = _root_.FBL.freeNormExt E g := by + have htop : (Exponent.one : Exponent).1 ≠ ⊤ := by norm_num [Exponent.one] + rw [freeNormExt, ite_eq_right htop, _root_.FBL.freeNormExt] + apply le_antisymm + · refine iSup_le fun n => iSup_le fun φ => iSup_le fun hφ => ?_ + let ψ : Fin n → FVLv.dualUnitBall E := fun i => + ⟨StrongDual.toWeakDual (φ i), by + dsimp [FVLv.dualUnitBall] + simpa [Metric.mem_closedBall, dist_eq_norm] using + normAdmissible_one_component_norm_le φ hφ i⟩ + have hψ : _root_.FBL.NormAdmissible E ψ := + (normAdmissible_one_iff_ball ψ).mp (by + intro x hx + simpa only [ψ, scalarPSum_one_eq_sum, WeakDual.toStrongDual_apply, + StrongDual.toWeakDual_apply] using hφ x hx) + have heq : scalarPSum Exponent.one (fun i => f (φ i)) = ∑ i, |g (ψ i)| := by + rw [scalarPSum_one_eq_sum] + apply Finset.sum_congr rfl + intro i _ + exact congrArg abs (hfg (ψ i)) + rw [heq] + exact le_iSup_of_le n (le_iSup_of_le ψ (le_iSup_of_le hψ le_rfl)) + · refine iSup_le fun n => iSup_le fun ψ => iSup_le fun hψ => ?_ + let φ : Fin n → Dual E := fun i => WeakDual.toStrongDual (ψ i).1 + have hφ : NormAdmissible Exponent.one φ := (normAdmissible_one_iff_ball ψ).mpr hψ + have heq : (∑ i, |g (ψ i)|) = scalarPSum Exponent.one (fun i => f (φ i)) := by + rw [scalarPSum_one_eq_sum] + apply Finset.sum_congr rfl + intro i _ + exact congrArg abs (hfg (ψ i)).symm + rw [heq] + exact le_iSup_of_le n (le_iSup_of_le φ (le_iSup_of_le hφ le_rfl)) + +private theorem freeNormExt_one_ofFVL_eq_banlat (v : FVL E) : + freeNormExt Exponent.one (ofFVL Exponent.one v).1.1 = + _root_.FBL.freeNormExt E (_root_.FBL.ofFVLv v).1.1 := by + apply freeNormExt_one_eq_of_restriction + intro ψ + exact (ofFVL_apply_ball Exponent.one v ψ).trans (_root_.FBL.ofFVLv_apply v ψ).symm + +theorem norm_ofFVL_one_eq_banlat (v : FVL E) : + ‖ofFVL Exponent.one v‖ = ‖_root_.FBL.ofFVLv v‖ := by + change (freeNormExt Exponent.one (ofFVL Exponent.one v).1.1).toReal = + (_root_.FBL.freeNormExt E (_root_.FBL.ofFVLv v).1.1).toReal + rw [freeNormExt_one_ofFVL_eq_banlat] + +/-- The canonical linear isometry between the exponent-one model and BanLat’s model. -/ +def banlatLinearEquiv : + Free Exponent.one E ≃ₗᵢ[ℝ] _root_.FBL E := + (LinearEquiv.refl ℝ (FVL E)).extendOfIsometry + (ofFVL Exponent.one (E := E)).toLinearMap (_root_.FBL.ofFVLv (E := E)) + (denseRange_ofFVL Exponent.one (E := E)) + (_root_.FBL.denseRange_ofFVLv (E := E)) + (fun v => (norm_ofFVL_one_eq_banlat v).symm) + +private theorem banlat_ofFVLv_sup (v w : FVL E) : + _root_.FBL.ofFVLv (v ⊔ w) = + (_root_.FBL.ofFVLv v : _root_.FBL E) ⊔ _root_.FBL.ofFVLv w := by + change FVLv.lift (_root_.FBL.ofLinear (E := E)) (v ⊔ w) = _ + exact map_sup _ _ _ + +private theorem banlat_ofFVLv_inf (v w : FVL E) : + _root_.FBL.ofFVLv (v ⊓ w) = + (_root_.FBL.ofFVLv v : _root_.FBL E) ⊓ _root_.FBL.ofFVLv w := by + change FVLv.lift (_root_.FBL.ofLinear (E := E)) (v ⊓ w) = _ + exact map_inf _ _ _ + +private theorem banlatLinearEquiv_ofFVL (v : FVL E) : + banlatLinearEquiv (ofFVL Exponent.one v) = _root_.FBL.ofFVLv v := by + exact LinearEquiv.extendOfIsometry_eq + (LinearEquiv.refl ℝ (FVL E)) + (ofFVL Exponent.one (E := E)).toLinearMap (_root_.FBL.ofFVLv (E := E)) + (denseRange_ofFVL Exponent.one (E := E)) + (_root_.FBL.denseRange_ofFVLv (E := E)) + (fun w => (norm_ofFVL_one_eq_banlat w).symm) v + +-- Keep density arguments abstract so their proofs do not repeatedly reduce the concrete norms. +private theorem map_binary_of_dense_range {A X Y : Type*} + [TopologicalSpace X] [TopologicalSpace Y] [T2Space Y] + (i : A → X) (hi : DenseRange i) (f : X → Y) (hf : Continuous f) + (sourceOperation : X → X → X) (targetOperation : Y → Y → Y) + (hX : Continuous (fun z : X × X => sourceOperation z.1 z.2)) + (hY : Continuous (fun z : Y × Y => targetOperation z.1 z.2)) + (hcore : ∀ a b, f (sourceOperation (i a) (i b)) = targetOperation (f (i a)) (f (i b))) + (x y : X) : f (sourceOperation x y) = targetOperation (f x) (f y) := by + have heq := (hi.prodMap hi).equalizer (hf.comp hX) + (hY.comp ((hf.comp continuous_fst).prodMk (hf.comp continuous_snd))) (by + funext z + exact hcore z.1 z.2) + exact congrFun heq (x, y) + +private theorem banlatLinearEquiv_map_sup (f g : Free Exponent.one E) : + banlatLinearEquiv (f ⊔ g) = banlatLinearEquiv f ⊔ banlatLinearEquiv g := by + refine map_binary_of_dense_range + (ofFVL Exponent.one (E := E)) (denseRange_ofFVL Exponent.one) + (banlatLinearEquiv (E := E)) banlatLinearEquiv.continuous + (· ⊔ ·) (· ⊔ ·) (continuous_fst.sup continuous_snd) + (continuous_fst.sup continuous_snd) ?_ f g + intro v w + rw [← map_sup (ofFVL Exponent.one (E := E)) v w, + banlatLinearEquiv_ofFVL, banlatLinearEquiv_ofFVL, + banlatLinearEquiv_ofFVL, banlat_ofFVLv_sup] + +private theorem banlatLinearEquiv_map_inf (f g : Free Exponent.one E) : + banlatLinearEquiv (f ⊓ g) = banlatLinearEquiv f ⊓ banlatLinearEquiv g := by + refine map_binary_of_dense_range + (ofFVL Exponent.one (E := E)) (denseRange_ofFVL Exponent.one) + (banlatLinearEquiv (E := E)) banlatLinearEquiv.continuous + (· ⊓ ·) (· ⊓ ·) (continuous_fst.inf continuous_snd) + (continuous_fst.inf continuous_snd) ?_ f g + intro v w + rw [← map_inf (ofFVL Exponent.one (E := E)) v w, + banlatLinearEquiv_ofFVL, banlatLinearEquiv_ofFVL, + banlatLinearEquiv_ofFVL, banlat_ofFVLv_inf] + +private theorem banlat_eval_abs_le_norm (g : _root_.FBL E) + (ψ : FVLv.dualUnitBall E) : |g ψ| ≤ ‖g‖ := by + have hψnorm : ‖WeakDual.toStrongDual ψ.1‖ ≤ 1 := by + have hψmem := ψ.property + change WeakDual.toStrongDual ψ.1 ∈ Metric.closedBall (0 : Dual E) 1 at hψmem + simpa [Metric.mem_closedBall, dist_eq_norm] using hψmem + have hAdm : _root_.FBL.NormAdmissible E (fun _ : Fin 1 => ψ) := + (normAdmissible_one_iff_ball (fun _ : Fin 1 => ψ)).mp + (normAdmissible_singleton Exponent.one _ hψnorm) + have hle : ENNReal.ofReal |g ψ| ≤ _root_.FBL.freeNormExt E g.1.1 := by + have h : ENNReal.ofReal + (∑ i : Fin 1, |g ((fun _ : Fin 1 => ψ) i)|) ≤ + _root_.FBL.freeNormExt E g.1.1 := by + rw [_root_.FBL.freeNormExt] + exact le_iSup_of_le (1 : ℕ) + (le_iSup_of_le (fun _ : Fin 1 => ψ) (le_iSup_of_le hAdm le_rfl)) + simpa using h + have hreal := (ENNReal.ofReal_le_iff_le_toReal (ne_of_lt g.1.2)).mp hle + exact hreal + +/-- Continuous evaluation on BanLat’s free Banach lattice at a dual-ball point. -/ +def banlatEvaluation (ψ : FVLv.dualUnitBall E) : _root_.FBL E →L[ℝ] ℝ := + ({ toFun := fun g => g ψ + map_add' := by intros; rfl + map_smul' := by intros; rfl } : _root_.FBL E →ₗ[ℝ] ℝ).mkContinuous 1 (by + intro g + change |g ψ| ≤ 1 * ‖g‖ + simpa only [one_mul] using banlat_eval_abs_le_norm g ψ) + +private theorem banlatLinearEquiv_apply (f : Free Exponent.one E) + (ψ : FVLv.dualUnitBall E) : + banlatLinearEquiv f ψ = f (WeakDual.toStrongDual ψ.1) := by + let φ : Dual E := WeakDual.toStrongDual ψ.1 + let e : FVL E → Free Exponent.one E := ofFVL Exponent.one + have hcL : Continuous (fun g : Free Exponent.one E => banlatLinearEquiv g ψ) := + (banlatEvaluation ψ).continuous.comp banlatLinearEquiv.continuous + have hcR : Continuous (fun g : Free Exponent.one E => g φ) := + (hpEvaluation Exponent.one φ).continuous.comp continuous_subtype_val + have hEq := (denseRange_ofFVL Exponent.one (E := E)).equalizer hcL hcR (by + funext v + change banlatLinearEquiv (ofFVL Exponent.one v) ψ = + ofFVL Exponent.one v φ + rw [banlatLinearEquiv_ofFVL, _root_.FBL.ofFVLv_apply] + exact (ofFVL_apply_ball Exponent.one v ψ).symm) + exact congrFun hEq f + +/-- Bridge to BanLat's completed ordinary free Banach lattice, at p = 1. -/ +theorem banlat_fbl_identification : + ∃ U : BanachLatEquiv (Free Exponent.one E) (_root_.FBL E), + ∀ (f : Free Exponent.one E) (φ : FVLv.dualUnitBall E), + U f φ = f (WeakDual.toStrongDual φ.1) := by + let U : BanachLatEquiv (Free Exponent.one E) (_root_.FBL E) := { + toLinearIsometryEquiv := banlatLinearEquiv + map_sup' := banlatLinearEquiv_map_sup + map_inf' := banlatLinearEquiv_map_inf } + exact ⟨U, fun f φ => banlatLinearEquiv_apply f φ⟩ + +/-- Full-dual homogeneous functions continuous on the weak-star unit ball. -/ +def WeakStarContinuousOnBall (f : Dual E → ℝ) : Prop := + Continuous (fun φ : FVLv.dualUnitBall E => f (WeakDual.toStrongDual φ.1)) + +/-- Section 2: weak-star continuity on every bounded dual ball. -/ +theorem weakStar_continuous_bounded (p : Exponent) (f : Free p E) (R : ℝ) : + ContinuousOn (fun φ : WeakDual ℝ E => f (WeakDual.toStrongDual φ)) + {φ | ‖WeakDual.toStrongDual φ‖ ≤ R} := by + apply continuousOn_of_uniform_approx_of_continuousOn + intro U hU + obtain ⟨ε, hε, hUε⟩ := Metric.mem_uniformity_dist.mp hU + let B : ℝ := max R 0 + 1 + have hB : 0 < B := by dsimp [B]; positivity + obtain ⟨v, hv⟩ := (denseRange_ofFVL p).exists_dist_lt f + (show 0 < ε / B by positivity) + let g : Free p E := ofFVL p v + have hnorm : ‖f - g‖ < ε / B := by + simpa only [g, dist_eq_norm] using hv + refine ⟨(fun φ : WeakDual ℝ E => g (WeakDual.toStrongDual φ)), ?_, ?_⟩ + · exact (ofFVL_weakstar_continuous p v).continuousOn + · intro φ hφ + apply hUε + rw [Real.dist_eq] + have hbound : ‖WeakDual.toStrongDual φ‖ ≤ B := by + have hRB : R ≤ B := by dsimp [B]; linarith [le_max_left R 0] + exact hφ.trans hRB + have hsmall : B * ‖f - g‖ < ε := by + have hmul := mul_lt_mul_of_pos_left hnorm hB + have hcalc : B * (ε / B) = ε := by field_simp + rw [hcalc] at hmul + exact hmul + exact (free_apply_sub_le p f g (WeakDual.toStrongDual φ)).trans_lt + ((mul_le_mul_of_nonneg_right hbound (norm_nonneg (f - g))).trans_lt hsmall) + +/-- Free functions are continuous when the weak-star dual is given its compactly generated +topology. Compact weak-star sets are norm bounded by uniform boundedness, so this follows from +continuity on every norm-bounded dual ball. -/ +theorem weakStar_continuous_compactlyGenerated [CompleteSpace E] + (p : Exponent) (f : Free p E) : + Continuous[TopologicalSpace.compactlyGenerated (WeakDual ℝ E), inferInstance] + (fun φ : WeakDual ℝ E => f (WeakDual.toStrongDual φ)) := by + apply continuous_from_compactlyGenerated + intro K g + have hb : Bornology.IsBounded (Set.range (g : K → WeakDual ℝ E)) := + (WeakDual.isBounded_iff_isVonNBounded).mpr + ((isCompact_range g.continuous).isVonNBounded ℝ) + obtain ⟨R, hR⟩ := isBounded_iff_forall_norm_le.mp hb + exact (weakStar_continuous_bounded p f R).comp_continuous g.continuous + (fun k => hR (g k) ⟨k, rfl⟩) + +/-- The zero-centered norm ball in the weak dual. -/ +def weakDualNormBall (R : ℝ) : Set (WeakDual ℝ E) := + {φ | ‖WeakDual.toStrongDual φ‖ ≤ R} + +/-- On a Banach dual, the compactly generated weak-star closed sets are exactly those whose +intersections with all norm balls are weak-star closed. The forward direction uses compactness +of weak-star closed dual balls; the reverse direction uses uniform boundedness on compact sets. -/ +theorem weakDual_isClosed_compactlyGenerated_iff [CompleteSpace E] + (s : Set (WeakDual ℝ E)) : + @IsClosed (WeakDual ℝ E) + (TopologicalSpace.compactlyGenerated.{u} (WeakDual ℝ E)) s ↔ + ∀ R : ℝ, IsClosed (s ∩ weakDualNormBall (E := E) R) := by + constructor + · intro h + have hk : ∀ (K : CompHaus.{u}) (g : C(K, WeakDual ℝ E)), + IsClosed (g ⁻¹' s) := by + rw [TopologicalSpace.compactlyGenerated, isClosed_coinduced, + isClosed_sigma_iff] at h + intro K g + simpa only [Set.preimage_preimage] using h ⟨K, g⟩ + intro R + have hBclosed : IsClosed (weakDualNormBall (E := E) R) := by + convert WeakDual.isClosed_closedBall (0 : Dual E) R using 1 + ext φ + simp [weakDualNormBall, Metric.mem_closedBall, dist_zero_right] + have hBcompact : IsCompact (weakDualNormBall (E := E) R) := by + convert WeakDual.isCompact_closedBall (0 : Dual E) R using 1 + ext φ + simp [weakDualNormBall, Metric.mem_closedBall, dist_zero_right] + let : CompactSpace (weakDualNormBall (E := E) R) := + isCompact_iff_compactSpace.mp hBcompact + let K : CompHaus.{u} := CompHaus.of (weakDualNormBall (E := E) R) + let g : C(K, WeakDual ℝ E) := ⟨Subtype.val, continuous_subtype_val⟩ + have hpre : IsClosed (g ⁻¹' s) := hk K g + have himage : IsClosed + ((Subtype.val : weakDualNormBall (E := E) R → WeakDual ℝ E) '' + ((Subtype.val : weakDualNormBall (E := E) R → WeakDual ℝ E) ⁻¹' s)) := + hBclosed.isClosedMap_subtype_val _ hpre + convert himage using 1 + ext φ + simp [weakDualNormBall, and_comm] + · intro h + rw [TopologicalSpace.compactlyGenerated, isClosed_coinduced, + isClosed_sigma_iff] + intro ⟨K, g⟩ + change IsClosed (g ⁻¹' s) + have hb : Bornology.IsBounded (Set.range (g : K → WeakDual ℝ E)) := + (WeakDual.isBounded_iff_isVonNBounded).mpr + ((isCompact_range g.continuous).isVonNBounded ℝ) + obtain ⟨R, hR⟩ := isBounded_iff_forall_norm_le.mp hb + have hs : g ⁻¹' s = g ⁻¹' (s ∩ weakDualNormBall (E := E) R) := by + ext k + have hk := hR (g k) ⟨k, rfl⟩ + change ‖WeakDual.toStrongDual (g k)‖ ≤ R at hk + simp [weakDualNormBall, hk] + rw [hs] + exact (h R).preimage g.continuous + +/-- The easy direction of the endpoint representation: every free function is homogeneous and +weak-star continuous on the dual unit ball. -/ +theorem inFree_infinity_imp (f : Dual E → ℝ) + (hf : InFree Exponent.infinity f) : + PosHomogeneous f ∧ WeakStarContinuousOnBall f := by + obtain ⟨g, hg⟩ := hf + constructor + · intro a ha φ + calc + f (a • φ) = g (a • φ) := (hg _).symm + _ = a * g φ := g.1.2.1 a ha φ + _ = a * f φ := by rw [hg] + · have hc : Continuous (fun ψ : FVLv.dualUnitBall E => + g (WeakDual.toStrongDual ψ.1)) := + (weakStar_continuous_bounded Exponent.infinity g 1).comp_continuous + continuous_subtype_val (fun ψ => by + have hψ := ψ.2 + change WeakDual.toStrongDual ψ.1 ∈ + Metric.closedBall (0 : Dual E) 1 at hψ + change ‖WeakDual.toStrongDual ψ.1‖ ≤ 1 + simpa only [Metric.mem_closedBall, dist_zero_right] using hψ) + change Continuous (fun ψ : FVLv.dualUnitBall E => + f (WeakDual.toStrongDual ψ.1)) + convert hc using 1 + funext ψ + exact (hg _).symm + +/-- Weak-star continuity on the compact dual ball makes the endpoint free norm finite. -/ +theorem weakStar_homogeneous_mem_HP_infinity (f : Dual E → ℝ) + (hhom : PosHomogeneous f) (hcont : WeakStarContinuousOnBall f) : + f ∈ finiteNormSublattice Exponent.infinity E := by + refine ⟨hhom, ?_⟩ + let g : C(FVLv.dualUnitBall E, ℝ) := ⟨fun ψ => f (WeakDual.toStrongDual ψ.1), hcont⟩ + have hbound (φ : Dual E) (hφ : ‖φ‖ ≤ 1) : |f φ| ≤ ‖g‖ := by + have hm : WeakDual.toStrongDual (StrongDual.toWeakDual φ) ∈ + Metric.closedBall (0 : Dual E) 1 := by + change φ ∈ Metric.closedBall (0 : Dual E) 1 + simpa only [Metric.mem_closedBall, dist_zero_right] using hφ + let ψ : FVLv.dualUnitBall E := ⟨StrongDual.toWeakDual φ, hm⟩ + have h := ContinuousMap.norm_coe_le_norm g ψ + change ‖f φ‖ ≤ ‖g‖ at h + simpa only [Real.norm_eq_abs] using h + have hle : freeNormExt Exponent.infinity f ≤ ENNReal.ofReal ‖g‖ := by + rw [freeNormExt, ite_eq_left (show (Exponent.infinity : Exponent).1 = ⊤ by rfl)] + exact iSup_le fun φ => iSup_le fun hφ => ENNReal.ofReal_le_ofReal (hbound φ hφ) + exact hle.trans_lt ENNReal.ofReal_lt_top + +/-- A target-relative version of lattice Stone–Weierstrass: interpolating the target at +each pair of points suffices to approximate that target uniformly. This does not require +the lattice to contain nonzero constants. -/ +private theorem relative_sublattice_stone_weierstrass + {K : Type*} [TopologicalSpace K] [CompactSpace K] + (L : Set C(K, ℝ)) (hL : L.Nonempty) + (hInf : ∀ a ∈ L, ∀ b ∈ L, a ⊓ b ∈ L) + (hSup : ∀ a ∈ L, ∀ b ∈ L, a ⊔ b ∈ L) + (f : C(K, ℝ)) + (hInterp : ∀ x y : K, ∃ g ∈ L, g x = f x ∧ g y = f y) : + f ∈ closure L := by + refine Filter.Frequently.mem_closure + ((Filter.HasBasis.frequently_iff Metric.nhds_basis_ball).mpr fun ε hε => ?_) + simp only [Metric.mem_ball] + by_cases hK : Nonempty K + swap + · exact ⟨hL.some, (ContinuousMap.dist_lt_iff hε).mpr fun x => False.elim (hK ⟨x⟩), + hL.choose_spec⟩ + choose g hg gx gy using hInterp + let V : K → K → Set K := fun x y => {z | f z - ε < g x y z} + have hV (x y : K) : V x y ∈ 𝓝 y := by + apply IsOpen.mem_nhds + · exact isOpen_lt (f.continuous.sub continuous_const) (g x y).continuous + · dsimp [V] + rw [gy] + linarith + let ys : K → Finset K := fun x => + (CompactSpace.elim_nhds_subcover (V x) (hV x)).choose + have hys (x : K) : ⋃ y ∈ ys x, V x y = ⊤ := + (CompactSpace.elim_nhds_subcover (V x) (hV x)).choose_spec + have hys_ne (x : K) : (ys x).Nonempty := + Set.nonempty_of_union_eq_top_of_nonempty _ _ hK (hys x) + let a : K → C(K, ℝ) := fun x => (ys x).sup' (hys_ne x) (g x) + have haL (x : K) : a x ∈ L := by + dsimp [a] + exact Finset.sup'_mem _ hSup _ _ _ (fun y _ => hg x y) + have halow (x z : K) : f z - ε < a x z := by + obtain ⟨y, hym, hz⟩ := Set.exists_set_mem_of_union_eq_top _ _ (hys x) z + dsimp [a] + simp only [ContinuousMap.sup'_apply, Finset.lt_sup'_iff] + exact ⟨y, hym, hz⟩ + have haeq (x : K) : a x x = f x := by + dsimp [a] + simp [gx] + let W : K → Set K := fun x => {z | a x z < f z + ε} + have hW (x : K) : W x ∈ 𝓝 x := by + apply IsOpen.mem_nhds + · exact isOpen_lt (a x).continuous (f.continuous.add continuous_const) + · dsimp [W] + rw [haeq] + linarith + let xs : Finset K := (CompactSpace.elim_nhds_subcover W hW).choose + have hxs : ⋃ x ∈ xs, W x = ⊤ := + (CompactSpace.elim_nhds_subcover W hW).choose_spec + have hxs_ne : xs.Nonempty := + Set.nonempty_of_union_eq_top_of_nonempty _ _ hK hxs + let b : C(K, ℝ) := xs.inf' hxs_ne a + have hbL : b ∈ L := by + dsimp [b] + exact Finset.inf'_mem _ hInf _ _ _ (fun x _ => haL x) + refine ⟨b, ?_, hbL⟩ + rw [ContinuousMap.dist_lt_iff hε] + intro z + rw [show ∀ c d ε : ℝ, dist c d < ε ↔ c < d + ε ∧ d - ε < c by + intros; simp only [← Metric.mem_ball, Real.ball_eq_Ioo, Set.mem_Ioo, and_comm]] + constructor + · simp only [b, Finset.inf'_lt_iff, ContinuousMap.inf'_apply] + exact Set.exists_set_mem_of_union_eq_top _ _ hxs z + · simp only [b, Finset.lt_inf'_iff, ContinuousMap.inf'_apply] + intro x _ + exact halow x z + +/-- A nonzero dual functional has a vector on which it does not vanish. -/ +private theorem exists_eval_ne_zero (φ : Dual E) (hφ : φ ≠ 0) : + ∃ x : E, φ x ≠ 0 := by + by_contra h + push Not at h + apply hφ + ext x + exact h x + +/-- Algebraic free-lattice expressions interpolate a positively homogeneous function +at any two points of the weak-star dual ball. -/ +private theorem fvl_two_point_interp (f : Dual E → ℝ) (hhom : PosHomogeneous f) + (φ ψ : FVLv.dualUnitBall E) : + ∃ v : FVL E, + v φ = f (WeakDual.toStrongDual φ.1) ∧ + v ψ = f (WeakDual.toStrongDual ψ.1) := by + let φD : Dual E := WeakDual.toStrongDual φ.1 + let ψD : Dual E := WeakDual.toStrongDual ψ.1 + have hfzero : f 0 = 0 := by + simpa using hhom 0 le_rfl (0 : Dual E) + by_cases hφ : φD = 0 + · by_cases hψ : ψD = 0 + · refine ⟨0, ?_, ?_⟩ <;> simp [φD, ψD, hφ, hψ, hfzero] + · obtain ⟨x, hx⟩ := exists_eval_ne_zero ψD hψ + let v : FVL E := (f ψD / ψD x) • FVLv.of x + refine ⟨v, ?_, ?_⟩ + · change (f ψD / ψD x) * φD x = f φD + simp [hφ, hfzero] + · change (f ψD / ψD x) * ψD x = f ψD + field_simp + · by_cases hψ : ψD = 0 + · obtain ⟨x, hx⟩ := exists_eval_ne_zero φD hφ + let v : FVL E := (f φD / φD x) • FVLv.of x + refine ⟨v, ?_, ?_⟩ + · change (f φD / φD x) * φD x = f φD + field_simp + · change (f φD / φD x) * ψD x = f ψD + simp [hψ, hfzero] + · obtain ⟨x, hx⟩ := exists_eval_ne_zero φD hφ + obtain ⟨y, hy⟩ := exists_eval_ne_zero ψD hψ + let u : FVL E := |FVLv.of x| + |FVLv.of y| + have hu (θ : FVLv.dualUnitBall E) : + u θ = |(WeakDual.toStrongDual θ.1 : Dual E) x| + + |(WeakDual.toStrongDual θ.1 : Dual E) y| := rfl + have huφ : 0 < u φ := by + rw [hu] + have hx' : 0 < |φD x| := abs_pos.mpr hx + change 0 < |φD x| + |φD y| + positivity + have huψ : 0 < u ψ := by + rw [hu] + have hy' : 0 < |ψD y| := abs_pos.mpr hy + change 0 < |ψD x| + |ψD y| + positivity + by_cases hsep : ∃ z : E, φD z * u ψ ≠ ψD z * u φ + · obtain ⟨z, hz⟩ := hsep + let d : ℝ := φD z * u ψ - ψD z * u φ + have hd : d ≠ 0 := sub_ne_zero.mpr hz + let a : ℝ := (f φD * u ψ - f ψD * u φ) / d + let b : ℝ := (φD z * f ψD - ψD z * f φD) / d + let v : FVL E := a • FVLv.of z + b • u + refine ⟨v, ?_, ?_⟩ + · change a * φD z + b * u φ = f φD + dsimp [a, b] + field_simp [hd] + dsimp [d] at * + ring + · change a * ψD z + b * u ψ = f ψD + dsimp [a, b] + field_simp [hd] + dsimp [d] at * + ring + · push Not at hsep + let c : ℝ := u ψ / u φ + have hc : 0 ≤ c := by dsimp [c]; positivity + have hψeq : ψD = c • φD := by + ext z + change ψD z = c * φD z + dsimp [c] + have hz := hsep z + field_simp [huφ.ne'] + nlinarith + let v : FVL E := (f φD / u φ) • u + refine ⟨v, ?_, ?_⟩ + · change (f φD / u φ) * u φ = f φD + field_simp + · change (f φD / u φ) * u ψ = f ψD + rw [hψeq, hhom c hc φD] + dsimp [c] + field_simp + +/-- Restriction of an endpoint free function to the weak-star dual unit ball is an +isometry onto a closed subspace of continuous functions. -/ +def infinityRestriction : Free Exponent.infinity E →ₗᵢ[ℝ] + C(FVLv.dualUnitBall E, ℝ) where + toFun g := + ⟨fun ψ => g (WeakDual.toStrongDual ψ.1), + (inFree_infinity_imp (fun φ => g φ) ⟨g, fun _ => rfl⟩).2⟩ + map_add' := by + intro g h + ext ψ + rfl + map_smul' := by + intro c g + ext ψ + rfl + norm_map' := by + intro g + apply le_antisymm + · apply (ContinuousMap.norm_le (f := + (⟨fun ψ => g (WeakDual.toStrongDual ψ.1), + (inFree_infinity_imp (fun φ => g φ) ⟨g, fun _ => rfl⟩).2⟩ : + C(FVLv.dualUnitBall E, ℝ))) (norm_nonneg g)).2 + intro ψ + have hψ : ‖WeakDual.toStrongDual ψ.1‖ ≤ 1 := by + have hm := ψ.2 + change WeakDual.toStrongDual ψ.1 ∈ + Metric.closedBall (0 : Dual E) 1 at hm + simpa only [Metric.mem_closedBall, dist_zero_right] using hm + change |g (WeakDual.toStrongDual ψ.1)| ≤ ‖g‖ + exact hp_unit_eval_le Exponent.infinity g.1 (WeakDual.toStrongDual ψ.1) hψ + · change (freeNormExt Exponent.infinity g).toReal ≤ + ‖(⟨fun ψ => g (WeakDual.toStrongDual ψ.1), + (inFree_infinity_imp (fun φ => g φ) ⟨g, fun _ => rfl⟩).2⟩ : + C(FVLv.dualUnitBall E, ℝ))‖ + apply ENNReal.toReal_le_of_le_ofReal (norm_nonneg _) + rw [freeNormExt, ite_eq_left (show (Exponent.infinity : Exponent).1 = ⊤ by rfl)] + refine iSup_le fun φ => iSup_le fun hφ => ?_ + let ψ : FVLv.dualUnitBall E := ⟨StrongDual.toWeakDual φ, by + change φ ∈ Metric.closedBall (0 : Dual E) 1 + simpa only [Metric.mem_closedBall, dist_zero_right] using hφ⟩ + have hval := ContinuousMap.norm_coe_le_norm + (⟨fun ψ => g (WeakDual.toStrongDual ψ.1), + (inFree_infinity_imp (fun φ => g φ) ⟨g, fun _ => rfl⟩).2⟩ : + C(FVLv.dualUnitBall E, ℝ)) ψ + change ‖g φ‖ ≤ _ at hval + exact ENNReal.ofReal_le_ofReal (by + simpa only [Real.norm_eq_abs] using hval) + +/-- Equation (2.2): a full-dual function belongs to the infinity free lattice exactly +when it is positively homogeneous and weak-star continuous on the dual unit ball. +The reverse implication uses lattice approximation on that compact ball. -/ +theorem infinity_representation (f : Dual E → ℝ) : + InFree Exponent.infinity f ↔ PosHomogeneous f ∧ WeakStarContinuousOnBall f := by + constructor + · exact inFree_infinity_imp f + · intro hf + have hfHP : f ∈ finiteNormSublattice Exponent.infinity E := + weakStar_homogeneous_mem_HP_infinity f hf.1 hf.2 + have hfFree : (⟨f, hfHP⟩ : HP Exponent.infinity E) ∈ + freeSublattice Exponent.infinity E := by + let r : Free Exponent.infinity E →ₗᵢ[ℝ] C(FVLv.dualUnitBall E, ℝ) := + infinityRestriction + let L : Set C(FVLv.dualUnitBall E, ℝ) := Set.range r + let fBall : C(FVLv.dualUnitBall E, ℝ) := + ⟨fun ψ => f (WeakDual.toStrongDual ψ.1), hf.2⟩ + have hL : L.Nonempty := ⟨r 0, 0, rfl⟩ + have hInf : ∀ a ∈ L, ∀ b ∈ L, a ⊓ b ∈ L := by + rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ + refine ⟨a ⊓ b, ?_⟩ + ext ψ + rfl + have hSup : ∀ a ∈ L, ∀ b ∈ L, a ⊔ b ∈ L := by + rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ + refine ⟨a ⊔ b, ?_⟩ + ext ψ + rfl + have hInterp (ψ χ : FVLv.dualUnitBall E) : + ∃ g ∈ L, g ψ = fBall ψ ∧ g χ = fBall χ := by + obtain ⟨v, hvψ, hvχ⟩ := fvl_two_point_interp f hf.1 ψ χ + refine ⟨r (ofFVL Exponent.infinity v), + ⟨ofFVL Exponent.infinity v, rfl⟩, ?_, ?_⟩ + · exact (ofFVL_apply_ball Exponent.infinity v ψ).trans hvψ + · exact (ofFVL_apply_ball Exponent.infinity v χ).trans hvχ + have hclosure : fBall ∈ closure L := + relative_sublattice_stone_weierstrass L hL hInf hSup fBall hInterp + have hclosed : IsClosed L := + r.isometry.isUniformInducing.isComplete_range.isClosed + obtain ⟨g, hg⟩ : fBall ∈ L := hclosed.closure_eq ▸ hclosure + have hfun (φ : Dual E) : g φ = f φ := by + let ψ := normalizedDual φ + have hscale : ‖φ‖ • WeakDual.toStrongDual ψ.1 = φ := by + change ‖φ‖ • (‖φ‖⁻¹ • φ) = φ + by_cases hφ : φ = 0 + · subst φ + simp + · rw [smul_smul, mul_inv_cancel₀ (norm_ne_zero_iff.mpr hφ), one_smul] + have hball : g (WeakDual.toStrongDual ψ.1) = + f (WeakDual.toStrongDual ψ.1) := by + have h := congrArg (fun a : C(FVLv.dualUnitBall E, ℝ) => a ψ) hg + exact h + calc + g φ = g (‖φ‖ • WeakDual.toStrongDual ψ.1) := + congrArg (fun θ => g θ) hscale.symm + _ = ‖φ‖ * g (WeakDual.toStrongDual ψ.1) := + g.1.2.1 ‖φ‖ (norm_nonneg φ) _ + _ = ‖φ‖ * f (WeakDual.toStrongDual ψ.1) := by rw [hball] + _ = f φ := by rw [← hf.1 ‖φ‖ (norm_nonneg φ) _, hscale] + have heq : (⟨f, hfHP⟩ : HP Exponent.infinity E) = g.1 := by + apply Subtype.ext + funext φ + exact (hfun φ).symm + rw [heq] + exact g.2 + exact ⟨⟨⟨f, hfHP⟩, hfFree⟩, fun _ => rfl⟩ + +/-- Section 2: full-dual norm continuity, used in the polar-restriction argument. -/ +theorem free_function_norm_continuous (p : Exponent) (f : Free p E) : + Continuous (f : Dual E → ℝ) := by + refine Metric.continuous_iff.mpr fun φ ε hε => ?_ + let R : ℝ := ‖φ‖ + 1 + have hR : 0 < R := by dsimp [R]; positivity + obtain ⟨v, hv⟩ := (denseRange_ofFVL p).exists_dist_lt f + (show 0 < ε / (6 * R) by positivity) + let g : Free p E := ofFVL p v + have hnorm : ‖f - g‖ < ε / (6 * R) := by + simpa only [g, dist_eq_norm] using hv + obtain ⟨δ, hδ, hcont⟩ := Metric.continuousAt_iff.mp + (ofFVL_norm_continuous p v).continuousAt (ε / 3) (by positivity) + refine ⟨min δ 1, lt_min hδ zero_lt_one, ?_⟩ + intro ψ hψ + have hψδ : dist ψ φ < δ := lt_of_lt_of_le hψ (min_le_left _ _) + have hψ1 : dist ψ φ < 1 := lt_of_lt_of_le hψ (min_le_right _ _) + have hψnorm : ‖ψ‖ ≤ R := by + calc + ‖ψ‖ = ‖(ψ - φ) + φ‖ := by rw [sub_add_cancel] + _ ≤ ‖ψ - φ‖ + ‖φ‖ := norm_add_le _ _ + _ = dist ψ φ + ‖φ‖ := by rw [dist_eq_norm] + _ ≤ R := by dsimp [R]; linarith + have hφnorm : ‖φ‖ ≤ R := by dsimp [R]; linarith + have hsmall : R * ‖f - g‖ < ε / 6 := by + have hmul := mul_lt_mul_of_pos_left hnorm hR + have hcalc : R * (ε / (6 * R)) = ε / 6 := by + field_simp + rw [hcalc] at hmul + exact hmul + have hψerr : dist (f ψ) (g ψ) < ε / 6 := by + calc + dist (f ψ) (g ψ) = |f ψ - g ψ| := Real.dist_eq .. + _ ≤ ‖ψ‖ * ‖f - g‖ := free_apply_sub_le p f g ψ + _ ≤ R * ‖f - g‖ := mul_le_mul_of_nonneg_right hψnorm (norm_nonneg _) + _ < ε / 6 := hsmall + have hφerr : dist (f φ) (g φ) < ε / 6 := by + calc + dist (f φ) (g φ) = |f φ - g φ| := Real.dist_eq .. + _ ≤ ‖φ‖ * ‖f - g‖ := free_apply_sub_le p f g φ + _ ≤ R * ‖f - g‖ := mul_le_mul_of_nonneg_right hφnorm (norm_nonneg _) + _ < ε / 6 := hsmall + have hgdiff : dist (g ψ) (g φ) < ε / 3 := hcont hψδ + have hψerr' : dist (g ψ) (f ψ) < ε / 6 := by + simpa only [dist_comm] using hψerr + have hφerr' : dist (g φ) (f φ) < ε / 6 := by + simpa only [dist_comm] using hφerr + calc + dist (f ψ) (f φ) ≤ dist (g ψ) (g φ) + + (dist (g ψ) (f ψ) + dist (g φ) (f φ)) := dist_triangle4_left .. + _ < ε := by linarith + +/-- A norm-continuous real lattice homomorphism, retaining both bundled APIs. -/ +structure LatticeOperator (X : Type u) (Y : Type v) + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [NormedVectorLattice X] + [NormedAddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [NormedVectorLattice Y] + extends X →L[ℝ] Y where + /-- Preservation of binary lattice suprema by the underlying continuous linear map. -/ + map_sup' : ∀ x y, toContinuousLinearMap (x ⊔ y) = + toContinuousLinearMap x ⊔ toContinuousLinearMap y + /-- Preservation of binary lattice infima by the underlying continuous linear map. -/ + map_inf' : ∀ x y, toContinuousLinearMap (x ⊓ y) = + toContinuousLinearMap x ⊓ toContinuousLinearMap y + +namespace LatticeOperator +variable {X : Type u} {Y : Type v} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [NormedVectorLattice X] + [NormedAddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [NormedVectorLattice Y] +instance : CoeFun (LatticeOperator X Y) (fun _ => X → Y) := + ⟨fun T => T.toContinuousLinearMap⟩ +/-- Forget the continuity data of a bounded lattice operator, retaining its real linear +map and preservation of suprema and infima in BanLat’s `VecLatHom` interface. -/ +def toVecLatHom (T : LatticeOperator X Y) : VecLatHom X Y := + { T.toContinuousLinearMap.toLinearMap with + map_sup' := T.map_sup', map_inf' := T.map_inf' } +end LatticeOperator + +/-- A bounded lattice homomorphism out of the free lattice is determined by its generators. -/ +theorem latticeOperator_ext_delta (p : Exponent) {X : Type w} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (M N : LatticeOperator (Free p E) X) + (h : ∀ x : E, M (delta p x) = N (delta p x)) : M = N := by + let T : E →ₗ[ℝ] X := M.toContinuousLinearMap.toLinearMap.comp (delta p).toLinearMap + have hM : M.toVecLatHom.comp (ofFVL p) = FVLv.lift T := + FVLv.lift_unique T _ (by + intro x + change M (ofFVL p (FVLv.of x)) = M (delta p x) + rw [ofFVL_of]) + have hN : N.toVecLatHom.comp (ofFVL p) = FVLv.lift T := + FVLv.lift_unique T _ (by + intro x + change N (ofFVL p (FVLv.of x)) = M (delta p x) + rw [ofFVL_of] + exact (h x).symm) + have hMN : M.toVecLatHom.comp (ofFVL p) = + N.toVecLatHom.comp (ofFVL p) := hM.trans hN.symm + have hfun : (M : Free p E → X) = (N : Free p E → X) := + (denseRange_ofFVL p).equalizer M.toContinuousLinearMap.continuous + N.toContinuousLinearMap.continuous (by + funext v + exact DFunLike.congr_fun hMN v) + have hlin : M.toContinuousLinearMap = N.toContinuousLinearMap := by + ext f + exact congrFun hfun f + cases M with + | mk m hsup hinf => + cases N with + | mk n hsup' hinf' => + cases hlin + rfl + +private theorem freeNormExt_comp_le (p : Exponent) (T : F →L[ℝ] E) + (f : Dual F → ℝ) (hf : PosHomogeneous f) : + freeNormExt p (fun φ : Dual E => f (φ.comp T)) ≤ + ENNReal.ofReal ‖T‖ * freeNormExt p f := by + by_cases hT0 : ‖T‖ = 0 + · have hT : T = 0 := norm_eq_zero.mp hT0 + have hf0 : f 0 = 0 := by + have h := hf 0 (le_refl 0) (0 : Dual F) + simpa using h + have hfun : (fun φ : Dual E => f (φ.comp T)) = fun _ => 0 := by + funext φ + simp [hT, hf0] + rw [hfun, freeNormExt_zero, hT0, ENNReal.ofReal_zero, zero_mul] + · have hT : 0 < ‖T‖ := lt_of_le_of_ne (norm_nonneg T) (Ne.symm hT0) + by_cases htop : p.1 = ⊤ + · rw [freeNormExt, ite_eq_left htop] + refine iSup_le fun φ => iSup_le fun hφ => ?_ + let ψ : Dual F := ‖T‖⁻¹ • φ.comp T + have hcomp : ‖φ.comp T‖ ≤ ‖T‖ := by + calc + ‖φ.comp T‖ ≤ ‖φ‖ * ‖T‖ := φ.opNorm_comp_le T + _ ≤ 1 * ‖T‖ := mul_le_mul_of_nonneg_right hφ (norm_nonneg T) + _ = ‖T‖ := one_mul _ + have hψ : ‖ψ‖ ≤ 1 := by + dsimp [ψ] + rw [norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hT)] + calc + ‖T‖⁻¹ * ‖φ.comp T‖ ≤ ‖T‖⁻¹ * ‖T‖ := + mul_le_mul_of_nonneg_left hcomp (le_of_lt (inv_pos.mpr hT)) + _ = 1 := inv_mul_cancel₀ hT.ne' + have hscaled : ‖T‖ • ψ = φ.comp T := by + dsimp [ψ] + rw [smul_smul, mul_inv_cancel₀ hT.ne', one_smul] + have hval : f (φ.comp T) = ‖T‖ * f ψ := by + rw [← hscaled, hf ‖T‖ (le_of_lt hT) ψ] + have hle := ofReal_abs_le_freeNormExt p f ψ hψ + calc + ENNReal.ofReal |f (φ.comp T)| = + ENNReal.ofReal ‖T‖ * ENNReal.ofReal |f ψ| := by + rw [hval, abs_mul, abs_of_nonneg (norm_nonneg T), + ENNReal.ofReal_mul (norm_nonneg T)] + _ ≤ ENNReal.ofReal ‖T‖ * freeNormExt p f := + mul_le_mul_of_nonneg_left hle (by positivity) + · rw [freeNormExt, ite_eq_right htop] + refine iSup_le fun n => iSup_le fun φ => iSup_le fun hφ => ?_ + let ψ : Fin n → Dual F := fun i => ‖T‖⁻¹ • (φ i).comp T + have hψ : NormAdmissible p ψ := normAdmissible_comp_scaled p T hT φ hφ + have hscaled (i : Fin n) : ‖T‖ • ψ i = (φ i).comp T := by + dsimp [ψ] + rw [smul_smul, mul_inv_cancel₀ hT.ne', one_smul] + have hfun : (fun i => f ((φ i).comp T)) = fun i => ‖T‖ * f (ψ i) := by + funext i + rw [← hscaled i, hf ‖T‖ (le_of_lt hT) (ψ i)] + have hle : ENNReal.ofReal (scalarPSum p (fun i => f (ψ i))) ≤ + freeNormExt p f := by + rw [freeNormExt, ite_eq_right htop] + exact le_iSup_of_le n (le_iSup_of_le ψ (le_iSup_of_le hψ le_rfl)) + calc + ENNReal.ofReal (scalarPSum p (fun i => f ((φ i).comp T))) = + ENNReal.ofReal ‖T‖ * + ENNReal.ofReal (scalarPSum p (fun i => f (ψ i))) := by + rw [hfun, scalarPSum_smul, abs_of_pos hT, + ENNReal.ofReal_mul (norm_nonneg T)] + _ ≤ ENNReal.ofReal ‖T‖ * freeNormExt p f := + mul_le_mul_of_nonneg_left hle (by positivity) + +private theorem hp_comp_norm_le (p : Exponent) (T : F →L[ℝ] E) + (f : HP p F) : + (freeNormExt p (fun φ : Dual E => f (φ.comp T))).toReal ≤ ‖T‖ * ‖f‖ := by + have hle := freeNormExt_comp_le p T f.1 f.2.1 + have htop : ENNReal.ofReal ‖T‖ * freeNormExt p f.1 ≠ ⊤ := + ne_of_lt (ENNReal.mul_lt_top ENNReal.ofReal_lt_top f.2.2) + calc + (freeNormExt p (fun φ : Dual E => f (φ.comp T))).toReal ≤ + (ENNReal.ofReal ‖T‖ * freeNormExt p f.1).toReal := + ENNReal.toReal_mono htop hle + _ = ‖T‖ * ‖f‖ := by + rw [ENNReal.toReal_mul, ENNReal.toReal_ofReal (norm_nonneg T)] + rfl + +private theorem freeNormExt_comp_norm_le (p : Exponent) (T : F →L[ℝ] E) + (f : Free p F) : + (freeNormExt p (fun φ : Dual E => f (φ.comp T))).toReal ≤ ‖T‖ * ‖f‖ := + hp_comp_norm_le p T f.1 + +/-- The lattice operator on homogeneous functions induced by composition with an adjoint. -/ +def compHP (p : Exponent) (T : F →L[ℝ] E) : + LatticeOperator (HP p F) (HP p E) where + toContinuousLinearMap := LinearMap.mkContinuous + { toFun f := ⟨fun φ => f (φ.comp T), by + refine ⟨?_, ?_⟩ + · intro a ha φ + change f ((a • φ).comp T) = a * f (φ.comp T) + have hcomp : (a • φ).comp T = a • (φ.comp T) := by + ext x + rfl + rw [hcomp] + exact f.2.1 a ha (φ.comp T) + · exact (freeNormExt_comp_le p T f.1 f.2.1).trans_lt + (ENNReal.mul_lt_top ENNReal.ofReal_lt_top f.2.2)⟩ + map_add' := by + intro f g + apply Subtype.ext + funext φ + rfl + map_smul' := by + intro c f + apply Subtype.ext + funext φ + rfl } + ‖T‖ (by intro f; exact hp_comp_norm_le p T f) + map_sup' := by + intro f g + apply Subtype.ext + funext φ + rfl + map_inf' := by + intro f g + apply Subtype.ext + funext φ + rfl + +private theorem compHP_mem_free (p : Exponent) (T : F →L[ℝ] E) + (f : Free p F) : compHP p T f.1 ∈ freeSublattice p E := by + let D : VectorSublattice (HP p F) := { + toSubmodule := { + carrier := {h | compHP p T h ∈ freeSublattice p E} + zero_mem' := by + change compHP p T (0 : HP p F) ∈ freeSublattice p E + rw [map_zero] + exact (freeSublattice p E).zero_mem + add_mem' := by + intro h k hh hk + change compHP p T (h + k) ∈ freeSublattice p E + rw [map_add] + exact (freeSublattice p E).add_mem hh hk + smul_mem' := by + intro c h hh + change compHP p T (c • h) ∈ freeSublattice p E + rw [map_smul] + exact (freeSublattice p E).smul_mem c hh } + sup_mem' := by + intro h k hh hk + change compHP p T (h ⊔ k) ∈ freeSublattice p E + rw [(compHP p T).map_sup'] + exact (freeSublattice p E).sup_mem hh hk } + have hDclosed : IsClosed (D : Set (HP p F)) := by + change IsClosed ((compHP p T).toContinuousLinearMap ⁻¹' + (freeSublattice p E : Set (HP p E))) + exact (VectorSublattice.isClosed_topologicalClosure _).preimage + (compHP p T).toContinuousLinearMap.continuous + have hgenerated : + VectorSublattice.generated (Set.range (hpEval p : F → HP p F)) ≤ D := by + apply VectorSublattice.generated_le + rintro _ ⟨x, rfl⟩ + change compHP p T (hpEval p x) ∈ freeSublattice p E + have heq : compHP p T (hpEval p x) = hpEval p (T x) := by + apply Subtype.ext + funext φ + rfl + rw [heq] + exact (delta p (T x)).2 + have hclosure := VectorSublattice.topologicalClosure_minimal hgenerated hDclosed + have hf : (f.1 : HP p F) ∈ D := hclosure f.2 + exact hf + +/-- Equation (2.3): induced operator is composition with the adjoint. -/ +def induced (p : Exponent) (T : F →L[ℝ] E) : LatticeOperator (Free p F) (Free p E) where + toContinuousLinearMap := + ((compHP p T).toContinuousLinearMap.domRestrict (freeSublattice p F).toSubmodule).codRestrict + (freeSublattice p E).toSubmodule (by intro f; exact compHP_mem_free p T f) + map_sup' := by + intro f g + apply Subtype.ext + exact (compHP p T).map_sup' f.1 g.1 + map_inf' := by + intro f g + apply Subtype.ext + exact (compHP p T).map_inf' f.1 g.1 + +/-- Equation (2.3): the induced map acts by precomposition with the continuous adjoint, +so its value at φ is the original function evaluated at `φ.comp T`. -/ +theorem canonical_map_formulas (p : Exponent) (T : F →L[ℝ] E) + (f : Free p F) (φ : Dual E) : induced p T f φ = f (φ.comp T) := by rfl + +/-- Section 1: norm and generator formula for induced maps. -/ +theorem induced_norm_generators (p : Exponent) (T : F →L[ℝ] E) : + ‖(induced p T).toContinuousLinearMap‖ = ‖T‖ ∧ + ∀ x, induced p T (delta p x) = delta p (T x) := by + have hgen (x : F) : induced p T (delta p x) = delta p (T x) := by + apply Subtype.ext + apply Subtype.ext + funext φ + rfl + have hupper : ‖(induced p T).toContinuousLinearMap‖ ≤ ‖T‖ := + (induced p T).toContinuousLinearMap.opNorm_le_bound (norm_nonneg T) (by + intro f + change (freeNormExt p (fun φ : Dual E => f (φ.comp T))).toReal ≤ ‖T‖ * ‖f‖ + exact freeNormExt_comp_norm_le p T f) + have hlower : ‖T‖ ≤ ‖(induced p T).toContinuousLinearMap‖ := + T.opNorm_le_bound (norm_nonneg _) (by + intro x + calc + ‖T x‖ = ‖delta p (T x)‖ := ((delta p).norm_map (T x)).symm + _ = ‖induced p T (delta p x)‖ := by rw [hgen] + _ ≤ ‖(induced p T).toContinuousLinearMap‖ * ‖delta p x‖ := + (induced p T).toContinuousLinearMap.le_opNorm (delta p x) + _ = ‖(induced p T).toContinuousLinearMap‖ * ‖x‖ := by + rw [(delta p).norm_map]) + exact ⟨le_antisymm hupper hlower, hgen⟩ + +/-- An induced homomorphism satisfies the original operator's norm bound. -/ +theorem induced_norm_le (p : Exponent) (T : F →L[ℝ] E) (f : Free p F) : + ‖induced p T f‖ ≤ ‖T‖ * ‖f‖ := by + have h := (induced p T).toContinuousLinearMap.le_opNorm f + rwa [(induced_norm_generators p T).1] at h + +/-- The algebraic core, regarded as a submodule of the free Banach lattice. -/ +abbrev endpointRange (p : Exponent) := LinearMap.range (ofFVL p (E := E)).toLinearMap + +/-- Identify the algebraic free lattice with its embedded range. -/ +def endpointRangeEquiv (p : Exponent) : + FBLOrderContinuousLH.FVL E ≃ₗ[ℝ] endpointRange (E := E) p := + LinearEquiv.ofInjective (ofFVL p (E := E)).toLinearMap + (ofFVL_embedding p).1 + +private theorem endpointRangeEquiv_apply (p : Exponent) (v : FVLv E) : + (endpointRange (E := E) p).subtype ((endpointRangeEquiv p) v) = ofFVL p v := + LinearEquiv.ofInjective_apply (f := (ofFVL p (E := E)).toLinearMap) + (h := (ofFVL_embedding p).1) v + +private theorem endpointRangeEquiv_symm_apply (p : Exponent) + (z : endpointRange (E := E) p) : + ofFVL p ((endpointRangeEquiv p).symm z) = (z : Free p E) := + LinearEquiv.ofInjective_symm_apply (f := (ofFVL p (E := E)).toLinearMap) + (h := (ofFVL_embedding p).1) z + +private theorem endpointRange_dense (p : Exponent) : + DenseRange (endpointRange (E := E) p).subtype := by + apply denseRange_iff_closure_range.mpr + ext x + constructor + · intro _; trivial + · intro _ + have hx : x ∈ closure (Set.range (ofFVL p (E := E))) := by + rw [(denseRange_ofFVL p (E := E)).closure_range] + trivial + apply closure_mono ?_ hx + rintro _ ⟨v, rfl⟩ + exact ⟨⟨ofFVL p v, ⟨v, rfl⟩⟩, rfl⟩ + +/-- The algebraic change-of-exponent map between two free-lattice models. -/ +def parameterRangeMap (p q : Exponent) : + endpointRange (E := E) p →ₗ[ℝ] Free q E := + (ofFVL q (E := E)).toLinearMap.comp (endpointRangeEquiv p).symm.toLinearMap + +private theorem parameterRangeMap_bound {p q : Exponent} (hpq : p ≤ q) + (x : endpointRange (E := E) p) : + ‖parameterRangeMap p q x‖ ≤ ‖(x : Free p E)‖ := by + let v := (endpointRangeEquiv p).symm x + have hx : ofFVL p v = (x : Free p E) := by + exact endpointRangeEquiv_symm_apply p x + change ‖ofFVL q v‖ ≤ ‖(x : Free p E)‖ + rw [← hx] + exact norm_ofFVL_mono hpq v + +/-- Extend the contractive change-of-exponent map to the completed free lattices. -/ +def parameterExtension {p q : Exponent} (_hpq : p ≤ q) : Free p E →L[ℝ] Free q E := + (parameterRangeMap p q).extendOfNorm (endpointRange (E := E) p).subtype + +private theorem parameterExtension_apply_range {p q : Exponent} (hpq : p ≤ q) + (z : endpointRange (E := E) p) : + parameterExtension hpq ((endpointRange (E := E) p).subtype z) = + parameterRangeMap p q z := + LinearMap.extendOfNorm_eq (f := parameterRangeMap p q) + (e := (endpointRange (E := E) p).subtype) (endpointRange_dense p) + ⟨1, fun x => by simpa using parameterRangeMap_bound hpq x⟩ z + +private theorem parameterExtension_ofFVL {p q : Exponent} (hpq : p ≤ q) (v : FVL E) : + parameterExtension hpq (ofFVL p v) = ofFVL q v := by + rw [← endpointRangeEquiv_apply p v, parameterExtension_apply_range] + exact congrArg (ofFVL q (E := E)) ((endpointRangeEquiv p).symm_apply_apply v) + +private theorem parameterExtension_norm_le {p q : Exponent} (hpq : p ≤ q) + (x : Free p E) : ‖parameterExtension hpq x‖ ≤ ‖x‖ := by + have hb : ∀ y : endpointRange (E := E) p, + ‖parameterRangeMap p q y‖ ≤ (1 : ℝ) * ‖(endpointRange (E := E) p).subtype y‖ := by + intro y + simpa using parameterRangeMap_bound hpq y + simpa [parameterExtension] using + (LinearMap.norm_extendOfNorm_apply_le (f := parameterRangeMap p q) + (e := (endpointRange (E := E) p).subtype) (endpointRange_dense p) 1 hb x) + +private theorem parameterExtension_apply {p q : Exponent} (hpq : p ≤ q) + (f : Free p E) (φ : Dual E) : parameterExtension hpq f φ = f φ := by + have hleft : Continuous (fun g : Free p E => parameterExtension hpq g φ) := + ((hpEvaluation q φ).continuous.comp continuous_subtype_val).comp + (parameterExtension hpq).continuous + have hright : Continuous (fun g : Free p E => g φ) := + (hpEvaluation p φ).continuous.comp continuous_subtype_val + have heq := (denseRange_ofFVL p (E := E)).equalizer hleft hright (by + funext v + change parameterExtension hpq (ofFVL p v) φ = ofFVL p v φ + rw [parameterExtension_ofFVL] + rfl) + exact congrFun heq f + +/-- Section 2 and Section 5: change of convexity parameter is the identity on functions. -/ +def inclusion {p q : Exponent} (hpq : p ≤ q) : LatticeOperator (Free p E) (Free q E) where + toContinuousLinearMap := parameterExtension hpq + map_sup' := by + intro f g + apply Subtype.ext + apply Subtype.ext + funext φ + change parameterExtension hpq (f ⊔ g) φ = + parameterExtension hpq f φ ⊔ parameterExtension hpq g φ + simp only [parameterExtension_apply] + rfl + map_inf' := by + intro f g + apply Subtype.ext + apply Subtype.ext + funext φ + change parameterExtension hpq (f ⊓ g) φ = + parameterExtension hpq f φ ⊓ parameterExtension hpq g φ + simp only [parameterExtension_apply] + rfl + +/-- Section 5: the canonical parameter map acts as the identity on full-dual functions. -/ +theorem inclusion_apply {p q : Exponent} (hpq : p ≤ q) (f : Free p E) (φ : Dual E) : + inclusion hpq f φ = f φ := parameterExtension_apply hpq f φ + +/-- The actual scalar p-sum function used in BanLat's homogeneous functional calculus. -/ +def pSumFunction (p : Exponent) (n : ℕ) : posHomFunctions n := + ⟨⟨scalarPSum p, by + convert (continuous_norm.comp + (PiLp.continuous_toLp p.1 (fun _ : Fin n => ℝ))) using 1 + ext a + exact scalarPSum_eq_piLp_norm p a⟩, by + intro c hc a + have hfun : c • a = fun i => c * a i := by + funext i + simp + change scalarPSum p (c • a) = c * scalarPSum p a + rw [hfun, scalarPSum_smul, abs_of_nonneg hc]⟩ + +/-- Functional-calculus p-sums in arbitrary Banach lattices. -/ +def latticePSum (p : Exponent) {X : Type u} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [BanachLattice X] {n : ℕ} (x : Fin n → X) : X := + letI := isUniformlyCompleteVectorLattice_of_banachLattice X + PosHomFunction.functionalCalculus x (pSumFunction p n) + +/-- Evaluation of a continuous positively homogeneous function at a real vector. -/ +def realPosHomEval {n : ℕ} (x : Fin n → ℝ) : VecLatHom (posHomFunctions n) ℝ where + toFun f := f x + map_add' := by intros; rfl + map_smul' := by intros; rfl + map_sup' := by intros; rfl + map_inf' := by intros; rfl + +section RealPosHomCalc +local instance : IsUniformlyCompleteVectorLattice ℝ := + isUniformlyCompleteVectorLattice_of_banachLattice ℝ + +private theorem realPosHomFunctionalCalculus {n : ℕ} (x : Fin n → ℝ) + (h : posHomFunctions n) : PosHomFunction.functionalCalculus x h = h x := by + have heq := PosHomFunction.eq_functionalCalculus_of_map_coordinate x + (realPosHomEval x) (by intro i; rfl) + exact (DFunLike.congr_fun heq h).symm +end RealPosHomCalc + +/-- Full-dual version of the scalar functional-calculus identity. -/ +theorem latticePSum_apply (p q : Exponent) {n : ℕ} (f : Fin n → Free p E) (φ : Dual E) : + latticePSum q f φ = scalarPSum q (fun i => f i φ) := by + let := isUniformlyCompleteVectorLattice_of_banachLattice (Free p E) + let := isUniformlyCompleteVectorLattice_of_banachLattice ℝ + change evalVecLatHom p φ (PosHomFunction.functionalCalculus f (pSumFunction q n)) = _ + calc + evalVecLatHom p φ (PosHomFunction.functionalCalculus f (pSumFunction q n)) = + PosHomFunction.functionalCalculus (fun i => evalVecLatHom p φ (f i)) + (pSumFunction q n) := by + exact PosHomFunction.functionalCalculus_map (evalVecLatHom p φ) f + (pSumFunction q n) + _ = scalarPSum q (fun i => f i φ) := by + rw [realPosHomFunctionalCalculus] + rfl + +/-- The p-convexity estimate with a fixed constant C ≥ 1: every finite lattice p-sum +has norm at most C times the scalar p-sum of the individual norms. All exponents, +including the maximum operation at ∞, use the same functional-calculus interface. -/ +def ConvexWith (p : Exponent) (C : ℝ) (X : Type u) [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [BanachLattice X] : Prop := + 1 ≤ C ∧ ∀ (n : ℕ) (x : Fin n → X), + ‖latticePSum p x‖ ≤ C * scalarPSum p (fun i => ‖x i‖) + +/-- A Banach lattice is p-convex if its finite lattice p-sums satisfy `ConvexWith p C` +for some constant C ≥ 1. The endpoint uses finite suprema of absolute values. -/ +def IsPConvex (p : Exponent) (X : Type u) [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [BanachLattice X] : Prop := ∃ C, ConvexWith p C X + +/-- Adding the same scalar to every coordinate changes a finite p-sum by at most its +number of coordinates times the scalar's absolute value. -/ +private theorem scalarPSum_add_const_le (p : Exponent) {n : ℕ} + (a : Fin n → ℝ) (ε : ℝ) : + scalarPSum p (fun i => a i + ε) ≤ scalarPSum p a + n * |ε| := by + calc + scalarPSum p (fun i => a i + ε) ≤ + scalarPSum p a + scalarPSum p (fun _ : Fin n => ε) := + scalarPSum_add_le p a (fun _ => ε) + _ ≤ scalarPSum p a + scalarPSum Exponent.one (fun _ : Fin n => ε) := by + gcongr + exact scalarPSum_mono_exponent p.2 (fun _ : Fin n => ε) + _ = scalarPSum p a + n * |ε| := by + simp [scalarPSum, Exponent.one] + +/-- A closed lattice ideal quotient preserves lattice p-sums. -/ +private theorem quotient_latticePSum_map {X : Type u} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (p : Exponent) (J : OrderIdeal X) (hJ : IsClosed (J : Set X)) + {n : ℕ} (x : Fin n → X) : + letI : NormedAddCommGroup (X ⧸ J.toSubmodule) := J.quotientNormedAddCommGroup hJ + letI : Lattice (X ⧸ J.toSubmodule) := J.instQuotientLattice + letI : IsOrderedAddMonoid (X ⧸ J.toSubmodule) := J.instQuotientIsOrderedAddMonoid + letI : BanachLattice (X ⧸ J.toSubmodule) := J.quotientBanachLattice hJ + J.mkQ (latticePSum p x) = latticePSum p (fun i => J.mkQ (x i)) := by + let : NormedAddCommGroup (X ⧸ J.toSubmodule) := J.quotientNormedAddCommGroup hJ + let : Lattice (X ⧸ J.toSubmodule) := J.instQuotientLattice + let : IsOrderedAddMonoid (X ⧸ J.toSubmodule) := J.instQuotientIsOrderedAddMonoid + let : BanachLattice (X ⧸ J.toSubmodule) := J.quotientBanachLattice hJ + let : IsUniformlyCompleteVectorLattice X := + isUniformlyCompleteVectorLattice_of_banachLattice X + let : IsUniformlyCompleteVectorLattice (X ⧸ J.toSubmodule) := + isUniformlyCompleteVectorLattice_of_banachLattice (X ⧸ J.toSubmodule) + change J.mkQVecLatHom (PosHomFunction.functionalCalculus x (pSumFunction p n)) = + PosHomFunction.functionalCalculus (fun i => J.mkQVecLatHom (x i)) (pSumFunction p n) + exact PosHomFunction.functionalCalculus_map J.mkQVecLatHom x (pSumFunction p n) + +/-- A closed lattice ideal quotient retains a p-convexity constant. -/ +theorem quotient_convexWith {X : Type u} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (p : Exponent) (C : ℝ) (hC : ConvexWith p C X) + (J : OrderIdeal X) (hJ : IsClosed (J : Set X)) : + letI : NormedAddCommGroup (X ⧸ J.toSubmodule) := J.quotientNormedAddCommGroup hJ + letI : Lattice (X ⧸ J.toSubmodule) := J.instQuotientLattice + letI : IsOrderedAddMonoid (X ⧸ J.toSubmodule) := J.instQuotientIsOrderedAddMonoid + letI : BanachLattice (X ⧸ J.toSubmodule) := J.quotientBanachLattice hJ + ConvexWith p C (X ⧸ J.toSubmodule) := by + let : NormedAddCommGroup (X ⧸ J.toSubmodule) := J.quotientNormedAddCommGroup hJ + let : Lattice (X ⧸ J.toSubmodule) := J.instQuotientLattice + let : IsOrderedAddMonoid (X ⧸ J.toSubmodule) := J.instQuotientIsOrderedAddMonoid + let : BanachLattice (X ⧸ J.toSubmodule) := J.quotientBanachLattice hJ + constructor + · exact hC.1 + · intro n x + classical + refine le_of_forall_pos_le_add fun ε hε => ?_ + let δ : ℝ := ε / (C * (n + 1)) + have hCpos : 0 < C := lt_of_lt_of_le zero_lt_one hC.1 + have hden : 0 < C * (n + 1 : ℝ) := by positivity + have hδ : 0 < δ := div_pos hε hden + have hlift : ∀ i : Fin n, ∃ y : X, J.mkQ y = x i ∧ ‖y‖ < ‖x i‖ + δ := by + intro i + exact Submodule.Quotient.norm_mk_lt (x i) hδ + choose y hy hybound using hlift + have hmap : J.mkQ (latticePSum p y) = latticePSum p x := by + rw [quotient_latticePSum_map p J hJ y] + congr 1 + funext i + exact hy i + have hsum : scalarPSum p (fun i => ‖y i‖) ≤ + scalarPSum p (fun i => ‖x i‖ + δ) := by + apply scalarPSum_mono_abs + intro i + rw [abs_of_nonneg (norm_nonneg _), abs_of_nonneg (add_nonneg (norm_nonneg _) hδ.le)] + exact (hybound i).le + calc + ‖latticePSum p x‖ = ‖J.mkQ (latticePSum p y)‖ := by rw [hmap] + _ ≤ ‖latticePSum p y‖ := Submodule.Quotient.norm_mk_le J.toSubmodule _ + _ ≤ C * scalarPSum p (fun i => ‖y i‖) := hC.2 n y + _ ≤ C * scalarPSum p (fun i => ‖x i‖ + δ) := + mul_le_mul_of_nonneg_left hsum hCpos.le + _ ≤ C * scalarPSum p (fun i => ‖x i‖) + ε := by + have hbound := scalarPSum_add_const_le p (fun i => ‖x i‖) δ + rw [abs_of_pos hδ] at hbound + have hδid : C * (n : ℝ) * δ ≤ ε := by + calc + C * (n : ℝ) * δ ≤ C * ((n : ℝ) + 1) * δ := by + gcongr + exact le_add_of_nonneg_right zero_le_one + _ = ε := by + dsimp [δ] + exact mul_div_cancel₀ ε (ne_of_gt hden) + nlinarith + +/-- A quotient by a closed lattice ideal is p-convex whenever the original lattice is. -/ +theorem quotient_isPConvex {X : Type u} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (p : Exponent) (hX : IsPConvex p X) + (J : OrderIdeal X) (hJ : IsClosed (J : Set X)) : + letI : NormedAddCommGroup (X ⧸ J.toSubmodule) := J.quotientNormedAddCommGroup hJ + letI : Lattice (X ⧸ J.toSubmodule) := J.instQuotientLattice + letI : IsOrderedAddMonoid (X ⧸ J.toSubmodule) := J.instQuotientIsOrderedAddMonoid + letI : BanachLattice (X ⧸ J.toSubmodule) := J.quotientBanachLattice hJ + IsPConvex p (X ⧸ J.toSubmodule) := by + obtain ⟨C, hC⟩ := hX + exact ⟨C, quotient_convexWith p C hC J hJ⟩ + +/-- The infimum of the constants C satisfying `ConvexWith p C X`. For p-convex spaces, +`convexityConstant_ge_one` and `convexityConstant_spec` show that this infimum is itself +an admissible constant. Its use as an optimal constant requires `IsPConvex p X`. -/ +def convexityConstant (p : Exponent) (X : Type u) [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [BanachLattice X] : ℝ := sInf {C | ConvexWith p C X} + +private theorem scalarPSum_swap (p : Exponent) {n m : ℕ} (a : Fin n → Fin m → ℝ) : + scalarPSum p (fun i => scalarPSum p (a i)) = + scalarPSum p (fun j => scalarPSum p (fun i => a i j)) := by + let A : PiLp p.1 (fun _ : Fin n => PiLp p.1 (fun _ : Fin m => ℝ)) := + WithLp.toLp p.1 (fun i => WithLp.toLp p.1 (a i)) + let B : PiLp p.1 (fun _ : Fin m => PiLp p.1 (fun _ : Fin n => ℝ)) := + WithLp.toLp p.1 (fun j => WithLp.toLp p.1 (fun i => a i j)) + let e : (Σ _ : Fin n, Fin m) ≃ (Σ _ : Fin m, Fin n) := { + toFun := fun z => Sigma.mk z.2 z.1 + invFun := fun z => Sigma.mk z.2 z.1 + left_inv := by intro z; cases z; rfl + right_inv := by intro z; cases z; rfl } + let T := (LinearIsometryEquiv.piLpCurry ℝ p.1 (fun _ : Fin n => fun _ : Fin m => ℝ)).symm + let U := LinearIsometryEquiv.piLpCongrLeft p.1 ℝ ℝ e + let V := LinearIsometryEquiv.piLpCurry ℝ p.1 (fun _ : Fin m => fun _ : Fin n => ℝ) + have hswap : V (U (T A)) = B := by + ext j i + rfl + have hnorm : ‖A‖ = ‖B‖ := by + calc + ‖A‖ = ‖T A‖ := (T.norm_map A).symm + _ = ‖U (T A)‖ := (U.norm_map (T A)).symm + _ = ‖V (U (T A))‖ := (V.norm_map (U (T A))).symm + _ = ‖B‖ := by rw [hswap] + have hleft : scalarPSum p (fun i => scalarPSum p (a i)) = ‖A‖ := by + simp only [scalarPSum_eq_piLp_norm] + by_cases htop : p.1 = ⊤ + · change ‖WithLp.toLp p.1 (fun i => ‖WithLp.toLp p.1 (a i)‖)‖ = + ‖WithLp.toLp p.1 (fun i => WithLp.toLp p.1 (a i))‖ + rw [htop] + simp only [PiLp.norm_eq_ciSup, Real.norm_eq_abs] + exact iSup_congr fun i => abs_of_nonneg + (Real.iSup_nonneg fun j => abs_nonneg _) + · have hp : 0 < p.1.toReal := ENNReal.toReal_pos_iff.mpr + ⟨lt_of_lt_of_le zero_lt_one p.2, lt_top_iff_ne_top.mpr htop⟩ + simp only [A, PiLp.norm_eq_sum hp, Real.norm_eq_abs] + congr 1 + apply Finset.sum_congr rfl + intro i hi + rw [abs_of_nonneg (Real.rpow_nonneg + (Finset.sum_nonneg fun j hj => Real.rpow_nonneg (abs_nonneg _) _) _)] + have hright : scalarPSum p (fun j => scalarPSum p (fun i => a i j)) = ‖B‖ := by + simp only [scalarPSum_eq_piLp_norm] + by_cases htop : p.1 = ⊤ + · change ‖WithLp.toLp p.1 (fun j => ‖WithLp.toLp p.1 (fun i => a i j)‖)‖ = + ‖WithLp.toLp p.1 (fun j => WithLp.toLp p.1 (fun i => a i j))‖ + rw [htop] + simp only [PiLp.norm_eq_ciSup, Real.norm_eq_abs] + exact iSup_congr fun i => abs_of_nonneg + (Real.iSup_nonneg fun j => abs_nonneg _) + · have hp : 0 < p.1.toReal := ENNReal.toReal_pos_iff.mpr + ⟨lt_of_lt_of_le zero_lt_one p.2, lt_top_iff_ne_top.mpr htop⟩ + simp only [B, PiLp.norm_eq_sum hp, Real.norm_eq_abs] + congr 1 + apply Finset.sum_congr rfl + intro j hj + rw [abs_of_nonneg (Real.rpow_nonneg + (Finset.sum_nonneg fun i hi => Real.rpow_nonneg (abs_nonneg _) _) _)] + exact hleft.trans (hnorm.trans hright.symm) + +private theorem realLp_finset_sum_le {ι κ : Type*} + [Fintype κ] {r : ℝ} (hr : 1 ≤ r) (s : Finset ι) + (a : ι → κ → ℝ) (ha : ∀ i ∈ s, ∀ j, 0 ≤ a i j) : + (∑ j, (∑ i ∈ s, a i j) ^ r) ^ (1 / r) ≤ + ∑ i ∈ s, (∑ j, a i j ^ r) ^ (1 / r) := by + classical + induction s using Finset.induction_on with + | empty => + have hrpos : 0 < r := lt_of_lt_of_le zero_lt_one hr + simp [Real.zero_rpow hrpos.ne', Real.zero_rpow (inv_ne_zero hrpos.ne')] + | @insert i s his ih => + have hai : ∀ j, 0 ≤ a i j := fun j => ha i (Finset.mem_insert_self ..) j + have has : ∀ k ∈ s, ∀ j, 0 ≤ a k j := by + intro k hk j + exact ha k (Finset.mem_insert_of_mem hk) j + simp only [Finset.sum_insert his] + calc + (∑ j, (a i j + ∑ k ∈ s, a k j) ^ r) ^ (1 / r) ≤ + (∑ j, a i j ^ r) ^ (1 / r) + + (∑ j, (∑ k ∈ s, a k j) ^ r) ^ (1 / r) := + Real.Lp_add_le_of_nonneg Finset.univ hr + (by intro j hj; exact hai j) + (by intro j hj; exact Finset.sum_nonneg fun k hk => has k hk j) + _ ≤ (∑ j, a i j ^ r) ^ (1 / r) + + ∑ k ∈ s, (∑ j, a k j ^ r) ^ (1 / r) := by + gcongr + exact ih has + +private theorem realMixedPSum_mono {n m : ℕ} {p q : ℝ} (hp : 0 < p) + (hpq : p ≤ q) (a : Fin n → Fin m → ℝ) : + (∑ j, ((∑ i, |a i j| ^ p) ^ (1 / p)) ^ q) ^ (1 / q) ≤ + (∑ i, ((∑ j, |a i j| ^ q) ^ (1 / q)) ^ p) ^ (1 / p) := by + have hq : 0 < q := lt_of_lt_of_le hp hpq + let r : ℝ := q / p + have hr : 1 ≤ r := (one_le_div hp).mpr hpq + let b : Fin n → Fin m → ℝ := fun i j => |a i j| ^ p + have hb : ∀ i ∈ (Finset.univ : Finset (Fin n)), ∀ j, 0 ≤ b i j := by + intro i hi j + exact Real.rpow_nonneg (abs_nonneg _) _ + have hMink := realLp_finset_sum_le hr Finset.univ b hb + have hMLnonneg : 0 ≤ (∑ j, (∑ i ∈ Finset.univ, b i j) ^ r) ^ (1 / r) := by + apply Real.rpow_nonneg + exact Finset.sum_nonneg fun j hj => + Real.rpow_nonneg (Finset.sum_nonneg fun i hi => hb i hi j) _ + have hpow := Real.rpow_le_rpow hMLnonneg hMink (one_div_nonneg.mpr hp.le) + convert hpow using 1 + · have hterm (j : Fin m) : ((∑ i, |a i j| ^ p) ^ (1 / p)) ^ q = + (∑ i, b i j) ^ r := by + change ((∑ i, |a i j| ^ p) ^ (1 / p)) ^ q = + (∑ i, |a i j| ^ p) ^ r + rw [← Real.rpow_mul (Finset.sum_nonneg fun i hi => + Real.rpow_nonneg (abs_nonneg _) _)] + congr 1 + dsimp [r] + field_simp + simp_rw [hterm] + rw [← Real.rpow_mul (Finset.sum_nonneg fun j hj => + Real.rpow_nonneg (Finset.sum_nonneg fun i hi => hb i hi j) _)] + congr 1 + dsimp [r] + field_simp + · congr 1 + apply Finset.sum_congr rfl + intro i hi + have hinner : (∑ j, b i j ^ r) = ∑ j, |a i j| ^ q := by + apply Finset.sum_congr rfl + intro j hj + change (|a i j| ^ p) ^ r = |a i j| ^ q + rw [← Real.rpow_mul (abs_nonneg _)] + congr 1 + dsimp [r] + field_simp + rw [hinner] + rw [← Real.rpow_mul (Finset.sum_nonneg fun j hj => + Real.rpow_nonneg (abs_nonneg _) _)] + congr 1 + dsimp [r] + field_simp + +/-- Mixed finite p-sums satisfy the Minkowski interchange inequality. -/ +theorem scalarPSum_mixed_le_finite {p q : Exponent} (hpq : p ≤ q) + (hq : q.IsFinite) {n m : ℕ} (a : Fin n → Fin m → ℝ) : + scalarPSum q (fun j => scalarPSum p (fun i => a i j)) ≤ + scalarPSum p (fun i => scalarPSum q (fun j => a i j)) := by + have hp : p.IsFinite := lt_of_le_of_lt hpq hq + have hpReal : 0 < p.1.toReal := ENNReal.toReal_pos_iff.mpr + ⟨lt_of_lt_of_le zero_lt_one p.2, hp⟩ + have hpqReal : p.1.toReal ≤ q.1.toReal := + ENNReal.toReal_mono (ne_of_lt hq) hpq + have h := realMixedPSum_mono hpReal hpqReal a + simpa [scalarPSum, ne_of_lt hp, ne_of_lt hq, + abs_of_nonneg (Real.rpow_nonneg (Finset.sum_nonneg fun _ _ => + Real.rpow_nonneg (abs_nonneg _) _) _)] using h + +private theorem freeNormExt_latticePSum_le (p : Exponent) {n : ℕ} + (f : Fin n → Free p E) : + freeNormExt p (latticePSum p f : Free p E).1.1 ≤ + ENNReal.ofReal (scalarPSum p (fun i => ‖f i‖)) := by + by_cases htop : p.1 = ⊤ + · rw [freeNormExt, ite_eq_left htop] + refine iSup_le fun φ => iSup_le fun hφ => ?_ + apply ENNReal.ofReal_le_ofReal + rw [latticePSum_apply, abs_of_nonneg (scalarPSum_nonneg ..)] + apply scalarPSum_mono_abs + intro i + have hnorm : ‖(f i).1‖ = ‖f i‖ := rfl + simpa only [abs_of_nonneg (norm_nonneg (f i)), hnorm] using + (hp_unit_eval_le p (f i).1 φ hφ) + · rw [freeNormExt, ite_eq_right htop] + refine iSup_le fun m => iSup_le fun φ => iSup_le fun hφ => ?_ + apply ENNReal.ofReal_le_ofReal + simp_rw [latticePSum_apply] + rw [scalarPSum_swap] + apply scalarPSum_mono_abs + intro i + have hle := hp_admissible_eval_le p htop (f i).1 φ hφ + have hnorm : ‖(f i).1‖ = ‖f i‖ := rfl + simpa only [abs_of_nonneg (scalarPSum_nonneg ..), + abs_of_nonneg (norm_nonneg (f i)), hnorm] using hle + +/-- Section 1: free lattices have convexity constant one. -/ +theorem free_pConvex (p : Exponent) : ConvexWith p 1 (Free p E) := by + refine ⟨le_rfl, ?_⟩ + intro n f + rw [one_mul] + change (freeNormExt p (latticePSum p f : Free p E).1.1).toReal ≤ _ + exact ENNReal.toReal_le_of_le_ofReal (scalarPSum_nonneg ..) + (freeNormExt_latticePSum_le p f) + +/-- The endpoint free lattice has convexity constant one at every exponent. -/ +theorem free_infinity_pConvex (p : Exponent) : + ConvexWith p 1 (Free Exponent.infinity E) := by + refine ⟨le_rfl, ?_⟩ + intro n f + rw [one_mul] + change (freeNormExt Exponent.infinity + (latticePSum p f : Free Exponent.infinity E).1.1).toReal ≤ _ + apply ENNReal.toReal_le_of_le_ofReal (scalarPSum_nonneg ..) + rw [freeNormExt, ite_eq_left (show (Exponent.infinity : Exponent).1 = ⊤ by rfl)] + refine iSup_le fun φ => iSup_le fun hφ => ?_ + apply ENNReal.ofReal_le_ofReal + rw [latticePSum_apply, abs_of_nonneg (scalarPSum_nonneg ..)] + apply scalarPSum_mono_abs + intro i + have h := hp_unit_eval_le Exponent.infinity (f i).1 φ hφ + simpa using h + +/-- Section 5: higher-convexity free lattices have lower-convexity constant one. -/ +theorem free_lower_convexity {p q : Exponent} (hpq : p ≤ q) : + ConvexWith p 1 (Free q E) := by + by_cases h : p = q + · subst q + exact free_pConvex p + · by_cases hq : q = Exponent.infinity + · subst q + exact free_infinity_pConvex p + · have hqfinite : q.IsFinite := lt_top_iff_ne_top.mpr (by + intro htop + exact hq (Subtype.ext htop)) + refine ⟨le_rfl, ?_⟩ + intro n f + rw [one_mul] + change (freeNormExt q (latticePSum p f : Free q E).1.1).toReal ≤ _ + apply ENNReal.toReal_le_of_le_ofReal (scalarPSum_nonneg ..) + rw [freeNormExt, ite_eq_right (ne_of_lt hqfinite)] + refine iSup_le fun m => iSup_le fun φ => iSup_le fun hφ => ?_ + apply ENNReal.ofReal_le_ofReal + simp_rw [latticePSum_apply] + calc + scalarPSum q (fun j => scalarPSum p (fun i => f i (φ j))) ≤ + scalarPSum p (fun i => scalarPSum q (fun j => f i (φ j))) := + scalarPSum_mixed_le_finite hpq hqfinite _ + _ ≤ scalarPSum p (fun i => ‖f i‖) := by + apply scalarPSum_mono_abs + intro i + have hle := hp_admissible_eval_le q (ne_of_lt hqfinite) (f i).1 φ hφ + have hnorm : ‖(f i).1‖ = ‖f i‖ := rfl + simpa only [abs_of_nonneg (scalarPSum_nonneg ..), + abs_of_nonneg (norm_nonneg (f i)), hnorm] using hle + +/-- At p = 1, BanLat's free Banach lattice lift gives the extension with its sharp norm. -/ +theorem universal_property_one_core {X : Type w} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (S : E →L[ℝ] X) : + ∃ L : LatticeOperator (Free Exponent.one E) X, + (∀ x, L (delta Exponent.one x) = S x) ∧ + ‖L.toContinuousLinearMap‖ ≤ ‖S‖ := by + obtain ⟨U, hU⟩ := banlat_fbl_identification (E := E) + let A : Free Exponent.one E →L[ℝ] _root_.FBL E := + U.toContinuousLinearEquiv.toContinuousLinearMap + let B : Free Exponent.one E →L[ℝ] X := + (_root_.FBL.liftContinuousLinearMap S).comp A + let L : LatticeOperator (Free Exponent.one E) X := { + toContinuousLinearMap := B + map_sup' := by + intro f g + change _root_.FBL.lift S (U (f ⊔ g)) = + _root_.FBL.lift S (U f) ⊔ _root_.FBL.lift S (U g) + have h : U (f ⊔ g) = U f ⊔ U g := U.map_sup' f g + rw [h] + exact (_root_.FBL.lift S).map_sup' (U f) (U g) + map_inf' := by + intro f g + change _root_.FBL.lift S (U (f ⊓ g)) = + _root_.FBL.lift S (U f) ⊓ _root_.FBL.lift S (U g) + have h : U (f ⊓ g) = U f ⊓ U g := U.map_inf' f g + rw [h] + exact (_root_.FBL.lift S).map_inf' (U f) (U g) } + have hUdelta (x : E) : U (delta Exponent.one x) = _root_.FBL.of x := by + apply Subtype.ext + apply Subtype.ext + ext ψ + calc + (U (delta Exponent.one x) : _root_.FBL E) ψ = + (delta Exponent.one x) (WeakDual.toStrongDual ψ.1) := hU _ ψ + _ = (_root_.FBL.of x : _root_.FBL E) ψ := rfl + refine ⟨L, ?_, ?_⟩ + · intro x + change _root_.FBL.liftContinuousLinearMap S (U (delta Exponent.one x)) = S x + rw [hUdelta, _root_.FBL.liftContinuousLinearMap_apply, _root_.FBL.lift_of] + · change ‖B‖ ≤ ‖S‖ + apply B.opNorm_le_bound (norm_nonneg S) + intro f + change ‖_root_.FBL.liftContinuousLinearMap S (U f)‖ ≤ ‖S‖ * ‖f‖ + calc + ‖_root_.FBL.liftContinuousLinearMap S (U f)‖ ≤ + ‖_root_.FBL.liftContinuousLinearMap S‖ * ‖U f‖ := + (_root_.FBL.liftContinuousLinearMap S).le_opNorm (U f) + _ = ‖S‖ * ‖f‖ := by + have h : ‖U f‖ = ‖f‖ := U.toLinearIsometryEquiv.norm_map f + rw [_root_.FBL.norm_lift, h] + +/-- Every admissible p-convexity constant is at least one. -/ +theorem convexityConstant_ge_one (p : Exponent) {X : Type w} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (hX : IsPConvex p X) : 1 ≤ convexityConstant p X := by + obtain ⟨C, hC⟩ := hX + unfold convexityConstant + apply le_csInf ⟨C, hC⟩ + intro b hb + exact hb.1 + +/-- The optimal p-convexity constant itself satisfies the finite-family estimate. -/ +theorem convexityConstant_spec (p : Exponent) {X : Type w} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (hX : IsPConvex p X) : ConvexWith p (convexityConstant p X) X := by + obtain ⟨C, hC⟩ := hX + constructor + · exact le_csInf ⟨C, hC⟩ (fun b hb => hb.1) + · intro n x + let a := scalarPSum p (fun i => ‖x i‖) + have ha : 0 ≤ a := scalarPSum_nonneg p _ + by_cases h0 : a = 0 + · have hB := hC.2 n x + change ‖latticePSum p x‖ ≤ C * a at hB + change ‖latticePSum p x‖ ≤ convexityConstant p X * a + rw [h0, mul_zero] at hB ⊢ + exact hB + · have hap : 0 < a := lt_of_le_of_ne ha (Ne.symm h0) + have hdiv : ‖latticePSum p x‖ / a ≤ convexityConstant p X := by + apply le_csInf ⟨C, hC⟩ + intro b hb + exact (div_le_iff₀ hap).mpr (hb.2 n x) + change ‖latticePSum p x‖ ≤ convexityConstant p X * a + exact (div_le_iff₀ hap).mp hdiv + +/-- An admissible family evaluates every free-lattice element within its free norm. -/ +theorem freeNorm_family_le (p : Exponent) {n : ℕ} (f : Free p E) + (ψ : Fin n → Dual E) (hψ : NormAdmissible p ψ) : + scalarPSum p (fun i => f (ψ i)) ≤ ‖f‖ := by + by_cases htop : p.1 = ⊤ + · by_cases hn : n = 0 + · subst n + rw [scalarPSum_eq_piLp_norm] + have hz : (WithLp.toLp p.1 (fun i : Fin 0 => f (ψ i)) : + PiLp p.1 (fun _ : Fin 0 => ℝ)) = 0 := Subsingleton.elim _ _ + rw [hz, norm_zero] + exact norm_nonneg f + have : Nonempty (Fin n) := ⟨⟨0, Nat.pos_of_ne_zero hn⟩⟩ + have hφnorm (i : Fin n) : ‖ψ i‖ ≤ 1 := by + apply (ψ i).opNorm_le_bound zero_le_one + intro x + have hcoord := PiLp.norm_apply_le + (WithLp.toLp p.1 (fun j => ψ j x) : PiLp p.1 (fun _ : Fin n => ℝ)) i + have hsum := normAdmissible_eval_le_norm p ψ hψ x + rw [scalarPSum_eq_piLp_norm] at hsum + simpa only [Real.norm_eq_abs, one_mul] using hcoord.trans hsum + rw [scalarPSum_eq_piLp_norm, htop, PiLp.norm_eq_ciSup] + apply ciSup_le + intro i + have hle := ofReal_abs_le_freeNormExt p (fun θ : Dual E => f θ) (ψ i) (hφnorm i) + have hfin : freeNormExt p (fun θ : Dual E => f θ) ≠ ⊤ := ne_of_lt f.1.2.2 + have hreal := (ENNReal.ofReal_le_iff_le_toReal hfin).mp hle + change |f (ψ i)| ≤ ‖f‖ at hreal + simpa only [Real.norm_eq_abs] using hreal + · have hle : ENNReal.ofReal (scalarPSum p (fun i => f (ψ i))) ≤ + freeNormExt p (fun θ : Dual E => f θ) := by + rw [freeNormExt, ite_eq_right htop] + exact le_iSup_of_le n (le_iSup_of_le ψ (le_iSup_of_le hψ le_rfl)) + have hfin : freeNormExt p (fun θ : Dual E => f θ) ≠ ⊤ := ne_of_lt f.1.2.2 + exact (ENNReal.ofReal_le_iff_le_toReal hfin).mp hle + +section PConvexLiftBound + +variable {X : Type w} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [BanachLattice X] + +/-- A positive dual functional dominates the scalar p-sum of its values by its value on the +lattice p-sum. -/ +theorem positive_dual_scalarPSum_le (p : Exponent) {n : ℕ} (x : Fin n → X) + (ψ : Dual X) (hψ : 0 ≤ ψ) : + scalarPSum p (fun i => ψ (x i)) ≤ ψ (latticePSum p x) := by + let := isUniformlyCompleteVectorLattice_of_banachLattice X + let y : PiLp p.1 (fun _ : Fin n => ℝ) := WithLp.toLp p.1 (fun i => ψ (x i)) + obtain ⟨l, hl, hly⟩ := exists_dual_vector'' ℝ y + let a : Fin n → ℝ := fun i => l (PiLp.single p.1 i 1) + have hlin (z : Fin n → ℝ) : + ∑ i, a i * z i = l (WithLp.toLp p.1 z) := by + have hz := (PiLp.basisFun p.1 ℝ (Fin n)).sum_repr (WithLp.toLp p.1 z) + simpa [a, map_sum, map_smul, smul_eq_mul, mul_comm] using congrArg l hz + have hpoint : (∑ i, a i • PosHomFunction.coordinate i) ≤ pSumFunction p n := by + intro z + change (∑ i, a i • PosHomFunction.coordinate i : posHomFunctions n) z ≤ scalarPSum p z + change ((posHomFunctions n).toSubmodule.subtype + (∑ i, a i • PosHomFunction.coordinate i)) z ≤ _ + simp only [map_sum, map_smul, ContinuousMap.sum_apply, + ContinuousMap.smul_apply, smul_eq_mul] + change (∑ i, a i * z i) ≤ scalarPSum p z + rw [hlin, scalarPSum_eq_piLp_norm] + exact (le_abs_self _).trans ((l.le_opNorm _).trans + (by simpa only [one_mul] using mul_le_mul_of_nonneg_right hl (norm_nonneg _))) + have hcalc := (PosHomFunction.functionalCalculus x).monotone hpoint + simp only [map_sum, map_smul, PosHomFunction.functionalCalculus_coordinate] at hcalc + have hbound := StrongDual.apply_le_apply_of_nonneg hψ hcalc + simp only [map_sum, map_smul, smul_eq_mul] at hbound + rw [hlin] at hbound + change l y ≤ ψ (latticePSum p x) at hbound + simpa [hly, scalarPSum_eq_piLp_norm, y] using hbound + +private theorem positive_dual_family_pSum_le (p : Exponent) {C : ℝ} + (hC : ConvexWith p C X) {m n : ℕ} (ψ : Fin m → Dual X) + (hψ : ∀ i, 0 ≤ ψ i) (x : Fin n → X) : + ∑ i, scalarPSum p (fun j => ψ i (x j)) ≤ + ‖∑ i, ψ i‖ * C * scalarPSum p (fun j => ‖x j‖) := by + have h := Finset.sum_le_sum (s := Finset.univ) + (fun i _ => positive_dual_scalarPSum_le p x (ψ i) (hψ i)) + calc + ∑ i, scalarPSum p (fun j => ψ i (x j)) ≤ ∑ i, ψ i (latticePSum p x) := h + _ = (∑ i, ψ i) (latticePSum p x) := by simp + _ ≤ ‖∑ i, ψ i‖ * ‖latticePSum p x‖ := + (le_abs_self _).trans ((∑ i, ψ i).le_opNorm _) + _ ≤ ‖∑ i, ψ i‖ * (C * scalarPSum p (fun j => ‖x j‖)) := + mul_le_mul_of_nonneg_left (hC.2 n x) (norm_nonneg _) + _ = _ := by ring + +private theorem mem_convexHull_exists_fin {d : ℕ} {s : Set (Fin d → ℝ)} + {a : Fin d → ℝ} (ha : a ∈ convexHull ℝ s) : + ∃ n : ℕ, ∃ c : Fin n → ℝ, ∃ z : Fin n → (Fin d → ℝ), + (∀ j, 0 ≤ c j) ∧ (∑ j, c j = 1) ∧ (∀ j, z j ∈ s) ∧ ∑ j, c j • z j = a := by + obtain ⟨ι, _, c, z, hc, hsum, hz, ha⟩ := mem_convexHull_iff_exists_fintype.mp ha + let e := Fintype.equivFin ι + refine ⟨Fintype.card ι, c ∘ e.symm, z ∘ e.symm, fun j => hc _, ?_, fun j => hz _, ?_⟩ + · simpa only [Function.comp_apply] using (e.symm.sum_comp c).trans hsum + · simpa only [Function.comp_apply] using + (e.symm.sum_comp (fun j => c j • z j)).trans ha + +private theorem positive_dual_convexHull_pSum_le (p : Exponent) (hp : p.IsFinite) {C : ℝ} + (hC : ConvexWith p C X) {m : ℕ} (ψ : Fin m → Dual X) + (hψ : ∀ i, 0 ≤ ψ i) {a : Fin m → ℝ} + (ha : a ∈ convexHull ℝ ((fun x : X => fun i => |ψ i x| ^ p.1.toReal) '' + Metric.closedBall 0 1)) : + ∑ i, (a i) ^ (1 / p.1.toReal) ≤ ‖∑ i, ψ i‖ * C := by + obtain ⟨n, c, z, hc, hsum, hz, rfl⟩ := mem_convexHull_exists_fin ha + choose x hx hz using hz + let y : Fin n → X := fun j => c j ^ (1 / p.1.toReal) • x j + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos_iff.mpr + ⟨lt_of_lt_of_le zero_lt_one p.2, hp⟩ + have hpow (j : Fin n) : (c j ^ (1 / p.1.toReal)) ^ p.1.toReal = c j := by + simpa only [one_div] using Real.rpow_inv_rpow (hc j) hp0.ne' + have hcoord (i : Fin m) : (∑ j, c j • z j) i = ∑ j, |ψ i (y j)| ^ p.1.toReal := by + simp only [Finset.sum_apply, Pi.smul_apply, smul_eq_mul] + apply Finset.sum_congr rfl + intro j _ + rw [← hz j] + simp only [y, map_smul, smul_eq_mul, abs_mul, + abs_of_nonneg (Real.rpow_nonneg (hc j) _)] + rw [Real.mul_rpow (Real.rpow_nonneg (hc j) _) (abs_nonneg _), hpow] + have hynorm : scalarPSum p (fun j => ‖y j‖) ≤ 1 := by + have hle : scalarPSum p (fun j => ‖y j‖) ≤ + scalarPSum p (fun j => c j ^ (1 / p.1.toReal)) := by + apply scalarPSum_mono_abs + intro j + rw [abs_of_nonneg (norm_nonneg (y j))] + simp only [y, norm_smul, Real.norm_eq_abs, + abs_of_nonneg (Real.rpow_nonneg (hc j) _)] + exact mul_le_of_le_one_right (Real.rpow_nonneg (hc j) _) + (mem_closedBall_zero_iff.mp (hx j)) + convert hle using 1 + simp only [scalarPSum, ite_eq_right (ne_of_lt hp), + abs_of_nonneg (Real.rpow_nonneg (hc _) _), hpow, hsum, Real.one_rpow] + have h := positive_dual_family_pSum_le p hC ψ hψ y + have hb := h.trans (mul_le_of_le_one_right + (mul_nonneg (norm_nonneg _) (le_trans zero_le_one hC.1)) hynorm) + simpa only [hcoord, scalarPSum, ite_eq_right (ne_of_lt hp)] using hb + +private theorem exists_positive_diagonal_weights {n : ℕ} {r δ : ℝ} + (hr : 0 < r) (hδ : 0 < δ) (K : Set (Fin n → ℝ)) + (hK : IsCompact K) (hne : K.Nonempty) (hconv : Convex ℝ K) + (hpos : ∀ a ∈ K, ∀ i, 0 ≤ a i) : + ∃ a ∈ K, ∀ b ∈ K, + ∑ i, (a i + δ) ^ (r - 1) * b i ≤ + ∑ i, (a i + δ) ^ (r - 1) * a i := by + let g : (Fin n → ℝ) → ℝ := fun a => ∑ i, (a i + δ) ^ r + have hg : Continuous g := by + exact continuous_finsetSum _ (fun i _ => + ((continuous_apply i).add continuous_const).rpow_const (fun _ => Or.inr hr.le)) + obtain ⟨a, ha, hmax⟩ := hK.exists_isMaxOn hne hg.continuousOn + have hd (i : Fin n) : HasFDerivAt (fun b : Fin n → ℝ => (b i + δ) ^ r) + ((r * (a i + δ) ^ (r - 1)) • + (ContinuousLinearMap.proj i : (Fin n → ℝ) →L[ℝ] ℝ)) a := by + exact (((ContinuousLinearMap.proj i : (Fin n → ℝ) →L[ℝ] ℝ).hasFDerivAt + (x := a)).add_const δ).rpow_const + (Or.inl (ne_of_gt (add_pos_of_nonneg_of_pos (hpos a ha i) hδ))) + have hdg := HasFDerivAt.fun_sum (u := Finset.univ) (fun i _ => hd i) + refine ⟨a, ha, ?_⟩ + intro b hb + have hdir := hmax.isLocalMaxOn.hasFDerivWithinAt_nonpos hdg.hasFDerivWithinAt + (sub_mem_posTangentConeAt_of_segment_subset (hconv.segment_subset ha hb)) + simp only [sum_apply, smul_apply, + ContinuousLinearMap.proj_apply, Pi.sub_apply, smul_eq_mul] at hdir + simp_rw [mul_assoc, mul_sub] at hdir + rw [Finset.sum_sub_distrib, ← Finset.mul_sum, ← Finset.mul_sum] at hdir + nlinarith + +private theorem positive_dual_diagonal_bound (p : Exponent) (hp : p.IsFinite) {C δ : ℝ} + (hC : ConvexWith p C X) (hδ : 0 < δ) {m : ℕ} (ψ : Fin m → Dual X) + (hψ : ∀ i, 0 ≤ ψ i) : + ∃ a : Fin m → ℝ, (∀ i, 0 ≤ a i) ∧ + (∑ i, (a i) ^ (1 / p.1.toReal) ≤ ‖∑ i, ψ i‖ * C) ∧ + ∀ x : X, ‖x‖ ≤ 1 → + ∑ i, (a i + δ) ^ (1 / p.1.toReal - 1) * |ψ i x| ^ p.1.toReal ≤ + ∑ i, (a i + δ) ^ (1 / p.1.toReal) := by + let A : Set (Fin m → ℝ) := (fun x : X => fun i => |ψ i x| ^ p.1.toReal) '' + Metric.closedBall 0 1 + let K := closure (convexHull ℝ A) + let b : Fin m → ℝ := fun i => ‖ψ i‖ ^ p.1.toReal + have hA : A ⊆ Icc 0 b := by + rintro _ ⟨x, hx, rfl⟩ + constructor + · intro i + exact Real.rpow_nonneg (abs_nonneg _) _ + · intro i + apply Real.rpow_le_rpow (abs_nonneg _) _ ENNReal.toReal_nonneg + exact ((ψ i).le_opNorm x).trans + (mul_le_of_le_one_right (norm_nonneg _) (mem_closedBall_zero_iff.mp hx)) + have hKsub : K ⊆ Icc 0 b := closure_minimal (convexHull_min hA (convex_Icc _ _)) + isClosed_Icc + have hK : IsCompact K := isCompact_Icc.of_isClosed_subset isClosed_closure hKsub + have hne : K.Nonempty := by + have hmem : (fun i => |ψ i (0 : X)| ^ p.1.toReal) ∈ A := + ⟨0, mem_closedBall_zero_iff.mpr (by simp), rfl⟩ + exact ⟨_, subset_closure (subset_convexHull ℝ A hmem)⟩ + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos_iff.mpr + ⟨lt_of_lt_of_le zero_lt_one p.2, hp⟩ + have hg : Continuous (fun a : Fin m → ℝ => ∑ i, (a i) ^ (1 / p.1.toReal)) := + continuous_finsetSum _ (fun i _ => (continuous_apply i).rpow_const + (fun _ => Or.inr (by positivity))) + have hbound : ∀ a ∈ K, ∑ i, (a i) ^ (1 / p.1.toReal) ≤ ‖∑ i, ψ i‖ * C := by + apply closure_minimal + · exact fun a ha => positive_dual_convexHull_pSum_le p hp hC ψ hψ ha + · exact isClosed_le hg continuous_const + obtain ⟨a, ha, hw⟩ := exists_positive_diagonal_weights (one_div_pos.mpr hp0) hδ + K hK hne (convex_convexHull ℝ A).closure (fun a ha i => (hKsub ha).1 i) + refine ⟨a, (hKsub ha).1, hbound a ha, ?_⟩ + intro x hx + have hxK : (fun i => |ψ i x| ^ p.1.toReal) ∈ K := + subset_closure (subset_convexHull ℝ A ⟨x, mem_closedBall_zero_iff.mpr hx, rfl⟩) + apply (hw _ hxK).trans + apply Finset.sum_le_sum + intro i _ + have hai : 0 < a i + δ := add_pos_of_nonneg_of_pos ((hKsub ha).1 i) hδ + calc + (a i + δ) ^ (1 / p.1.toReal - 1) * a i ≤ + (a i + δ) ^ (1 / p.1.toReal - 1) * (a i + δ) := + mul_le_mul_of_nonneg_left (le_add_of_nonneg_right hδ.le) (Real.rpow_nonneg hai.le _) + _ = (a i + δ) ^ (1 / p.1.toReal) := by + rw [Real.rpow_sub_one hai.ne', div_mul_cancel₀ _ hai.ne'] + +/-- A uniformly bounded family of functionals evaluates free elements with the same bound. -/ +theorem freeNorm_scaled_family_le (p : Exponent) {n : ℕ} + (f : Free p E) (φ : Fin n → Dual E) {D : ℝ} (hD : 0 < D) + (hφ : ∀ x : E, ‖x‖ ≤ 1 → scalarPSum p (fun i => φ i x) ≤ D) : + scalarPSum p (fun i => f (φ i)) ≤ D * ‖f‖ := by + let θ : Fin n → Dual E := fun i => D⁻¹ • φ i + have hθ : NormAdmissible p θ := by + intro x hx + change scalarPSum p (fun i => D⁻¹ * φ i x) ≤ 1 + rw [scalarPSum_smul, abs_of_pos (inv_pos.mpr hD)] + exact (mul_le_mul_of_nonneg_left (hφ x hx) (inv_nonneg.mpr hD.le)).trans + (by rw [inv_mul_cancel₀ hD.ne']) + have h := freeNorm_family_le p f θ hθ + have hf : PosHomogeneous (fun η => f η) := f.1.2.1 + have hscale (i : Fin n) : f (φ i) = D * f (θ i) := by + rw [← hf D hD.le] + simp [θ, smul_smul, hD.ne'] + simp_rw [hscale] + rw [scalarPSum_smul, abs_of_pos hD] + exact mul_le_mul_of_nonneg_left h hD.le + +private theorem scalarPSum_weighted_holder (p : Exponent) (hp : p.IsFinite) {n : ℕ} + (d u : Fin n → ℝ) (hd : ∀ i, 0 < d i) : + ∑ i, u i ≤ (∑ i, d i) ^ (1 - 1 / p.1.toReal) * + scalarPSum p (fun i => d i ^ (1 / p.1.toReal - 1) * u i) := by + have hp1 : 1 ≤ p.1.toReal := + (ENNReal.toReal_le_toReal (by simp) (ne_of_lt hp)).mpr p.2 + have hp0 : 0 < p.1.toReal := lt_of_lt_of_le zero_lt_one hp1 + have hpow (i : Fin n) : + d i * (|u i| / d i) ^ p.1.toReal = + |d i ^ (1 / p.1.toReal - 1) * u i| ^ p.1.toReal := by + rw [abs_mul, abs_of_pos (Real.rpow_pos_of_pos (hd i) _), + Real.mul_rpow (Real.rpow_nonneg (hd i).le _) (abs_nonneg _), + ← Real.rpow_mul (hd i).le, Real.div_rpow (abs_nonneg _) (hd i).le] + have he : (1 / p.1.toReal - 1) * p.1.toReal = 1 - p.1.toReal := by + field_simp + rw [he, Real.rpow_sub (hd i), Real.rpow_one] + ring + have h := Real.inner_le_weight_mul_Lp_of_nonneg Finset.univ hp1 d + (fun i => |u i| / d i) (fun i => (hd i).le) + (fun i => div_nonneg (abs_nonneg _) (hd i).le) + have hmul (i : Fin n) : d i * (|u i| / d i) = |u i| := by + field_simp [(hd i).ne'] + simp_rw [hmul, hpow] at h + apply (Finset.sum_le_sum (fun i _ => le_abs_self (u i))).trans + simpa only [scalarPSum, ite_eq_right (ne_of_lt hp), one_div] using h + +private theorem free_positive_dual_sum_le_add (p : Exponent) (hp : p.IsFinite) {C δ : ℝ} + (hC : ConvexWith p C X) (hδ : 0 < δ) {m : ℕ} (ψ : Fin m → Dual X) + (hψ : ∀ i, 0 ≤ ψ i) (f : Free p X) : + ∑ i, f (ψ i) ≤ (‖∑ i, ψ i‖ * C + m * δ ^ (1 / p.1.toReal)) * ‖f‖ := by + by_cases hm : m = 0 + · subst m + simp + have : Nonempty (Fin m) := ⟨⟨0, Nat.pos_of_ne_zero hm⟩⟩ + obtain ⟨a, ha, hsum, hdiag⟩ := positive_dual_diagonal_bound p hp hC hδ ψ hψ + let r := 1 / p.1.toReal + let d : Fin m → ℝ := fun i => (a i + δ) ^ r + let B := ∑ i, d i + have hp1 : 1 ≤ p.1.toReal := + (ENNReal.toReal_le_toReal (by simp) (ne_of_lt hp)).mpr p.2 + have hp0 : 0 < p.1.toReal := lt_of_lt_of_le zero_lt_one hp1 + have hd (i : Fin m) : 0 < d i := + Real.rpow_pos_of_pos (add_pos_of_nonneg_of_pos (ha i) hδ) _ + have hB : 0 < B := Finset.sum_pos (fun i _ => hd i) Finset.univ_nonempty + let φ : Fin m → Dual X := fun i => d i ^ (r - 1) • ψ i + have hφpow (i : Fin m) (x : X) : + |φ i x| ^ p.1.toReal = (a i + δ) ^ (r - 1) * |ψ i x| ^ p.1.toReal := by + simp only [φ, smul_apply, smul_eq_mul, abs_mul, + abs_of_pos (Real.rpow_pos_of_pos (hd i) _)] + rw [Real.mul_rpow (Real.rpow_nonneg (hd i).le _) (abs_nonneg _), + ← Real.rpow_mul (hd i).le] + dsimp [d] + rw [← Real.rpow_mul (le_of_lt (add_pos_of_nonneg_of_pos (ha i) hδ))] + congr 2 + dsimp [r] + field_simp + have hφ : ∀ x : X, ‖x‖ ≤ 1 → scalarPSum p (fun i => φ i x) ≤ B ^ r := by + intro x hx + rw [scalarPSum, ite_eq_right (ne_of_lt hp)] + simp_rw [hφpow] + exact Real.rpow_le_rpow + (Finset.sum_nonneg (fun i _ => mul_nonneg + (Real.rpow_nonneg (add_nonneg (ha i) hδ.le) _) (Real.rpow_nonneg (abs_nonneg _) _))) + (hdiag x hx) (by positivity) + have hfree := freeNorm_scaled_family_le p f φ (Real.rpow_pos_of_pos hB r) hφ + have hh := scalarPSum_weighted_holder p hp d (fun i => f (ψ i)) hd + have hf : PosHomogeneous (fun η => f η) := f.1.2.1 + have heval (i : Fin m) : f (φ i) = d i ^ (r - 1) * f (ψ i) := + hf _ (Real.rpow_nonneg (hd i).le _) _ + have hmain : ∑ i, f (ψ i) ≤ B * ‖f‖ := by + change ∑ i, f (ψ i) ≤ B ^ (1 - r) * + scalarPSum p (fun i => d i ^ (r - 1) * f (ψ i)) at hh + simp_rw [← heval] at hh + calc + ∑ i, f (ψ i) ≤ B ^ (1 - r) * scalarPSum p (fun i => f (φ i)) := hh + _ ≤ B ^ (1 - r) * (B ^ r * ‖f‖) := + mul_le_mul_of_nonneg_left hfree (Real.rpow_nonneg hB.le _) + _ = B * ‖f‖ := by rw [← mul_assoc, ← Real.rpow_add hB, sub_add_cancel, Real.rpow_one] + have hBbound : B ≤ ‖∑ i, ψ i‖ * C + m * δ ^ r := by + calc + B ≤ ∑ i, ((a i) ^ r + δ ^ r) := + Finset.sum_le_sum (fun i _ => Real.rpow_add_le_add_rpow (ha i) hδ.le + (one_div_nonneg.mpr hp0.le) ((div_le_one hp0).mpr hp1)) + _ = (∑ i, (a i) ^ r) + m * δ ^ r := by simp [Finset.sum_add_distrib] + _ ≤ ‖∑ i, ψ i‖ * C + m * δ ^ r := add_le_add hsum le_rfl + exact hmain.trans (mul_le_mul_of_nonneg_right hBbound (norm_nonneg _)) + +private theorem free_positive_dual_sum_le_finite (p : Exponent) (hp : p.IsFinite) {C : ℝ} + (hC : ConvexWith p C X) {m : ℕ} (ψ : Fin m → Dual X) + (hψ : ∀ i, 0 ≤ ψ i) (f : Free p X) : + ∑ i, f (ψ i) ≤ ‖∑ i, ψ i‖ * C * ‖f‖ := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos_iff.mpr + ⟨lt_of_lt_of_le zero_lt_one p.2, hp⟩ + have hlim : Tendsto (fun δ : ℝ => + (‖∑ i, ψ i‖ * C + m * δ ^ (1 / p.1.toReal)) * ‖f‖) + (𝓝[>] 0) (𝓝 (‖∑ i, ψ i‖ * C * ‖f‖)) := by + have hr : 0 ≤ 1 / p.1.toReal := one_div_nonneg.mpr hp0.le + have hcont : Continuous (fun δ : ℝ => + (‖∑ i, ψ i‖ * C + m * δ ^ (1 / p.1.toReal)) * ‖f‖) := by + fun_prop + simpa only [Real.zero_rpow (ne_of_gt (one_div_pos.mpr hp0)), mul_zero, add_zero] using + (hcont.continuousAt (x := 0)).tendsto.mono_left + (nhdsWithin_le_nhds (s := Ioi (0 : ℝ))) + apply ge_of_tendsto hlim + filter_upwards [self_mem_nhdsWithin] with δ hδ + exact free_positive_dual_sum_le_add p hp hC hδ ψ hψ f + +/-- Each coordinate is dominated in absolute value by the functional-calculus p-sum. -/ +theorem abs_le_latticePSum (p : Exponent) {n : ℕ} (x : Fin n → X) (i : Fin n) : + |x i| ≤ latticePSum p x := by + let := isUniformlyCompleteVectorLattice_of_banachLattice X + have h : |PosHomFunction.coordinate i| ≤ pSumFunction p n := by + intro z + change |z i| ≤ scalarPSum p z + rw [scalarPSum_eq_piLp_norm] + exact PiLp.norm_apply_le (WithLp.toLp p.1 z) i + have hcalc := (PosHomFunction.functionalCalculus x).monotone h + simpa only [latticePSum, VecLatHom.map_abs, + PosHomFunction.functionalCalculus_coordinate] using hcalc + +/-- Infinity-convexity controls the sum of the norms of a finite positive dual family. -/ +theorem positive_dual_norm_sum_le_infinity {C : ℝ} (hC : ConvexWith Exponent.infinity C X) + {m : ℕ} (ψ : Fin m → Dual X) (hψ : ∀ i, 0 ≤ ψ i) : + ∑ i, ‖ψ i‖ ≤ ‖∑ i, ψ i‖ * C := by + have happrox (ε : ℝ) (hε : 0 < ε) : + ∑ i, ‖ψ i‖ ≤ ‖∑ i, ψ i‖ * C + m * ε := by + have hex (i : Fin m) : ∃ x : X, ‖x‖ ≤ 1 ∧ ‖ψ i‖ - ε ≤ ψ i |x| := by + obtain ⟨x, hx, hval⟩ := (ψ i).exists_lt_apply_of_lt_opNorm (sub_lt_self _ hε) + exact ⟨x, hx.le, hval.le.trans (StrongDual.abs_apply_le_apply_abs (hψ i) x)⟩ + choose x hx hval using hex + have hscalar : scalarPSum Exponent.infinity (fun i => ‖x i‖) ≤ 1 := by + simp only [scalarPSum, Exponent.infinity, ↓reduceIte] + exact_mod_cast Finset.sup_le (fun i _ => show + (⟨|‖x i‖|, abs_nonneg _⟩ : ℝ≥0) ≤ 1 by + change |‖x i‖| ≤ (1 : ℝ) + simpa using hx i) + have hz : ‖latticePSum Exponent.infinity x‖ ≤ C := + (hC.2 m x).trans (mul_le_of_le_one_right (le_trans zero_le_one hC.1) hscalar) + have hupper : ∑ i, ψ i |x i| ≤ ‖∑ i, ψ i‖ * C := by + calc + ∑ i, ψ i |x i| ≤ ∑ i, ψ i (latticePSum Exponent.infinity x) := + Finset.sum_le_sum (fun i _ => StrongDual.apply_le_apply_of_nonneg (hψ i) + (abs_le_latticePSum Exponent.infinity x i)) + _ = (∑ i, ψ i) (latticePSum Exponent.infinity x) := by simp + _ ≤ ‖∑ i, ψ i‖ * ‖latticePSum Exponent.infinity x‖ := + (le_abs_self _).trans ((∑ i, ψ i).le_opNorm _) + _ ≤ ‖∑ i, ψ i‖ * C := mul_le_mul_of_nonneg_left hz (norm_nonneg _) + have hlower := Finset.sum_le_sum (s := Finset.univ) (fun i _ => hval i) + simp only [Finset.sum_sub_distrib, Finset.sum_const, Finset.card_fin, nsmul_eq_mul] at hlower + linarith + have hlim : Tendsto (fun ε : ℝ => ‖∑ i, ψ i‖ * C + m * ε) + (𝓝[>] 0) (𝓝 (‖∑ i, ψ i‖ * C)) := by + have hc : Continuous (fun ε : ℝ => ‖∑ i, ψ i‖ * C + m * ε) := by fun_prop + simpa only [mul_zero, add_zero] using + (hc.continuousAt (x := 0)).tendsto.mono_left + (nhdsWithin_le_nhds (s := Ioi (0 : ℝ))) + apply ge_of_tendsto hlim + filter_upwards [self_mem_nhdsWithin] with ε hε + exact happrox ε hε + +/-- Positive dual families evaluate a free function within the p-convexity bound. +For finite exponents, diagonal weights come from optimization on a finite-dimensional compact +convex set. -/ +theorem free_positive_dual_sum_le (p : Exponent) {C : ℝ} (hC : ConvexWith p C X) + {m : ℕ} (ψ : Fin m → Dual X) (hψ : ∀ i, 0 ≤ ψ i) (f : Free p X) : + ∑ i, f (ψ i) ≤ ‖∑ i, ψ i‖ * C * ‖f‖ := by + by_cases hp : p.IsFinite + · exact free_positive_dual_sum_le_finite p hp hC ψ hψ f + have hpinf : p = Exponent.infinity := Subtype.ext (not_lt_top_iff.mp hp) + subst p + calc + ∑ i, f (ψ i) ≤ ∑ i, ‖ψ i‖ * ‖f‖ := Finset.sum_le_sum (fun i _ => + (le_abs_self _).trans (hp_apply_abs_le Exponent.infinity f.1 (ψ i))) + _ = (∑ i, ‖ψ i‖) * ‖f‖ := (Finset.sum_mul ..).symm + _ ≤ ‖∑ i, ψ i‖ * C * ‖f‖ := mul_le_mul_of_nonneg_right + (positive_dual_norm_sum_le_infinity hC ψ hψ) (norm_nonneg _) + +private theorem free_positive_dual_finset_sum_le (p : Exponent) {C : ℝ} + (hC : ConvexWith p C X) {ι : Type*} (s : Finset ι) (ψ : ι → Dual X) + (hψ : ∀ i ∈ s, 0 ≤ ψ i) (f : Free p X) : + ∑ i ∈ s, f (ψ i) ≤ ‖∑ i ∈ s, ψ i‖ * C * ‖f‖ := by + let e := Fintype.equivFin s + have h := free_positive_dual_sum_le p hC + (fun i => ψ (e.symm i).1) (fun i => hψ _ (e.symm i).2) f + rw [e.symm.sum_comp (fun i : s => f (ψ i.1)), + e.symm.sum_comp (fun i : s => ψ i.1), Finset.univ_eq_attach, + Finset.sum_attach s (fun i => f (ψ i)), Finset.sum_attach s ψ] at h + exact h + +private theorem positive_dual_linearCombination_le_eval {n : ℕ} (x : Fin n → X) + (e : LLexpr n) (ψ : Dual X) (hψ : 0 ≤ ψ) (c : Fin n → ℝ) + (hc : c ∈ (LLexpr.normalize e).pos.coeffs) : + ψ (Fintype.linearCombination ℝ x c) ≤ + LLexpr.eval (fun i => ψ (x i)) e + ψ ((LLexpr.normalize e).neg.eval x) := by + have hlin (d : Fin n → ℝ) : ψ (Fintype.linearCombination ℝ x d) = + Fintype.linearCombination ℝ (fun i => ψ (x i)) d := by + simp [Fintype.linearCombination_apply, map_sum, map_smul] + have hA : ψ (Fintype.linearCombination ℝ x c) ≤ + (LLexpr.normalize e).pos.eval (fun i => ψ (x i)) := by + rw [hlin] + exact Finset.le_sup' (f := Fintype.linearCombination ℝ (fun i => ψ (x i))) hc + have hB : (LLexpr.normalize e).neg.eval (fun i => ψ (x i)) ≤ + ψ ((LLexpr.normalize e).neg.eval x) := by + apply Finset.sup'_le + intro d hd + rw [← hlin] + exact StrongDual.apply_le_apply_of_nonneg hψ + (Finset.le_sup' (f := Fintype.linearCombination ℝ x) hd) + rw [← LLexpr.normalize_eval, LLexpr.NormalForm.eval] + linarith + +private theorem positive_dual_fvl_lift_le (p : Exponent) {C : ℝ} (hC : ConvexWith p C X) + (S : E →L[ℝ] X) (v : FVLv E) (ψ : Dual X) (hψ : 0 ≤ ψ) : + ψ (FVLv.lift S.toLinearMap v) ≤ ‖ψ‖ * C * ‖induced p S (ofFVL p v)‖ := by + obtain ⟨n, x, e, rfl⟩ := FVLv.exists_eval_of_eq v + let y : Fin n → X := fun i => S (x i) + let N := LLexpr.normalize e + let f : Free p X := induced p S (ofFVL p (LLexpr.eval (fun i => FVLv.of (x i)) e)) + have hf (θ : Dual X) : f θ = LLexpr.eval (fun i => θ (y i)) e := by + change ofFVL p (LLexpr.eval (fun i => FVLv.of (x i)) e) (θ.comp S) = _ + exact ofFVL_expr_apply p x e (θ.comp S) + have hlift : FVLv.lift S.toLinearMap (LLexpr.eval (fun i => FVLv.of (x i)) e) = + LLexpr.eval y e := by + simpa [FVLv.lift_of, y] using + LLexpr.map_eval (FVLv.lift S.toLinearMap) (fun i => FVLv.of (x i)) e + rw [hlift, ← LLexpr.normalize_eval, LLexpr.NormalForm.eval, map_sub] + change ψ (N.pos.eval y) - ψ (N.neg.eval y) ≤ ‖ψ‖ * C * ‖f‖ + suffices hb : ψ (N.pos.eval y) ≤ ‖ψ‖ * C * ‖f‖ + ψ (N.neg.eval y) by linarith + have hψOD : (0 : OrderDualSpace X) ≤ StrongDual.toOrderDualSpace ψ := by + exact hψ + apply (OrderBoundedHom.isLUB_apply_finset_sup N.pos.nonempty hψOD + (Fintype.linearCombination ℝ y)).2 + rintro _ ⟨θ, hθpos, hθsum, rfl⟩ + let χ : (Fin n → ℝ) → Dual X := fun i => StrongDual.ofOrderDualSpace (θ i) + have hχpos : ∀ i ∈ N.pos.coeffs, 0 ≤ χ i := by + intro i hi + exact hθpos i hi + have hχsum : ∑ i ∈ N.pos.coeffs, χ i = ψ := by + change ∑ i ∈ N.pos.coeffs, StrongDual.equivOrderDualSpace.symm (θ i) = ψ + rw [← map_sum, hθsum] + exact StrongDual.equivOrderDualSpace.symm_apply_apply ψ + have hbound := free_positive_dual_finset_sum_le p hC N.pos.coeffs χ hχpos f + rw [hχsum] at hbound + calc + ∑ i ∈ N.pos.coeffs, θ i (Fintype.linearCombination ℝ y i) = + ∑ i ∈ N.pos.coeffs, χ i (Fintype.linearCombination ℝ y i) := rfl + _ ≤ ∑ i ∈ N.pos.coeffs, (f (χ i) + χ i (N.neg.eval y)) := by + apply Finset.sum_le_sum + intro i hi + rw [hf] + exact positive_dual_linearCombination_le_eval y e (χ i) (hχpos i hi) i hi + _ = (∑ i ∈ N.pos.coeffs, f (χ i)) + ψ (N.neg.eval y) := by + rw [Finset.sum_add_distrib, ← sum_apply, hχsum] + _ ≤ ‖ψ‖ * C * ‖f‖ + ψ (N.neg.eval y) := add_le_add hbound le_rfl + +private theorem norm_fvl_lift_le_induced (p : Exponent) {C : ℝ} (hC : ConvexWith p C X) + (S : E →L[ℝ] X) (v : FVLv E) : + ‖FVLv.lift S.toLinearMap v‖ ≤ C * ‖induced p S (ofFVL p |v|)‖ := by + obtain ⟨ψ, hψ, hψnorm, hψval⟩ := StrongDual.exists_positive_dual_norming + (x := |FVLv.lift S.toLinearMap v|) (abs_nonneg _) + have h := positive_dual_fvl_lift_le p hC S |v| ψ hψ + rw [VecLatHom.map_abs, hψval, norm_abs_eq_norm] at h + apply h.trans + simpa only [one_mul] using mul_le_mul_of_nonneg_right + (mul_le_mul_of_nonneg_right hψnorm (le_trans zero_le_one hC.1)) + (norm_nonneg (induced p S (ofFVL p |v|))) + +/-- The algebraic free-vector-lattice lift into a p-convex Banach lattice satisfies the required +sharp bound. -/ +theorem fvl_lift_pConvex_norm_le (p : Exponent) {C : ℝ} (hC : ConvexWith p C X) + (S : E →L[ℝ] X) (v : FVLv E) : + ‖FVLv.lift S.toLinearMap v‖ ≤ (C * ‖S‖) * ‖ofFVL p v‖ := by + have hop : ‖induced p S (ofFVL p |v|)‖ ≤ ‖S‖ * ‖ofFVL p v‖ := by + simpa only [VecLatHom.map_abs, norm_abs_eq_norm] using + induced_norm_le p S (ofFVL p |v|) + exact (norm_fvl_lift_le_induced p hC S v).trans + ((mul_le_mul_of_nonneg_left hop (le_trans zero_le_one hC.1)).trans_eq + (mul_assoc C ‖S‖ ‖ofFVL p v‖).symm) + +end PConvexLiftBound + +/-- A coordinate projection from a finite real `ℓᵖ` space as a continuous linear map. -/ +abbrev piLpEvalCLM (p : Exponent) (n : ℕ) (i : Fin n) : + PiLp p.1 (fun _ : Fin n => ℝ) →L[ℝ] ℝ := + PiLp.proj p.1 (fun _ : Fin n => ℝ) i + +/-- A coordinate projection from a finite real `ℓᵖ` space as a lattice homomorphism. -/ +def piLpEvalVec (p : Exponent) (n : ℕ) (i : Fin n) : + VecLatHom (PiLp p.1 (fun _ : Fin n => ℝ)) ℝ where + toFun z := z i + map_add' := by intros; rfl + map_smul' := by intros; rfl + map_sup' := by intros; rfl + map_inf' := by intros; rfl + +private theorem fvl_lift_piLp_apply (p : Exponent) (n : ℕ) + (S : E →L[ℝ] PiLp p.1 (fun _ : Fin n => ℝ)) (v : FVLv E) (i : Fin n) : + (FVLv.lift S.toLinearMap v) i = ofFVL p v ((piLpEvalCLM p n i).comp S) := by + let φ : Dual E := (piLpEvalCLM p n i).comp S + let ev := evalVecLatHom p φ + have hleft : (piLpEvalVec p n i).comp (FVLv.lift S.toLinearMap) = + FVLv.lift (φ : E →ₗ[ℝ] ℝ) := by + apply FVLv.lift_unique + intro x + change (FVLv.lift S.toLinearMap (FVLv.of x)) i = φ x + rw [FVLv.lift_of] + rfl + have hright : ev.comp (ofFVL p) = FVLv.lift (φ : E →ₗ[ℝ] ℝ) := by + apply FVLv.lift_unique + intro x + change ofFVL p (FVLv.of x) φ = φ x + rw [ofFVL_of] + rfl + exact DFunLike.congr_fun (hleft.trans hright.symm) v + +private theorem norm_fvl_lift_piLp (p : Exponent) (n : ℕ) + (S : E →L[ℝ] PiLp p.1 (fun _ : Fin n => ℝ)) (v : FVLv E) : + ‖FVLv.lift S.toLinearMap v‖ = + scalarPSum p (fun i => ofFVL p v ((piLpEvalCLM p n i).comp S)) := by + rw [scalarPSum_eq_piLp_norm] + congr 1 + apply PiLp.ext + intro i + exact fvl_lift_piLp_apply p n S v i + +private theorem free_family_piLp_le (p : Exponent) (n : ℕ) + (S : E →L[ℝ] PiLp p.1 (fun _ : Fin n => ℝ)) (f : Free p E) : + scalarPSum p (fun i => f ((piLpEvalCLM p n i).comp S)) ≤ ‖S‖ * ‖f‖ := by + let φ : Fin n → Dual E := fun i => (piLpEvalCLM p n i).comp S + by_cases hS : S = 0 + · have hφzero (i : Fin n) : φ i = 0 := by simp [φ, hS] + have hz : (fun i => f (φ i)) = (0 : Fin n → ℝ) := by + funext i + rw [hφzero i] + exact free_apply_zero p f + rw [hz, scalarPSum_eq_piLp_norm] + change ‖(0 : PiLp p.1 (fun _ : Fin n => ℝ))‖ ≤ ‖S‖ * ‖f‖ + simp only [hS, norm_zero, zero_mul, le_refl] + have hSpos : 0 < ‖S‖ := norm_pos_iff.mpr hS + apply freeNorm_scaled_family_le p f φ hSpos + intro x hx + have hscalar : scalarPSum p (fun i => φ i x) = ‖S x‖ := by + rw [scalarPSum_eq_piLp_norm] + rfl + rw [hscalar] + exact (S.le_opNorm x).trans + ((mul_le_mul_of_nonneg_left hx (norm_nonneg S)).trans_eq (mul_one _)) + +/-- The algebraic free-lattice lift has the sharp bound for a finite `ℓᵖ` target. -/ +theorem fvl_lift_piLp_norm_le (p : Exponent) (n : ℕ) + (S : E →L[ℝ] PiLp p.1 (fun _ : Fin n => ℝ)) (v : FVLv E) : + ‖FVLv.lift S.toLinearMap v‖ ≤ ‖S‖ * ‖ofFVL p v‖ := by + rw [norm_fvl_lift_piLp] + exact free_family_piLp_le p n S (ofFVL p v) + +section ContinuousMapLift +private theorem fvl_lift_continuousMap_apply {K : Type*} + [TopologicalSpace K] (p : Exponent) + (S : E →L[ℝ] C(K, ℝ)) (v : FVLv E) (k : K) : + (FVLv.lift S.toLinearMap v) k = + ofFVL p v ((ContinuousMap.evalCLM ℝ k).comp S) := by + let φ : Dual E := (ContinuousMap.evalCLM ℝ k).comp S + let ev : VecLatHom C(K, ℝ) ℝ := { + toFun z := z k + map_add' := by intros; rfl + map_smul' := by intros; rfl + map_sup' := by intros; rfl + map_inf' := by intros; rfl } + let evFree : VecLatHom (Free p E) ℝ := { + toFun f := f φ + map_add' := by intros; rfl + map_smul' := by intros; rfl + map_sup' := by intros; rfl + map_inf' := by intros; rfl } + have hleft : ev.comp (FVLv.lift S.toLinearMap) = + FVLv.lift (φ : E →ₗ[ℝ] ℝ) := by + apply FVLv.lift_unique + intro x + change (FVLv.lift S.toLinearMap (FVLv.of x)) k = φ x + rw [FVLv.lift_of] + rfl + have hright : evFree.comp (ofFVL p) = + FVLv.lift (φ : E →ₗ[ℝ] ℝ) := by + apply FVLv.lift_unique + intro x + change ofFVL p (FVLv.of x) φ = φ x + rw [ofFVL_of] + rfl + exact DFunLike.congr_fun (hleft.trans hright.symm) v + +private theorem free_eval_continuousMap_le {K : Type*} + [TopologicalSpace K] [CompactSpace K] (p : Exponent) + (S : E →L[ℝ] C(K, ℝ)) (f : Free p E) (k : K) : + ‖f ((ContinuousMap.evalCLM ℝ k).comp S)‖ ≤ ‖S‖ * ‖f‖ := by + let φ : Dual E := (ContinuousMap.evalCLM ℝ k).comp S + have hφnorm : ‖φ‖ ≤ ‖S‖ := by + apply φ.opNorm_le_bound (norm_nonneg S) + intro x + exact (ContinuousMap.norm_coe_le_norm (S x) k).trans (S.le_opNorm x) + have h : ‖f φ‖ ≤ ‖φ‖ * ‖f‖ := by + simpa only [Real.norm_eq_abs] using free_apply_abs_le p f φ + exact h.trans (mul_le_mul_of_nonneg_right hφnorm (norm_nonneg _)) + +/-- The algebraic free-lattice lift is bounded for every compact-space continuous-function target. +The estimate holds for every exponent because one dual functional norms each point evaluation. -/ +theorem fvl_lift_continuousMap_norm_le {K : Type*} + [TopologicalSpace K] [CompactSpace K] (p : Exponent) + (S : E →L[ℝ] C(K, ℝ)) (v : FVLv E) : + ‖FVLv.lift S.toLinearMap v‖ ≤ ‖S‖ * ‖ofFVL p v‖ := by + apply (ContinuousMap.norm_le (FVLv.lift S.toLinearMap v) + (mul_nonneg (norm_nonneg S) (norm_nonneg (ofFVL p v)))).mpr + intro k + exact (congrArg norm (fvl_lift_continuousMap_apply p S v k)).le.trans + (free_eval_continuousMap_le p S (ofFVL p v) k) + +end ContinuousMapLift + +section AlgebraicLiftExtension +private theorem exists_bounded_linear_extension + {V W X : Type*} [NormedAddCommGroup V] [NormedSpace ℝ V] + [NormedAddCommGroup W] [NormedSpace ℝ W] + [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X] + (e : V →ₗ[ℝ] W) (he : DenseRange e) (B : V →ₗ[ℝ] X) + (C : ℝ) (hC : 0 ≤ C) (hB : ∀ z, ‖B z‖ ≤ C * ‖e z‖) : + ∃ A : W →L[ℝ] X, (∀ z, A (e z) = B z) ∧ ‖A‖ ≤ C := by + let A := B.extendOfNorm e + refine ⟨A, ?_, ?_⟩ + · exact LinearMap.extendOfNorm_eq he ⟨C, hB⟩ + · apply A.opNorm_le_bound hC + exact LinearMap.norm_extendOfNorm_apply_le he C hB + +private theorem exists_algebraic_lift_extension (p : Exponent) {X : Type w} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (S : E →L[ℝ] X) (C : ℝ) (hC : 0 ≤ C) + (hb : ∀ v : FVLv E, + ‖FVLv.lift S.toLinearMap v‖ ≤ C * ‖ofFVL p v‖) : + ∃ A : Free p E →L[ℝ] X, + (∀ v : FVLv E, A (ofFVL p v) = FVLv.lift S.toLinearMap v) ∧ ‖A‖ ≤ C := by + exact exists_bounded_linear_extension (V := FVLv E) (W := Free p E) (X := X) + (ofFVL p (E := E)).toLinearMap (denseRange_ofFVL p) + (FVLv.lift S.toLinearMap).toLinearMap C hC hb + +private theorem algebraic_lift_extension_map_sup (p : Exponent) {X : Type w} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [NormedVectorLattice X] + (S : E →L[ℝ] X) (A : Free p E →L[ℝ] X) + (hA : ∀ v : FVLv E, A (ofFVL p v) = FVLv.lift S.toLinearMap v) + (f g : Free p E) : A (f ⊔ g) = A f ⊔ A g := by + refine map_binary_of_dense_range (ofFVL p (E := E)) (denseRange_ofFVL p) + A A.continuous (· ⊔ ·) (· ⊔ ·) (continuous_fst.sup continuous_snd) + (continuous_fst.sup continuous_snd) ?_ f g + intro v w + rw [← map_sup (ofFVL p (E := E)) v w, hA, hA, hA] + exact (FVLv.lift S.toLinearMap).map_sup' v w + +private theorem algebraic_lift_extension_map_inf (p : Exponent) {X : Type w} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [NormedVectorLattice X] + (S : E →L[ℝ] X) (A : Free p E →L[ℝ] X) + (hA : ∀ v : FVLv E, A (ofFVL p v) = FVLv.lift S.toLinearMap v) + (f g : Free p E) : A (f ⊓ g) = A f ⊓ A g := by + refine map_binary_of_dense_range (ofFVL p (E := E)) (denseRange_ofFVL p) + A A.continuous (· ⊓ ·) (· ⊓ ·) (continuous_fst.inf continuous_snd) + (continuous_fst.inf continuous_snd) ?_ f g + intro v w + rw [← map_inf (ofFVL p (E := E)) v w, hA, hA, hA] + exact (FVLv.lift S.toLinearMap).map_inf' v w + +/-- A norm estimate on the algebraic free vector lattice extends its lift to the completed +free Banach lattice, preserving both lattice operations. -/ +theorem universal_property_of_fvl_bound (p : Exponent) {X : Type w} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (S : E →L[ℝ] X) (C : ℝ) (hC : 0 ≤ C) + (hb : ∀ v : FVLv E, + ‖FVLv.lift S.toLinearMap v‖ ≤ C * ‖ofFVL p v‖) : + ∃ L : LatticeOperator (Free p E) X, + (∀ x, L (delta p x) = S x) ∧ + ‖L.toContinuousLinearMap‖ ≤ C ∧ + ∀ M : LatticeOperator (Free p E) X, + (∀ x, M (delta p x) = S x) → M = L := by + obtain ⟨A, hA, hnorm⟩ := exists_algebraic_lift_extension p S C hC hb + let L : LatticeOperator (Free p E) X := { + toContinuousLinearMap := A + map_sup' := algebraic_lift_extension_map_sup p S A hA + map_inf' := algebraic_lift_extension_map_inf p S A hA } + have hgen (x : E) : L (delta p x) = S x := by + change A (delta p x) = S x + rw [← ofFVL_of p x, hA, FVLv.lift_of] + rfl + refine ⟨L, hgen, ?_, ?_⟩ + · exact hnorm + · intro M hM + exact latticeOperator_ext_delta p M L + (fun x => (hM x).trans (hgen x).symm) +end AlgebraicLiftExtension + +/-- The full free-lattice extension into continuous real functions on a compact space. -/ +theorem universal_property_continuousMap {K : Type*} + [TopologicalSpace K] [CompactSpace K] (p : Exponent) + (S : E →L[ℝ] C(K, ℝ)) : + ∃ L : LatticeOperator (Free p E) C(K, ℝ), + (∀ x, L (delta p x) = S x) ∧ + ‖L.toContinuousLinearMap‖ ≤ ‖S‖ ∧ + ∀ M : LatticeOperator (Free p E) C(K, ℝ), + (∀ x, M (delta p x) = S x) → M = L := + universal_property_of_fvl_bound p S ‖S‖ (norm_nonneg S) + (fvl_lift_continuousMap_norm_le p S) + +/-- The universal property for an AM-space with a unit, transported along Kakutani's +lattice-isometric representation as continuous functions on a compact space. -/ +theorem universal_property_amSpaceWithUnit {X : Type w} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] + [AMSpaceWithUnit X] [Nontrivial X] + (p : Exponent) (S : E →L[ℝ] X) : + ∃ L : LatticeOperator (Free p E) X, + (∀ x, L (delta p x) = S x) ∧ + ‖L.toContinuousLinearMap‖ ≤ ‖S‖ ∧ + ∀ M : LatticeOperator (Free p E) X, + (∀ x, M (delta p x) = S x) → M = L := by + let e := AMSpaceWithUnit.kakutaniEquiv X + let S' : E →L[ℝ] C(AMSpaceWithUnit.LatticeCharacter X, ℝ) := + e.toContinuousLinearEquiv.toContinuousLinearMap.comp S + obtain ⟨L', hgen, hbound, _⟩ := universal_property_continuousMap p S' + let L : LatticeOperator (Free p E) X := { + toContinuousLinearMap := e.symm.toContinuousLinearEquiv.toContinuousLinearMap.comp + L'.toContinuousLinearMap + map_sup' := by + intro a b + change e.symm (L' (a ⊔ b)) = e.symm (L' a) ⊔ e.symm (L' b) + rw [L'.map_sup'] + exact e.symm.map_sup' _ _ + map_inf' := by + intro a b + change e.symm (L' (a ⊓ b)) = e.symm (L' a) ⊓ e.symm (L' b) + rw [L'.map_inf'] + exact e.symm.map_inf' _ _ } + refine ⟨L, ?_, ?_, ?_⟩ + · intro x + change e.symm (L' (delta p x)) = S x + rw [hgen x] + change e.toLinearIsometryEquiv.symm (e.toLinearIsometryEquiv (S x)) = S x + exact e.toLinearIsometryEquiv.symm_apply_apply (S x) + · calc + ‖L.toContinuousLinearMap‖ ≤ ‖e.symm.toContinuousLinearEquiv.toContinuousLinearMap‖ * + ‖L'.toContinuousLinearMap‖ := ContinuousLinearMap.opNorm_comp_le _ _ + _ ≤ ‖S‖ := by + have he : ‖e.symm.toContinuousLinearEquiv.toContinuousLinearMap‖ ≤ 1 := + e.symm.toLinearIsometryEquiv.toLinearIsometry.norm_toContinuousLinearMap_le + have hS : ‖S'‖ ≤ ‖S‖ := by + calc + ‖S'‖ ≤ ‖e.toContinuousLinearEquiv.toContinuousLinearMap‖ * ‖S‖ := + ContinuousLinearMap.opNorm_comp_le _ _ + _ ≤ 1 * ‖S‖ := mul_le_mul_of_nonneg_right + e.toLinearIsometryEquiv.toLinearIsometry.norm_toContinuousLinearMap_le (norm_nonneg S) + _ = ‖S‖ := one_mul _ + calc + ‖e.symm.toContinuousLinearEquiv.toContinuousLinearMap‖ * ‖L'.toContinuousLinearMap‖ ≤ + 1 * ‖L'.toContinuousLinearMap‖ := + mul_le_mul_of_nonneg_right he (norm_nonneg L'.toContinuousLinearMap) + _ = ‖L'.toContinuousLinearMap‖ := one_mul _ + _ ≤ ‖S'‖ := hbound + _ ≤ ‖S‖ := hS + · intro M hM + exact latticeOperator_ext_delta p M L (fun x => (hM x).trans (by + change S x = e.symm (L' (delta p x)) + rw [hgen x] + change S x = e.toLinearIsometryEquiv.symm (e.toLinearIsometryEquiv (S x)) + exact (e.toLinearIsometryEquiv.symm_apply_apply (S x)).symm)) + +/-- The full free-lattice extension into a finite scalar `ℓᵖ` target. -/ +theorem universal_property_piLp (p : Exponent) (n : ℕ) + (S : E →L[ℝ] PiLp p.1 (fun _ : Fin n => ℝ)) : + ∃ L : LatticeOperator (Free p E) (PiLp p.1 (fun _ : Fin n => ℝ)), + (∀ x, L (delta p x) = S x) ∧ + ‖L.toContinuousLinearMap‖ ≤ ‖S‖ ∧ + ∀ M : LatticeOperator (Free p E) (PiLp p.1 (fun _ : Fin n => ℝ)), + (∀ x, M (delta p x) = S x) → M = L := + universal_property_of_fvl_bound p S ‖S‖ (norm_nonneg S) + (fvl_lift_piLp_norm_le p n S) + +/-- The full universal property at p = 1, transported from BanLat. -/ +theorem universal_property_one (X : Type w) + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (hX : IsPConvex Exponent.one X) (S : E →L[ℝ] X) : + ∃ L : LatticeOperator (Free Exponent.one E) X, + (∀ x, L (delta Exponent.one x) = S x) ∧ + ‖L.toContinuousLinearMap‖ ≤ convexityConstant Exponent.one X * ‖S‖ ∧ + ∀ M : LatticeOperator (Free Exponent.one E) X, + (∀ x, M (delta Exponent.one x) = S x) → M = L := by + obtain ⟨L, hL, hbound⟩ := universal_property_one_core S + refine ⟨L, hL, ?_, ?_⟩ + · calc + ‖L.toContinuousLinearMap‖ ≤ ‖S‖ := hbound + _ = 1 * ‖S‖ := (one_mul _).symm + _ ≤ convexityConstant Exponent.one X * ‖S‖ := + mul_le_mul_of_nonneg_right (convexityConstant_ge_one Exponent.one hX) (norm_nonneg S) + · intro M hM + exact latticeOperator_ext_delta Exponent.one M L + (fun x => (hM x).trans (hL x).symm) + +/-- The universal property of `Free p E`: every bounded linear map from E into a +p-convex Banach lattice X extends uniquely to a bounded lattice homomorphism. Its operator +norm is bounded by the optimal p-convexity constant of X times the original operator norm. +Uniqueness is among all bounded lattice homomorphisms agreeing on `delta p`. -/ +theorem universal_property (p : Exponent) {X : Type w} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [BanachLattice X] + (hX : IsPConvex p X) (S : E →L[ℝ] X) : + ∃ L : LatticeOperator (Free p E) X, + (∀ x, L (delta p x) = S x) ∧ + ‖L.toContinuousLinearMap‖ ≤ convexityConstant p X * ‖S‖ ∧ + ∀ M : LatticeOperator (Free p E) X, (∀ x, M (delta p x) = S x) → M = L := by + exact universal_property_of_fvl_bound p S (convexityConstant p X * ‖S‖) + (mul_nonneg (le_trans zero_le_one (convexityConstant_ge_one p hX)) (norm_nonneg S)) + (fvl_lift_pConvex_norm_le p (convexityConstant_spec p hX) S) + +/-- Functoriality of the free-lattice construction: inducing a composite bounded linear +map gives the composite of the induced lattice maps. -/ +theorem induced_comp (p : Exponent) {G : Type w} + [NormedAddCommGroup G] [NormedSpace ℝ G] (S : E →L[ℝ] G) (T : F →L[ℝ] E) : + (induced p (S.comp T)).toContinuousLinearMap = + (induced p S).toContinuousLinearMap.comp (induced p T).toContinuousLinearMap := by + apply ContinuousLinearMap.ext + intro f + apply Subtype.ext + apply Subtype.ext + funext φ + rfl + +/-- The induced map of the identity is the identity. -/ +theorem induced_id (p : Exponent) : + (induced p (ContinuousLinearMap.id ℝ E)).toContinuousLinearMap = + ContinuousLinearMap.id ℝ (Free p E) := by + apply ContinuousLinearMap.ext + intro f + apply Subtype.ext + apply Subtype.ext + funext φ + rfl + +/-- A bounded left inverse makes the induced map injective. -/ +theorem induced_injective_of_leftInverse (p : Exponent) + (T : F →L[ℝ] E) (U : E →L[ℝ] F) + (h : U.comp T = ContinuousLinearMap.id ℝ F) : + Function.Injective (induced p T) := by + intro f g hfg + have hcomp := induced_comp p U T + rw [h, induced_id] at hcomp + have hf := congrArg (fun L : Free p F →L[ℝ] Free p F => L f) hcomp + have hg := congrArg (fun L : Free p F →L[ℝ] Free p F => L g) hcomp + simpa only [ContinuousLinearMap.id_apply, ContinuousLinearMap.comp_apply] using + hf.trans ((congrArg (fun z => induced p U z) hfg).trans hg.symm) + +/-- A bounded right inverse makes the induced map surjective. -/ +theorem induced_surjective_of_rightInverse (p : Exponent) + (T : F →L[ℝ] E) (U : E →L[ℝ] F) + (h : T.comp U = ContinuousLinearMap.id ℝ E) : + Function.Surjective (induced p T) := by + intro g + refine ⟨induced p U g, ?_⟩ + have hcomp := induced_comp p T U + rw [h, induced_id] at hcomp + have hg := congrArg (fun L : Free p E →L[ℝ] Free p E => L g) hcomp + simpa using hg.symm + +/-- The induced operator vanishes exactly when the original operator does. -/ +theorem induced_eq_zero_iff (p : Exponent) (T : F →L[ℝ] E) : + (induced p T).toContinuousLinearMap = 0 ↔ T = 0 := by + calc + (induced p T).toContinuousLinearMap = 0 ↔ + ‖(induced p T).toContinuousLinearMap‖ = 0 := norm_eq_zero.symm + _ ↔ ‖T‖ = 0 := by rw [(induced_norm_generators p T).1] + _ ↔ T = 0 := norm_eq_zero + +/-- Injectivity of the induced operator forces injectivity on the generators. -/ +theorem induced_injective_imp (p : Exponent) (T : F →L[ℝ] E) + (h : Function.Injective (induced p T)) : Function.Injective T := by + intro x y hxy + apply (delta p).injective + apply h + rw [(induced_norm_generators p T).2 x, + (induced_norm_generators p T).2 y, hxy] + +/-- A surjective dual pullback makes the induced free-lattice operator injective. -/ +theorem induced_injective_of_dual_surjective (p : Exponent) (T : F →L[ℝ] E) + (h : ∀ φ : Dual F, ∃ ψ : Dual E, ψ.comp T = φ) : + Function.Injective (induced p T) := by + intro f g hfg + apply Subtype.ext + apply Subtype.ext + funext φ + obtain ⟨ψ, rfl⟩ := h φ + exact congrArg (fun k : Free p E => k ψ) hfg + +/-- Norm density of the dual pullback suffices for injectivity of the induced map. -/ +theorem induced_injective_of_dual_denseRange (p : Exponent) (T : F →L[ℝ] E) + (h : DenseRange (fun ψ : Dual E => ψ.comp T)) : + Function.Injective (induced p T) := by + intro f g hfg + apply Subtype.ext + apply Subtype.ext + have heq : (fun φ : Dual F => f φ) = (fun φ : Dual F => g φ) := + h.equalizer (free_function_norm_continuous p f) + (free_function_norm_continuous p g) (by + funext ψ + exact congrArg (fun k : Free p E => k ψ) hfg) + exact heq + +/-- Density of the dual pullback in the compactly generated weak-star topology suffices for +injectivity. This is the topology in which every free function is continuous. -/ +theorem induced_injective_of_dual_compactlyGenerated_dense [CompleteSpace F] + (p : Exponent) (T : F →L[ℝ] E) + (h : @DenseRange (WeakDual ℝ F) + (TopologicalSpace.compactlyGenerated (WeakDual ℝ F)) + (Dual E) + (fun ψ => (StrongDual.toWeakDual (ψ.comp T) : WeakDual ℝ F))) : + Function.Injective (induced p T) := by + let : TopologicalSpace (WeakDual ℝ F) := + TopologicalSpace.compactlyGenerated (WeakDual ℝ F) + intro f g hfg + apply Subtype.ext + apply Subtype.ext + have heq := h.equalizer (weakStar_continuous_compactlyGenerated p f) + (weakStar_continuous_compactlyGenerated p g) (by + funext ψ + exact congrArg (fun k : Free p E => k ψ) hfg) + funext φ + exact congrFun heq (StrongDual.toWeakDual φ) + +/-- For an injective operator, a dual functional can be matched on any finite set +by pulling back a dual functional from the codomain. -/ +private theorem dual_pullback_finset_interp (T : F →L[ℝ] E) + (hT : Function.Injective T) (s : Finset F) (φ : Dual F) : + ∃ ψ : Dual E, ∀ x ∈ s, ψ (T x) = φ x := by + let V : Submodule ℝ F := Submodule.span ℝ (s : Set F) + let t : V →ₗ[ℝ] E := T.toLinearMap.comp V.subtype + let W : Submodule ℝ E := t.range + have : FiniteDimensional ℝ V := FiniteDimensional.span_finset ℝ s + have : FiniteDimensional ℝ W := + FiniteDimensional.of_surjective t.rangeRestrict t.surjective_rangeRestrict + have htinj : Function.Injective t := by + intro a b hab + apply Subtype.ext + exact hT hab + let e : V ≃ₗ[ℝ] W := LinearEquiv.ofBijective t.rangeRestrict + ⟨(fun a b hab => htinj (congrArg Subtype.val hab)), t.surjective_rangeRestrict⟩ + let ell : W →ₗ[ℝ] ℝ := (φ : F →ₗ[ℝ] ℝ).comp (V.subtype.comp e.symm.toLinearMap) + let ellc : Dual W := ⟨ell, ell.continuous_of_finiteDimensional⟩ + obtain ⟨ψ, hψ, _⟩ := exists_extension_norm_eq W ellc + refine ⟨ψ, ?_⟩ + intro x hx + have hxV : x ∈ V := Submodule.subset_span hx + let vx : V := ⟨x, hxV⟩ + have hte : (e vx : E) = T x := rfl + calc + ψ (T x) = ψ (e vx : E) := by rw [hte] + _ = ellc (e vx) := hψ (e vx) + _ = φ x := by simp [ellc, ell, e, vx] + +/-- The range of dual pullback is convex in the weak-star dual. -/ +theorem dual_pullback_range_convex (T : F →L[ℝ] E) : + Convex ℝ (Set.range (fun ψ : Dual E => + (StrongDual.toWeakDual (ψ.comp T) : WeakDual ℝ F))) := by + let L : Dual E →ₗ[ℝ] WeakDual ℝ F := { + toFun := fun ψ => StrongDual.toWeakDual (ψ.comp T) + map_add' := by + intro ψ χ + change StrongDual.toWeakDual ((ψ + χ).comp T) = + StrongDual.toWeakDual (ψ.comp T) + StrongDual.toWeakDual (χ.comp T) + rw [← map_add] + congr 1 + map_smul' := by + intro a ψ + change StrongDual.toWeakDual ((a • ψ).comp T) = + a • StrongDual.toWeakDual (ψ.comp T) + rw [← map_smul] + congr 1 } + change Convex ℝ (LinearMap.range L : Set (WeakDual ℝ F)) + exact Submodule.convex _ + +/-- The pullback of dual functionals along an injective operator is weak-star dense. -/ +theorem dual_pullback_weakstar_dense (T : F →L[ℝ] E) + (hT : Function.Injective T) : + DenseRange (fun ψ : Dual E => (StrongDual.toWeakDual (ψ.comp T) : WeakDual ℝ F)) := by + apply denseRange_iff_closure_range.mpr + ext φ + constructor + · intro _; trivial + · intro _ + rw [mem_closure_iff_nhds] + intro U hU + have hEmb : Topology.IsEmbedding (fun θ : WeakDual ℝ F => (θ : F → ℝ)) := + WeakBilin.isEmbedding (by + intro a b hab + apply ContinuousLinearMap.ext + intro x + simpa only [topDualPairing_apply] using + congrArg (fun l : F →ₗ[ℝ] ℝ => l x) hab) + have hnhds : (𝓝 φ : Filter (WeakDual ℝ F)) = + Filter.comap (fun θ : WeakDual ℝ F => (θ : F → ℝ)) + (𝓝 (fun x : F => φ x)) := hEmb.isInducing.nhds_eq_comap φ + rw [hnhds] at hU + obtain ⟨V, hV, hVU⟩ := Filter.mem_comap.mp hU + rw [nhds_pi] at hV + have hV' : V ∈ Filter.pi (fun x : F => pure (φ x)) := + Filter.pi_mono (fun x => pure_le_nhds (φ x)) hV + obtain ⟨I, hIfinite, hIV⟩ := Filter.mem_pi_pure.mp hV' + obtain ⟨ψ, hψ⟩ := dual_pullback_finset_interp T hT hIfinite.toFinset + φ.toStrongDual + refine ⟨StrongDual.toWeakDual (ψ.comp T), ?_, ⟨ψ, rfl⟩⟩ + apply hVU + apply hIV + intro x hx + have hxs : x ∈ hIfinite.toFinset := hIfinite.mem_toFinset.mpr hx + simpa only [ContinuousLinearMap.comp_apply, StrongDual.toWeakDual_apply, + WeakDual.toStrongDual_apply] using hψ x hxs + +private theorem weakDual_finite_separator (C : Set (WeakDual ℝ E)) (hC : IsCompact C) + (S : Set E) (hS : ∀ φ ∈ C, ∃ x ∈ S, 1 < |φ x|) : + ∃ s : Finset E, (∀ x ∈ s, x ∈ S) ∧ ∀ φ ∈ C, ∃ x ∈ s, 1 < |φ x| := by + classical + let U (x : S) : Set (WeakDual ℝ E) := {φ | 1 < |φ x|} + have hU (x : S) : IsOpen (U x) := + isOpen_lt continuous_const (WeakDual.eval_continuous (x : E)).abs + have hcover : C ⊆ ⋃ x : S, U x := by + intro φ hφ + obtain ⟨x, hx, hval⟩ := hS φ hφ + exact mem_iUnion.mpr ⟨⟨x, hx⟩, hval⟩ + obtain ⟨s, hs⟩ := hC.elim_finite_subcover U hU hcover + refine ⟨s.image Subtype.val, ?_, ?_⟩ + · intro x hx + obtain ⟨y, _, rfl⟩ := Finset.mem_image.mp hx + exact y.property + · intro φ hφ + obtain ⟨x, hx, hval⟩ := mem_iUnion₂.mp (hs hφ) + exact ⟨x, Finset.mem_image.mpr ⟨x, hx, rfl⟩, hval⟩ + +private theorem weakDual_small_separator (φ : WeakDual ℝ E) {r : ℝ} + (hr : 0 < r) (hφ : r < ‖φ.toStrongDual‖) : + ∃ x : E, ‖x‖ ≤ r⁻¹ ∧ 1 < |φ x| := by + obtain ⟨y, hy, hval⟩ := φ.toStrongDual.exists_lt_apply_of_lt_opNorm hφ + refine ⟨r⁻¹ • y, ?_, ?_⟩ + · rw [norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hr)] + exact (mul_le_mul_of_nonneg_left hy.le (inv_nonneg.mpr hr.le)).trans_eq (mul_one _) + · rw [map_smul, smul_eq_mul] + rw [abs_mul, abs_of_pos (inv_pos.mpr hr)] + have h := mul_lt_mul_of_pos_left hval (inv_pos.mpr hr) + simpa only [inv_mul_cancel₀ hr.ne', Real.norm_eq_abs, WeakDual.toStrongDual_apply] using h + +omit [NormedSpace ℝ E] in +private theorem isCompact_insert_iUnion_finset_small (s : ℕ → Finset E) + (hs : ∀ n x, x ∈ s n → ‖x‖ ≤ ((n : ℝ) + 1)⁻¹) : + IsCompact (insert 0 (⋃ n, (s n : Set E))) := by + classical + apply isCompact_of_finite_subcover + intro ι U hU hcover + obtain ⟨i₀, hi₀⟩ := mem_iUnion.mp (hcover (mem_insert 0 _)) + obtain ⟨δ, hδ, hball⟩ := Metric.isOpen_iff.mp (hU i₀) 0 hi₀ + obtain ⟨N, hN⟩ := exists_nat_one_div_lt hδ + let H : Finset E := (Finset.range N).biUnion s + have hHcover : (H : Set E) ⊆ ⋃ i, U i := by + intro x hx + obtain ⟨n, _, hxn⟩ := Finset.mem_biUnion.mp hx + exact hcover (mem_insert_of_mem 0 (mem_iUnion.mpr ⟨n, hxn⟩)) + obtain ⟨t, ht⟩ := H.finite_toSet.isCompact.elim_finite_subcover U hU hHcover + refine ⟨insert i₀ t, ?_⟩ + intro x hx + rcases mem_insert_iff.mp hx with rfl | hx + · exact mem_iUnion₂.mpr ⟨i₀, Finset.mem_insert_self _ _, hi₀⟩ + · obtain ⟨n, hxn⟩ := mem_iUnion.mp hx + by_cases hn : n < N + · have hxH : x ∈ H := Finset.mem_biUnion.mpr ⟨n, Finset.mem_range.mpr hn, hxn⟩ + obtain ⟨i, hi, hxi⟩ := mem_iUnion₂.mp (ht hxH) + exact mem_iUnion₂.mpr ⟨i, Finset.mem_insert_of_mem hi, hxi⟩ + · have hn' : (N : ℝ) ≤ n := by exact_mod_cast Nat.le_of_not_gt hn + have hnorm : ‖x‖ < δ := calc + ‖x‖ ≤ ((n : ℝ) + 1)⁻¹ := hs n x hxn + _ ≤ ((N : ℝ) + 1)⁻¹ := inv_anti₀ (by positivity) (by linarith) + _ < δ := by simpa only [one_div] using hN + have hxU := hball (show x ∈ Metric.ball 0 δ by simpa using hnorm) + exact mem_iUnion₂.mpr ⟨i₀, Finset.mem_insert_self _ _, hxU⟩ + +/-- A set closed on every weak-star dual ball and avoiding zero is separated from zero by +uniform evaluation on a norm-compact set of predual vectors. Finite separating families are +constructed on successive balls, with the norms of newly added vectors tending to zero. -/ +theorem weakDual_exists_compact_separator (C : Set (WeakDual ℝ E)) + (hC : ∀ R : ℝ, IsClosed (C ∩ weakDualNormBall (E := E) R)) + (h0 : (0 : WeakDual ℝ E) ∉ C) : + ∃ K : Set E, IsCompact K ∧ ∀ φ ∈ C, ∃ x ∈ K, 1 < |φ x| := by + classical + have hball (R : ℝ) : IsCompact (C ∩ weakDualNormBall (E := E) R) := by + apply (WeakDual.isCompact_closedBall (0 : Dual E) R).of_isClosed_subset (hC R) + intro φ hφ + simpa only [weakDualNormBall, Set.mem_ofPred_eq, Set.mem_preimage, + Metric.mem_closedBall, dist_zero_right] using hφ.2 + let P (n : ℕ) (s : Finset E) : Prop := + ∀ φ ∈ C, ‖φ.toStrongDual‖ ≤ (n : ℝ) + 1 → ∃ x ∈ s, 1 < |φ x| + have hinit : ∃ s : Finset E, P 0 s := by + have hw : ∀ φ ∈ C ∩ weakDualNormBall (E := E) 1, ∃ x ∈ (univ : Set E), 1 < |φ x| := by + intro φ hφ + have hn : 0 < ‖φ.toStrongDual‖ := norm_pos_iff.mpr (by + intro hz + apply h0 + have hφ0 : φ = 0 := WeakDual.toStrongDual.injective (by simpa using hz) + simpa [hφ0] using hφ.1) + obtain ⟨x, _, hx⟩ := weakDual_small_separator φ (half_pos hn) (half_lt_self hn) + exact ⟨x, mem_univ x, hx⟩ + obtain ⟨s, _, hs⟩ := weakDual_finite_separator _ (hball 1) univ hw + refine ⟨s, ?_⟩ + intro φ hφ hn + apply hs φ + exact ⟨hφ, by simpa [weakDualNormBall] using hn⟩ + have hstep (n : ℕ) (s : Finset E) (hs : P n s) : + ∃ t : Finset E, (∀ x ∈ t, ‖x‖ ≤ ((n : ℝ) + 1)⁻¹) ∧ P (n + 1) (s ∪ t) := by + let D : Set (WeakDual ℝ E) := + (C ∩ weakDualNormBall (E := E) ((n : ℝ) + 2)) ∩ {φ | ∀ x ∈ s, |φ x| ≤ 1} + have hD : IsCompact D := by + apply (hball ((n : ℝ) + 2)).inter_right + have heq : {φ : WeakDual ℝ E | ∀ x ∈ s, |φ x| ≤ 1} = + ⋂ x ∈ s, {φ : WeakDual ℝ E | |φ x| ≤ 1} := by ext φ; simp + rw [heq] + exact isClosed_biInter fun x _ => + isClosed_le (WeakDual.eval_continuous x).abs continuous_const + have hlarge (φ : WeakDual ℝ E) (hφ : φ ∈ D) : (n : ℝ) + 1 < ‖φ.toStrongDual‖ := by + by_contra hn + obtain ⟨x, hx, hval⟩ := hs φ hφ.1.1 (le_of_not_gt hn) + exact (not_lt_of_ge (hφ.2 x hx)) hval + obtain ⟨t, ht, hsep⟩ := weakDual_finite_separator D hD + {x : E | ‖x‖ ≤ ((n : ℝ) + 1)⁻¹} (fun φ hφ => + weakDual_small_separator φ (by positivity) (hlarge φ hφ)) + refine ⟨t, ht, ?_⟩ + intro φ hφ hn + by_cases hold : ∃ x ∈ s, 1 < |φ x| + · obtain ⟨x, hx, hval⟩ := hold + exact ⟨x, Finset.mem_union_left _ hx, hval⟩ + · have hφD : φ ∈ D := by + refine ⟨⟨hφ, ?_⟩, ?_⟩ + · change ‖φ.toStrongDual‖ ≤ (n : ℝ) + 2 + simpa only [Nat.cast_add, Nat.cast_one, add_assoc, one_add_one_eq_two] using hn + · intro x hx + exact le_of_not_gt (fun hval => hold ⟨x, hx, hval⟩) + obtain ⟨x, hx, hval⟩ := hsep φ hφD + exact ⟨x, Finset.mem_union_right _ hx, hval⟩ + choose t ht hnext using hstep + obtain ⟨s₀, hs₀⟩ := hinit + let b : ∀ n, {s : Finset E // P n s} := + fun n => Nat.rec ⟨s₀, hs₀⟩ (fun n s => + ⟨s.val ∪ t n s.val s.property, hnext n s.val s.property⟩) n + let d (n : ℕ) : Finset E := t n (b n).val (b n).property + let K : Set E := (s₀ : Set E) ∪ insert 0 (⋃ n, (d n : Set E)) + have hK : IsCompact K := s₀.finite_toSet.isCompact.union + (isCompact_insert_iUnion_finset_small d (fun n => ht n (b n).val (b n).property)) + have hbK (n : ℕ) : ((b n).val : Set E) ⊆ K := by + induction n with + | zero => exact subset_union_left + | succ n ih => + intro x hx + change x ∈ (b n).val ∪ d n at hx + rcases Finset.mem_union.mp hx with hx | hx + · exact ih hx + · exact Or.inr (mem_insert_of_mem 0 (mem_iUnion.mpr ⟨n, hx⟩)) + refine ⟨K, hK, ?_⟩ + intro φ hφ + obtain ⟨n, hn⟩ := exists_nat_gt ‖φ.toStrongDual‖ + obtain ⟨x, hx, hval⟩ := (b n).property φ hφ (by linarith) + exact ⟨x, hbK n hx, hval⟩ + +/-- For an injective operator with Banach domain, dual pullbacks approximate every functional +uniformly on each norm-compact set. The closed absolutely convex hull is compact; separating +its graph under `(T, φ)` from `(0, ε)` gives the approximating functional. -/ +theorem dual_pullback_uniform_approx_compact [CompleteSpace F] (T : F →L[ℝ] E) + (hT : Function.Injective T) (K : Set F) (hK : IsCompact K) + (φ : Dual F) {ε : ℝ} (hε : 0 < ε) : + ∃ ψ : Dual E, ∀ x ∈ K, |ψ (T x) - φ x| < ε := by + let A : Set F := closedAbsConvexHull ℝ (insert 0 K) + have hAcompact : IsCompact A := + isCompact_closedAbsConvexHull_of_totallyBounded (hK.insert 0).totallyBounded + have hAabs : AbsConvex ℝ A := absConvex_convexClosedHull + have hA0 : (0 : F) ∈ A := subset_closedAbsConvexHull (mem_insert _ _) + let L : F →L[ℝ] E × ℝ := T.prod φ + have hnot : (0, ε) ∉ L '' A := by + rintro ⟨x, _, hx⟩ + have hTx : T x = 0 := congrArg Prod.fst hx + have hx0 : x = 0 := hT (hTx.trans (map_zero T).symm) + have hφx : φ x = ε := congrArg Prod.snd hx + simp only [hx0, map_zero] at hφx + exact hε.ne' hφx.symm + obtain ⟨f, a, hfa, ha⟩ := geometric_hahn_banach_closed_point + (hAabs.2.linear_image L.toLinearMap) (hAcompact.image L.continuous).isClosed hnot + have ha0 : 0 < a := by + simpa using hfa (L 0) ⟨0, hA0, rfl⟩ + let c : ℝ := f (0, 1) + have hfvertical (r : ℝ) : f (0, r) = r * c := by + simpa [c] using f.map_smul r (0, 1) + rw [hfvertical] at ha + have hc : 0 < c := (mul_pos_iff_of_pos_left hε).mp (ha0.trans ha) + let ψ : Dual E := -(c⁻¹ • f.comp (ContinuousLinearMap.inl ℝ E ℝ)) + refine ⟨ψ, ?_⟩ + intro x hx + have hxA : x ∈ A := subset_closedAbsConvexHull (mem_insert_of_mem 0 hx) + have hnxA : -x ∈ A := by + simpa using hAabs.1.smul_mem (show ‖(-1 : ℝ)‖ ≤ 1 by norm_num) hxA + have hbound : |f (L x)| < ε * c := by + have hpos := hfa (L x) ⟨x, hxA, rfl⟩ + have hneg := hfa (L (-x)) ⟨-x, hnxA, rfl⟩ + simp only [map_neg] at hneg + exact (abs_lt.mpr ⟨by linarith, hpos⟩).trans ha + have hfL : f (L x) = f (T x, 0) + φ x * c := by + have heq : L x = (T x, 0) + (0, φ x) := by simp [L] + rw [heq, map_add, hfvertical] + have herror : ψ (T x) - φ x = -(f (L x) / c) := by + change -(c⁻¹ * f (T x, 0)) - φ x = -(f (L x) / c) + rw [hfL] + field_simp + ring + rw [herror, abs_neg, abs_div, abs_of_pos hc] + exact (div_lt_iff₀ hc).mpr hbound + +open scoped CompactConvergenceCLM in +/-- Dual pullback along an injective operator with Banach domain has dense range for uniform +convergence on norm-compact subsets of the domain. -/ +theorem dual_pullback_compactConvergence_dense [CompleteSpace F] (T : F →L[ℝ] E) + (hT : Function.Injective T) : + DenseRange (fun ψ : Dual E => + (UniformConvergenceCLM.ofFun (RingHom.id ℝ) ℝ + {K : Set F | IsCompact K} (ψ.comp T) : F →L_c[ℝ] ℝ)) := by + intro φ + rw [mem_closure_iff_nhds] + intro U hU + have hU0 : (fun η : F →L_c[ℝ] ℝ => η + φ) ⁻¹' U ∈ 𝓝 0 := by + exact (continuous_id.add continuous_const).continuousAt.preimage_mem_nhds (by simpa using hU) + obtain ⟨⟨K, ε⟩, ⟨hK, hε⟩, hsub⟩ := + (CompactConvergenceCLM.hasBasis_nhds_zero_of_basis + (σ := RingHom.id ℝ) (E := F) (Metric.nhds_basis_ball (x := (0 : ℝ)))).mem_iff.mp hU0 + let e := UniformConvergenceCLM.ofFun (RingHom.id ℝ) ℝ {K : Set F | IsCompact K} + obtain ⟨ψ, hψ⟩ := dual_pullback_uniform_approx_compact T hT K hK (e.symm φ) hε + refine ⟨e (ψ.comp T), ?_, ψ, rfl⟩ + have hmem : e (ψ.comp T) - φ ∈ {f : F →L_c[ℝ] ℝ | + ∀ x ∈ K, f x ∈ Metric.ball 0 ε} := by + intro x hx + rw [Metric.mem_ball, dist_zero_right, Real.norm_eq_abs] + change |ψ (T x) - (e.symm φ) x| < ε + exact hψ x hx + simpa only [Set.mem_preimage, sub_add_cancel] using hsub hmem + +/-- An injective operator with Banach domain induces an injective free-lattice map. -/ +theorem induced_injective_of [CompleteSpace F] (p : Exponent) (T : F →L[ℝ] E) + (hT : Function.Injective T) : Function.Injective (induced p T) := by + intro f g hfg + apply Subtype.ext + apply Subtype.ext + funext φ + by_contra hφ + let C : Set (WeakDual ℝ F) := {θ | f (θ.toStrongDual + φ) = g (θ.toStrongDual + φ)} + have h0 : (0 : WeakDual ℝ F) ∉ C := by simpa [C] using hφ + have hC (R : ℝ) : IsClosed (C ∩ weakDualNormBall (E := F) R) := by + have hB : IsClosed (weakDualNormBall (E := F) R) := by + convert WeakDual.isClosed_closedBall (0 : Dual F) R using 1 + ext θ + simp [weakDualNormBall, Metric.mem_closedBall, dist_zero_right] + have hcont (a : Free p F) : + ContinuousOn (fun θ : WeakDual ℝ F => a (θ.toStrongDual + φ)) + (weakDualNormBall (E := F) R) := by + have htrans : ContinuousOn (fun θ : WeakDual ℝ F => θ + StrongDual.toWeakDual φ) + (weakDualNormBall (E := F) R) := (continuous_id.add continuous_const).continuousOn + have hc := (weakStar_continuous_bounded p a (R + ‖φ‖)).comp htrans (by + intro θ hθ + change ‖θ.toStrongDual + φ‖ ≤ R + ‖φ‖ + change ‖θ.toStrongDual‖ ≤ R at hθ + exact (norm_add_le _ _).trans (add_le_add hθ le_rfl)) + convert hc using 1 + funext θ + rfl + simpa only [C, Set.ofPred_and, Set.ofPred_mem_eq, inter_comm] + using hB.isClosed_eq (hcont f) (hcont g) + obtain ⟨K, hK, hsep⟩ := weakDual_exists_compact_separator C hC h0 + obtain ⟨ψ, hψ⟩ := dual_pullback_uniform_approx_compact T hT K hK φ zero_lt_one + let θ : WeakDual ℝ F := StrongDual.toWeakDual (ψ.comp T - φ) + have hθ : θ ∈ C := by + change f ((ψ.comp T - φ) + φ) = g ((ψ.comp T - φ) + φ) + rw [sub_add_cancel] + exact congrArg (fun k : Free p E => k ψ) hfg + obtain ⟨x, hx, hval⟩ := hsep θ hθ + exact (not_lt_of_gt (hψ x hx)) hval + +/-- Injectivity follows if each dual functional can be approximated, in the weak-star topology, +by a norm-bounded slice of the dual pullback range. This isolates the boundedness needed to +apply weak-star continuity of free functions on dual balls. -/ +theorem induced_injective_of_dual_bounded_weakstar_dense (p : Exponent) (T : F →L[ℝ] E) + (h : ∀ φ : Dual F, ∃ R : ℝ, + (StrongDual.toWeakDual φ : WeakDual ℝ F) ∈ + closure {θ : WeakDual ℝ F | + (∃ ψ : Dual E, θ = StrongDual.toWeakDual (ψ.comp T)) ∧ + ‖WeakDual.toStrongDual θ‖ ≤ R}) : + Function.Injective (induced p T) := by + intro f g hfg + apply Subtype.ext + apply Subtype.ext + funext φ + obtain ⟨R, hR⟩ := h φ + let s : Set (WeakDual ℝ F) := + {θ | (∃ ψ : Dual E, θ = StrongDual.toWeakDual (ψ.comp T)) ∧ + ‖WeakDual.toStrongDual θ‖ ≤ R} + let b : Set (WeakDual ℝ F) := {θ | ‖WeakDual.toStrongDual θ‖ ≤ R} + have hsb : s ⊆ b := fun θ hθ => hθ.2 + have hbclosed : IsClosed b := by + convert (WeakDual.isClosed_closedBall (0 : Dual F) R) using 1 + ext θ + simp [b, Metric.mem_closedBall, dist_zero_right] + have hclosure : closure s ⊆ b := closure_minimal hsb hbclosed + have hff : ContinuousOn (fun θ : WeakDual ℝ F => f (WeakDual.toStrongDual θ)) + (closure s) := (weakStar_continuous_bounded p f R).mono hclosure + have hgg : ContinuousOn (fun θ : WeakDual ℝ F => g (WeakDual.toStrongDual θ)) + (closure s) := (weakStar_continuous_bounded p g R).mono hclosure + have heq : EqOn (fun θ : WeakDual ℝ F => f (WeakDual.toStrongDual θ)) + (fun θ : WeakDual ℝ F => g (WeakDual.toStrongDual θ)) s := by + intro θ hθ + obtain ⟨ψ, hψ⟩ := hθ.1 + subst θ + exact congrArg (fun k : Free p E => k ψ) hfg + have heqclosure := heq.of_subset_closure hff hgg subset_closure (Subset.rfl) + exact heqclosure hR + +/-- An injective operator with closed range induces an injective operator on the free lattices. -/ +theorem induced_injective_of_isClosed_range [CompleteSpace E] [CompleteSpace F] + (p : Exponent) + (T : F →L[ℝ] E) (hT : Function.Injective T) + (hc : IsClosed (Set.range T)) : Function.Injective (induced p T) := by + apply induced_injective_of_dual_surjective p T + intro φ + let R : T.range →L[ℝ] F := (T.equivRange hT hc).symm.toContinuousLinearMap + obtain ⟨ψ, hψ, _⟩ := exists_extension_norm_eq T.range (φ.comp R) + refine ⟨ψ, ?_⟩ + apply ContinuousLinearMap.ext + intro x + change ψ (T x) = φ x + rw [hψ ⟨T x, ⟨x, rfl⟩⟩] + change φ (R ⟨T x, ⟨x, rfl⟩⟩) = φ x + rw [show R ⟨T x, ⟨x, rfl⟩⟩ = x from by + exact T.equivRange_symm_apply hT hc x] + +/-- Surjectivity of the induced map gives a uniform lower bound for dual pullback. -/ +theorem induced_surjective_dual_bound (p : Exponent) (T : F →L[ℝ] E) + (h : Function.Surjective (induced p T)) : + ∃ C > 0, ∀ φ : Dual E, ‖φ‖ ≤ C * ‖φ.comp T‖ := by + have hs : Function.Surjective (induced p T).toContinuousLinearMap := h + obtain ⟨C, hC, hpre⟩ := + (induced p T).toContinuousLinearMap.exists_preimage_norm_le hs + refine ⟨C, hC, fun φ => ?_⟩ + apply φ.opNorm_le_bound (mul_nonneg hC.le (norm_nonneg _)) + intro x + obtain ⟨f, hfx, hfn⟩ := hpre (delta p x) + have hval : φ x = f (φ.comp T) := by + have hv := congrArg (fun g : Free p E => g φ) hfx + exact hv.symm + calc + ‖φ x‖ = |f (φ.comp T)| := by rw [hval, Real.norm_eq_abs] + _ ≤ ‖φ.comp T‖ * ‖f‖ := hp_apply_abs_le p f.1 (φ.comp T) + _ ≤ ‖φ.comp T‖ * (C * ‖delta p x‖) := + mul_le_mul_of_nonneg_left hfn (norm_nonneg _) + _ = (C * ‖φ.comp T‖) * ‖x‖ := by + rw [(delta p).norm_map] + ring + +private theorem dual_bound_unitBall_closure {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + (T : F →L[ℝ] E) (C : ℝ) (hC : 0 < C) + (hb : ∀ φ : StrongDual ℝ E, ‖φ‖ ≤ C * ‖φ.comp T‖) : + Metric.closedBall (0 : E) 1 ⊆ + closure (T '' Metric.closedBall (0 : F) (C + 1)) := by + intro y hy + by_contra hn + let s : Set E := closure (T '' Metric.closedBall (0 : F) (C + 1)) + have hs : Convex ℝ s := + ((convex_closedBall (0 : F) (C + 1)).linear_image T.toLinearMap).closure + obtain ⟨φ, u, hu, huy⟩ := geometric_hahn_banach_closed_point hs isClosed_closure hn + have hR : 0 < C + 1 := by linarith + have hzero : (0 : E) ∈ s := by + apply subset_closure + exact ⟨0, by simp [hR.le], by simp⟩ + have hu0 : 0 < u := by simpa using hu 0 hzero + have hbound : ‖φ.comp T‖ ≤ u / (C + 1) := by + have hpoint (x : F) (hx : ‖x‖ ≤ C + 1) : |φ (T x)| ≤ u := by + have hxp : φ (T x) < u := hu (T x) (subset_closure ⟨x, by simpa using hx, rfl⟩) + have hxn : φ (T (-x)) < u := hu (T (-x)) (subset_closure + ⟨-x, by simpa using hx, rfl⟩) + have hn' : -φ (T x) < u := by simpa using hxn + exact abs_le.mpr ⟨by linarith, hxp.le⟩ + apply (φ.comp T).opNorm_le_bound (div_nonneg hu0.le hR.le) + intro x + by_cases hx : x = 0 + · simp [hx] + let v : F := ‖x‖⁻¹ • x + have hxnorm : ‖x‖ ≠ 0 := norm_ne_zero_iff.mpr hx + have hvnorm : ‖v‖ = 1 := by + simp [v, norm_smul, inv_mul_cancel₀ hxnorm] + have hxv : ‖x‖ • v = x := by + simp [v, smul_smul, mul_inv_cancel₀ hxnorm] + have hvball : ‖(C + 1) • v‖ ≤ C + 1 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_nonneg hR.le, hvnorm, mul_one] + have hp := hpoint ((C + 1) • v) hvball + have hvbound : (C + 1) * |φ (T v)| ≤ u := by + simpa only [T.map_smul, map_smul, smul_eq_mul, abs_mul, + abs_of_nonneg hR.le] using hp + have hvle : |φ (T v)| ≤ u / (C + 1) := + (le_div_iff₀ hR).mpr (by simpa only [mul_comm] using hvbound) + change |φ (T x)| ≤ u / (C + 1) * ‖x‖ + calc + |φ (T x)| = |φ (T (‖x‖ • v))| := by rw [hxv] + _ = ‖x‖ * |φ (T v)| := by + rw [T.map_smul, map_smul, smul_eq_mul, abs_mul, + abs_of_nonneg (norm_nonneg x)] + _ ≤ ‖x‖ * (u / (C + 1)) := mul_le_mul_of_nonneg_left hvle (norm_nonneg x) + _ = (u / (C + 1)) * ‖x‖ := mul_comm _ _ + have hphi : φ y ≤ C * ‖φ.comp T‖ := by + calc + φ y ≤ ‖φ y‖ := by simpa only [Real.norm_eq_abs] using le_abs_self (φ y) + _ ≤ ‖φ‖ * ‖y‖ := φ.le_opNorm y + _ ≤ C * ‖φ.comp T‖ * ‖y‖ := by gcongr; exact hb φ + _ ≤ C * ‖φ.comp T‖ := by + have hy1 : ‖y‖ ≤ 1 := by simpa using hy + nlinarith [mul_nonneg hC.le (norm_nonneg (φ.comp T))] + have hfinal : C * ‖φ.comp T‖ ≤ u := by + have hn : 0 ≤ ‖φ.comp T‖ := norm_nonneg _ + have hmul := (mul_le_mul_of_nonneg_left hbound hR.le) + rw [mul_div_cancel₀ _ hR.ne'] at hmul + nlinarith + exact (not_lt_of_ge (hphi.trans hfinal)) huy + +private theorem dual_bound_approx_preimage {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + (T : F →L[ℝ] E) (C : ℝ) (hC : 0 < C) + (hb : ∀ φ : StrongDual ℝ E, ‖φ‖ ≤ C * ‖φ.comp T‖) (y : E) : + ∃ x : F, ‖T x - y‖ ≤ (1 / 2 : ℝ) * ‖y‖ ∧ ‖x‖ ≤ (C + 1) * ‖y‖ := by + by_cases hy : y = 0 + · subst y + exact ⟨0, by simp, by simp⟩ + have hyn : ‖y‖ ≠ 0 := norm_ne_zero_iff.mpr hy + have hyp : 0 < ‖y‖ := lt_of_le_of_ne (norm_nonneg y) (Ne.symm hyn) + let z : E := ‖y‖⁻¹ • y + have hz : z ∈ Metric.closedBall (0 : E) 1 := by + have hzn : ‖z‖ = 1 := by simp [z, norm_smul, inv_mul_cancel₀ hyn] + simpa using hzn.le + have hcl := dual_bound_unitBall_closure T C hC hb hz + obtain ⟨w, ⟨v, hv, rfl⟩, hd⟩ := + (Metric.mem_closure_iff.mp hcl) (1 / 2) (by norm_num) + have hyz : ‖y‖ • z = y := by simp [z, smul_smul, mul_inv_cancel₀ hyn] + refine ⟨‖y‖ • v, ?_, ?_⟩ + · have hdist : ‖T v - z‖ < (1 / 2 : ℝ) := by + simpa only [dist_eq_norm, norm_sub_rev] using hd + calc + ‖T (‖y‖ • v) - y‖ = ‖T (‖y‖ • v) - ‖y‖ • z‖ := by rw [hyz] + _ = ‖y‖ * ‖T v - z‖ := by + rw [T.map_smul, ← smul_sub, norm_smul, Real.norm_eq_abs, + abs_of_nonneg (norm_nonneg y)] + _ ≤ (1 / 2 : ℝ) * ‖y‖ := by + have h := mul_lt_mul_of_pos_left hdist hyp + nlinarith + · have hvn : ‖v‖ ≤ C + 1 := by simpa using hv + calc + ‖‖y‖ • v‖ = ‖y‖ * ‖v‖ := by + rw [norm_smul, Real.norm_eq_abs, abs_of_nonneg (norm_nonneg y)] + _ ≤ (C + 1) * ‖y‖ := by nlinarith [mul_nonneg (norm_nonneg y) (sub_nonneg.mpr hvn)] + +private theorem surjective_of_dual_bound {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F] + (T : F →L[ℝ] E) (C : ℝ) (hC : 0 < C) + (hb : ∀ φ : StrongDual ℝ E, ‖φ‖ ≤ C * ‖φ.comp T‖) : + Function.Surjective T := by + have happrox := dual_bound_approx_preimage T C hC hb + choose g hg using happrox + let h (y : E) := y - T (g y) + have hle : ∀ y, ‖h y‖ ≤ (1 / 2 : ℝ) * ‖y‖ := by + intro y + simpa only [h, norm_sub_rev] using (hg y).1 + intro y + have hnle : ∀ n : ℕ, ‖h^[n] y‖ ≤ (1 / 2 : ℝ) ^ n * ‖y‖ := by + intro n + induction n with + | zero => simp only [one_div, one_mul, Function.iterate_zero_apply, pow_zero, le_rfl] + | succ n IH => + rw [Function.iterate_succ'] + apply le_trans (hle _) _ + rw [pow_succ', mul_assoc] + gcongr + let u n := g (h^[n] y) + have ule : ∀ n, ‖u n‖ ≤ (1 / 2 : ℝ) ^ n * ((C + 1) * ‖y‖) := fun n => by + apply le_trans (hg _).2 + calc + (C + 1) * ‖h^[n] y‖ ≤ (C + 1) * ((1 / 2 : ℝ) ^ n * ‖y‖) := by + exact mul_le_mul_of_nonneg_left (hnle n) (by linarith) + _ = (1 / 2 : ℝ) ^ n * ((C + 1) * ‖y‖) := by ring + have sNu : Summable fun n => ‖u n‖ := by + refine .of_nonneg_of_le (fun n => norm_nonneg _) ule ?_ + exact Summable.mul_right _ (summable_geometric_of_lt_one (by simp) (by norm_num)) + have su : Summable u := sNu.of_norm + let x := tsum u + have fsumeq : ∀ n : ℕ, T (∑ i ∈ Finset.range n, u i) = y - h^[n] y := by + intro n + induction n with + | zero => simp [T.map_zero] + | succ n IH => rw [Finset.sum_range_succ, T.map_add, IH, Function.iterate_succ_apply', sub_add] + have hsum : Filter.Tendsto (fun n => ∑ i ∈ Finset.range n, u i) Filter.atTop (𝓝 x) := + su.hasSum.tendsto_sum_nat + have L₁ : Filter.Tendsto (fun n => T (∑ i ∈ Finset.range n, u i)) Filter.atTop (𝓝 (T x)) := + (T.continuous.tendsto _).comp hsum + simp only [fsumeq] at L₁ + have L₂ : Filter.Tendsto (fun n => y - h^[n] y) Filter.atTop (𝓝 (y - 0)) := by + refine tendsto_const_nhds.sub ?_ + rw [tendsto_iff_norm_sub_tendsto_zero] + simp only [sub_zero] + refine squeeze_zero (fun _ => norm_nonneg _) hnle ?_ + rw [← zero_mul ‖y‖] + refine (_root_.tendsto_pow_atTop_nhds_zero_of_lt_one ?_ ?_).mul tendsto_const_nhds <;> norm_num + have feq : T x = y - 0 := tendsto_nhds_unique L₁ L₂ + exact ⟨x, by simpa using feq⟩ + +/-- Surjectivity of the induced free-lattice map forces surjectivity of the original map. -/ +theorem induced_surjective_imp [CompleteSpace F] + (p : Exponent) (T : F →L[ℝ] E) + (h : Function.Surjective (induced p T)) : Function.Surjective T := by + obtain ⟨C, hC, hb⟩ := induced_surjective_dual_bound p T h + exact surjective_of_dual_bound T C hC hb + +/-- Dense range passes from an operator to its induced free-lattice operator. -/ +theorem induced_denseRange_of (p : Exponent) (T : F →L[ℝ] E) + (hT : DenseRange T) : DenseRange (induced p T) := by + let R : VectorSublattice (Free p E) := { + toSubmodule := (induced p T).toContinuousLinearMap.range + sup_mem' := by + intro a b ha hb + obtain ⟨f, rfl⟩ := ha + obtain ⟨g, rfl⟩ := hb + exact ⟨f ⊔ g, (induced p T).map_sup' f g⟩ } + have hgen (x : E) : delta p x ∈ R.topologicalClosure := by + have hx : x ∈ closure (Set.range T) := by + rw [hT.closure_range] + trivial + have hx' : delta p x ∈ closure ((delta p) '' Set.range T) := + mem_closure_image (delta p).continuous.continuousAt hx + have hsub : (delta p) '' Set.range T ⊆ (R : Set (Free p E)) := by + rintro _ ⟨_, ⟨y, rfl⟩, rfl⟩ + exact ⟨delta p y, (induced_norm_generators p T).2 y⟩ + change delta p x ∈ (R.topologicalClosure : Set (Free p E)) + rw [VectorSublattice.topologicalClosure_coe] + exact closure_mono hsub hx' + have hExpr {n : ℕ} (x : Fin n → E) (e : LLexpr n) : + LLexpr.eval (fun i => delta p (x i)) e ∈ R.topologicalClosure := by + induction e with + | zero => exact (R.topologicalClosure).zero_mem + | var i => exact hgen (x i) + | add e₁ e₂ h₁ h₂ => exact (R.topologicalClosure).add_mem h₁ h₂ + | smul c e h => exact (R.topologicalClosure).smul_mem c h + | sup e₁ e₂ h₁ h₂ => exact (R.topologicalClosure).sup_mem h₁ h₂ + | inf e₁ e₂ h₁ h₂ => exact (R.topologicalClosure).inf_mem h₁ h₂ + have hfv (v : FVL E) : ofFVL p v ∈ R.topologicalClosure := by + obtain ⟨n, x, e, he⟩ := FVLv.exists_eval_of_eq v + rw [← he, LLexpr.map_eval] + simpa only [ofFVL_of] using hExpr x e + have hCtop : R.topologicalClosure = ⊤ := by + ext y + constructor + · intro _ + trivial + · intro _ + have hy : y ∈ closure (Set.range (ofFVL p (E := E))) := by + rw [(denseRange_ofFVL p (E := E)).closure_range] + trivial + have hsub : Set.range (ofFVL p (E := E)) ⊆ + (R.topologicalClosure : Set (Free p E)) := by + rintro _ ⟨v, rfl⟩ + exact hfv v + exact closure_minimal hsub (VectorSublattice.isClosed_topologicalClosure R) hy + apply denseRange_iff_closure_range.mpr + change closure (R : Set (Free p E)) = Set.univ + rw [← VectorSublattice.topologicalClosure_coe, hCtop] + rfl + +/-- Dense induced range detects every functional annihilating the original range. -/ +private theorem induced_denseRange_dual_ker (p : Exponent) (T : F →L[ℝ] E) + (hD : DenseRange (induced p T)) (φ : Dual E) (hφ : φ.comp T = 0) : φ = 0 := by + have heval : Continuous (fun g : Free p E => g φ) := by + exact (hpEvaluation p φ).continuous.comp continuous_subtype_val + have hclosed : IsClosed {g : Free p E | g φ = 0} := + isClosed_eq heval continuous_const + have hsub : Set.range (induced p T) ⊆ {g : Free p E | g φ = 0} := by + rintro _ ⟨f, rfl⟩ + change f (φ.comp T) = 0 + rw [hφ] + exact free_apply_zero p f + have hall : ∀ g : Free p E, g φ = 0 := by + intro g + have hg : g ∈ closure (Set.range (induced p T)) := by + rw [hD.closure_range] + trivial + exact closure_minimal hsub hclosed hg + apply ContinuousLinearMap.ext + intro x + have hx := hall (delta p x) + change φ x = 0 at hx + exact hx + +private theorem denseRange_of_dual_ker (T : F →L[ℝ] E) + (h : ∀ φ : Dual E, φ.comp T = 0 → φ = 0) : DenseRange T := by + let K := T.range.topologicalClosure + have hKclosed : IsClosed (K : Set E) := T.range.isClosed_topologicalClosure + let : IsClosed (K : Set E) := hKclosed + have hKtop : K = ⊤ := by + ext x + constructor + · intro _ + trivial + · intro _ + by_contra hx + let z : E ⧸ K := K.mkQ x + have hz : z ≠ 0 := by + simpa [z] using hx + obtain ⟨ψ, _, hψz⟩ := exists_dual_vector'' ℝ z + let φ : Dual E := ψ.comp K.mkQL + have hφT : φ.comp T = 0 := by + apply ContinuousLinearMap.ext + intro y + change ψ (K.mkQ (T y)) = 0 + have hy : T y ∈ K := T.range.le_topologicalClosure ⟨y, rfl⟩ + have hq : K.mkQ (T y) = 0 := (Submodule.Quotient.mk_eq_zero K).2 hy + rw [hq] + simp + have hφ : φ = 0 := h φ hφT + have hz0 : ‖z‖ = 0 := by + calc + ‖z‖ = ψ z := hψz.symm + _ = φ x := rfl + _ = 0 := by rw [hφ]; simp + exact hz (norm_eq_zero.mp hz0) + apply denseRange_iff_closure_range.mpr + change closure (T.range : Set E) = Set.univ + change (K : Set E) = Set.univ + rw [hKtop] + rfl + +/-- The induced map has dense range exactly when the original operator does. -/ +theorem induced_denseRange_iff (p : Exponent) (T : F →L[ℝ] E) : + DenseRange (induced p T) ↔ DenseRange T := by + constructor + · intro hD + apply denseRange_of_dual_ker T + intro φ hφ + exact induced_denseRange_dual_ker p T hD φ hφ + · exact induced_denseRange_of p T + +/-- Surjectivity of the underlying operator lifts through the free lattice quotient. -/ +theorem induced_surjective_of [CompleteSpace E] [CompleteSpace F] + (p : Exponent) (T : F →L[ℝ] E) (hT : Function.Surjective T) : + Function.Surjective (induced p T) := by + let J : OrderIdeal (Free p F) := + OrderIdeal.ofKerVecLatHom (induced p T).toVecLatHom + have hJ : IsClosed (J : Set (Free p F)) := by + change IsClosed ((induced p T).toContinuousLinearMap.ker : Set (Free p F)) + exact (induced p T).toContinuousLinearMap.isClosed_ker + let : NormedAddCommGroup (Free p F ⧸ J.toSubmodule) := J.quotientNormedAddCommGroup hJ + let : Lattice (Free p F ⧸ J.toSubmodule) := J.instQuotientLattice + let : IsOrderedAddMonoid (Free p F ⧸ J.toSubmodule) := J.instQuotientIsOrderedAddMonoid + let : BanachLattice (Free p F ⧸ J.toSubmodule) := J.quotientBanachLattice hJ + have hQ : IsPConvex p (Free p F ⧸ J.toSubmodule) := + quotient_isPConvex p ⟨1, free_pConvex p⟩ J hJ + let : IsClosed (T.ker : Set F) := T.isClosed_ker + let Tq : F ⧸ T.ker →L[ℝ] E := T.ker.liftQL T (le_refl _) + have hqinj : Tq.ker = ⊥ := by + change (T.ker.liftQ T.toLinearMap (le_refl _)).ker = ⊥ + exact Submodule.ker_liftQ_eq_bot _ _ _ (le_refl _) + have hqsurj : Tq.range = ⊤ := by + change (T.ker.liftQ T.toLinearMap (le_refl _)).range = ⊤ + rw [Submodule.range_liftQ] + exact LinearMap.range_eq_top.mpr hT + let TqEquiv : (F ⧸ T.ker) ≃L[ℝ] E := + ContinuousLinearEquiv.ofBijective Tq hqinj hqsurj + let qdelta : F →L[ℝ] (Free p F ⧸ J.toSubmodule) := + J.toSubmodule.mkQL.comp (delta p).toContinuousLinearMap + have hker : T.ker ≤ qdelta.ker := by + intro x hx + change J.mkQ (delta p x) = 0 + apply (Submodule.Quotient.mk_eq_zero J.toSubmodule).mpr + change (induced p T) (delta p x) = 0 + rw [(induced_norm_generators p T).2 x, (show T x = 0 from hx)] + simp + let S : E →L[ℝ] (Free p F ⧸ J.toSubmodule) := + (T.ker.liftQL qdelta hker).comp TqEquiv.symm.toContinuousLinearMap + obtain ⟨L, hL, _, _⟩ := universal_property p hQ S + have hRker : J.toSubmodule ≤ (induced p T).toContinuousLinearMap.ker := le_refl _ + let R : (Free p F ⧸ J.toSubmodule) →L[ℝ] Free p E := + J.toSubmodule.liftQL (induced p T).toContinuousLinearMap hRker + have hR_mk (g : Free p F) : R (J.mkQ g) = induced p T g := by + rfl + have hRsup (a b : Free p F ⧸ J.toSubmodule) : R (a ⊔ b) = R a ⊔ R b := by + obtain ⟨g, rfl⟩ := Submodule.Quotient.mk_surjective J.toSubmodule a + obtain ⟨h, rfl⟩ := Submodule.Quotient.mk_surjective J.toSubmodule b + change R (J.mkQ g ⊔ J.mkQ h) = R (J.mkQ g) ⊔ R (J.mkQ h) + rw [← J.mkQ_sup, hR_mk, hR_mk, hR_mk] + exact (induced p T).map_sup' g h + have hRinf (a b : Free p F ⧸ J.toSubmodule) : R (a ⊓ b) = R a ⊓ R b := by + obtain ⟨g, rfl⟩ := Submodule.Quotient.mk_surjective J.toSubmodule a + obtain ⟨h, rfl⟩ := Submodule.Quotient.mk_surjective J.toSubmodule b + change R (J.mkQ g ⊓ J.mkQ h) = R (J.mkQ g) ⊓ R (J.mkQ h) + rw [← J.mkQ_inf, hR_mk, hR_mk, hR_mk] + exact (induced p T).map_inf' g h + let RL : LatticeOperator (Free p E) (Free p E) := { + toContinuousLinearMap := R.comp L.toContinuousLinearMap + map_sup' := by + intro a b + change R (L (a ⊔ b)) = R (L a) ⊔ R (L b) + rw [L.map_sup', hRsup] + map_inf' := by + intro a b + change R (L (a ⊓ b)) = R (L a) ⊓ R (L b) + rw [L.map_inf', hRinf] } + have hTqmk (x : F) : TqEquiv (Submodule.Quotient.mk x) = T x := by + rfl + have hST (x : F) : S (T x) = J.mkQ (delta p x) := by + change (T.ker.liftQL qdelta hker) (TqEquiv.symm (T x)) = J.mkQ (delta p x) + rw [← hTqmk x, TqEquiv.symm_apply_apply] + rfl + have hRLdelta (x : E) : RL (delta p x) = delta p x := by + obtain ⟨y, rfl⟩ := hT x + change R (L (delta p (T y))) = delta p (T y) + rw [hL (T y), hST y, hR_mk, (induced_norm_generators p T).2 y] + have hRLid : RL = { + toContinuousLinearMap := ContinuousLinearMap.id ℝ (Free p E) + map_sup' := by intros; rfl + map_inf' := by intros; rfl } := by + apply latticeOperator_ext_delta p + exact hRLdelta + intro f + obtain ⟨g, hg⟩ := Submodule.Quotient.mk_surjective J.toSubmodule (L f) + change J.mkQ g = L f at hg + refine ⟨g, ?_⟩ + have hRLf : R (L f) = f := by + have h := congrArg (fun A : LatticeOperator (Free p E) (Free p E) => A f) hRLid + exact h + calc + induced p T g = R (J.mkQ g) := (hR_mk g).symm + _ = R (L f) := by rw [hg] + _ = f := hRLf + + +/-- Section 1: faithful behavior on zero, injectivity, dense range and surjectivity. -/ +theorem induced_basic_properties [CompleteSpace E] [CompleteSpace F] + (p : Exponent) (T : F →L[ℝ] E) : + ((induced p T).toContinuousLinearMap = 0 ↔ T = 0) ∧ + (Function.Injective (induced p T) ↔ Function.Injective T) ∧ + (DenseRange (induced p T) ↔ DenseRange T) ∧ + (Function.Surjective (induced p T) ↔ Function.Surjective T) := by + exact ⟨induced_eq_zero_iff p T, + ⟨induced_injective_imp p T, induced_injective_of p T⟩, + induced_denseRange_iff p T, + ⟨induced_surjective_imp p T, induced_surjective_of p T⟩⟩ + +/-- Section 5: canonical inclusions are contractive, injective, have dense range and fix +generators. -/ +theorem inclusion_properties {p q : Exponent} (hpq : p ≤ q) : + ‖(inclusion (E := E) hpq).toContinuousLinearMap‖ ≤ 1 ∧ + Function.Injective (inclusion (E := E) hpq) ∧ DenseRange (inclusion (E := E) hpq) ∧ + ∀ x : E, inclusion hpq (delta p x) = delta q x := by + refine ⟨?_, ?_, ?_, ?_⟩ + · apply (inclusion (E := E) hpq).toContinuousLinearMap.opNorm_le_bound zero_le_one + intro f + change ‖parameterExtension hpq f‖ ≤ 1 * ‖f‖ + simpa only [one_mul] using parameterExtension_norm_le hpq f + · intro f g h + apply Subtype.ext + apply Subtype.ext + funext φ + have hφ := congrArg (fun k : Free q E => k φ) h + simpa only [inclusion_apply] using hφ + · apply denseRange_iff_closure_range.mpr + ext z + constructor + · intro _; trivial + · intro _ + have hz : z ∈ closure (Set.range (ofFVL q (E := E))) := by + rw [(denseRange_ofFVL q (E := E)).closure_range] + trivial + apply closure_mono ?_ hz + rintro _ ⟨v, rfl⟩ + exact ⟨ofFVL p v, parameterExtension_ofFVL hpq v⟩ + · intro x + rw [← ofFVL_of p x, ← ofFVL_of q x] + exact parameterExtension_ofFVL hpq (FVLv.of x) + +/-- The algebraic change-of-exponent map from the core to the infinity model. -/ +def endpointRangeMap (p : Exponent) : + endpointRange (E := E) p →ₗ[ℝ] Free Exponent.infinity E := + parameterRangeMap p Exponent.infinity + +/-- The continuous extension of the algebraic map into the infinity model. -/ +def endpointExtension (p : Exponent) : Free p E →L[ℝ] Free Exponent.infinity E := + parameterExtension (Exponent.le_infinity p) + +/-- The endpoint extension preserves binary suprema. -/ +theorem endpointExtension_map_sup (p : Exponent) (f g : Free p E) : + endpointExtension p (f ⊔ g) = endpointExtension p f ⊔ endpointExtension p g := + (inclusion (Exponent.le_infinity p)).map_sup' f g + +/-- The endpoint extension preserves binary infima. -/ +theorem endpointExtension_map_inf (p : Exponent) (f g : Free p E) : + endpointExtension p (f ⊓ g) = endpointExtension p f ⊓ endpointExtension p g := + (inclusion (Exponent.le_infinity p)).map_inf' f g + +/-- The canonical inclusion into the endpoint free lattice, constructed from the dense FVL. -/ +def inclusionInfinity (p : Exponent) : + LatticeOperator (Free p E) (Free Exponent.infinity E) := + inclusion (Exponent.le_infinity p) + +/-- The canonical map to the infinity free lattice preserves every full-dual evaluation. -/ +theorem inclusionInfinity_apply (p : Exponent) (f : Free p E) (φ : Dual E) : + inclusionInfinity p f φ = f φ := inclusion_apply (Exponent.le_infinity p) f φ + +/-- The canonical map into the infinity free lattice has operator norm at most one. -/ +theorem inclusionInfinity_norm_le (p : Exponent) : + ‖(inclusionInfinity p (E := E)).toContinuousLinearMap‖ ≤ 1 := + (inclusion_properties (E := E) (Exponent.le_infinity p)).1 + +/-- The endpoint inclusion maps each canonical generator to the same generator at ∞. -/ +theorem inclusionInfinity_generators (p : Exponent) (x : E) : + inclusionInfinity p (delta p x) = delta Exponent.infinity x := + (inclusion_properties (Exponent.le_infinity p)).2.2.2 x + +/-- The endpoint inclusion is injective because it leaves the underlying dual function unchanged. -/ +theorem inclusionInfinity_injective (p : Exponent) : + Function.Injective (inclusionInfinity p (E := E)) := + (inclusion_properties (E := E) (Exponent.le_infinity p)).2.1 + +/-- The endpoint inclusion has norm-dense range, since its range contains the algebraic +generators. -/ +theorem inclusionInfinity_denseRange (p : Exponent) : + DenseRange (inclusionInfinity p (E := E)) := + (inclusion_properties (E := E) (Exponent.le_infinity p)).2.2.1 + +/-- Equation (2.4): the reverse triangle inequality for lattice absolute values and +the identities expressing `a - a ⊓ b` as the positive part of `a - b`. The latter is +nonnegative and bounded by `|a - b|`; these estimates control witness approximations. -/ +theorem lattice_inequalities {X : Type w} [AddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] (a b : X) : + |(|a| - |b|)| ≤ |a - b| ∧ 0 ≤ a - a ⊓ b ∧ + a - a ⊓ b = (a - b) ⊔ 0 ∧ (a - b) ⊔ 0 ≤ |a - b| := by + refine ⟨abs_abs_sub_abs_le a b, ?_, ?_, ?_⟩ + · rw [sub_inf_eq_posPart] + exact posPart_nonneg _ + · exact sub_inf_eq_posPart a b + · exact posPart_le_abs _ + +end FBLOrderContinuousLH diff --git a/LeanPool/FBLOrderContinuity/Order.lean b/LeanPool/FBLOrderContinuity/Order.lean new file mode 100644 index 0000000000..7f88a08b0c --- /dev/null +++ b/LeanPool/FBLOrderContinuity/Order.lean @@ -0,0 +1,2098 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + +module + +public import LeanPool.FBLOrderContinuity.Model +public import LeanPool.FBLOrderContinuity.BanLat.Operators.OrderContinuous +public import Mathlib.Analysis.Normed.Module.DoubleDual +public import Mathlib.ModelTheory.Substructures + + + +/-! +# Order continuity and algebraic witnesses + +This module formalizes the order-theoretic part of Sections 1–3. `DecreasesToZero` +expresses decrease to a greatest lower bound of zero, and `SigmaOrderContinuous` is +the sequential version of BanLat's order-continuity predicate. The countable supremum +property of `Free p E` reduces order continuity to tests on sequences in `FVL E`. + +The main results are `separable_reduction`, `injectivity`, `noncompact_minima`, and +`necessary`. They reduce failure of order continuity to separable Banach-space ideals +and give explicit witnesses. `intro_infty` proves the complete endpoint criterion: +the original operator is zero or bounded below. + +The final part treats vector spaces without a norm through `AlgebraicFVL`, proves +`fvl_characterization`, and identifies that model with BanLat's `FVL` when a norm is +available. Banach-space ideals here concern Hahn–Banach extension of dual functionals. +-/ + +@[expose] public section + +noncomputable section +open scoped BigOperators ENNReal Topology +open Filter Set +universe u v w +namespace FBLOrderContinuousLH + +/-- Section 2: decreasing nets with greatest lower bound zero. -/ +def DecreasesToZero {ι : Type w} {X : Type u} [Preorder ι] [Preorder X] [Zero X] + (x : ι → X) : Prop := Antitone x ∧ IsGLB (Set.range x) 0 + +/-- Section 2: the sequential order-continuity test for positive maps. -/ +def SigmaOrderContinuous {X : Type u} {Y : Type v} + [Preorder X] [Zero X] [Preorder Y] [Zero Y] (S : X → Y) : Prop := + ∀ x : ℕ → X, DecreasesToZero x → DecreasesToZero (fun n => S (x n)) + +/-- Section 2: the countable supremum property, including arbitrary subsets. -/ +def CountableSupProperty (X : Type u) [Preorder X] : Prop := + ∀ (A : Set X) (a : X), IsLUB A a → + ∃ B : Set X, B ⊆ A ∧ B.Countable ∧ IsLUB B a + +/-- A positive operator's decreasing-net test agrees with BanLat's order convergence API. -/ +theorem orderContinuous_iff_decreasing {X : Type u} {Y : Type v} + [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [VectorLattice X] + [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + (S : X →ₗ[ℝ] Y) (hS : ∀ x, 0 ≤ x → 0 ≤ S x) : + IsOrderContinuousOp S ↔ + ∀ (ι : Type u) [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι] + (x : ι → X), DecreasesToZero x → DecreasesToZero (fun i => S (x i)) := by + have hmono : Monotone S := Positive.monotone_iff.mpr hS + constructor + · intro h ι _ _ _ x hx + have hc := h (orderConvergesTo_of_antitone_isGLB hx.1 hx.2) + exact ⟨hmono.comp_antitone hx.1, + ⟨by rintro _ ⟨i, rfl⟩; exact hS _ (hx.2.1 ⟨i, rfl⟩), + fun _ hb => by simpa only [map_zero] using hc.forall_le (fun i => hb ⟨i, rfl⟩)⟩⟩ + · intro h ι _ _ _ x a hx + rcases hx with ⟨κ, hκ, hdκ, hnκ, r, hr, hrpos, hrglb, hevent⟩ + let := hκ + let := hdκ + let := hnκ + obtain ⟨ha, hb⟩ := h κ r ⟨hr, hrglb⟩ + rcases orderConvergesTo_of_antitone_isGLB ha hb with + ⟨τ, hτ, hdτ, hnτ, s, hs, hspos, hsglb, hsevent⟩ + refine ⟨τ, hτ, hdτ, hnτ, s, hs, hspos, hsglb, fun k => ?_⟩ + obtain ⟨j, hj⟩ := (hsevent k).exists + exact (hevent j).mono fun i hi => by + calc + |S (x i) - S a| = |S (x i - a)| := by rw [map_sub] + _ ≤ S |x i - a| := Positive.abs_le_map_abs hS _ + _ ≤ S (r j) := hmono hi + _ ≤ |S (r j) - 0| := by simpa only [sub_zero] using le_abs_self (S (r j)) + _ ≤ s k := hj + +/-- Order-continuous positive operators preserve decreasing sequences, in any domain universe. -/ +theorem orderContinuous_sigmaOrderContinuous {X : Type u} {Y : Type v} + [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [VectorLattice X] + [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + (S : X →ₗ[ℝ] Y) (hS : ∀ x, 0 ≤ x → 0 ≤ S x) (h : IsOrderContinuousOp S) : + SigmaOrderContinuous S := by + intro x hx + have hrange : Set.range (fun n : ULift.{u} ℕ => x n.down) = Set.range x := + ULift.down_surjective.range_comp x + have hc := (orderContinuous_iff_decreasing S hS).mp h (ULift.{u} ℕ) + (fun n => x n.down) ⟨fun _ _ h => hx.1 h, hrange.symm ▸ hx.2⟩ + exact ⟨fun _ _ h => hc.1 (show (ULift.up _ : ULift.{u} ℕ) ≤ ULift.up _ from h), + (ULift.down_surjective.range_comp (fun n => S (x n))) ▸ hc.2⟩ + +/-- Proposition 2.2 (`prop:csp-operator`): for a positive linear map whose domain has +the countable supremum property, preservation of decreasing order-null sequences is +equivalent to order continuity for arbitrary directed nets. -/ +theorem csp_operator {X : Type u} {Y : Type v} + [AddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [VectorLattice X] + [AddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [VectorLattice Y] + (hX : CountableSupProperty X) (S : X →ₗ[ℝ] Y) + (hS : ∀ x, 0 ≤ x → 0 ≤ S x) : + IsOrderContinuousOp S ↔ SigmaOrderContinuous S := by + rw [orderContinuous_iff_decreasing S hS] + constructor + · intro h x hx + have hrange : Set.range (fun n : ULift.{u} ℕ => x n.down) = Set.range x := + (ULift.down_surjective.range_comp x) + have hc := h (ULift.{u} ℕ) (fun n => x n.down) + ⟨fun _ _ h => hx.1 h, hrange.symm ▸ hx.2⟩ + exact ⟨fun _ _ h => hc.1 (show (ULift.up _ : ULift.{u} ℕ) ≤ ULift.up _ from h), + (ULift.down_surjective.range_comp (fun n => S (x n))) ▸ hc.2⟩ + · intro h ι _ _ _ x hx + classical + obtain ⟨B, hB, hBc, hBlub⟩ := hX (-(Set.range x)) 0 (by simpa using hx.2.neg) + let i₀ : ι := Classical.choice inferInstance + obtain ⟨b, hb⟩ := (hBc.insert (-x i₀)).exists_eq_range (Set.insert_nonempty _ _) + have hbi (n : ℕ) : ∃ i, x i = -b n := by + change -b n ∈ Set.range x + apply Set.mem_neg.mp + have hn : b n ∈ insert (-x i₀) B := hb.symm ▸ Set.mem_range_self n + rcases hn with hn | hn + · simp only [hn, Set.mem_neg, neg_neg, Set.mem_range_self] + · exact hB hn + choose a ha using hbi + choose upper hleft hright using (fun i j : ι => directed_of (· ≤ ·) i j) + let β : ℕ → ι := Nat.rec i₀ (fun n i => upper i (a n)) + have hβ : Monotone β := monotone_nat_of_le_succ fun n => hleft (β n) (a n) + have haβ (n : ℕ) : a n ≤ β (n + 1) := hright (β n) (a n) + have hxβ : DecreasesToZero (fun n => x (β n)) := by + refine ⟨hx.1.comp_monotone hβ, ⟨?_, ?_⟩⟩ + · rintro _ ⟨n, rfl⟩ + exact hx.2.1 ⟨β n, rfl⟩ + · intro z hz + suffices 0 ≤ -z by simpa using this + apply hBlub.2 + intro y hy + obtain ⟨n, rfl⟩ := hb ▸ Set.mem_insert_of_mem _ hy + have hz' : z ≤ -b n := (hz ⟨n + 1, rfl⟩).trans ((hx.1 (haβ n)).trans_eq (ha n)) + exact le_neg.mpr hz' + exact ⟨(Positive.monotone_iff.mpr hS).comp_antitone hx.1, + ⟨by rintro _ ⟨i, rfl⟩; exact hS _ (hx.2.1 ⟨i, rfl⟩), + fun z hz => (h _ hxβ).2.2 (by rintro _ ⟨n, rfl⟩; exact hz ⟨β n, rfl⟩)⟩⟩ + +variable {E : Type u} {F : Type v} + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + +private theorem finite_positive_lower_bound {ι : Type*} (s : Finset ι) (r : ι → ℝ) + (hr : ∀ i ∈ s, 0 < r i) : ∃ δ > 0, ∀ i ∈ s, δ ≤ r i := by + classical + induction s using Finset.induction_on with + | empty => exact ⟨1, zero_lt_one, by simp⟩ + | @insert i s hi ih => + obtain ⟨δ, hδ, hle⟩ := ih (fun j hj => hr j (Finset.mem_insert_of_mem hj)) + refine ⟨min (r i) δ, lt_min (hr i (Finset.mem_insert_self _ _)) hδ, ?_⟩ + intro j hj + rcases Finset.mem_insert.mp hj with rfl | hj + · exact min_le_left _ _ + · exact (min_le_right _ _).trans (hle j hj) + +private theorem weakDual_neighborhood_finite (φ : WeakDual ℝ E) + (U : Set (WeakDual ℝ E)) (hU : U ∈ 𝓝 φ) : + ∃ (s : Finset E) (δ : ℝ), 0 < δ ∧ + ∀ ψ : WeakDual ℝ E, (∀ x ∈ s, |ψ x - φ x| < δ) → ψ ∈ U := by + classical + have hEmb : Topology.IsEmbedding (fun θ : WeakDual ℝ E => (θ : E → ℝ)) := + WeakBilin.isEmbedding (by + intro a b hab + apply ContinuousLinearMap.ext + intro x + simpa only [topDualPairing_apply] using congrArg (fun l : E →ₗ[ℝ] ℝ => l x) hab) + rw [hEmb.isInducing.nhds_eq_comap φ] at hU + obtain ⟨V, hV, hVU⟩ := Filter.mem_comap.mp hU + rw [nhds_pi] at hV + obtain ⟨⟨s, r⟩, ⟨hs, hr⟩, hsub⟩ := + (Filter.hasBasis_pi (fun x : E => Metric.nhds_basis_ball (x := φ x))).mem_iff.mp hV + obtain ⟨δ, hδ, hle⟩ := finite_positive_lower_bound hs.toFinset r + (fun x hx => hr x (hs.mem_toFinset.mp hx)) + refine ⟨hs.toFinset, δ, hδ, fun ψ hψ => hVU (hsub ?_)⟩ + intro x hx + exact (show |ψ x - φ x| < r x from + (hψ x (hs.mem_toFinset.mpr hx)).trans_le (hle x (hs.mem_toFinset.mpr hx))) + +private theorem positive_free_certificate (p : Exponent) (f : Free p E) (hf : 0 < f) : + ∃ (φ : Dual E) (n m k : ℕ) (x : Fin n → E), ‖φ‖ ≤ 1 / 3 ∧ + (∀ i, ‖x i‖ ≤ m) ∧ + ∀ ψ : Dual E, ‖ψ‖ ≤ 1 → + (∀ i, |ψ (x i) - φ (x i)| < 1 / ((k : ℝ) + 1)) → 0 < f ψ := by + classical + obtain ⟨θ, hθ⟩ : ∃ θ : Dual E, 0 < f θ := by + by_contra! h + exact hf.not_ge ((free_le_iff p _ _).mpr h) + let a : ℝ := 1 / (3 * (‖θ‖ + 1)) + have ha : 0 < a := by dsimp [a]; positivity + let φ := a • θ + have hφnorm : ‖φ‖ ≤ 1 / 3 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos ha] + dsimp [a] + rw [one_div_mul_eq_div, div_le_iff₀ (by positivity)] + linarith + have hφ : 0 < f φ := by rw [show f φ = a * f θ from f.1.2.1 a ha.le θ]; positivity + have hev : {ψ : WeakDual ℝ E | 0 < f ψ.toStrongDual} ∈ + 𝓝[{ψ | ‖ψ.toStrongDual‖ ≤ 1}] (StrongDual.toWeakDual φ) := + (weakStar_continuous_bounded p f 1 _ (by change ‖φ‖ ≤ 1; linarith)).preimage_mem_nhdsWithin + (Ioi_mem_nhds hφ) + obtain ⟨U, hU, hsub⟩ := mem_nhdsWithin_iff_exists_mem_nhds_inter.mp hev + obtain ⟨s, δ, hδ, hcert⟩ := weakDual_neighborhood_finite (StrongDual.toWeakDual φ) U hU + obtain ⟨k, hk⟩ := exists_nat_one_div_lt hδ + let x : Fin (Fintype.card s) → E := fun i => ((Fintype.equivFin s).symm i : E) + obtain ⟨C, hC⟩ := (Set.finite_range x).isBounded.exists_norm_le + obtain ⟨m, hm⟩ := exists_nat_gt C + refine ⟨φ, Fintype.card s, m, k, x, hφnorm, + fun i => (hC _ (Set.mem_range_self i)).trans hm.le, fun ψ hψ hclose => ?_⟩ + apply hsub + refine ⟨hcert (StrongDual.toWeakDual ψ) ?_, hψ⟩ + intro y hy + have hi := hclose ((Fintype.equivFin s) ⟨y, hy⟩) + simpa only [x, Equiv.symm_apply_apply, StrongDual.toWeakDual_apply] using hi.trans hk + +private theorem finite_color_triple {C : Type*} [Finite C] (c : ℕ → ℕ → C) : + ∃ i j k, i < j ∧ j < k ∧ c i j = c i k ∧ c k i = c k j := by + let U := hyperfilter ℕ + have hcol (i : ℕ) : ∃ a, ∀ᶠ j in U, c j i = a := + Ultrafilter.eventually_exists_iff.mp (Eventually.of_forall (fun j => ⟨c j i, rfl⟩)) + choose d hd using hcol + obtain ⟨a, ha⟩ : ∃ a, ∀ᶠ i in U, d i = a := + Ultrafilter.eventually_exists_iff.mp (Eventually.of_forall (fun i => ⟨d i, rfl⟩)) + obtain ⟨i, hi⟩ := ha.exists + obtain ⟨b, hb⟩ : ∃ b, ∀ᶠ j in U, c i j = b := + Ultrafilter.eventually_exists_iff.mp (Eventually.of_forall (fun j => ⟨c i j, rfl⟩)) + have hlarge (n : ℕ) : ∀ᶠ j in U, n < j := + Nat.hyperfilter_le_atTop (eventually_gt_atTop n) + obtain ⟨j, hj, hij, hlargej⟩ := (ha.and (hb.and (hlarge i))).exists + obtain ⟨k, hik, hki, hkj, hlargek⟩ := + (hb.and ((hd i).and ((hd j).and (hlarge j)))).exists + exact ⟨i, j, k, hlargej, hlargek, hij.trans hik.symm, + hki.trans (hi.trans (hj.symm.trans hkj.symm))⟩ + +private theorem bounded_matrix_triple {n : ℕ} (a : ℕ → ℕ → (Fin n → ℝ)) + {C δ : ℝ} (hC : 0 ≤ C) (ha : ∀ i j t, |a i j t| ≤ C) (hδ : 0 < δ) : + ∃ i j k, i < j ∧ j < k ∧ + (∀ t, |a i j t - a i k t| < δ) ∧ (∀ t, |a k i t - a k j t| < δ) := by + classical + have hmem (i j : ℕ) : a i j ∈ Metric.closedBall (0 : Fin n → ℝ) C := by + rw [mem_closedBall_zero_iff, pi_norm_le_iff_of_nonneg hC] + exact ha i j + obtain ⟨s, hs, hcover⟩ := Metric.totallyBounded_iff.mp + (isCompact_closedBall (0 : Fin n → ℝ) C).totallyBounded (δ / 2) (by positivity) + have hchoose (i j : ℕ) : ∃ b ∈ s, dist (a i j) b < δ / 2 := by + obtain ⟨b, hb, hdist⟩ := Set.mem_iUnion₂.mp (hcover (hmem i j)) + exact ⟨b, hb, hdist⟩ + choose b hb hdist using hchoose + let := hs.fintype + have hclose (i j k l : ℕ) (heq : b i j = b k l) : + ∀ t, |a i j t - a k l t| < δ := by + have hd : dist (a i j) (a k l) < δ := by + have ht := dist_triangle (a i j) (b i j) (a k l) + rw [heq, dist_comm (b k l) (a k l)] at ht + have hdij := hdist i j + rw [heq] at hdij + linarith [hdist k l] + intro t + exact (show |a i j t - a k l t| ≤ dist (a i j) (a k l) from + norm_le_pi_norm (a i j - a k l) t).trans_lt hd + obtain ⟨i, j, k, hij, hjk, hrow, hcol⟩ := + finite_color_triple (fun i j => (⟨b i j, hb i j⟩ : s)) + exact ⟨i, j, k, hij, hjk, hclose i j i k (congrArg Subtype.val hrow), + hclose k i k j (congrArg Subtype.val hcol)⟩ + +/-- Section 2, the disjoint-family consequence used to obtain the countable supremum property. -/ +theorem disjoint_positive_countable (p : Exponent) (A : Set (Free p E)) + (hpos : ∀ f ∈ A, 0 < f) (hdisj : A.Pairwise (fun f g => f ⊓ g = 0)) : + A.Countable := by + classical + let B (n m k : ℕ) : Set (Free p E) := {f | f ∈ A ∧ + ∃ (φ : Dual E) (x : Fin n → E), ‖φ‖ ≤ 1 / 3 ∧ (∀ i, ‖x i‖ ≤ m) ∧ + ∀ ψ : Dual E, ‖ψ‖ ≤ 1 → + (∀ i, |ψ (x i) - φ (x i)| < 1 / ((k : ℝ) + 1)) → 0 < f ψ} + have hfinite (n m k : ℕ) : (B n m k).Finite := by + by_contra hfin + let a := Set.Infinite.natEmbedding (B n m k) hfin + choose φ x hφ hx hcert using (fun i => (a i).2.2) + obtain ⟨i, j, l, hij, hjl, hrow, hcol⟩ := bounded_matrix_triple + (fun i j t => φ j (x i t)) (Nat.cast_nonneg m) + (fun i j t => ((φ j).le_opNorm (x i t)).trans (by + have := hx i t + have := hφ j + nlinarith [norm_nonneg (φ j), norm_nonneg (x i t)])) + (show 0 < 1 / ((k : ℝ) + 1) by positivity) + let ψ : Dual E := φ i - φ j + φ l + have hψ : ‖ψ‖ ≤ 1 := by + have hnorm := (norm_add_le (φ i - φ j) (φ l)).trans + (add_le_add (norm_sub_le (φ i) (φ j)) le_rfl) + dsimp [ψ] + linarith [hφ i, hφ j, hφ l] + have hi : 0 < (a i).1 ψ := hcert i ψ hψ (fun t => by + have heq : ψ (x i t) - φ i (x i t) = -(φ j (x i t) - φ l (x i t)) := by + simp only [ψ, sub_apply, add_apply] + ring + rw [heq, abs_neg] + exact hrow t) + have hl : 0 < (a l).1 ψ := hcert l ψ hψ (fun t => by + have heq : ψ (x l t) - φ l (x l t) = φ i (x l t) - φ j (x l t) := by + simp only [ψ, sub_apply, add_apply] + ring + rw [heq] + exact hcol t) + have hne : (a i).1 ≠ (a l).1 := fun he => (ne_of_lt (hij.trans hjl)) + (a.injective (Subtype.ext he)) + have hzero := congrArg (fun f : Free p E => f ψ) + (hdisj (a i).2.1 (a l).2.1 hne) + change min ((a i).1 ψ) ((a l).1 ψ) = 0 at hzero + exact (lt_min hi hl).ne' hzero + apply (Set.countable_iUnion fun n => Set.countable_iUnion fun m => + Set.countable_iUnion fun k => (hfinite n m k).countable).mono + intro f hf + obtain ⟨φ, n, m, k, x, hφ, hx, hcert⟩ := positive_free_certificate p f (hpos f hf) + exact Set.mem_iUnion.mpr ⟨n, Set.mem_iUnion.mpr ⟨m, + Set.mem_iUnion.mpr ⟨k, hf, φ, x, hφ, hx, hcert⟩⟩⟩ + +private theorem countable_disjoint_detection (p : Exponent) + (C : Set (Free p E)) (hC : ∀ f ∈ C, 0 ≤ f) : + ∃ B : Set (Free p E), B ⊆ C ∧ B.Countable ∧ + ∀ g : Free p E, 0 ≤ g → (∀ b ∈ B, g ⊓ b = 0) → ∀ c ∈ C, g ⊓ c = 0 := by + classical + let L : Set (Free p E) := {f | 0 < f ∧ ∃ c ∈ C, f ≤ c} + let Q : Set (Set (Free p E)) := {D | D ⊆ L ∧ D.Pairwise (fun f g => f ⊓ g = 0)} + obtain ⟨D, hD, hmax⟩ := zorn_subset Q (by + intro chain hchain hc + refine ⟨⋃₀ chain, ⟨?_, ?_⟩, fun s hs => Set.subset_sUnion_of_mem hs⟩ + · rintro f ⟨s, hs, hfs⟩ + exact (hchain hs).1 hfs + · rintro f ⟨s, hs, hfs⟩ g ⟨t, ht, hgt⟩ hne + rcases hc.total hs ht with hst | hts + · exact (hchain ht).2 (hst hfs) hgt hne + · exact (hchain hs).2 hfs (hts hgt) hne) + have hDc := disjoint_positive_countable p D (fun f hf => (hD.1 hf).1) hD.2 + let := hDc.to_subtype + choose v hv hle using (fun y : D => (hD.1 y.2).2) + refine ⟨Set.range v, ?_, Set.countable_range v, ?_⟩ + · rintro _ ⟨y, rfl⟩ + exact hv y + · intro g hg hgb c hc + let z := g ⊓ c + have hzpos : 0 ≤ z := le_inf hg (hC c hc) + apply le_antisymm _ hzpos + by_contra hzne + have hzlt : 0 < z := lt_of_le_of_ne hzpos (fun he => hzne (le_of_eq he.symm)) + have hzL : z ∈ L := ⟨hzlt, c, hc, inf_le_right⟩ + have hzy (y : Free p E) (hy : y ∈ D) : z ⊓ y = 0 := by + have hypos := (hD.1 hy).1.le + exact le_antisymm ((inf_le_inf (show z ≤ g from inf_le_left) (hle ⟨y, hy⟩)).trans_eq + (hgb (v ⟨y, hy⟩) (Set.mem_range_self _))) (le_inf hzpos hypos) + have hinsert : insert z D ∈ Q := by + refine ⟨Set.insert_subset_iff.mpr ⟨hzL, hD.1⟩, ?_⟩ + exact Set.pairwise_insert.mpr ⟨hD.2, fun y hy _ => + ⟨hzy y hy, (inf_comm y z).trans (hzy y hy)⟩⟩ + have hzD : z ∈ D := hmax hinsert (Set.subset_insert _ _) (Set.mem_insert _ _) + exact hzlt.ne' (by simpa only [inf_idem] using hzy z hzD) + +private theorem countable_lower_approximation (p : Exponent) + (A : Set (Free p E)) (a : Free p E) (ha : 0 ≤ a) (hA : IsLUB A a) + (r : ℝ) (hr : 0 ≤ r) (hr1 : r < 1) : + ∃ B : Set (Free p E), B ⊆ A ∧ B.Countable ∧ + ∀ b, 0 ≤ b → b ∈ upperBounds B → r • a ≤ b := by + classical + let C := (fun u : Free p E => (u - r • a)⁺) '' A + obtain ⟨D, hDC, hDc, hdet⟩ := countable_disjoint_detection p C + (by rintro _ ⟨u, _, rfl⟩; exact posPart_nonneg _) + let := hDc.to_subtype + choose v hv hveq using (fun d : D => hDC d.2) + refine ⟨Set.range v, ?_, Set.countable_range v, ?_⟩ + · rintro _ ⟨d, rfl⟩ + exact hv d + · intro b hb hbB + let g := (r • a - b)⁺ ⊓ ((1 - r) • a) + have hg : 0 ≤ g := le_inf (posPart_nonneg _) (smul_nonneg (by linarith) ha) + have hgd (d : D) : g ⊓ d.1 = 0 := by + rw [← hveq d] + apply le_antisymm _ (le_inf hg (posPart_nonneg _)) + have hbound := inf_le_inf (show g ≤ (r • a - b)⁺ from inf_le_left) + (posPart_mono (sub_le_sub_right (hbB (Set.mem_range_self d)) (r • a))) + apply hbound.trans_eq + simpa only [negPart_def, neg_sub, posPart_def] using + posPart_inf_negPart_eq_zero (r • a - b) + have hgu (u : Free p E) (hu : u ∈ A) : g ⊓ (u - r • a)⁺ = 0 := + hdet g hg (fun d hd => hgd ⟨d, hd⟩) _ ⟨u, hu, rfl⟩ + have hupper : a - g ∈ upperBounds A := by + intro u hu + apply (free_le_iff p _ _).mpr + intro φ + have hua := (free_le_iff p _ _).mp (hA.1 hu) φ + have hgφ := (free_le_iff p _ _).mp hg φ + have hgbound := (free_le_iff p _ _).mp (show g ≤ (1 - r) • a from inf_le_right) φ + have hz := congrArg (fun f : Free p E => f φ) (hgu u hu) + change min (g φ) (max (u φ - r * a φ) 0) = 0 at hz + change g φ ≤ (1 - r) * a φ at hgbound + change u φ ≤ a φ - g φ + by_cases hzero : g φ = 0 + · simpa only [hzero, sub_zero] using hua + have hgp : 0 < g φ := lt_of_le_of_ne hgφ (Ne.symm hzero) + have hur : u φ ≤ r * a φ := by + by_contra! hlt + exact (lt_min hgp (lt_max_of_lt_left (by linarith))).ne' hz + nlinarith + have hgzero : g ≤ 0 := by + have h := hA.2 hupper + exact sub_nonpos.mp (by simpa using sub_le_sub_left h a) + apply (free_le_iff p _ _).mpr + intro φ + have hgz := (free_le_iff p _ _).mp hgzero φ + have haφ := (free_le_iff p _ _).mp ha φ + have hbφ := (free_le_iff p _ _).mp hb φ + change 0 ≤ a φ at haφ + change 0 ≤ b φ at hbφ + change r * a φ ≤ b φ + change min (max (r * a φ - b φ) 0) ((1 - r) * a φ) ≤ 0 at hgz + by_contra! hlt + have hap : 0 < a φ := by nlinarith + exact (lt_min (lt_max_of_lt_left (by linarith)) (mul_pos (by linarith) hap)).not_ge hgz + +private theorem countable_lub_positive (p : Exponent) + (A : Set (Free p E)) (a : Free p E) (hA : IsLUB A a) (hne : A.Nonempty) + (hpos : ∀ u ∈ A, 0 ≤ u) : + ∃ B : Set (Free p E), B ⊆ A ∧ B.Countable ∧ IsLUB B a := by + classical + obtain ⟨a₀, ha₀⟩ := hne + have ha : 0 ≤ a := (hpos a₀ ha₀).trans (hA.1 ha₀) + let r (n : ℕ) : ℝ := 1 - 1 / ((n : ℝ) + 1) + have hr (n : ℕ) : 0 ≤ r n := by + dsimp [r] + have h : 1 / ((n : ℝ) + 1) ≤ 1 := (div_le_one (by positivity)).mpr + (by linarith [Nat.cast_nonneg (α := ℝ) n]) + linarith + have hr1 (n : ℕ) : r n < 1 := by + dsimp [r] + have : 0 < 1 / ((n : ℝ) + 1) := by positivity + linarith + choose B hBA hBc hB using + (fun n => countable_lower_approximation p A a ha hA (r n) (hr n) (hr1 n)) + refine ⟨insert a₀ (⋃ n, B n), Set.insert_subset_iff.mpr ⟨ha₀, Set.iUnion_subset hBA⟩, + (Set.countable_iUnion hBc).insert a₀, ⟨fun u hu => hA.1 ?_, ?_⟩⟩ + · rcases hu with rfl | hu + · exact ha₀ + · obtain ⟨n, hn⟩ := Set.mem_iUnion.mp hu + exact hBA n hn + · intro b hb + have hbpos : 0 ≤ b := (hpos a₀ ha₀).trans (hb (Set.mem_insert _ _)) + have hbound (n : ℕ) : r n • a ≤ b := hB n b hbpos + (fun u hu => hb (Set.mem_insert_of_mem _ (Set.mem_iUnion.mpr ⟨n, hu⟩))) + have hrconv : Tendsto r atTop (𝓝 1) := by + simpa only [sub_zero] using (tendsto_const_nhds (x := (1 : ℝ))).sub + tendsto_one_div_add_atTop_nhds_zero_nat + exact le_of_tendsto' (by simpa only [one_smul] using hrconv.smul_const a) hbound + +/-- Lemma 2.1 (`lem:csp`): every free p-convex lattice over a Banach space has the +countable supremum property. The proof first shows that pairwise disjoint families of +strictly positive elements are countable, then extracts a countable set with the same supremum. -/ +theorem csp (p : Exponent) : CountableSupProperty (Free p E) := by + classical + intro A a hA + by_cases hne : A.Nonempty + · obtain ⟨a₀, ha₀⟩ := hne + let P := (fun u : Free p E => u ⊔ a₀ - a₀) '' A + have hPpos : ∀ u ∈ P, 0 ≤ u := by + rintro _ ⟨u, _, rfl⟩ + exact sub_nonneg.mpr le_sup_right + have hPlub : IsLUB P (a - a₀) := by + refine ⟨?_, ?_⟩ + · rintro _ ⟨u, hu, rfl⟩ + exact sub_le_sub_right (sup_le (hA.1 hu) (hA.1 ha₀)) a₀ + · intro b hb + apply sub_le_iff_le_add.mpr + apply hA.2 + intro u hu + exact le_sup_left.trans (sub_le_iff_le_add.mp (hb ⟨u, hu, rfl⟩)) + obtain ⟨D, hDP, hDc, hDlub⟩ := countable_lub_positive p P (a - a₀) hPlub + ⟨a₀ ⊔ a₀ - a₀, a₀, ha₀, rfl⟩ hPpos + let := hDc.to_subtype + choose v hv hveq using (fun d : D => hDP d.2) + refine ⟨insert a₀ (Set.range v), ?_, (Set.countable_range v).insert a₀, ⟨?_, ?_⟩⟩ + · rintro u (rfl | ⟨d, rfl⟩) + · exact ha₀ + · exact hv d + · rintro u (rfl | ⟨d, rfl⟩) + · exact hA.1 ha₀ + · exact hA.1 (hv d) + · intro b hb + have hbase : a₀ ≤ b := hb (Set.mem_insert _ _) + have hDupper : b - a₀ ∈ upperBounds D := by + intro d hd + exact (hveq ⟨d, hd⟩).symm.trans_le (sub_le_sub_right + (sup_le (hb (Set.mem_insert_of_mem _ (Set.mem_range_self ⟨d, hd⟩))) hbase) a₀) + exact (sub_le_sub_iff_right a₀).mp (hDlub.2 hDupper) + · exact ⟨A, Set.Subset.rfl, (Set.not_nonempty_iff_eq_empty.mp hne) ▸ Set.countable_empty, hA⟩ + +/-- Lemma 2.3 (`lem:sigma-order-continuity`): a positive linear map from `Free p E` +is order continuous exactly when it preserves decreasing order-null sequences. The +countable supremum property supplies the reduction; boundedness of the map is unnecessary. -/ +theorem sigma_order_continuity (p : Exponent) + {Y : Type v} [NormedAddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] + [BanachLattice Y] (S : Free p E →ₗ[ℝ] Y) (hS : ∀ x, 0 ≤ x → 0 ≤ S x) : + IsOrderContinuousOp S ↔ SigmaOrderContinuous S := csp_operator (csp p) S hS + +private theorem positive_fvl_approximation (p : Exponent) (f : Free p F) (hf : 0 ≤ f) + {ε : ℝ} (hε : 0 < ε) : ∃ g : FVL F, 0 ≤ g ∧ ‖ofFVL p g - f‖ < ε := by + obtain ⟨g, hg⟩ := (denseRange_ofFVL p).exists_dist_lt f hε + refine ⟨g ⊔ 0, le_sup_right, ?_⟩ + rw [SupHomClass.map_sup, map_zero, ← sup_eq_left.mpr hf] + exact (norm_sup_sub_sup_le_norm _ _ _).trans_lt + (by simpa only [dist_eq_norm, norm_sub_rev] using hg) + +private theorem fvl_minima_decreases (p : Exponent) (h : ℕ → Free p F) + (hh : DecreasesToZero h) (g : ℕ → FVL F) (hgpos : ∀ n, 0 ≤ g n) + (herr : Tendsto (fun n => ofFVL p (g n) - h n) atTop (𝓝 0)) : + DecreasesToZero (fun n => ofFVL p ((Finset.range (n + 1)).inf' + (Finset.nonempty_range_iff.mpr (Nat.succ_ne_zero n)) g)) := by + let f (n : ℕ) : FVL F := (Finset.range (n + 1)).inf' + (Finset.nonempty_range_iff.mpr (Nat.succ_ne_zero n)) g + have hfpos (n : ℕ) : 0 ≤ f n := Finset.le_inf' _ _ (fun i _ => hgpos i) + have hfbound (n : ℕ) : ofFVL p (f n) ≤ ofFVL p (g n) := + (ofFVL p).monotone (Finset.inf'_le g (Finset.mem_range.mpr (Nat.lt_succ_self n))) + change DecreasesToZero (fun n => ofFVL p (f n)) + refine ⟨?_, ⟨?_, ?_⟩⟩ + · intro m n hmn + apply (ofFVL p).monotone + exact Finset.le_inf' _ _ (fun i hi => Finset.inf'_le g + (Finset.range_mono (Nat.add_le_add_right hmn 1) hi)) + · rintro _ ⟨n, rfl⟩ + exact (ofFVL p).map_nonneg (hfpos n) + · intro b hb + apply hh.2.2 + rintro _ ⟨m, rfl⟩ + apply sub_nonpos.mp + apply ge_of_tendsto herr + exact (eventually_ge_atTop m).mono fun n hn => + sub_le_sub ((hb ⟨n, rfl⟩).trans (hfbound n)) (hh.1 hn) + +private theorem sigma_test_of_fvl (p : Exponent) (S : LatticeOperator (Free p F) (Free p E)) + (htest : ∀ f : ℕ → FVL F, (∀ n, 0 ≤ f n) → + DecreasesToZero (fun n => ofFVL p (f n)) → + DecreasesToZero (fun n => S (ofFVL p (f n)))) : SigmaOrderContinuous S := by + intro h hh + refine ⟨S.toVecLatHom.monotone.comp_antitone hh.1, ⟨?_, ?_⟩⟩ + · rintro _ ⟨n, rfl⟩ + exact S.toVecLatHom.map_nonneg (hh.2.1 ⟨n, rfl⟩) + · intro u hu + by_contra hule + let v := u ⊔ 0 + have hvpos : 0 ≤ v := le_sup_right + have hvne : v ≠ 0 := fun hz => hule (hz ▸ le_sup_left) + have hvnorm : 0 < ‖v‖ := norm_pos_iff.mpr hvne + have hvbound (n : ℕ) : v ≤ S (h n) := sup_le (hu ⟨n, rfl⟩) + (S.toVecLatHom.map_nonneg (hh.2.1 ⟨n, rfl⟩)) + let C := ‖S.toContinuousLinearMap‖ + have hC : 0 ≤ C := norm_nonneg _ + let c (n : ℕ) : ℝ := ‖v‖ / (4 * (1 + C)) * (1 / 2 : ℝ) ^ n + have hc (n : ℕ) : 0 < c n := + mul_pos (div_pos hvnorm (mul_pos (by norm_num) (by linarith))) (pow_pos (by norm_num) n) + choose g hgpos hgerr using (fun n => positive_fvl_approximation p (h n) + (hh.2.1 ⟨n, rfl⟩) (hc n)) + have hcsum : Summable c := summable_geometric_two.mul_left _ + have herr : Tendsto (fun n => ofFVL p (g n) - h n) atTop (𝓝 0) := + squeeze_zero_norm (fun n => (hgerr n).le) hcsum.tendsto_atTop_zero + let f (n : ℕ) : FVL F := (Finset.range (n + 1)).inf' + (Finset.nonempty_range_iff.mpr (Nat.succ_ne_zero n)) g + have hfpos (n : ℕ) : 0 ≤ f n := Finset.le_inf' _ _ (fun i _ => hgpos i) + have hf := fvl_minima_decreases p h hh g hgpos herr + let z (n : ℕ) : Free p E := |S (ofFVL p (g n) - h n)| + have hzc (n : ℕ) : ‖z n‖ ≤ C * c n := by + rw [norm_abs_eq_norm] + exact (S.toContinuousLinearMap.le_opNorm _).trans + (mul_le_mul_of_nonneg_left (hgerr n).le hC) + have hzsum : Summable z := (hcsum.mul_left C).of_norm_bounded hzc + let e : Free p E := ∑' n, z n + have hepos : 0 ≤ e := tsum_nonneg (fun n => abs_nonneg _) + have hze (n : ℕ) : z n ≤ e := hzsum.le_tsum n (fun _ _ => abs_nonneg _) + have hsum : HasSum (fun n => C * c n) (C * (‖v‖ / (2 * (1 + C)))) := by + have heq : ‖v‖ / (4 * (1 + C)) * (∑' n : ℕ, (1 / 2 : ℝ) ^ n) = + ‖v‖ / (2 * (1 + C)) := by + rw [tsum_geometric_two] + field_simp + ring + exact (heq ▸ summable_geometric_two.hasSum.mul_left (‖v‖ / (4 * (1 + C)))).mul_left C + have henorm : ‖e‖ < ‖v‖ := (tsum_of_norm_bounded hsum hzc).trans_lt (by + rw [← mul_div_assoc, div_lt_iff₀ (by positivity)] + nlinarith) + have hvg (n : ℕ) : v - e ≤ S (ofFVL p (g n)) := by + have hz : S (h n) - S (ofFVL p (g n)) ≤ z n := by + simpa only [z, map_sub, neg_sub] using neg_le_abs (S (ofFVL p (g n) - h n)) + exact (sub_le_sub (hvbound n) (hze n)).trans (sub_le_comm.mp hz) + have hvf (n : ℕ) : v - e ≤ S (ofFVL p (f n)) := by + change v - e ≤ S.toVecLatHom (ofFVL p ((Finset.range (n + 1)).inf' _ g)) + rw [map_finset_inf', map_finset_inf'] + exact Finset.le_inf' _ _ (fun i _ => hvg i) + have hvle : v ≤ e := sub_nonpos.mp ((htest f hfpos hf).2.2 + (by rintro _ ⟨n, rfl⟩; exact hvf n)) + exact henorm.not_ge (norm_le_norm_of_abs_le_abs + (by simpa only [abs_of_nonneg hvpos, abs_of_nonneg hepos] using hvle)) + +/-- Proposition 2.4 (`prop:fvl-sequential-test`): order continuity of an induced map +can be tested on positive sequences in the algebraic free lattice that decrease to zero +in `Free p F`. Norm density and lattice approximation reduce the general sequential test +to this common algebraic core. -/ +theorem fvl_sequential_test (p : Exponent) (T : F →L[ℝ] E) : + IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap ↔ + ∀ f : ℕ → FVL F, (∀ n, 0 ≤ f n) → + DecreasesToZero (fun n => ofFVL p (f n)) → + DecreasesToZero (fun n => induced p T (ofFVL p (f n))) := by + constructor + · intro h f _ hf + exact orderContinuous_sigmaOrderContinuous _ + (fun _ hx => (induced p T).toVecLatHom.map_nonneg hx) h _ hf + · intro h + exact (sigma_order_continuity p _ + (fun _ hx => (induced p T).toVecLatHom.map_nonneg hx)).mpr + (sigma_test_of_fvl p (induced p T) h) + +/-- Section 2: closed Banach-space ideals, via a linear Hahn--Banach extension isometry. -/ +def IsBanachSpaceIdeal (M : Submodule ℝ E) : Prop := + IsClosed (M : Set E) ∧ ∃ Φ : Dual M →ₗᵢ[ℝ] Dual E, + ∀ (ψ : Dual M) (x : M), Φ ψ x = ψ x + +/-- Section 2: equivalence with the annihilator-kernel definition. -/ +theorem banachSpaceIdeal_iff_projection (M : Submodule ℝ E) : + IsBanachSpaceIdeal M ↔ IsClosed (M : Set E) ∧ + ∃ P : Dual E →L[ℝ] Dual E, P.comp P = P ∧ ‖P‖ ≤ 1 ∧ + ∀ φ : Dual E, P φ = 0 ↔ ∀ x : M, φ x = 0 := by + let R : Dual E →L[ℝ] Dual M := (ContinuousLinearMap.compL ℝ M E ℝ).flip M.subtypeL + have hR (φ : Dual E) (x : M) : R φ x = φ x := rfl + have hRnorm (φ : Dual E) : ‖R φ‖ ≤ ‖φ‖ := (R φ).opNorm_le_bound (norm_nonneg φ) + (fun x => φ.le_opNorm x) + have hRsurj : Function.Surjective R := by + intro ψ + obtain ⟨φ, hφ, _⟩ := exists_extension_norm_eq M ψ + exact ⟨φ, ContinuousLinearMap.ext hφ⟩ + constructor + · rintro ⟨hclosed, Φ, hext⟩ + refine ⟨hclosed, Φ.toContinuousLinearMap.comp R, ?_, ?_, ?_⟩ + · apply ContinuousLinearMap.ext + intro φ + change Φ (R (Φ (R φ))) = Φ (R φ) + exact congrArg Φ (ContinuousLinearMap.ext (hext (R φ))) + · refine (Φ.toContinuousLinearMap.comp R).opNorm_le_bound zero_le_one (fun φ => ?_) + change ‖Φ (R φ)‖ ≤ 1 * ‖φ‖ + simpa only [Φ.norm_map, one_mul] using hRnorm φ + · intro φ + change Φ (R φ) = 0 ↔ _ + rw [map_eq_zero_iff Φ Φ.injective] + exact ⟨fun h x => DFunLike.congr_fun h x, fun h => ContinuousLinearMap.ext h⟩ + · rintro ⟨hclosed, P, hP, hPnorm, hker⟩ + obtain ⟨L, hL⟩ := R.toLinearMap.exists_rightInverse_of_surjective + (LinearMap.range_eq_top.mpr hRsurj) + let Φ : Dual M →ₗ[ℝ] Dual E := P.toLinearMap.comp L + have hL' (ψ : Dual M) (x : M) : L ψ x = ψ x := + DFunLike.congr_fun (DFunLike.congr_fun hL ψ) x + have hext (ψ : Dual M) (x : M) : Φ ψ x = ψ x := by + have hz : P (L ψ - P (L ψ)) = 0 := by + rw [map_sub] + exact sub_eq_zero.mpr (DFunLike.congr_fun hP (L ψ)).symm + have hx := (hker _).mp hz x + change L ψ x - P (L ψ) x = 0 at hx + exact (sub_eq_zero.mp hx).symm.trans (hL' ψ x) + have hnorm (ψ : Dual M) : ‖Φ ψ‖ = ‖ψ‖ := by + apply le_antisymm + · obtain ⟨φ, hφ, hnormφ⟩ := exists_extension_norm_eq M ψ + have heq : Φ ψ = P φ := by + apply sub_eq_zero.mp + change P (L ψ) - P φ = 0 + rw [← map_sub] + exact (hker _).mpr (fun x => by simp [hL' ψ x, hφ x]) + rw [heq] + calc + ‖P φ‖ ≤ ‖P‖ * ‖φ‖ := P.le_opNorm φ + _ ≤ ‖φ‖ := mul_le_of_le_one_left (norm_nonneg _) hPnorm + _ = ‖ψ‖ := hnormφ + · apply ψ.opNorm_le_bound (norm_nonneg _) + intro x + rw [← hext ψ x] + exact (Φ ψ).le_opNorm x + exact ⟨hclosed, ⟨Φ, hnorm⟩, hext⟩ + +/-- Restriction to invariant subspaces, retaining the original underlying operator. -/ +def restrictOperator (T : F →L[ℝ] E) (M : Submodule ℝ F) (N : Submodule ℝ E) + (h : ∀ x : M, T x ∈ N) : M →L[ℝ] N where + toFun x := ⟨T x, h x⟩ + map_add' x y := Subtype.ext (map_add T (x : F) (y : F)) + map_smul' r x := Subtype.ext (map_smul T r (x : F)) + cont := (T.continuous.comp continuous_subtype_val).subtype_mk h + +/-- A countable set can be closed under a countable family of finitary operations. -/ +private theorem countable_finitary_hull {X : Type*} {I : ℕ → Type*} + [∀ n, Countable (I n)] (f : ∀ n, I n → (Fin n → X) → X) + (A : Set X) (hA : A.Countable) : + ∃ B : Set X, A ⊆ B ∧ B.Countable ∧ + ∀ n i (a : Fin n → X), (∀ j, a j ∈ B) → f n i a ∈ B := by + let L : FirstOrder.Language := ⟨I, fun _ => Empty⟩ + let : L.Structure X := ⟨fun {n} => f n, fun {_} => isEmptyElim⟩ + let S := FirstOrder.Language.Substructure.closure L A + have : Countable (Σ n, L.Functions n) := inferInstanceAs (Countable (Σ n, I n)) + have : Countable S := hA.substructure_closure L + exact ⟨S, FirstOrder.Language.Substructure.subset_closure, Set.to_countable _, + fun _ i a ha => S.fun_mem i a ha⟩ + +/-- Countable rational data for finite systems of approximate norm inequalities. -/ +abbrev IdealTest (n : ℕ) := + Σ m : ℕ, Σ k : ℕ, + (Fin k → Fin n → ℚ) × (Fin k → Fin m → ℚ) × (Fin k → ℚ) × Fin m + +/-- Choose vectors satisfying a finite rational norm test, or zero if none exist. -/ +def idealTestWitness {n m k : ℕ} (r : Fin k → Fin n → ℚ) + (q : Fin k → Fin m → ℚ) (t : Fin k → ℚ) (a : Fin n → E) : Fin m → E := by + classical + exact if h : ∃ z : Fin m → E, ∀ i, + ‖(∑ j, (r i j : ℝ) • a j) + ∑ j, (q i j : ℝ) • z j‖ < t i + then h.choose else 0 + +/-- Closure under approximate witnesses for finite rational norm inequalities. -/ +def HasNormWitnesses (B : Set E) : Prop := + ∀ (n m k : ℕ) (a : Fin n → E), (∀ j, a j ∈ B) → + ∀ (x : Fin m → E) (r : Fin k → Fin n → ℚ) (q : Fin k → Fin m → ℚ) + (ε : ℝ), 0 < ε → ∃ z : Fin m → E, (∀ j, z j ∈ B) ∧ ∀ i, + ‖(∑ j, (r i j : ℝ) • a j) + ∑ j, (q i j : ℝ) • z j‖ < + ‖(∑ j, (r i j : ℝ) • a j) + ∑ j, (q i j : ℝ) • x j‖ + ε + +/-- Close under chosen witnesses for finite rational norm inequalities. -/ +private theorem countable_norm_hull (A : Set E) (hA : A.Countable) : + ∃ B : Set E, A ⊆ B ∧ (0 : E) ∈ B ∧ B.Countable ∧ + HasNormWitnesses B := by + classical + let f (n : ℕ) (d : IdealTest n) (a : Fin n → E) : E := + idealTestWitness d.2.2.1 d.2.2.2.1 d.2.2.2.2.1 a d.2.2.2.2.2 + obtain ⟨B, hAB, hB, hclosed⟩ := countable_finitary_hull f (insert 0 A) (hA.insert 0) + refine ⟨B, fun _ h => hAB (mem_insert_of_mem _ h), hAB (mem_insert _ _), hB, ?_⟩ + intro n m k a ha x r q ε hε + choose t htl htu using fun i : Fin k => exists_rat_btwn + (show ‖(∑ j, (r i j : ℝ) • a j) + ∑ j, (q i j : ℝ) • x j‖ < + ‖(∑ j, (r i j : ℝ) • a j) + ∑ j, (q i j : ℝ) • x j‖ + ε from lt_add_of_pos_right _ hε) + have hex : ∃ z : Fin m → E, ∀ i, + ‖(∑ j, (r i j : ℝ) • a j) + ∑ j, (q i j : ℝ) • z j‖ < t i := ⟨x, htl⟩ + refine ⟨idealTestWitness r q t a, fun j => hclosed n ⟨m, k, r, q, t, j⟩ a ha, ?_⟩ + intro i + unfold idealTestWitness + rw [dite_eq_left hex] + exact (hex.choose_spec i).trans (htu i) + +private theorem HasNormWitnesses.finite {B : Set E} (hB : HasNormWitnesses B) + {α β γ : Type*} [Fintype α] [Fintype β] [Finite γ] + (a : α → E) (ha : ∀ j, a j ∈ B) (x : β → E) + (r : γ → α → ℚ) (q : γ → β → ℚ) {ε : ℝ} (hε : 0 < ε) : + ∃ z : β → E, (∀ j, z j ∈ B) ∧ ∀ i, + ‖(∑ j, (r i j : ℝ) • a j) + ∑ j, (q i j : ℝ) • z j‖ < + ‖(∑ j, (r i j : ℝ) • a j) + ∑ j, (q i j : ℝ) • x j‖ + ε := by + classical + let := Fintype.ofFinite γ + let ea := (Fintype.equivFin α).symm + let eb := (Fintype.equivFin β).symm + let ec := (Fintype.equivFin γ).symm + obtain ⟨z, hz, hnorm⟩ := hB _ _ _ (a ∘ ea) (fun j => ha _) (x ∘ eb) + (fun i j => r (ec i) (ea j)) (fun i j => q (ec i) (eb j)) ε hε + refine ⟨z ∘ eb.symm, fun j => hz _, fun i => ?_⟩ + have h := hnorm (ec.symm i) + simp only [Equiv.apply_symm_apply, Function.comp_apply] at h ⊢ + have hr : ∑ j, (r i (ea j) : ℝ) • a (ea j) = ∑ j, (r i j : ℝ) • a j := + Equiv.sum_comp ea (fun j => (r i j : ℝ) • a j) + have hx : ∑ j, (q i (eb j) : ℝ) • x (eb j) = ∑ j, (q i j : ℝ) • x j := + Equiv.sum_comp eb (fun j => (q i j : ℝ) • x j) + have hz' : ∑ j, (q i (eb j) : ℝ) • z j = ∑ j, (q i j : ℝ) • z (eb.symm j) := by + simpa only [Equiv.symm_apply_apply] using + (Equiv.sum_comp eb (fun j => (q i j : ℝ) • z (eb.symm j))) + simpa only [hr, hx, hz'] using h + +/-- The canonical bidual evaluation of a subspace, viewed in its weak-star bidual. -/ +def idealBidualEval (M : Submodule ℝ E) : M →ₗ[ℝ] WeakDual ℝ (Dual M) := + StrongDual.toWeakDual.toLinearMap.comp (NormedSpace.inclusionInDoubleDual ℝ M).toLinearMap + +private theorem idealBidualEval_norm (M : Submodule ℝ E) (x : M) : + ‖(idealBidualEval M x).toStrongDual‖ = ‖x‖ := + (NormedSpace.inclusionInDoubleDualLi ℝ).norm_map x + +private theorem HasNormWitnesses.finite_model {B : Set E} (hB : HasNormWitnesses B) + (M : Submodule ℝ E) (hBM : B ⊆ M) + (s : Finset ((E →₀ ℚ) × B)) {ε : ℝ} (hε : 0 < ε) (hε1 : ε ≤ 1) : + ∃ R : E → WeakDual ℝ (Dual M), + (∀ x, ‖(R x).toStrongDual‖ ≤ ‖x‖ + 1) ∧ + ∀ j ∈ s, + ‖(j.1.sum (fun x q => (q : ℝ) • R x) - idealBidualEval M ⟨j.2, hBM j.2.2⟩).toStrongDual‖ < + ‖j.1.sum (fun x q => (q : ℝ) • x) - j.2.1‖ + ε := by + classical + let t : Finset E := s.biUnion (fun j => j.1.support) + have ht (j : s) : j.1.1.support ⊆ t := fun x hx => Finset.mem_biUnion.mpr ⟨j.1, j.2, hx⟩ + let a : s → E := fun j => j.1.2.1 + let r : s ⊕ t → s → ℚ := fun i j => match i with + | .inl k => if j = k then -1 else 0 + | .inr _ => 0 + let q : s ⊕ t → t → ℚ := fun i j => match i with + | .inl k => k.1.1 j + | .inr k => if j = k then 1 else 0 + obtain ⟨z, hz, hnorm⟩ := hB.finite a (fun j => j.1.2.2) Subtype.val r q hε + have hznorm (x : t) : ‖z x‖ < ‖(x : E)‖ + ε := by + simpa [r, q, apply_ite, ite_smul] using hnorm (Sum.inr x) + let zM (x : t) : M := ⟨z x, hBM (hz x)⟩ + let R (x : E) : WeakDual ℝ (Dual M) := + if hx : x ∈ t then idealBidualEval M (zM ⟨x, hx⟩) else 0 + have hR (x : t) : R x = idealBidualEval M (zM x) := by simp [R] + refine ⟨R, ?_, ?_⟩ + · intro x + by_cases hx : x ∈ t + · rw [show R x = idealBidualEval M (zM ⟨x, hx⟩) from hR ⟨x, hx⟩, + idealBidualEval_norm] + exact (hznorm ⟨x, hx⟩).le.trans (add_le_add le_rfl hε1) + · rw [show R x = 0 by simp [R, hx]] + change ‖(0 : Dual (Dual M))‖ ≤ ‖x‖ + 1 + simp only [norm_zero] + positivity + · intro j hj + have htest := hnorm (Sum.inl (⟨j, hj⟩ : s)) + simp only [r, q, apply_ite, Rat.cast_neg, Rat.cast_one, Rat.cast_zero, + ite_smul, neg_smul, one_smul, zero_smul, Finset.sum_ite_eq', Finset.mem_univ, + ite_true] at htest + have hsum {V : Type u} [AddCommGroup V] [Module ℝ V] (f : E → V) : + j.1.sum (fun x q => (q : ℝ) • f x) = ∑ x : t, (j.1 x : ℝ) • f x := by + rw [Finsupp.sum_of_support_subset j.1 (ht ⟨j, hj⟩) _ (by simp)] + exact (Finset.sum_attach t _).symm + rw [hsum R, hsum (fun x : E => x)] + have heq : (∑ x : t, (j.1 x : ℝ) • R x) - idealBidualEval M ⟨j.2, hBM j.2.2⟩ = + idealBidualEval M ((∑ x : t, (j.1 x : ℝ) • zM x) - ⟨j.2, hBM j.2.2⟩) := by + simp only [map_sub, map_sum, map_smul, hR] + rw [heq, idealBidualEval_norm] + change ‖((∑ x : t, (j.1 x : ℝ) • zM x) - ⟨j.2, hBM j.2.2⟩ : M).val‖ < _ + simp only [Submodule.coe_sub, Submodule.coe_sum, Submodule.coe_smul] + change ‖(∑ x : t, (j.1 x : ℝ) • z x) - j.2.1‖ < _ + simpa only [a, sub_eq_add_neg, add_comm] using htest + +/-- Weak-star compactness realizes all finite rational norm constraints simultaneously. -/ +private theorem HasNormWitnesses.bidual_model {B : Set E} (hB : HasNormWitnesses B) + (M : Submodule ℝ E) (hBM : B ⊆ M) : + ∃ R : E → WeakDual ℝ (Dual M), ∀ (c : E →₀ ℚ) (b : B), + ‖(c.sum (fun x q => (q : ℝ) • R x) - idealBidualEval M ⟨b, hBM b.2⟩).toStrongDual‖ ≤ + ‖c.sum (fun x q => (q : ℝ) • x) - b.1‖ := by + classical + let Ω : Set (E → WeakDual ℝ (Dual M)) := {R | ∀ x, ‖(R x).toStrongDual‖ ≤ ‖x‖ + 1} + have hΩ : IsCompact Ω := by + apply isCompact_pi_infinite (s := fun x : E => + {φ : WeakDual ℝ (Dual M) | ‖φ.toStrongDual‖ ≤ ‖x‖ + 1}) + intro x + convert WeakDual.isCompact_closedBall (0 : Dual (Dual M)) (‖x‖ + 1) using 1 + ext φ + simp only [mem_ofPred_eq, mem_preimage, Metric.mem_closedBall, dist_zero_right] + let I := ((E →₀ ℚ) × B) × {ε : ℝ // 0 < ε} + let C (i : I) : Set (E → WeakDual ℝ (Dual M)) := {R | + ‖(i.1.1.sum (fun x q => (q : ℝ) • R x) - idealBidualEval M ⟨i.1.2, hBM i.1.2.2⟩).toStrongDual‖ ≤ + ‖i.1.1.sum (fun x q => (q : ℝ) • x) - i.1.2.1‖ + i.2.1} + have hC (i : I) : IsClosed (C i) := by + have hc : Continuous (fun R : E → WeakDual ℝ (Dual M) => + i.1.1.sum (fun x q => (q : ℝ) • R x) - idealBidualEval M ⟨i.1.2, hBM i.1.2.2⟩) := by + exact (continuous_finsetSum i.1.1.support + (fun x _ => (show Continuous (fun R : E → WeakDual ℝ (Dual M) => R x) + from continuous_apply x).const_smul (i.1.1 x : ℝ))).sub continuous_const + convert (WeakDual.isClosed_closedBall (0 : Dual (Dual M)) + (‖i.1.1.sum (fun x q => (q : ℝ) • x) - i.1.2.1‖ + i.2.1)).preimage hc using 1 + ext R + simp only [C, mem_ofPred_eq, mem_preimage, Metric.mem_closedBall, dist_zero_right] + obtain ⟨R, _, hR⟩ := hΩ.inter_iInter_nonempty C hC (by + intro s + obtain ⟨δ, hδ, hδle⟩ := finite_positive_lower_bound s (fun i => i.2.1) (fun i _ => i.2.2) + obtain ⟨R, hRn, hRc⟩ := hB.finite_model M hBM (s.image Prod.fst) + (lt_min hδ zero_lt_one) (min_le_right δ 1) + refine ⟨R, hRn, ?_⟩ + simp only [mem_iInter] + intro i hi + exact (hRc i.1 (Finset.mem_image_of_mem _ hi)).le.trans + (add_le_add le_rfl ((min_le_left δ 1).trans (hδle i hi)))) + refine ⟨R, fun c b => ?_⟩ + apply le_of_forall_pos_le_add + intro ε hε + exact mem_iInter.mp hR ⟨⟨c, b⟩, ⟨ε, hε⟩⟩ + +private theorem HasNormWitnesses.linear_bidual_model {B : Set E} + (hB : HasNormWitnesses B) (h0 : (0 : E) ∈ B) + (M : Submodule ℝ E) (hBM : B ⊆ M) : + ∃ R : E →L[ℝ] Dual (Dual M), (∀ x, ‖R x‖ ≤ ‖x‖) ∧ + ∀ b : B, R b = NormedSpace.inclusionInDoubleDual ℝ M ⟨b, hBM b.2⟩ := by + classical + obtain ⟨R, hR⟩ := hB.bidual_model M hBM + have hsum_add {V : Type u} [AddCommGroup V] [Module ℝ V] + (f : E → V) (c d : E →₀ ℚ) : + (c + d).sum (fun x q => (q : ℝ) • f x) = + c.sum (fun x q => (q : ℝ) • f x) + d.sum (fun x q => (q : ℝ) • f x) := by + exact Finsupp.sum_add_index (by simp) (by intros; simp only [Rat.cast_add, add_smul]) + have hsingle {V : Type u} [AddCommGroup V] [Module ℝ V] + (f : E → V) (x : E) (q : ℚ) : + (Finsupp.single x q).sum (fun x q => (q : ℝ) • f x) = (q : ℝ) • f x := + Finsupp.sum_single_index (by simp) + have hnorm (x : E) : ‖(R x).toStrongDual‖ ≤ ‖x‖ := by + have h := hR (Finsupp.single x 1) ⟨0, h0⟩ + rw [hsingle R] at h + simpa only [hsingle, Rat.cast_one, one_smul, + show (⟨(0 : E), hBM h0⟩ : M) = 0 from rfl, map_zero, sub_zero] using h + have hz : (R 0).toStrongDual = 0 := by + have hh : ‖(R 0).toStrongDual‖ ≤ 0 := by simpa only [norm_zero] using hnorm 0 + exact (norm_le_zero_iff (a := (R 0).toStrongDual)).mp hh + have hadd (x y : E) : (R (x + y)).toStrongDual = (R x).toStrongDual + (R y).toStrongDual := by + have h := hR (Finsupp.single (x + y) 1 + Finsupp.single x (-1) + Finsupp.single y (-1)) ⟨0, h0⟩ + simp only [hsum_add R, hsingle R, hsum_add (fun x : E => x), + hsingle (fun x : E => x), Rat.cast_one, + Rat.cast_neg, one_smul, neg_smul, show (⟨(0 : E), hBM h0⟩ : M) = 0 from rfl, + map_zero, sub_zero] at h + have hrhs : x + y + -x + -y = 0 := by abel + rw [hrhs, norm_zero] at h + have h := (norm_le_zero_iff (a := (R (x + y) + -R x + -R y).toStrongDual)).mp h + change (R (x + y)).toStrongDual + -(R x).toStrongDual + -(R y).toStrongDual = 0 at h + exact eq_of_sub_eq_zero (by convert h using 1; abel) + let L : E →+ Dual (Dual M) := ⟨⟨fun x => (R x).toStrongDual, hz⟩, hadd⟩ + have hcont : Continuous L := + (AddMonoidHomClass.lipschitz_of_bound L 1 (fun x => by + change ‖(R x).toStrongDual‖ ≤ 1 * ‖x‖ + simpa only [one_mul] using hnorm x)).continuous + refine ⟨L.toRealLinearMap hcont, hnorm, fun b => ?_⟩ + have h := hR (Finsupp.single b.1 1) b + simp only [hsingle R, hsingle (fun x : E => x), Rat.cast_one, one_smul, + sub_self, norm_zero] at h + exact sub_eq_zero.mp ((norm_le_zero_iff (a := + (R b.1 - idealBidualEval M ⟨b, hBM b.2⟩).toStrongDual)).mp h) + +/-- Transposing the bidual contraction gives linear isometric Hahn–Banach extensions. -/ +private theorem HasNormWitnesses.isIdeal {B : Set E} (hB : HasNormWitnesses B) + (h0 : (0 : E) ∈ B) : + IsBanachSpaceIdeal (Submodule.span ℝ B).topologicalClosure := by + let M := (Submodule.span ℝ B).topologicalClosure + have hBM : B ⊆ M := fun x hx => Submodule.le_topologicalClosure _ (Submodule.subset_span hx) + obtain ⟨R, hRn, hRb⟩ := hB.linear_bidual_model h0 M hBM + let Φ : Dual M →ₗ[ℝ] Dual E := + { toFun := fun ψ => (ContinuousLinearMap.apply ℝ ℝ ψ).comp R + map_add' := fun ψ χ => by ext x; exact (R x).map_add ψ χ + map_smul' := fun c ψ => by ext x; exact (R x).map_smul c ψ } + have hΦ (ψ : Dual M) (x : E) : Φ ψ x = R x ψ := rfl + have hext (ψ : Dual M) (x : M) : Φ ψ x = ψ x := by + obtain ⟨φ, hφ, _⟩ := exists_extension_norm_eq M ψ + have hker : M ≤ (Φ ψ - φ).ker := by + apply Submodule.topologicalClosure_minimal + · apply Submodule.span_le.mpr + intro b hb + change Φ ψ b - φ b = 0 + rw [hΦ, hRb ⟨b, hb⟩] + exact sub_eq_zero.mpr (hφ ⟨b, hBM hb⟩).symm + · exact (Φ ψ - φ).isClosed_ker + have hx := hker x.2 + change Φ ψ x - φ x = 0 at hx + exact (sub_eq_zero.mp hx).trans (hφ x) + have hnorm (ψ : Dual M) : ‖Φ ψ‖ = ‖ψ‖ := by + apply le_antisymm + · apply (Φ ψ).opNorm_le_bound (norm_nonneg ψ) + intro x + rw [hΦ] + exact ((R x).le_opNorm ψ).trans (by nlinarith [hRn x, norm_nonneg ψ]) + · apply ψ.opNorm_le_bound (norm_nonneg _) + intro x + rw [← hext ψ x] + exact (Φ ψ).le_opNorm x + exact ⟨(Submodule.span ℝ B).isClosed_topologicalClosure, ⟨Φ, hnorm⟩, hext⟩ + +/-- The cited separable-ideal existence result used in Lemma 2.5. -/ +theorem separable_ideal_exists (A : Set E) (hA : A.Countable) : + ∃ M : Submodule ℝ E, A ⊆ M ∧ IsBanachSpaceIdeal M ∧ + TopologicalSpace.SeparableSpace M := by + obtain ⟨B, hAB, h0, hBc, hB⟩ := countable_norm_hull A hA + refine ⟨(Submodule.span ℝ B).topologicalClosure, ?_, hB.isIdeal h0, ?_⟩ + · exact hAB.trans (fun x hx => Submodule.le_topologicalClosure _ (Submodule.subset_span hx)) + · exact hBc.isSeparable.span.closure.separableSpace + +/-- Isometric linear extension of dual functionals preserves admissible families. -/ +theorem normAdmissible_linearIsometry (p : Exponent) + (Φ : Dual F →ₗᵢ[ℝ] Dual E) {n : ℕ} (ψ : Fin n → Dual F) + (hψ : NormAdmissible p ψ) : NormAdmissible p (fun i => Φ (ψ i)) := by + intro x hx + let y : PiLp p.1 (fun _ : Fin n => ℝ) := WithLp.toLp p.1 (fun i => Φ (ψ i) x) + obtain ⟨l, hl, hly⟩ := exists_dual_vector'' ℝ y + change l y = ‖y‖ at hly + let a : Fin n → ℝ := fun i => l (PiLp.single p.1 i 1) + have hlin (z : Fin n → ℝ) : ∑ i, a i * z i = l (WithLp.toLp p.1 z) := by + have hz := (PiLp.basisFun p.1 ℝ (Fin n)).sum_repr (WithLp.toLp p.1 z) + simpa [a, map_sum, map_smul, smul_eq_mul, mul_comm] using congrArg l hz + let θ : Dual F := ∑ i, a i • ψ i + have hθ : ‖θ‖ ≤ 1 := by + apply θ.opNorm_le_bound zero_le_one + intro z + change ‖(∑ i, a i • ψ i) z‖ ≤ 1 * ‖z‖ + simp only [sum_apply, smul_apply, smul_eq_mul, + hlin, one_mul] + exact (l.le_opNorm _).trans ((mul_le_mul_of_nonneg_right hl (norm_nonneg _)).trans + (by simpa only [one_mul, ← scalarPSum_eq_piLp_norm] using + normAdmissible_eval_le_norm p ψ hψ z)) + have hbound := (Φ θ).le_opNorm x + have heq : Φ θ x = l y := by + simp only [θ, map_sum, map_smul, sum_apply, smul_apply, smul_eq_mul, hlin] + rfl + rw [heq, hly, Φ.norm_map, Real.norm_of_nonneg (norm_nonneg _)] at hbound + exact (show scalarPSum p (fun i => Φ (ψ i) x) ≤ ‖θ‖ * ‖x‖ from + (scalarPSum_eq_piLp_norm p _).trans_le hbound).trans + (by nlinarith [norm_nonneg θ, norm_nonneg x]) + +/-- An isometric extension of dual functionals makes the induced contraction isometric. -/ +theorem induced_isometry_of_dual_extension (p : Exponent) (T : F →L[ℝ] E) + (hT : ‖T‖ ≤ 1) (Φ : Dual F →ₗᵢ[ℝ] Dual E) + (hext : ∀ ψ, (Φ ψ).comp T = ψ) : Isometry (induced p T) := by + apply AddMonoidHomClass.isometry_of_norm (induced p T).toContinuousLinearMap + intro f + apply le_antisymm + · exact ((induced p T).toContinuousLinearMap.le_opNorm f).trans (by + rw [(induced_norm_generators p T).1] + simpa only [one_mul] using mul_le_mul_of_nonneg_right hT (norm_nonneg f)) + · apply (ENNReal.ofReal_le_ofReal_iff (norm_nonneg _)).mp + rw [← freeNormExt_eq_norm p f, ← freeNormExt_eq_norm p (induced p T f)] + by_cases htop : p.1 = ⊤ + · simp only [freeNormExt, ite_eq_left htop] + refine iSup_le fun ψ => iSup_le fun hψ => ?_ + exact le_iSup_of_le (Φ ψ) (le_iSup_of_le (by simpa only [Φ.norm_map] using hψ) + (by rw [canonical_map_formulas, hext])) + · simp only [freeNormExt, ite_eq_right htop] + refine iSup_le fun n => iSup_le fun ψ => iSup_le fun hψ => ?_ + exact le_iSup_of_le n (le_iSup_of_le (fun i => Φ (ψ i)) + (le_iSup_of_le (normAdmissible_linearIsometry p Φ ψ hψ) + (by simp only [canonical_map_formulas, hext]; exact le_rfl))) + +/-- Section 2: ideal inclusions induce isometric embeddings. -/ +theorem ideal_induced_isometry (p : Exponent) + (M : Submodule ℝ E) (hM : IsBanachSpaceIdeal M) : + Isometry (induced p M.subtypeL) := by + obtain ⟨_, Φ, hext⟩ := hM + apply induced_isometry_of_dual_extension p M.subtypeL + (M.subtypeL.opNorm_le_bound zero_le_one (fun x => by simp)) Φ + exact fun ψ => ContinuousLinearMap.ext (hext ψ) + +/-- Each lattice expression depends on finitely many generators. -/ +theorem fvl_finite_generators (p : Exponent) (f : FVL E) : + ∃ A : Set E, A.Finite ∧ ∀ M : Submodule ℝ E, A ⊆ M → + ofFVL p f ∈ Set.range (induced p M.subtypeL) := by + obtain ⟨n, x, e, he⟩ := FVLv.exists_eval_of_eq f + refine ⟨Set.range x, Set.finite_range _, fun M hM => ?_⟩ + refine ⟨LLexpr.eval (fun i => delta p (⟨x i, hM (Set.mem_range_self i)⟩ : M)) e, ?_⟩ + change (induced p M.subtypeL).toVecLatHom _ = _ + rw [LLexpr.map_eval] + rw [← he, LLexpr.map_eval] + congr 1 + funext i + exact ((induced_norm_generators p M.subtypeL).2 _).trans (ofFVL_of p (x i)).symm + +/-- Countably many generators suffice to lift a free element through an ideal inclusion. -/ +private theorem free_countable_generators (p : Exponent) (f : Free p E) : + ∃ A : Set E, A.Countable ∧ ∀ M : Submodule ℝ E, IsBanachSpaceIdeal M → A ⊆ M → + f ∈ Set.range (induced p M.subtypeL) := by + obtain ⟨w, hw, hlim⟩ := mem_closure_iff_seq_limit.mp (denseRange_ofFVL p f) + choose v hv using hw + have hvlim : Tendsto (fun n => ofFVL p (v n)) atTop (𝓝 f) := by + simpa only [hv] using hlim + choose A hA hgen using fun n => fvl_finite_generators p (v n) + refine ⟨⋃ n, A n, Set.countable_iUnion (fun n => (hA n).countable), fun M hM hAM => ?_⟩ + apply (ideal_induced_isometry p M hM).isClosedEmbedding.isClosed_range.mem_of_tendsto hvlim + exact Eventually.of_forall (fun n => hgen n M (fun x hx => hAM (Set.mem_iUnion.mpr ⟨n, hx⟩))) + +private theorem banachSpaceIdeal_top : IsBanachSpaceIdeal (⊤ : Submodule ℝ E) := by + apply (banachSpaceIdeal_iff_projection _).mpr + refine ⟨isClosed_univ, ContinuousLinearMap.id ℝ (Dual E), rfl, + ContinuousLinearMap.norm_id_le, fun φ => ?_⟩ + constructor + · intro h x + exact congrArg (fun ψ : Dual E => ψ x) h + · intro h + exact ContinuousLinearMap.ext (fun x => h ⟨x, Submodule.mem_top⟩) + +private theorem separable_ideal_containing (A : Set E) (hA : A.Countable) : + ∃ M : Submodule ℝ E, A ⊆ M ∧ IsBanachSpaceIdeal M ∧ + TopologicalSpace.SeparableSpace M ∧ (TopologicalSpace.SeparableSpace E → M = ⊤) := by + classical + by_cases hE : TopologicalSpace.SeparableSpace E + · let := hE + exact ⟨⊤, fun _ _ => Submodule.mem_top, banachSpaceIdeal_top, inferInstance, fun _ => rfl⟩ + · obtain ⟨M, hAM, hM, hMs⟩ := separable_ideal_exists A hA + exact ⟨M, hAM, hM, hMs, fun h => (hE h).elim⟩ + +/-- Lemma 2.5 (`lem:separable-reduction`): failure of order continuity is witnessed +on separable Banach-space ideals M and N with T(M) contained in N. The restriction of T +still induces a map that fails order continuity. If the original domain is separable, +M can be taken to be the whole domain. -/ +theorem separable_reduction [CompleteSpace E] [CompleteSpace F] + (p : Exponent) (T : F →L[ℝ] E) + (hT : ¬ IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap) : + ∃ (M : Submodule ℝ F) (N : Submodule ℝ E) (h : ∀ x : M, T x ∈ N), + IsBanachSpaceIdeal M ∧ IsBanachSpaceIdeal N ∧ + TopologicalSpace.SeparableSpace M ∧ TopologicalSpace.SeparableSpace N ∧ + (TopologicalSpace.SeparableSpace F → M = ⊤) ∧ + ¬ IsOrderContinuousOp + (induced p (restrictOperator T M N h)).toContinuousLinearMap.toLinearMap := by + classical + let S := induced p T + obtain ⟨f, hf, g, hg, hg0⟩ : ∃ f : ℕ → Free p F, DecreasesToZero f ∧ + ∃ g : Free p E, (∀ n, g ≤ S (f n)) ∧ ¬ g ≤ 0 := by + by_contra! h + apply hT + apply (sigma_order_continuity p _ (fun _ hx => S.toVecLatHom.map_nonneg hx)).mpr + intro f hf + refine ⟨S.toVecLatHom.monotone.comp_antitone hf.1, ⟨?_, ?_⟩⟩ + · rintro _ ⟨n, rfl⟩ + exact S.toVecLatHom.map_nonneg (hf.2.1 ⟨n, rfl⟩) + · intro g hg + exact h f hf g (fun n => hg ⟨n, rfl⟩) + choose A hAc hAf using fun n => free_countable_generators p (f n) + obtain ⟨M, hAM, hM, hMs, hMtop⟩ := separable_ideal_containing (⋃ n, A n) + (Set.countable_iUnion hAc) + let := hMs + let : CompleteSpace M := hM.1.isComplete.completeSpace_coe + have hfM (n : ℕ) : f n ∈ Set.range (induced p M.subtypeL) := + hAf n M hM (fun x hx => hAM (Set.mem_iUnion.mpr ⟨n, hx⟩)) + choose fM hfM using hfM + obtain ⟨B, hBc, hBg⟩ := free_countable_generators p g + obtain ⟨D, hDc, hDd⟩ := TopologicalSpace.exists_countable_dense M + obtain ⟨N, hBN, hN, hNs⟩ := separable_ideal_exists + (B ∪ (fun x : M => T x) '' D) (hBc.union (hDc.image _)) + let := hNs + let : CompleteSpace N := hN.1.isComplete.completeSpace_coe + have hTN (x : M) : T x ∈ N := by + have hc : IsClosed {x : M | T x ∈ N} := + hN.1.preimage (T.continuous.comp continuous_subtype_val) + exact hc.closure_subset_iff.mpr (fun y hy => hBN (Or.inr ⟨y, hy, rfl⟩)) (hDd x) + obtain ⟨gN, hgN⟩ := hBg N hN (fun x hx => hBN (Or.inl hx)) + refine ⟨M, N, hTN, hM, hN, hMs, hNs, hMtop, ?_⟩ + let J := induced p M.subtypeL + let K := induced p N.subtypeL + let U := induced p (restrictOperator T M N hTN) + have hJ : Function.Injective J := (ideal_induced_isometry p M hM).injective + have hK : Function.Injective K := (ideal_induced_isometry p N hN).injective + have hdec : DecreasesToZero fM := by + refine ⟨?_, ⟨?_, ?_⟩⟩ + · intro n m hnm + apply J.toVecLatHom.le_of_map_le hJ + change J (fM m) ≤ J (fM n) + rw [hfM, hfM] + exact hf.1 hnm + · rintro _ ⟨n, rfl⟩ + apply J.toVecLatHom.le_of_map_le hJ + change J 0 ≤ J (fM n) + rw [map_zero J.toContinuousLinearMap, hfM] + exact hf.2.1 ⟨n, rfl⟩ + · intro z hz + apply J.toVecLatHom.le_of_map_le hJ + change J z ≤ J 0 + rw [map_zero J.toContinuousLinearMap] + apply hf.2.2 + rintro _ ⟨n, rfl⟩ + rw [← hfM n] + exact J.toVecLatHom.monotone (hz ⟨n, rfl⟩) + have hcomm (a : Free p M) : K (U a) = S (J a) := by + apply Subtype.ext + apply Subtype.ext + funext φ + rfl + have hlower (n : ℕ) : gN ≤ U (fM n) := by + apply K.toVecLatHom.le_of_map_le hK + change K gN ≤ K (U (fM n)) + rw [hcomm, hfM n, hgN] + exact hg n + intro hU + have hc := orderContinuous_sigmaOrderContinuous U.toContinuousLinearMap.toLinearMap + (fun _ hx => U.toVecLatHom.map_nonneg hx) hU fM hdec + have hgle : gN ≤ 0 := hc.2.2 (by rintro _ ⟨n, rfl⟩; exact hlower n) + apply hg0 + have hh := K.toVecLatHom.monotone hgle + change K gN ≤ K 0 at hh + simpa only [show K gN = g from hgN, map_zero] using hh + +/-- Section 1: an isomorphic embedding is quantitatively bounded below. -/ +def BoundedBelow {X : Type u} {Y : Type v} [Norm X] [Norm Y] (T : X → Y) : Prop := + ∃ c : ℝ, 0 < c ∧ ∀ x, c * ‖x‖ ≤ ‖T x‖ + +/-- Section 1's equivalent closed-range description. -/ +theorem embedding_iff [CompleteSpace E] [CompleteSpace F] (T : F →L[ℝ] E) : + BoundedBelow T ↔ Function.Injective T ∧ IsClosed (Set.range T) := by + change (∃ c > 0, ∀ x, c * ‖x‖ ≤ ‖T x‖) ↔ _ + rw [← antilipschitzWith_iff_exists_mul_le_norm] + exact ⟨fun ⟨_, h⟩ => ⟨h.injective, h.isClosed_range T.uniformContinuous⟩, + fun ⟨hi, hc⟩ => T.antilipschitz_of_injective_of_isClosed_range hi hc⟩ + +/-- An isomorphic lattice embedding retains the order-reflecting and norm conditions. -/ +def IsLatticeEmbedding {X : Type u} {Y : Type v} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [NormedVectorLattice X] + [NormedAddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [NormedVectorLattice Y] + (T : LatticeOperator X Y) : Prop := + BoundedBelow T ∧ Function.Injective T ∧ ∀ x y, T x ≤ T y ↔ x ≤ y + +/-- The positive algebraic sequence `(|δx + δy| - (n + 1)|δx - δy|) ⊔ 0`. For +distinct x and y it decreases to zero; if T identifies x and y, its induced image is +the constant `2 • |delta p (T x)|`. Used in Theorem 2.7 and Proposition 3.1. -/ +def collisionSequence (x y : E) (n : ℕ) : FVL E := + (|FVLv.of x + FVLv.of y| - (n + 1 : ℝ) • |FVLv.of x - FVLv.of y|) ⊔ 0 + +private theorem collision_scalar_nonpos {a b c : ℝ} (hb : b ≠ 0) + (h : ∀ n : ℕ, c ≤ max (|a| - (n + 1 : ℝ) * |b|) 0) : c ≤ 0 := by + obtain ⟨n, hn⟩ := exists_nat_gt (|a| / |b|) + have hmul : |a| < (n : ℝ) * |b| := (div_lt_iff₀ (abs_pos.mpr hb)).mp hn + have hle : |a| - (n + 1 : ℝ) * |b| ≤ 0 := by nlinarith [abs_nonneg b] + simpa only [max_eq_right hle] using h n + +private theorem nonpos_of_nonpos_off_kernel {D : Type*} [AddCommGroup D] [Module ℝ D] + (b : D →ₗ[ℝ] ℝ) (hb : b ≠ 0) (g : D → ℝ) + (hc : ∀ φ ψ, Continuous (fun t : ℝ => g (φ + t • ψ))) + (hg : ∀ φ, b φ ≠ 0 → g φ ≤ 0) : ∀ φ, g φ ≤ 0 := by + obtain ⟨ψ, hψ⟩ : ∃ ψ, b ψ ≠ 0 := by + by_contra! h + exact hb (LinearMap.ext h) + intro φ + by_cases hφ : b φ = 0 + · have ht : Tendsto (fun t : ℝ => g (φ + t • ψ)) (𝓝[≠] 0) (𝓝 (g φ)) := by + simpa using ((hc φ ψ).continuousAt (x := 0)).tendsto.mono_left + (nhdsWithin_le_nhds (s := ({0}ᶜ : Set ℝ))) + apply le_of_tendsto ht + filter_upwards [self_mem_nhdsWithin] with t ht + exact hg _ (by simpa [map_add, map_smul, hφ] using mul_ne_zero (by simpa using ht) hψ) + · exact hg φ hφ + +private theorem collisionSequence_apply (p : Exponent) (x y : E) (n : ℕ) (φ : Dual E) : + ofFVL p (collisionSequence x y n) φ = + max (|φ x + φ y| - (n + 1 : ℝ) * |φ x - φ y|) 0 := by + have h : ofFVL p (collisionSequence x y n) = + (|delta p x + delta p y| - (n + 1 : ℝ) • |delta p x - delta p y|) ⊔ 0 := by + simp only [collisionSequence, SupHomClass.map_sup, map_sub, map_smul, VecLatHom.map_abs, + map_add, ofFVL_of, map_zero] + exact congrArg (fun f : Free p E => f φ) h + +/-- For distinct vectors with the same image under T, the collision sequence decreases +to zero in the source while every image equals `2 • |delta p (T x)|`. The retained +nonzero-image hypothesis makes this a failure witness in Proposition 3.1; the displayed +identity and decrease themselves hold without using that hypothesis. -/ +theorem collision_sequence_properties (p : Exponent) (T : F →L[ℝ] E) (x y : F) (hne : x ≠ y) + (heq : T x = T y) (_hzero : T x ≠ 0) : + DecreasesToZero (fun n => ofFVL p (collisionSequence x y n)) ∧ + ∀ n, induced p T (ofFVL p (collisionSequence x y n)) = 2 • |delta p (T x)| := by + constructor + · refine ⟨?_, ⟨?_, ?_⟩⟩ + · intro m n hmn + apply (free_le_iff p _ _).2 + intro φ + simp only [collisionSequence_apply] + exact max_le_max_right 0 (by gcongr) + · rintro _ ⟨n, rfl⟩ + apply (free_le_iff p _ _).2 + intro φ + change 0 ≤ ofFVL p (collisionSequence x y n) φ + rw [collisionSequence_apply] + exact le_max_right _ _ + · intro g hg + let b : Dual F →ₗ[ℝ] ℝ := + { toFun := fun φ => φ (x - y) + map_add' := fun _ _ => rfl + map_smul' := fun _ _ => rfl } + have hb : b ≠ 0 := by + intro hb + obtain ⟨φ, _, hφ⟩ := exists_dual_vector'' ℝ (x - y) + exact (sub_ne_zero.mpr hne) (norm_eq_zero.mp (hφ.symm.trans (DFunLike.congr_fun hb φ))) + apply (free_le_iff p _ _).2 + intro φ + change g φ ≤ 0 + apply nonpos_of_nonpos_off_kernel b hb g + (fun ψ θ => (free_function_norm_continuous p g).comp + (continuous_const.add (continuous_id.smul continuous_const))) _ φ + intro ψ hψ + apply collision_scalar_nonpos (a := ψ x + ψ y) (b := ψ x - ψ y) + (by simpa only [b, LinearMap.coe_mk, AddHom.coe_mk, map_sub] using hψ) + intro n + simpa only [collisionSequence_apply] using (free_le_iff p _ _).1 (hg ⟨n, rfl⟩) ψ + · intro n + rw [two_smul] + apply Subtype.ext + apply Subtype.ext + funext φ + rw [canonical_map_formulas, collisionSequence_apply] + change max (|φ (T x) + φ (T y)| - (n + 1 : ℝ) * |φ (T x) - φ (T y)|) 0 = + |φ (T x)| + |φ (T x)| + simp [heq, ← two_mul, abs_mul] + +/-- Proposition 3.1 (`prop:injectivity`): if T is nonzero and its induced free-lattice +map is order continuous, then T is injective. Otherwise a collision sequence has a +constant nonzero image, contradicting preservation of decrease to zero. -/ +theorem injectivity (p : Exponent) + (T : F →L[ℝ] E) (hT : T ≠ 0) + (h : IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap) : + Function.Injective T := by + by_contra hn + obtain ⟨a, b, hab, hne⟩ : ∃ a b, T a = T b ∧ a ≠ b := by + simpa only [Function.Injective, not_forall, exists_prop] using hn + obtain ⟨v, hv⟩ : ∃ v, T v ≠ 0 := by + by_contra! hz + exact hT (ContinuousLinearMap.ext hz) + have hxy : v + (a - b) ≠ v := by simpa using sub_ne_zero.mpr hne + have hTv : T (v + (a - b)) = T v := by simp [map_add, map_sub, hab] + obtain ⟨hf, himage⟩ := collision_sequence_properties p T (v + (a - b)) v hxy hTv + (hTv ▸ hv) + have hc := orderContinuous_sigmaOrderContinuous _ + (fun _ h => (induced p T).toVecLatHom.map_nonneg h) h _ hf + have hle : 2 • |delta p (T (v + (a - b)))| ≤ 0 := hc.2.2 (by + rintro _ ⟨n, rfl⟩ + exact le_of_eq (himage n).symm) + obtain ⟨φ, _, hφ⟩ := exists_dual_vector'' ℝ (T v) + have hreal := (free_le_iff p _ _).1 hle φ + rw [two_smul] at hreal + change |φ (T (v + (a - b)))| + |φ (T (v + (a - b)))| ≤ 0 at hreal + rw [hTv, hφ] at hreal + change |‖T v‖| + |‖T v‖| ≤ 0 at hreal + rw [abs_norm] at hreal + exact (norm_pos_iff.mpr hv).not_ge (by linarith) + +/-- The finite nonempty minima in Proposition 3.2; index n means the first n+1 terms. -/ +def evaluationMinima (p : Exponent) (u : ℕ → E) (n : ℕ) : Free p E := + Finset.univ.inf' Finset.univ_nonempty (fun i : Fin (n + 1) => |delta p (u i)|) + +/-- Proposition 3.2's finite-dimensional escape lemma. -/ +theorem finite_dimensional_escape [CompleteSpace E] (u : ℕ → E) + (hb : Bornology.IsBounded (Set.range u)) + (hn : ¬ ∃ (a : ℕ → ℕ) (x : E), StrictMono a ∧ Tendsto (u ∘ a) atTop (𝓝 x)) : + ∃ ε : ℝ, 0 < ε ∧ ∀ M : Submodule ℝ E, FiniteDimensional ℝ M → + ∃ n, ε < Metric.infDist (u n) (M : Set E) := by + by_contra h + push Not at h + obtain ⟨C, hC⟩ := hb.exists_norm_le + have htb : TotallyBounded (Set.range u) := by + apply Metric.totallyBounded_iff.mpr + intro ε hε + obtain ⟨M, hM, hdist⟩ := h (ε / 4) (by positivity) + let := hM + let K : Set E := Subtype.val '' Metric.closedBall (0 : M) (C + ε / 2) + have hK : IsCompact K := (isCompact_closedBall (0 : M) (C + ε / 2)).image + continuous_subtype_val + obtain ⟨s, hs, hcover⟩ := Metric.totallyBounded_iff.mp hK.totallyBounded + (ε / 2) (by positivity) + refine ⟨s, hs, ?_⟩ + rintro _ ⟨n, rfl⟩ + obtain ⟨z, hz, hzu⟩ := (Metric.infDist_lt_iff (r := ε / 2) (show (M : Set E).Nonempty from + ⟨0, M.zero_mem⟩)).mp (lt_of_le_of_lt (hdist n) (by linarith)) + have hzK : z ∈ K := by + refine ⟨⟨z, hz⟩, ?_, rfl⟩ + change dist z 0 ≤ C + ε / 2 + have hnorm := dist_triangle z (u n) 0 + have hu := hC _ (Set.mem_range_self n) + rw [dist_zero_right, dist_zero_right, dist_comm z (u n)] at hnorm + rw [dist_zero_right] + linarith + obtain ⟨y, hy, hyz⟩ := Set.mem_iUnion₂.mp (hcover hzK) + apply Set.mem_iUnion₂.mpr + refine ⟨y, hy, ?_⟩ + exact (dist_triangle (u n) z y).trans_lt (by + have hzy := Metric.mem_ball.mp hyz + linarith) + have hcompact : IsCompact (closure (Set.range u)) := + isCompact_iff_totallyBounded_isComplete.mpr ⟨htb.closure, isClosed_closure.isComplete⟩ + obtain ⟨x, _, a, ha, hlim⟩ := hcompact.tendsto_subseq + (fun n => subset_closure (Set.mem_range_self n)) + exact hn ⟨a, x, ha, hlim⟩ + +private theorem weakDual_mem_closure_of_finite_agreement (A : Set (WeakDual ℝ E)) + (φ : WeakDual ℝ E) + (h : ∀ s : Finset E, ∃ ψ ∈ A, ∀ x ∈ s, ψ x = φ x) : φ ∈ closure A := by + rw [mem_closure_iff_nhds] + intro U hU + have hEmb : Topology.IsEmbedding (fun θ : WeakDual ℝ E => (θ : E → ℝ)) := + WeakBilin.isEmbedding (by + intro a b hab + apply ContinuousLinearMap.ext + intro x + simpa only [topDualPairing_apply] using + congrArg (fun l : E →ₗ[ℝ] ℝ => l x) hab) + rw [hEmb.isInducing.nhds_eq_comap φ] at hU + obtain ⟨V, hV, hVU⟩ := Filter.mem_comap.mp hU + rw [nhds_pi] at hV + have hV' : V ∈ Filter.pi (fun x : E => pure (φ x)) := + Filter.pi_mono (fun x => pure_le_nhds (φ x)) hV + obtain ⟨I, hI, hIV⟩ := Filter.mem_pi_pure.mp hV' + obtain ⟨ψ, hψ, hagree⟩ := h hI.toFinset + exact ⟨ψ, hVU (hIV (fun x => ψ x) (fun x hx => hagree x (hI.mem_toFinset.mpr hx))), hψ⟩ + +private theorem dual_adjust_annihilate (M : Submodule ℝ E) [FiniteDimensional ℝ M] + (u : E) (φ : Dual E) {ε : ℝ} (hε : 0 < ε) + (hu : ε < Metric.infDist u (M : Set E)) : + ∃ ψ : Dual E, (∀ x ∈ M, ψ x = φ x) ∧ ψ u = 0 ∧ + ‖ψ‖ ≤ ‖φ‖ + ‖φ‖ * ‖u‖ / ε := by + have : IsClosed (M : Set E) := M.closed_of_finiteDimensional + let d := ‖M.mkQ u‖ + have hd : ε < d := by + have heq : d = Metric.infDist u (M : Set E) := + QuotientAddGroup.norm_mk (S := M.toAddSubgroup) u + rwa [heq] + obtain ⟨l, hl, hlu⟩ := exists_dual_vector'' ℝ (M.mkQ u) + let θ : Dual E := l.comp M.mkQL + have hθu : θ u = d := hlu + have hθM (x : E) (hx : x ∈ M) : θ x = 0 := by + change l (M.mkQ x) = 0 + rw [show M.mkQ x = 0 from (Submodule.Quotient.mk_eq_zero M).mpr hx, map_zero] + have hθnorm : ‖θ‖ ≤ 1 := by + apply θ.opNorm_le_bound zero_le_one + intro x + calc + ‖θ x‖ ≤ ‖l‖ * ‖M.mkQ x‖ := l.le_opNorm _ + _ ≤ 1 * ‖x‖ := mul_le_mul hl (Submodule.Quotient.norm_mk_le M x) + (norm_nonneg _) zero_le_one + refine ⟨φ - (φ u / d) • θ, ?_, ?_, ?_⟩ + · intro x hx + simp [hθM x hx] + · simp [hθu, (hε.trans hd).ne'] + · calc + ‖φ - (φ u / d) • θ‖ ≤ ‖φ‖ + ‖(φ u / d) • θ‖ := norm_sub_le _ _ + _ ≤ ‖φ‖ + |φ u| / d := by + rw [norm_smul, Real.norm_eq_abs, abs_div, abs_of_pos (hε.trans hd)] + exact add_le_add le_rfl (mul_le_of_le_one_right + (div_nonneg (abs_nonneg _) (hε.trans hd).le) hθnorm) + _ ≤ ‖φ‖ + ‖φ‖ * ‖u‖ / ε := by + gcongr + exact φ.le_opNorm u + +/-- Proposition 3.2 (`prop:noncompact-minima`): for a bounded sequence with no +norm-convergent subsequence, the finite minima of the absolute evaluations decrease +to zero in `Free p E`. The minimum at index n uses the first n + 1 vectors. This is +the complete result underlying the introductory noncompactness observation. -/ +theorem noncompact_minima [CompleteSpace E] (p : Exponent) (u : ℕ → E) + (hu : Bornology.IsBounded (Set.range u)) + (hn : ¬ ∃ (a : ℕ → ℕ) (x : E), StrictMono a ∧ + Tendsto (u ∘ a) atTop (𝓝 x)) : DecreasesToZero (evaluationMinima p u) := by + classical + obtain ⟨ε, hε, hescape⟩ := finite_dimensional_escape u hu hn + obtain ⟨C, hC⟩ := hu.exists_norm_le + have hCpos : 0 ≤ C := (norm_nonneg (u 0)).trans (hC _ (Set.mem_range_self 0)) + refine ⟨?_, ⟨?_, ?_⟩⟩ + · intro m n hmn + apply Finset.le_inf' + intro i _ + exact Finset.inf'_le (fun j : Fin (n + 1) => |delta p (u j)|) + (Finset.mem_univ (⟨i, lt_of_lt_of_le i.isLt (Nat.add_le_add_right hmn 1)⟩ : Fin (n + 1))) + · rintro _ ⟨n, rfl⟩ + exact Finset.le_inf' _ _ (fun _ _ => abs_nonneg _) + · intro g hg + have hgabs (φ : Dual E) (n : ℕ) : g φ ≤ |φ (u n)| := by + have hgn := (hg (Set.mem_range_self n)).trans + (Finset.inf'_le (fun j : Fin (n + 1) => |delta p (u j)|) + (Finset.mem_univ (⟨n, Nat.lt_succ_self n⟩ : Fin (n + 1)))) + exact (free_le_iff p _ _).mp hgn φ + apply (free_le_iff p _ _).mpr + intro φ + let R : ℝ := ‖φ‖ + ‖φ‖ * C / ε + let A : Set (WeakDual ℝ E) := {ψ | ‖ψ.toStrongDual‖ ≤ R ∧ ∃ n, ψ (u n) = 0} + have hφR : ‖φ‖ ≤ R := le_add_of_nonneg_right (by positivity) + have hclosure : StrongDual.toWeakDual φ ∈ closure A := by + apply weakDual_mem_closure_of_finite_agreement + intro s + let M : Submodule ℝ E := Submodule.span ℝ (s : Set E) + let : FiniteDimensional ℝ M := FiniteDimensional.span_finset ℝ s + obtain ⟨n, hn⟩ := hescape M inferInstance + obtain ⟨ψ, hagree, hzero, hnorm⟩ := dual_adjust_annihilate M (u n) φ hε hn + refine ⟨StrongDual.toWeakDual ψ, ⟨?_, n, hzero⟩, ?_⟩ + · exact hnorm.trans (by dsimp [R]; gcongr; exact hC _ (Set.mem_range_self n)) + · intro x hx + exact hagree x (Submodule.subset_span hx) + exact ContinuousWithinAt.closure_le + (f := fun ψ : WeakDual ℝ E => g (WeakDual.toStrongDual ψ)) + (g := fun _ : WeakDual ℝ E => (0 : ℝ)) hclosure + (((weakStar_continuous_bounded p g R) _ hφR).mono (fun _ h => h.1)) + continuousWithinAt_const (fun ψ ⟨_, n, hn⟩ => by + simpa only [WeakDual.toStrongDual_apply, hn, abs_zero] using hgabs ψ.toStrongDual n) + +private theorem exists_unit_image_small (T : F →L[ℝ] E) (hT : ¬ BoundedBelow T) + {c : ℝ} (hc : 0 < c) : ∃ x : F, ‖x‖ = 1 ∧ ‖T x‖ < c := by + have hbad : ¬ ∀ x, c * ‖x‖ ≤ ‖T x‖ := fun h => hT ⟨c, hc, h⟩ + obtain ⟨x, hx⟩ := not_forall.mp hbad + have hxlt := lt_of_not_ge hx + have hnx : 0 < ‖x‖ := by + by_contra! hn + have hz : x = 0 := norm_eq_zero.mp (le_antisymm hn (norm_nonneg _)) + simp [hz] at hxlt + refine ⟨‖x‖⁻¹ • x, ?_, ?_⟩ + · rw [norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hnx), inv_mul_cancel₀ hnx.ne'] + · rw [map_smul, norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hnx)] + exact (inv_mul_lt_iff₀ hnx).mpr (by simpa [mul_comm] using hxlt) + +/-- Proposition 1.2 (`prop:necessary`): an operator between Banach spaces whose induced +free-lattice map is order continuous must be zero or bounded below. The proof combines +injectivity with the noncompact-minima witness to exclude an unbounded inverse on the range. -/ +theorem necessary [CompleteSpace F] (p : Exponent) (T : F →L[ℝ] E) + (h : IsOrderContinuousOp (induced p T).toContinuousLinearMap.toLinearMap) : + T = 0 ∨ BoundedBelow T := by + classical + by_cases hT : T = 0 + · exact Or.inl hT + right + by_contra hb + have hinj := injectivity p T hT h + obtain ⟨v, hv⟩ : ∃ v, T v ≠ 0 := by + by_contra! hz + exact hT (ContinuousLinearMap.ext hz) + let c (n : ℕ) : ℝ := ‖T v‖ / 4 * (1 / 2 : ℝ) ^ n + have hc (n : ℕ) : 0 < c n := by dsimp [c]; positivity + choose x hxnorm hxsmall using (fun n => exists_unit_image_small T hb (hc n)) + have hcsum : Summable c := summable_geometric_two.mul_left _ + have hclim : Tendsto c atTop (𝓝 0) := hcsum.tendsto_atTop_zero + have hTx : Tendsto (fun n => T (x n)) atTop (𝓝 0) := + squeeze_zero_norm (fun n => (hxsmall n).le) hclim + let u (n : ℕ) := v + x n + have hu : Bornology.IsBounded (Set.range u) := by + apply isBounded_iff_forall_norm_le.mpr + exact ⟨‖v‖ + 1, by rintro _ ⟨n, rfl⟩; exact (norm_add_le _ _).trans_eq (by rw [hxnorm])⟩ + have hn : ¬ ∃ (a : ℕ → ℕ) (w : F), StrictMono a ∧ Tendsto (u ∘ a) atTop (𝓝 w) := by + rintro ⟨a, w, ha, haw⟩ + have hxa : Tendsto (x ∘ a) atTop (𝓝 (w - v)) := by + simpa only [u, Function.comp_def, add_sub_cancel_left] using haw.sub_const v + have hnorm : ‖w - v‖ = 1 := tendsto_nhds_unique hxa.norm + (by simpa only [Function.comp_def, hxnorm] using (tendsto_const_nhds (x := (1 : ℝ)))) + have hzero : T (w - v) = 0 := tendsto_nhds_unique (T.continuous.tendsto _ |>.comp hxa) + (hTx.comp ha.tendsto_atTop) + have hw : w - v = 0 := hinj (hzero.trans (map_zero T).symm) + simp [hw] at hnorm + have hf := noncompact_minima p u hu hn + let z (n : ℕ) : Free p E := |delta p (T (x n))| + have hzc (n : ℕ) : ‖z n‖ ≤ c n := by + simpa only [z, norm_abs_eq_norm, LinearIsometry.norm_map] using (hxsmall n).le + have hzsum : Summable z := hcsum.of_norm_bounded hzc + let e : Free p E := ∑' n, z n + have hepos : 0 ≤ e := tsum_nonneg (fun n => abs_nonneg _) + have hze (n : ℕ) : z n ≤ e := hzsum.le_tsum n (fun _ _ => abs_nonneg _) + have hcnorm : HasSum c (‖T v‖ / 2) := by + have heq : ‖T v‖ / 4 * (∑' n : ℕ, (1 / 2 : ℝ) ^ n) = ‖T v‖ / 2 := by + rw [tsum_geometric_two] + ring + exact heq ▸ summable_geometric_two.hasSum.mul_left (‖T v‖ / 4) + have henorm : ‖e‖ ≤ ‖T v‖ / 2 := tsum_of_norm_bounded hcnorm hzc + let g : Free p E := |delta p (T v)| - e + have hbound (n : ℕ) : g ≤ induced p T (evaluationMinima p u n) := by + change g ≤ (induced p T).toVecLatHom + (Finset.univ.inf' Finset.univ_nonempty (fun i : Fin (n + 1) => |delta p (u i)|)) + rw [map_finset_inf'] + apply Finset.le_inf' + intro i _ + apply (free_le_iff p _ _).mpr + intro φ + change |φ (T v)| - e φ ≤ |φ (T (v + x i))| + have hzei := (free_le_iff p _ _).mp (hze i) φ + change |φ (T (x i))| ≤ e φ at hzei + rw [map_add, map_add] + have htriangle := abs_add_le (φ (T v) + φ (T (x i))) (-φ (T (x i))) + simp only [add_neg_cancel_right, abs_neg] at htriangle + linarith + have hcimage := orderContinuous_sigmaOrderContinuous _ + (fun _ h => (induced p T).toVecLatHom.map_nonneg h) h _ hf + have hgle : g ≤ 0 := hcimage.2.2 (by rintro _ ⟨n, rfl⟩; exact hbound n) + have hdle : |delta p (T v)| ≤ e := sub_nonpos.mp hgle + have hnormle : ‖T v‖ ≤ ‖e‖ := by + simpa only [abs_abs, abs_of_nonneg hepos, LinearIsometry.norm_map] using + (norm_le_norm_of_abs_le_abs (a := delta p (T v)) (b := e) + (by simpa only [abs_of_nonneg hepos] using hdle)) + exact (norm_pos_iff.mpr hv).not_ge (by linarith) + +/-- The absolute support function of a set, using the conditional real supremum. -/ +def compactSupport (K : Set E) (φ : Dual E) : ℝ := + sSup ((fun x => |φ x|) '' K) + +/-- Scaling a functional scales its absolute support by the scalar's absolute value. -/ +theorem compactSupport_smul (K : Set E) (a : ℝ) (φ : Dual E) : + compactSupport K (a • φ) = |a| * compactSupport K φ := by + unfold compactSupport + simp only [smul_apply, smul_eq_mul, abs_mul] + simpa only [← Set.image_smul, Set.image_image, smul_eq_mul, Function.comp_def] + using Real.sSup_smul_of_nonneg (abs_nonneg a) ((fun x : E => |φ x|) '' K) + +/-- Absolute support is positively homogeneous on the continuous dual. -/ +theorem compactSupport_homogeneous (K : Set E) : + PosHomogeneous (compactSupport K) := by + intro a ha φ + rw [compactSupport_smul, abs_of_nonneg ha] + +/-- Compact-set support is weak-star continuous on the dual unit ball. -/ +theorem compactSupport_continuous {K : Set E} (hK : IsCompact K) : + WeakStarContinuousOnBall (compactSupport K) := by + apply hK.continuous_sSup + apply Continuous.abs + apply continuous_prod_of_continuous_lipschitzWith' _ 1 + · intro φ + exact φ.1.toStrongDual.lipschitzWith.weaken (by + have h : ‖φ.1.toStrongDual‖ ≤ 1 := by + simpa only [FVLv.dualUnitBall, Set.mem_preimage, Metric.mem_closedBall, + dist_zero_right] using φ.2 + exact_mod_cast h) + · intro x + exact (WeakDual.eval_continuous x).comp continuous_subtype_val + +private theorem compactSupport_le {K : Set E} (hK : IsCompact K) + (φ : Dual E) {x : E} (hx : x ∈ K) : |φ x| ≤ compactSupport K φ := + le_csSup (hK.bddAbove_image φ.continuous.abs.continuousOn) (mem_image_of_mem _ hx) + +private theorem compactSupport_nonneg {K : Set E} (hK : IsCompact K) + (hne : K.Nonempty) (φ : Dual E) : 0 ≤ compactSupport K φ := by + obtain ⟨x, hx⟩ := hne + exact (abs_nonneg _).trans (compactSupport_le hK φ hx) + +private theorem weakDualNormBall_closed (R : ℝ) : + IsClosed (weakDualNormBall (E := E) R) := by + convert WeakDual.isClosed_closedBall (0 : Dual E) R using 1 + ext φ + simp [weakDualNormBall, Metric.mem_closedBall, dist_zero_right] + +private theorem weakDualNormBall_compact (R : ℝ) : + IsCompact (weakDualNormBall (E := E) R) := by + convert WeakDual.isCompact_closedBall (0 : Dual E) R using 1 + ext φ + simp [weakDualNormBall, Metric.mem_closedBall, dist_zero_right] + +private theorem boundedBelow_dual_lift [CompleteSpace E] [CompleteSpace F] + (T : F →L[ℝ] E) (hT : BoundedBelow T) : + ∃ C > 0, ∀ ψ : Dual F, ∃ φ : Dual E, φ.comp T = ψ ∧ ‖φ‖ ≤ C * ‖ψ‖ := by + obtain ⟨hi, hc⟩ := (embedding_iff T).mp hT + let R : T.range →L[ℝ] F := (T.equivRange hi hc).symm.toContinuousLinearMap + refine ⟨‖R‖ + 1, by positivity, fun ψ => ?_⟩ + obtain ⟨φ, hφ, hn⟩ := exists_extension_norm_eq T.range (ψ.comp R) + refine ⟨φ, ?_, ?_⟩ + · ext x + change φ (T x) = ψ x + rw [hφ ⟨T x, ⟨x, rfl⟩⟩] + change ψ (R ⟨T x, ⟨x, rfl⟩⟩) = ψ x + rw [show R ⟨T x, ⟨x, rfl⟩⟩ = x from T.equivRange_symm_apply hi hc x] + · calc + ‖φ‖ = ‖ψ.comp R‖ := hn + _ ≤ ‖ψ‖ * ‖R‖ := ContinuousLinearMap.opNorm_comp_le _ _ + _ ≤ (‖R‖ + 1) * ‖ψ‖ := by nlinarith [norm_nonneg ψ] + +/-- A bounded lift of every dual functional transfers closedness on norm balls. -/ +private theorem weakDual_closed_of_pullback [CompleteSpace E] [CompleteSpace F] + (T : F →L[ℝ] E) (hT : BoundedBelow T) (D : Set (WeakDual ℝ F)) + (hD : ∀ r : ℝ, IsClosed + ({φ : WeakDual ℝ E | StrongDual.toWeakDual (φ.toStrongDual.comp T) ∈ D} ∩ + weakDualNormBall r)) : + ∀ r : ℝ, IsClosed (D ∩ weakDualNormBall r) := by + obtain ⟨C, hC, hlift⟩ := boundedBelow_dual_lift T hT + let R : WeakDual ℝ E → WeakDual ℝ F := + fun φ => StrongDual.toWeakDual (φ.toStrongDual.comp T) + have hR : Continuous R := WeakDual.continuous_of_continuous_eval + (fun x => WeakDual.eval_continuous (T x)) + intro r + have heq : D ∩ weakDualNormBall r = + R '' ((R ⁻¹' D) ∩ weakDualNormBall (C * max r 0)) ∩ weakDualNormBall r := by + ext ψ + constructor + · rintro ⟨hψ, hn⟩ + obtain ⟨φ, hφ, hφn⟩ := hlift ψ.toStrongDual + refine ⟨⟨StrongDual.toWeakDual φ, ⟨?_, ?_⟩, ?_⟩, hn⟩ + · change StrongDual.toWeakDual (φ.comp T) ∈ D + rwa [hφ] + · exact hφn.trans (mul_le_mul_of_nonneg_left (hn.trans (le_max_left _ _)) hC.le) + · exact congrArg StrongDual.toWeakDual hφ + · rintro ⟨⟨φ, ⟨hφ, _⟩, rfl⟩, hn⟩ + exact ⟨hφ, hn⟩ + rw [heq] + exact ((weakDualNormBall_compact (C * max r 0)).of_isClosed_subset + (hD _) inter_subset_right).image hR |>.isClosed.inter (weakDualNormBall_closed r) + +/-- The image of a positive patch contains a compact-convergence neighborhood. -/ +private theorem dual_patch_compact [CompleteSpace E] [CompleteSpace F] + (T : F →L[ℝ] E) (hT : BoundedBelow T) (p : Exponent) (g : Free p E) + (φ₀ : Dual E) (ε : ℝ) (hε : ε < g φ₀) : + ∃ K : Set F, IsCompact K ∧ K.Nonempty ∧ ∀ ψ : Dual F, + (∀ x ∈ K, |(ψ - φ₀.comp T) x| ≤ 1) → + ∃ φ : Dual E, φ.comp T = ψ ∧ ε < g φ := by + let D : Set (WeakDual ℝ F) := {ψ | ∀ φ : Dual E, + φ.comp T = ψ.toStrongDual + φ₀.comp T → g φ ≤ ε} + have hD : ∀ r : ℝ, IsClosed (D ∩ weakDualNormBall r) := by + apply weakDual_closed_of_pullback T hT + intro r + let Z := {z : Dual E // z.comp T = 0} + let : Nonempty Z := ⟨⟨0, by simp⟩⟩ + have hset : {φ : WeakDual ℝ E | StrongDual.toWeakDual (φ.toStrongDual.comp T) ∈ D} ∩ + weakDualNormBall r = + ⋂ z : Z, {φ : WeakDual ℝ E | g (φ.toStrongDual + φ₀ + z.1) ≤ ε} ∩ + weakDualNormBall r := by + ext φ + simp only [mem_inter_iff, mem_ofPred_eq, mem_iInter] + constructor + · rintro ⟨hφ, hn⟩ z + refine ⟨hφ (φ.toStrongDual + φ₀ + z.1) ?_, hn⟩ + simp only [ContinuousLinearMap.add_comp, z.2, add_zero] + rfl + · intro hφ + refine ⟨?_, (hφ (Classical.choice inferInstance)).2⟩ + intro η hη + change η.comp T = φ.toStrongDual.comp T + φ₀.comp T at hη + have hz : (η - φ.toStrongDual - φ₀).comp T = 0 := by + rw [ContinuousLinearMap.sub_comp, ContinuousLinearMap.sub_comp, hη] + abel + have hh := (hφ ⟨η - φ.toStrongDual - φ₀, hz⟩).1 + have heq : φ.toStrongDual + φ₀ + (η - φ.toStrongDual - φ₀) = η := by abel + exact heq ▸ hh + rw [hset] + apply isClosed_iInter + intro z + have hc : ContinuousOn (fun φ : WeakDual ℝ E => g (φ.toStrongDual + (φ₀ + z.1))) + (weakDualNormBall r) := by + have ht : ContinuousOn (fun φ : WeakDual ℝ E => + φ + StrongDual.toWeakDual (φ₀ + z.1)) (weakDualNormBall r) := + (continuous_id.add continuous_const).continuousOn + have hh := (weakStar_continuous_bounded p g (r + ‖φ₀ + z.1‖)).comp ht (by + intro φ hφ + exact (norm_add_le _ _).trans (add_le_add hφ le_rfl)) + exact hh + simpa only [add_assoc, Set.ofPred_and, Set.ofPred_mem_eq, inter_comm] using + (weakDualNormBall_closed (E := E) r).isClosed_le hc continuousOn_const + have h0 : (0 : WeakDual ℝ F) ∉ D := by + intro h + exact hε.not_ge (h φ₀ (by simp)) + obtain ⟨K, hK, hsep⟩ := weakDual_exists_compact_separator D hD h0 + refine ⟨insert 0 K, hK.insert 0, Set.insert_nonempty _ _, fun ψ hψ => ?_⟩ + have hn : StrongDual.toWeakDual (ψ - φ₀.comp T) ∉ D := by + intro hd + obtain ⟨x, hx, hgt⟩ := hsep _ hd + exact hgt.not_ge (hψ x (mem_insert_of_mem _ hx)) + change ¬ (∀ φ : Dual E, φ.comp T = (ψ - φ₀.comp T) + φ₀.comp T → g φ ≤ ε) at hn + rw [sub_add_cancel] at hn + push Not at hn + exact hn + +/-- Homogenize a compact-convergence patch to obtain a nonzero free-lattice minorant. -/ +private theorem compact_patch_minorant {K : Set F} (hK : IsCompact K) + (hKne : K.Nonempty) (ψ₀ : Dual F) (e : F) (he : ψ₀ e = 1) + (ε : ℝ) (hε : 0 < ε) : + ∃ a : Free Exponent.infinity F, 0 < a ψ₀ ∧ ∀ f : Free Exponent.infinity F, + 0 ≤ f → (∀ ψ : Dual F, (∀ x ∈ K, |(ψ - ψ₀) x| ≤ 1) → ε ≤ f ψ) → a ≤ f := by + let Q : F →L[ℝ] F := ContinuousLinearMap.id ℝ F - ψ₀.smulRight e + let L := Q '' K + have hL : IsCompact L := hK.image Q.continuous + have hLne : L.Nonempty := hKne.image Q + obtain ⟨s, hs⟩ := (infinity_representation (compactSupport L)).mpr + ⟨compactSupport_homogeneous L, compactSupport_continuous hL⟩ + let a : Free Exponent.infinity F := ε • ((delta Exponent.infinity e - s) ⊔ 0) + have hval (ψ : Dual F) : a ψ = ε * max (ψ e - compactSupport L ψ) 0 := by + change ε * max (ψ e - s ψ) 0 = _ + rw [hs] + have hs₀ : compactSupport L ψ₀ = 0 := by + apply le_antisymm + · apply csSup_le (hLne.image _) + rintro _ ⟨_, ⟨x, hx, rfl⟩, rfl⟩ + simp [Q, he] + · exact compactSupport_nonneg hL hLne ψ₀ + refine ⟨a, ?_, fun f hf hpatch => ?_⟩ + · simpa [hval, he, hs₀] using hε + · apply (free_le_iff Exponent.infinity _ _).mpr + intro ψ + rw [hval] + by_cases hpos : 0 < ψ e - compactSupport L ψ + · have hspos := compactSupport_nonneg hL hLne ψ + have ht : 0 < ψ e := by linarith + have hpatch' : ε ≤ f ((ψ e)⁻¹ • ψ) := by + apply hpatch + intro x hx + have hb := compactSupport_le hL ψ (mem_image_of_mem Q hx) + have heq : (((ψ e)⁻¹ • ψ) - ψ₀) x = (ψ e)⁻¹ * ψ (Q x) := by + simp only [Q, sub_apply, ContinuousLinearMap.id_apply, + ContinuousLinearMap.smulRight_apply, map_sub, map_smul, smul_apply, smul_eq_mul] + field_simp + rw [heq, abs_mul, abs_of_pos (inv_pos.mpr ht)] + exact (mul_le_mul_of_nonneg_left hb (inv_nonneg.mpr ht.le)).trans + ((inv_mul_le_one₀ ht).mpr (by linarith)) + have hhom := f.1.2.1 ((ψ e)⁻¹) (inv_nonneg.mpr ht.le) ψ + have hbound : ε * ψ e ≤ f ψ := by + rw [hhom] at hpatch' + have hh := mul_le_mul_of_nonneg_left hpatch' ht.le + simpa only [← mul_assoc, mul_inv_cancel₀ ht.ne', one_mul, mul_comm (ψ e) ε] using hh + rw [max_eq_left hpos.le] + exact (mul_le_mul_of_nonneg_left (by linarith) hε.le).trans hbound + · rw [max_eq_right (le_of_not_gt hpos), mul_zero] + exact (free_le_iff Exponent.infinity _ _).mp hf ψ + +private theorem induced_infinity_orderContinuous_of_boundedBelow + [CompleteSpace E] [CompleteSpace F] (T : F →L[ℝ] E) (hT : BoundedBelow T) : + IsOrderContinuousOp (induced Exponent.infinity T).toContinuousLinearMap.toLinearMap := by + let S := induced Exponent.infinity T + apply (orderContinuous_iff_decreasing S.toContinuousLinearMap.toLinearMap + (fun _ h => S.toVecLatHom.map_nonneg h)).mpr + intro ι _ _ _ f hf + refine ⟨S.toVecLatHom.monotone.comp_antitone hf.1, ⟨?_, ?_⟩⟩ + · rintro _ ⟨i, rfl⟩ + exact S.toVecLatHom.map_nonneg (hf.2.1 ⟨i, rfl⟩) + · intro g hg + apply (free_le_iff Exponent.infinity _ _).mpr + intro φ₀ + change g φ₀ ≤ 0 + by_contra hn + have hgpos : 0 < g φ₀ := lt_of_not_ge hn + let ψ₀ := φ₀.comp T + have hψ₀ : ψ₀ ≠ 0 := by + intro hzero + let i : ι := Classical.choice inferInstance + have hh := (free_le_iff Exponent.infinity _ _).mp (hg ⟨i, rfl⟩) φ₀ + change g φ₀ ≤ f i ψ₀ at hh + rw [hzero] at hh + have hfzero : f i (0 : Dual F) = 0 := by + simpa using (f i).1.2.1 0 le_rfl (0 : Dual F) + exact hgpos.not_ge (hh.trans_eq hfzero) + obtain ⟨x, hx⟩ : ∃ x : F, ψ₀ x ≠ 0 := by + by_contra h + apply hψ₀ + ext x + simpa using not_exists.mp h x + let e := (ψ₀ x)⁻¹ • x + have he : ψ₀ e = 1 := by simp [e, hx] + obtain ⟨K, hK, hKne, hpatch⟩ := dual_patch_compact T hT Exponent.infinity g + φ₀ (g φ₀ / 2) (by linarith) + obtain ⟨a, hapos, ha⟩ := compact_patch_minorant hK hKne ψ₀ e he + (g φ₀ / 2) (by positivity) + have halower : a ∈ lowerBounds (Set.range f) := by + rintro _ ⟨i, rfl⟩ + apply ha (f i) (hf.2.1 ⟨i, rfl⟩) + intro ψ hψ + obtain ⟨φ, hφ, hφg⟩ := hpatch ψ hψ + have hh := (free_le_iff Exponent.infinity _ _).mp (hg ⟨i, rfl⟩) φ + change g φ ≤ f i (φ.comp T) at hh + rw [hφ] at hh + exact hφg.le.trans hh + have ha0 := (free_le_iff Exponent.infinity _ _).mp (hf.2.2 halower) ψ₀ + exact hapos.not_ge ha0 + +/-- Theorem 1.1 (`thm:intro-infty`): at exponent ∞, the induced map is order continuous +if and only if the original operator is zero or bounded below. The endpoint representation +and Hahn–Banach extension provide the converse to `necessary`. -/ +theorem intro_infty [CompleteSpace E] [CompleteSpace F] (T : F →L[ℝ] E) : + IsOrderContinuousOp (induced Exponent.infinity T).toContinuousLinearMap.toLinearMap ↔ + T = 0 ∨ BoundedBelow T := by + constructor + · exact necessary Exponent.infinity T + · rintro (hzero | hT) + · have hz := (induced_eq_zero_iff Exponent.infinity T).mpr hzero + intro ι _ _ _ x a _ + change OrderConvergesTo + (fun i => (induced Exponent.infinity T).toContinuousLinearMap (x i)) + ((induced Exponent.infinity T).toContinuousLinearMap a) + simpa only [hz, zero_apply] using + (orderConvergesTo_const (ι := ι) (0 : Free Exponent.infinity E)) + · exact induced_infinity_orderContinuous_of_boundedBelow T hT + +section Algebraic +variable (V : Type u) (W : Type v) + [AddCommGroup V] [Module ℝ V] [AddCommGroup W] [Module ℝ W] + +/-- Section 2: the algebraic-dual functional model, without a norm on the generator space. -/ +def algebraicFreeSublattice : VectorSublattice ((V →ₗ[ℝ] ℝ) → ℝ) := + VectorSublattice.generated (Set.range (fun x : V => fun φ : V →ₗ[ℝ] ℝ => φ x)) + +/-- The algebraic free vector lattice over a real vector space V, realized as the lattice +generated by evaluations on its algebraic dual. No norm or completeness assumption on V +is used; `algebraic_normed_identification` connects this model to BanLat when V is normed. -/ +abbrev AlgebraicFVL : Type u := algebraicFreeSublattice V + +theorem algebraic_precomp_mem (T : V →ₗ[ℝ] W) (f : AlgebraicFVL V) : + (fun φ : W →ₗ[ℝ] ℝ => f.1 (φ.comp T)) ∈ algebraicFreeSublattice W := by + let C : VectorSublattice ((V →ₗ[ℝ] ℝ) → ℝ) := + { carrier := {g | (fun φ : W →ₗ[ℝ] ℝ => g (φ.comp T)) ∈ algebraicFreeSublattice W} + zero_mem' := (algebraicFreeSublattice W).zero_mem + add_mem' := fun hg hh => (algebraicFreeSublattice W).add_mem hg hh + smul_mem' := fun r _ hg => (algebraicFreeSublattice W).smul_mem r hg + sup_mem' := fun hg hh => (algebraicFreeSublattice W).sup_mem hg hh } + apply VectorSublattice.generated_le (Y := C) _ f.2 + rintro _ ⟨x, rfl⟩ + exact VectorSublattice.subset_generated _ ⟨T x, rfl⟩ + +/-- Equation (2.6) (`eq:fvl-composition`): composition with the algebraic adjoint. -/ +def algebraicInduced (T : V →ₗ[ℝ] W) : VecLatHom (AlgebraicFVL V) (AlgebraicFVL W) where + toFun f := ⟨fun φ => f.1 (φ.comp T), algebraic_precomp_mem V W T f⟩ + map_add' _ _ := rfl + map_smul' _ _ := rfl + map_sup' _ _ := rfl + map_inf' _ _ := rfl + +/-- Section 2: canonical evaluation for the algebraic free vector lattice. -/ +def algebraicDelta (V : Type u) [AddCommGroup V] [Module ℝ V] : + V →ₗ[ℝ] AlgebraicFVL V where + toFun x := ⟨fun φ => φ x, VectorSublattice.subset_generated _ ⟨x, rfl⟩⟩ + map_add' x y := Subtype.ext (funext fun φ => map_add φ x y) + map_smul' r x := Subtype.ext (funext fun φ => map_smul φ r x) + +/-- Equation (2.6) on the canonical algebraic generators. -/ +theorem algebraicInduced_delta (V : Type u) (W : Type v) + [AddCommGroup V] [Module ℝ V] [AddCommGroup W] [Module ℝ W] + (T : V →ₗ[ℝ] W) (x : V) : + algebraicInduced V W T (algebraicDelta V x) = algebraicDelta W (T x) := rfl + +private theorem algebraic_apply_zero (f : AlgebraicFVL V) : f.1 0 = 0 := by + let C : VectorSublattice ((V →ₗ[ℝ] ℝ) → ℝ) := + { carrier := {g | g 0 = 0} + zero_mem' := rfl + add_mem' := fun {g h} hg hh => by change g 0 + h 0 = 0; rw [hg, hh, add_zero] + smul_mem' := fun r g hg => by change r * g 0 = 0; rw [hg, mul_zero] + sup_mem' := fun {g h} hg hh => by change g 0 ⊔ h 0 = 0; rw [hg, hh, sup_idem] } + apply VectorSublattice.generated_le (Y := C) _ f.2 + rintro _ ⟨x, rfl⟩ + rfl + +private theorem algebraic_continuous_line (f : AlgebraicFVL V) (φ ψ : V →ₗ[ℝ] ℝ) : + Continuous (fun t : ℝ => f.1 (φ + t • ψ)) := by + let C : VectorSublattice ((V →ₗ[ℝ] ℝ) → ℝ) := + { carrier := {g | Continuous (fun t : ℝ => g (φ + t • ψ))} + zero_mem' := continuous_const + add_mem' := fun hg hh => hg.add hh + smul_mem' := fun r _ hg => continuous_const.smul hg + sup_mem' := fun hg hh => hg.sup hh } + apply VectorSublattice.generated_le (Y := C) _ f.2 + rintro _ ⟨x, rfl⟩ + exact continuous_const.add (continuous_id.mul_const (ψ x)) + +private theorem algebraic_collision_decreasesToZero (x y : V) (hne : x ≠ y) : + DecreasesToZero (fun n : ℕ => + (|algebraicDelta V x + algebraicDelta V y| - + (n + 1 : ℝ) • |algebraicDelta V x - algebraicDelta V y|) ⊔ 0) := by + refine ⟨?_, ⟨?_, ?_⟩⟩ + · intro m n hmn φ + change max (|φ x + φ y| - (n + 1 : ℝ) * |φ x - φ y|) 0 ≤ + max (|φ x + φ y| - (m + 1 : ℝ) * |φ x - φ y|) 0 + exact max_le_max_right 0 (by gcongr) + · rintro _ ⟨n, rfl⟩ + exact le_sup_right + · intro g hg + let b : (V →ₗ[ℝ] ℝ) →ₗ[ℝ] ℝ := + { toFun := fun φ => φ (x - y) + map_add' := fun _ _ => rfl + map_smul' := fun _ _ => rfl } + have hb : b ≠ 0 := by + obtain ⟨φ, hφ⟩ := Module.Projective.exists_dual_eq_one ℝ (sub_ne_zero.mpr hne) + intro h + exact one_ne_zero (hφ.symm.trans (DFunLike.congr_fun h φ)) + intro φ + apply nonpos_of_nonpos_off_kernel b hb g.1 (algebraic_continuous_line V g) _ φ + intro ψ hψ + apply collision_scalar_nonpos (a := ψ x + ψ y) (b := ψ x - ψ y) + (by simpa only [b, LinearMap.coe_mk, AddHom.coe_mk, map_sub] using hψ) + intro n + exact hg ⟨n, rfl⟩ ψ + +private theorem linear_leftInverse_preserving (T : V →ₗ[ℝ] W) (hT : Function.Injective T) + (φ : W →ₗ[ℝ] ℝ) (e : V) (he : φ (T e) = 1) : + ∃ Q : W →ₗ[ℝ] V, Q.comp T = LinearMap.id ∧ (φ.comp T).comp Q = φ := by + obtain ⟨R, hR⟩ := T.exists_leftInverse_of_injective (LinearMap.ker_eq_bot.mpr hT) + have hR' (x : V) : R (T x) = x := DFunLike.congr_fun hR x + refine ⟨R + (φ - (φ.comp T).comp R).smulRight e, ?_, ?_⟩ + · ext x + simp only [LinearMap.comp_apply, LinearMap.add_apply, LinearMap.smulRight_apply, + LinearMap.sub_apply, hR', sub_self, zero_smul, add_zero, LinearMap.id_apply] + · ext x + simp only [LinearMap.comp_apply, LinearMap.add_apply, LinearMap.smulRight_apply, + LinearMap.sub_apply, map_add, map_smul, he, smul_eq_mul, mul_one, add_sub_cancel] + +/-- Injective linear maps induce order-continuous maps of the algebraic free lattices. -/ +theorem algebraicInduced_orderContinuous_of_injective (T : V →ₗ[ℝ] W) + (hT : Function.Injective T) : IsOrderContinuousOp (algebraicInduced V W T).toLinearMap := by + let S := algebraicInduced V W T + apply (orderContinuous_iff_decreasing S.toLinearMap (fun _ h => S.map_nonneg h)).2 + intro ι _ _ _ x hx + refine ⟨S.monotone.comp_antitone hx.1, ⟨?_, ?_⟩⟩ + · rintro _ ⟨i, rfl⟩ + exact S.map_nonneg (hx.2.1 ⟨i, rfl⟩) + · intro g hg + change ∀ φ : W →ₗ[ℝ] ℝ, g.1 φ ≤ 0 + intro φ + by_cases hφ : φ.comp T = 0 + · obtain ⟨i⟩ := ‹Nonempty ι› + have hi := hg (Set.mem_range_self i) + have hiφ : g.1 φ ≤ (x i).1 (φ.comp T) := hi φ + simpa only [hφ, algebraic_apply_zero] using hiφ + · obtain ⟨v, hv⟩ : ∃ v, φ (T v) ≠ 0 := by + by_contra! h + exact hφ (LinearMap.ext h) + obtain ⟨Q, hQT, hφQ⟩ := linear_leftInverse_preserving V W T hT φ + ((φ (T v))⁻¹ • v) (by simp [map_smul, hv]) + have hlower : algebraicInduced W V Q g ≤ 0 := hx.2.2 (by + rintro _ ⟨i, rfl⟩ + intro ψ + change g.1 (ψ.comp Q) ≤ (x i).1 ψ + have hi := hg (Set.mem_range_self i) (ψ.comp Q) + change g.1 (ψ.comp Q) ≤ (x i).1 ((ψ.comp Q).comp T) at hi + simpa only [LinearMap.comp_assoc, hQT, LinearMap.comp_id] using hi) + have hf := hlower (φ.comp T) + change g.1 ((φ.comp T).comp Q) ≤ 0 at hf + simpa only [hφQ] using hf + +/-- Lemma 2.6 (`lem:regular-inclusion`): the inclusion of a vector subspace induces an +order-continuous map of algebraic free vector lattices. This uses only linear algebra, +with no norm, topology, or closedness condition on the subspace. -/ +theorem regular_inclusion (M : Submodule ℝ V) : + IsOrderContinuousOp (algebraicInduced M V M.subtype).toLinearMap := + algebraicInduced_orderContinuous_of_injective M V M.subtype Subtype.val_injective + +/-- Theorem 2.7 (`thm:fvl-characterization`): for a nonzero linear map of real vector +spaces, the induced algebraic free-lattice map is order continuous exactly when the +original map is injective. The collision witness proves the necessary direction. -/ +theorem fvl_characterization (T : V →ₗ[ℝ] W) (hT : T ≠ 0) : + IsOrderContinuousOp (algebraicInduced V W T).toLinearMap ↔ Function.Injective T := by + refine ⟨?_, algebraicInduced_orderContinuous_of_injective V W T⟩ + intro h + by_contra hn + obtain ⟨a, b, hab, hne⟩ : ∃ a b, T a = T b ∧ a ≠ b := by + simpa only [Function.Injective, not_forall, exists_prop] using hn + obtain ⟨v, hv⟩ : ∃ v, T v ≠ 0 := by + by_contra! hz + exact hT (LinearMap.ext hz) + have hxy : v + (a - b) ≠ v := by simpa using sub_ne_zero.mpr hne + have hTv : T (v + (a - b)) = T v := by simp [map_add, map_sub, hab] + let f (n : ℕ) : AlgebraicFVL V := + (|algebraicDelta V (v + (a - b)) + algebraicDelta V v| - + (n + 1 : ℝ) • |algebraicDelta V (v + (a - b)) - algebraicDelta V v|) ⊔ 0 + have hf : DecreasesToZero f := algebraic_collision_decreasesToZero V _ _ hxy + have hc := orderContinuous_sigmaOrderContinuous _ + (fun _ h => (algebraicInduced V W T).map_nonneg h) h f hf + have hbound : |algebraicDelta W (T v)| + |algebraicDelta W (T v)| ≤ 0 := hc.2.2 (by + rintro _ ⟨n, rfl⟩ + intro φ + change |φ (T v)| + |φ (T v)| ≤ + max (|φ (T (v + (a - b))) + φ (T v)| - + (n + 1 : ℝ) * |φ (T (v + (a - b))) - φ (T v)|) 0 + simp [hTv, ← two_mul, abs_mul]) + obtain ⟨φ, hφ⟩ := Module.Projective.exists_dual_eq_one ℝ hv + have hh := hbound φ + change |φ (T v)| + |φ (T v)| ≤ (0 : ℝ) at hh + norm_num [hφ] at hh + +/-- The zero linear map induces the zero lattice map, which is order continuous. +Together with `fvl_characterization`, this covers every algebraic linear map, including +the zero case noted after Theorem 2.7. -/ +theorem algebraic_zero_orderContinuous : + IsOrderContinuousOp (algebraicInduced V W 0).toLinearMap := by + have hz (f : AlgebraicFVL V) : algebraicInduced V W 0 f = 0 := + Subtype.ext (funext fun φ => by + change f.1 (φ.comp 0) = 0 + simpa only [LinearMap.comp_zero] using algebraic_apply_zero V f) + intro ι _ _ _ x a _ + change OrderConvergesTo (fun i => algebraicInduced V W 0 (x i)) (algebraicInduced V W 0 a) + simpa only [hz] using + (orderConvergesTo_const (ι := ι) (0 : AlgebraicFVL W)) +end Algebraic + +/-- Bridge between the algebraic-dual and BanLat's normed-space model of FVL. -/ +theorem algebraic_normed_identification : + ∃ U : VecLatEquiv (AlgebraicFVL E) (FVL E), + ∀ (v : AlgebraicFVL E) (φ : FVLv.dualUnitBall E), + U v φ = v.1 (WeakDual.toStrongDual φ.1).toLinearMap := by + let L : VecLatHom (FVL E) (AlgebraicFVL E) := FVLv.lift (algebraicDelta E) + have heval (v : FVL E) (φ : FVLv.dualUnitBall E) : + (L v).1 (WeakDual.toStrongDual φ.1).toLinearMap = v φ := by + let evA : VecLatHom (AlgebraicFVL E) ℝ := + { toFun := fun f => f.1 (WeakDual.toStrongDual φ.1).toLinearMap + map_add' := fun _ _ => rfl + map_smul' := fun _ _ => rfl + map_sup' := fun _ _ => rfl + map_inf' := fun _ _ => rfl } + let evF : VecLatHom (FVL E) ℝ := + { toFun := fun f => f φ + map_add' := fun _ _ => rfl + map_smul' := fun _ _ => rfl + map_sup' := fun _ _ => rfl + map_inf' := fun _ _ => rfl } + have heq : evA.comp L = evF := FVLv.hom_ext fun x => by + change evA (FVLv.lift (algebraicDelta E) (FVLv.of x)) = φ.1 x + rw [FVLv.lift_of] + rfl + exact DFunLike.congr_fun heq v + have hinj : Function.Injective L := fun f g h => Subtype.ext (ContinuousMap.ext fun φ => by + rw [← heval f φ, ← heval g φ, h]) + let H := (algebraicFreeSublattice E).subtype.comp L + let C : VectorSublattice ((E →ₗ[ℝ] ℝ) → ℝ) := + { toSubmodule := H.toLinearMap.range + sup_mem' := by + rintro _ _ ⟨f, rfl⟩ ⟨g, rfl⟩ + exact ⟨f ⊔ g, map_sup H f g⟩ } + have hsurj : Function.Surjective L := by + intro v + have hv : v.1 ∈ C := by + apply VectorSublattice.generated_le (Y := C) _ v.2 + rintro _ ⟨x, rfl⟩ + exact ⟨FVLv.of x, congrArg Subtype.val (FVLv.lift_of (algebraicDelta E) x)⟩ + obtain ⟨f, hf⟩ := hv + exact ⟨f, Subtype.ext hf⟩ + let U : VecLatEquiv (FVL E) (AlgebraicFVL E) := + { LinearEquiv.ofBijective L.toLinearMap ⟨hinj, hsurj⟩ with + map_sup' := map_sup L + map_inf' := map_inf L } + refine ⟨U.symm, fun v φ => ?_⟩ + exact (heval (U.symm v) φ).symm.trans + (congrArg (fun f : AlgebraicFVL E => f.1 (WeakDual.toStrongDual φ.1).toLinearMap) + (U.toLinearEquiv.apply_symm_apply v)) + + +end FBLOrderContinuousLH diff --git a/LeanPool/FBLOrderContinuity/ParameterWitness.lean b/LeanPool/FBLOrderContinuity/ParameterWitness.lean new file mode 100644 index 0000000000..7a7d9bbcb8 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/ParameterWitness.lean @@ -0,0 +1,468 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + +module + +public import LeanPool.FBLOrderContinuity.Extension + + + +/-! +# Compact witnesses for a change of convexity parameter + +This module supplies Proposition 5.2 and the obstruction used in Theorem 5.1. +A nonsurjective inclusion from `Free p E` to `Free q E` separates the two norms on +the common algebraic core. Compact support majorants and a summable Minkowski sum +turn this separation into a compact disk whose support belongs to the target but +has infinite source free norm. + +`compact_support_finite_approximation` approximates that support by increasing +finite suprema of evaluations. `parameter_failure_witness` then produces a positive +algebraic sequence decreasing to zero in the source whose images converge in norm +to a strictly positive target element. All constructions allow q = infinity. +-/ + +@[expose] public section + +noncomputable section +open scoped BigOperators ENNReal Topology +open Filter Set +universe u +namespace FBLOrderContinuousLH + +variable {E : Type u} [NormedAddCommGroup E] [NormedSpace ℝ E] + +/-- The parameter inclusion agrees with the common algebraic free-lattice model. -/ +theorem inclusion_ofFVL {p q : Exponent} (hpq : p ≤ q) (v : FVL E) : + inclusion hpq (ofFVL p v) = ofFVL q v := by + apply Subtype.ext + apply Subtype.ext + funext φ + exact inclusion_apply hpq _ φ + +/-- If the canonical parameter inclusion is not surjective, then for any a, b > 0 +there is an algebraic element of p-free norm exactly a and q-free norm less than b. +Otherwise a lower bound on the dense algebraic core would make the dense inclusion +have closed range, forcing surjectivity. -/ +theorem parameter_norm_separation {p q : Exponent} (hpq : p ≤ q) + (honto : ¬ Function.Surjective (inclusion (E := E) hpq)) + (a b : ℝ) (ha : 0 < a) (hb : 0 < b) : + ∃ v : FVL E, ‖ofFVL p v‖ = a ∧ ‖ofFVL q v‖ < b := by + have hnot : ¬ BoundedBelow (inclusion (E := E) hpq) := by + intro h + have hc := ((embedding_iff (inclusion (E := E) hpq).toContinuousLinearMap).mp h).2 + apply honto + rw [← Set.range_eq_univ, ← hc.closure_eq] + exact (inclusion_properties (E := E) hpq).2.2.1.closure_range + have hbad : ∃ v : FVL E, ‖ofFVL q v‖ < (b / a) * ‖ofFVL p v‖ := by + by_contra! h + apply hnot + refine ⟨b / a, div_pos hb ha, fun f => ?_⟩ + exact (denseRange_ofFVL p).induction_on f + (isClosed_le (continuous_const.mul continuous_norm) + (inclusion hpq).toContinuousLinearMap.continuous.norm) + (fun v => by simpa only [inclusion_ofFVL] using h v) + obtain ⟨v, hv⟩ := hbad + have hvpos : 0 < ‖ofFVL p v‖ := + (mul_pos_iff_of_pos_left (div_pos hb ha)).mp ((norm_nonneg _).trans_lt hv) + refine ⟨(a / ‖ofFVL p v‖) • v, ?_, ?_⟩ + · rw [map_smul, norm_smul, Real.norm_of_nonneg (div_pos ha hvpos).le] + exact div_mul_cancel₀ a hvpos.ne' + · rw [map_smul, norm_smul, Real.norm_of_nonneg (div_pos ha hvpos).le] + calc + _ < (a / ‖ofFVL p v‖) * ((b / a) * ‖ofFVL p v‖) := + mul_lt_mul_of_pos_left hv (div_pos ha hvpos) + _ = b := by field_simp + +/-- The support of the unit ball in a finite-dimensional space is the dual norm. -/ +theorem support_unitBall [FiniteDimensional ℝ E] (φ : Dual E) : + support (Metric.closedBall (0 : E) 1) φ = ‖φ‖ := by + have hne : (Metric.closedBall (0 : E) 1).Nonempty := ⟨0, by simp⟩ + have hb := (isCompact_closedBall (0 : E) 1).isBounded + have hsupport : BddAbove ((fun x : E => |φ x|) '' Metric.closedBall 0 1) := by + refine ⟨‖φ‖, ?_⟩ + rintro _ ⟨x, hx, rfl⟩ + exact (φ.le_opNorm x).trans (mul_le_of_le_one_right (norm_nonneg φ) + (by simpa only [Metric.mem_closedBall, dist_zero_right] using hx)) + apply le_antisymm + · apply csSup_le (hne.image _) + rintro _ ⟨x, hx, rfl⟩ + exact (φ.le_opNorm x).trans (mul_le_of_le_one_right (norm_nonneg φ) + (by simpa only [Metric.mem_closedBall, dist_zero_right] using hx)) + · apply ContinuousLinearMap.opNorm_le_of_unit_norm + (apply_nonneg (supportSeminorm _ hne hb) φ) + intro x hx + exact le_csSup hsupport ⟨x, by simp [Metric.mem_closedBall, dist_zero_right, hx], rfl⟩ + +/-- For finite q, the majorant-norm formula gives a compact absolutely convex support +majorant of an algebraic element with any prescribed positive norm error. -/ +private theorem finite_parameter_compact_majorant [CompleteSpace E] + (q : Exponent) (hq : q.IsFinite) (v : FVL E) (ε : ℝ) (hε : 0 < ε) : + ∃ (K : Set E) (h : Free q E), K.Nonempty ∧ AbsConvex ℝ K ∧ IsCompact K ∧ + (∀ φ, h φ = support K φ) ∧ + (∀ φ, |fvlFunction v φ| ≤ h φ) ∧ ‖h‖ < ‖ofFVL q v‖ + ε := by + obtain ⟨r, ⟨n, x, rfl, hmajor⟩, hcost⟩ := exists_lt_of_csInf_lt + (fvl_majorant_nonempty q hq v) + (by rw [← majorant_norm q hq]; exact lt_add_of_pos_right _ hε) + obtain ⟨K, hK, _, hs⟩ := finite_family_disk_in_span q hq x + obtain ⟨hne, hac, hc⟩ := summable_disk_compact q K hK + refine ⟨K, latticePSum q (fun i => delta q (x i)), hne, hac, hc, ?_, ?_, ?_⟩ + · intro φ + exact (latticePSum_apply q q _ φ).trans (hs φ).symm + · intro φ + rw [latticePSum_apply] + exact hmajor φ + · exact ((free_pConvex (E := E) q).2 n (fun i => delta q (x i))).trans_lt + (by simpa only [one_mul, (delta q).norm_map] using hcost) + +/-- At the infinity endpoint, an algebraic element has a compact support majorant +whose free norm is no larger than its own. Work in the finite-dimensional span of +its generators and map a scaled unit ball into the original space. -/ +private theorem infinity_compact_majorant [CompleteSpace E] (v : FVL E) : + ∃ (K : Set E) (h : Free Exponent.infinity E), + K.Nonempty ∧ AbsConvex ℝ K ∧ IsCompact K ∧ + (∀ φ, h φ = support K φ) ∧ + (∀ φ, |fvlFunction v φ| ≤ h φ) ∧ ‖h‖ ≤ ‖ofFVL Exponent.infinity v‖ := by + obtain ⟨A, hA, hgen⟩ := fvl_finite_generators Exponent.infinity v + let M := Submodule.span ℝ A + let : FiniteDimensional ℝ M := FiniteDimensional.span_of_finite (K := ℝ) hA + obtain ⟨w, hw⟩ := hgen M Submodule.subset_span + have hi := (poe_one_iff_isometry Exponent.infinity M M.closed_of_finiteDimensional).mp + (poe_infinity_one M M.closed_of_finiteDimensional) + have hwNorm : ‖w‖ = ‖ofFVL Exponent.infinity v‖ := + (hi.norm_map_of_map_zero (map_zero (induced Exponent.infinity M.subtypeL).toContinuousLinearMap) + w).symm.trans (congrArg norm hw) + let c := ‖ofFVL Exponent.infinity v‖ + let L : M →L[ℝ] E := c • M.subtypeL + let K : Set E := L '' Metric.closedBall 0 1 + have hball : IsPCompactDisk Exponent.infinity (Metric.closedBall (0 : M) 1) := + (isPCompactDisk_infinity_iff _).mpr ⟨⟨0, by simp⟩, + ⟨balanced_closedBall_zero, convex_closedBall _ _⟩, isCompact_closedBall _ _⟩ + have hK := pCompactDisk_image Exponent.infinity _ hball L + obtain ⟨hne, hac, hc⟩ := summable_disk_compact Exponent.infinity K hK + obtain ⟨h, hh⟩ := compact_support_inFree_infinity K hc + have hs (φ : Dual E) : support K φ = c * ‖φ.comp M.subtypeL‖ := by + change support (L '' Metric.closedBall 0 1) φ = _ + simp only [support, compactSupport, Set.image_image] + change support (Metric.closedBall 0 1) (φ.comp L) = _ + rw [support_unitBall, show φ.comp L = c • φ.comp M.subtypeL from + ContinuousLinearMap.comp_smul φ c M.subtypeL, norm_smul, Real.norm_eq_abs, + abs_of_nonneg (norm_nonneg _)] + refine ⟨K, h, hne, hac, hc, hh, ?_, ?_⟩ + · intro φ + rw [hh, hs] + have heq : fvlFunction v φ = w (φ.comp M.subtypeL) := by + rw [← (model_evaluation Exponent.infinity (0 : E) v φ).2, ← hw, canonical_map_formulas] + rw [heq, mul_comm c] + exact (hp_apply_abs_le Exponent.infinity w.1 _).trans_eq + (congrArg (‖φ.comp M.subtypeL‖ * ·) hwNorm) + · apply (ENNReal.ofReal_le_ofReal_iff (norm_nonneg _)).mp + rw [← freeNormExt_eq_norm] + change (⨆ φ, ⨆ (_ : ‖φ‖ ≤ 1), ENNReal.ofReal |h φ|) ≤ _ + refine iSup_le fun φ => iSup_le fun hφ => ENNReal.ofReal_le_ofReal ?_ + rw [hh, hs, abs_of_nonneg + (mul_nonneg (show 0 ≤ c from norm_nonneg _) (norm_nonneg (φ.comp M.subtypeL)))] + have hrestrict : ‖φ.comp M.subtypeL‖ ≤ 1 := by + apply (φ.comp M.subtypeL).opNorm_le_bound zero_le_one + intro x + exact (φ.le_opNorm (x : E)).trans + (mul_le_mul_of_nonneg_right hφ (norm_nonneg x)) + exact mul_le_of_le_one_right (norm_nonneg _) hrestrict + +/-- Every algebraic free function has a nonempty absolutely convex compact support +majorant whose q-free norm is within ε of its own, for any ε > 0. Finite q uses +finite p-sum majorants; q = ∞ uses the finite-dimensional span of the generators. +The majorant dominates the absolute value on the whole continuous dual. -/ +theorem parameter_compact_majorant [CompleteSpace E] + (q : Exponent) (v : FVL E) (ε : ℝ) (hε : 0 < ε) : + ∃ (K : Set E) (h : Free q E), K.Nonempty ∧ AbsConvex ℝ K ∧ IsCompact K ∧ + (∀ φ, h φ = support K φ) ∧ + (∀ φ, |fvlFunction v φ| ≤ h φ) ∧ ‖h‖ < ‖ofFVL q v‖ + ε := by + rcases lt_or_eq_of_le (le_top : q.1 ≤ ⊤) with hq | hq + · exact finite_parameter_compact_majorant q hq v ε hε + · have heq : q = Exponent.infinity := Subtype.ext hq + subst q + obtain ⟨K, h, hne, hac, hc, hh, hdom, hnorm⟩ := infinity_compact_majorant v + exact ⟨K, h, hne, hac, hc, hh, hdom, hnorm.trans_lt (lt_add_of_pos_right _ hε)⟩ + +/-- Evaluation at a fixed dual functional as a continuous linear functional on +`Free p E`. The estimate `hp_apply_abs_le` bounds its operator norm by the norm +of the dual functional and allows evaluation to commute with norm-convergent series. -/ +abbrev freeEvalCLM (p : Exponent) (φ : Dual E) : Free p E →L[ℝ] ℝ := + freeEvaluationCLM p φ + +private theorem norm_le_of_support_representation (p : Exponent) (K : Set E) + (hK : IsCompact K) (h : Free p E) (hh : ∀ φ, h φ = support K φ) + {x : E} (hx : x ∈ K) : ‖x‖ ≤ ‖h‖ := by + obtain ⟨φ, hφ, hφx⟩ := exists_dual_vector'' ℝ x + have hb : BddAbove ((fun y : E => |φ y|) '' K) := + (hK.image φ.continuous.abs).bddAbove + calc + ‖x‖ = |φ x| := by simpa using (congrArg abs hφx).symm + _ ≤ support K φ := le_csSup hb (Set.mem_image_of_mem _ hx) + _ ≤ |h φ| := by rw [← hh]; exact le_abs_self _ + _ ≤ ‖φ‖ * ‖h‖ := hp_apply_abs_le p h.1 φ + _ ≤ ‖h‖ := mul_le_of_le_one_left (norm_nonneg _) hφ + +/-- Nonsurjectivity of the parameter inclusion yields a nonempty absolutely convex +compact set whose support belongs to `Free q E` with norm at most one but has +infinite p-free norm. A summable series of compact majorants turns arbitrarily +large algebraic norm separation into this single support-function witness. -/ +theorem parameter_support_separation [CompleteSpace E] {p q : Exponent} (hpq : p ≤ q) + (honto : ¬ Function.Surjective (inclusion (E := E) hpq)) : + ∃ K : Set E, K.Nonempty ∧ AbsConvex ℝ K ∧ IsCompact K ∧ + ∃ r : Free q E, (∀ φ, r φ = support K φ) ∧ + 0 ≤ r ∧ ‖r‖ ≤ 1 ∧ freeNormExt p (support K) = ⊤ := by + choose v hv hsmall using fun n : ℕ => + parameter_norm_separation hpq honto (n + 1) ((1 / 2 : ℝ) ^ n / 4) + (by positivity) (by positivity) + choose K r hne hac hc hr hdom hnorm using fun n => + parameter_compact_majorant q (v n) ((1 / 2 : ℝ) ^ n / 4) (by positivity) + have hnorm' (n : ℕ) : ‖r n‖ ≤ (1 / 2 : ℝ) ^ n / 2 := by + have hn := hnorm n + have hs := hsmall n + linarith + have hsum : Summable (fun n : ℕ => (1 / 2 : ℝ) ^ n / 2) := + summable_geometric_two.div_const 2 + have hrnorm : Summable (fun n => ‖r n‖) := + Summable.of_nonneg_of_le (fun _ => norm_nonneg _) hnorm' hsum + have hrsum : Summable r := hrnorm.of_norm + have hbound (n : ℕ) (x : E) (hx : x ∈ K n) : ‖x‖ ≤ (1 / 2 : ℝ) ^ n / 2 := + (norm_le_of_support_representation q (K n) (hc n) (r n) (hr n) hx).trans (hnorm' n) + obtain ⟨hDne, hDac, hDc, hDs⟩ := seriesDisk_properties K + (fun n => (1 / 2 : ℝ) ^ n / 2) (fun _ => by positivity) hsum + (fun n => ⟨hne n, hac n, hc n⟩) hbound + have hrpos (n : ℕ) : 0 ≤ r n := by + intro φ + rw [hr] + exact apply_nonneg (supportSeminorm _ (hne n) (hc n).isBounded) φ + have hrep (φ : Dual E) : (∑' n, r n) φ = support (seriesDisk K) φ := by + rw [hDs] + exact ((freeEvalCLM q φ).map_tsum hrsum).trans + (tsum_congr fun n => hr n φ) + refine ⟨seriesDisk K, hDne, hDac, hDc, ∑' n, r n, hrep, tsum_nonneg hrpos, ?_, ?_⟩ + · calc + ‖∑' n, r n‖ ≤ ∑' n, ‖r n‖ := norm_tsum_le_tsum_norm hrnorm + _ ≤ ∑' n : ℕ, (1 / 2 : ℝ) ^ n / 2 := hrnorm.tsum_le_tsum hnorm' hsum + _ = 1 := by rw [tsum_div_const, tsum_geometric_two]; norm_num + · by_contra hfin + obtain ⟨n, hn⟩ := exists_nat_gt (freeNormExt p (support (seriesDisk K))).toReal + have hnorm : freeNormExt p (ofFVL p (v n)) ≤ freeNormExt p (support (seriesDisk K)) := by + apply freeNormExt_mono_abs + intro φ + rw [(model_evaluation p (0 : E) _ _).2, ← hrep] + exact (hdom n φ).trans + (((hrsum.le_tsum n (fun k _ => hrpos k)) φ).trans (le_abs_self _)) + rw [freeNormExt_eq_norm] at hnorm + have hh := ENNReal.toReal_mono hfin hnorm + rw [ENNReal.toReal_ofReal (norm_nonneg _), hv] at hh + linarith + +/-- Closed absolutely convex sets are determined by their support bounds. -/ +theorem mem_of_abs_eval_le_support (K : Set E) (hne : K.Nonempty) + (hac : AbsConvex ℝ K) (hc : IsClosed K) (x : E) + (hx : ∀ φ : Dual E, |φ x| ≤ support K φ) : x ∈ K := by + by_contra hnot + obtain ⟨φ, a, hφ, hax⟩ := geometric_hahn_banach_closed_point hac.2 hc hnot + have hs : support K φ ≤ a := by + apply csSup_le (hne.image _) + rintro _ ⟨y, hy, rfl⟩ + apply abs_le.mpr + refine ⟨?_, (hφ y hy).le⟩ + have hneg : -y ∈ K := by + simpa only [neg_one_smul] using hac.1.smul_mem (a := (-1 : ℝ)) (by norm_num) hy + have hh := hφ (-y) hneg + rw [map_neg] at hh + linarith + exact hax.not_ge ((le_abs_self _).trans ((hx φ).trans hs)) + +private theorem support_mono_compact {A K : Set E} (hA : A.Nonempty) (hK : IsCompact K) + (hAK : A ⊆ K) (φ : Dual E) : support A φ ≤ support K φ := by + apply csSup_le (hA.image _) + rintro _ ⟨x, hx, rfl⟩ + exact le_csSup (hK.image φ.continuous.abs).bddAbove (Set.mem_image_of_mem _ (hAK hx)) + +private theorem finiteSupport_nonnegative (A : Finset E) : 0 ≤ finiteSupport A := by + classical + by_cases hA : A.Nonempty + · exact (abs_nonneg (FVLv.of hA.choose)).trans (by + simpa only [finiteSupport, dite_eq_left hA] using + Finset.le_sup' (fun a : E => |FVLv.of a|) hA.choose_spec) + · simp [finiteSupport, hA] + +private theorem finiteSupport_mono {A B : Finset E} (hAB : A ⊆ B) : + finiteSupport A ≤ finiteSupport B := by + classical + by_cases hA : A.Nonempty + · rw [finiteSupport, dite_eq_left hA, finiteSupport, dite_eq_left (hA.mono hAB)] + exact Finset.sup'_le _ _ (fun a ha => Finset.le_sup' (fun b : E => |FVLv.of b|) (hAB ha)) + · simpa only [finiteSupport, dite_eq_right hA] using finiteSupport_nonnegative B + +omit [NormedSpace ℝ E] in +private theorem compact_finite_net (K : Set E) (hne : K.Nonempty) (hc : IsCompact K) + (ε : ℝ) (hε : 0 < ε) : + ∃ A : Finset E, A.Nonempty ∧ (A : Set E) ⊆ K ∧ + ∀ x ∈ K, ∃ y ∈ A, dist x y < ε := by + classical + obtain ⟨A, hAK, hAf, hcover⟩ := hc.elim_finite_subcover_image + (b := K) (c := fun y => Metric.ball y ε) (fun _ _ => Metric.isOpen_ball) + (by intro x hx; exact Set.mem_iUnion₂.mpr ⟨x, hx, Metric.mem_ball_self hε⟩) + have hnet (x : E) (hx : x ∈ K) : ∃ y ∈ hAf.toFinset, dist x y < ε := by + obtain ⟨y, hy, hxy⟩ := Set.mem_iUnion₂.mp (hcover hx) + exact ⟨y, hAf.mem_toFinset.mpr hy, hxy⟩ + obtain ⟨y, hy, _⟩ := hnet hne.some hne.some_mem + exact ⟨hAf.toFinset, ⟨y, hy⟩, fun x hx => hAK (hAf.mem_toFinset.mp hx), hnet⟩ + +private theorem finite_net_support_norm (K : Set E) (hne : K.Nonempty) (hc : IsCompact K) + (r : Free Exponent.infinity E) (hr : ∀ φ, r φ = support K φ) + (A : Finset E) (hA : A.Nonempty) (hAK : (A : Set E) ⊆ K) + (ε : ℝ) (hε : 0 < ε) (hnet : ∀ x ∈ K, ∃ y ∈ A, dist x y < ε) : + ‖r - ofFVL Exponent.infinity (finiteSupport A)‖ ≤ ε := by + apply (ENNReal.ofReal_le_ofReal_iff hε.le).mp + rw [← freeNormExt_eq_norm] + change (⨆ φ, ⨆ (_ : ‖φ‖ ≤ 1), + ENNReal.ofReal |r φ - fvlFunction (finiteSupport A) φ|) ≤ ENNReal.ofReal ε + refine iSup_le fun φ => iSup_le fun hφ => ENNReal.ofReal_le_ofReal ?_ + rw [hr, finiteSupport_support A hA, abs_of_nonneg + (sub_nonneg.mpr (support_mono_compact hA.to_set hc hAK φ))] + apply sub_le_iff_le_add.mpr + apply csSup_le (hne.image _) + rintro _ ⟨x, hx, rfl⟩ + obtain ⟨y, hy, hxy⟩ := hnet x hx + have hybound : |φ y| ≤ support (A : Set E) φ := + le_csSup ((A.finite_toSet.isCompact.image φ.continuous.abs).bddAbove) + (Set.mem_image_of_mem _ hy) + have hdiff : |φ (x - y)| ≤ ε := by + exact (φ.le_opNorm (x - y)).trans + ((mul_le_of_le_one_left (norm_nonneg _) hφ).trans (by + simpa only [dist_eq_norm] using hxy.le)) + calc + |φ x| ≤ |φ (x - y)| + |φ y| := by + simpa only [map_sub, sub_add_cancel] using abs_add_le (φ (x - y)) (φ y) + _ ≤ ε + support (A : Set E) φ := add_le_add hdiff hybound + +/-- If the support of a nonempty compact K is represented in `Free q E`, it is +the norm limit of finite-support functions from increasing nonempty finite subsets +of K. Finite q follows from summable-disk approximation; the endpoint follows +from finite nets in K. These nested approximants supply the algebraic failure witness. -/ +theorem compact_support_finite_approximation [CompleteSpace E] + (q : Exponent) (K : Set E) (hne : K.Nonempty) (hc : IsCompact K) + (r : Free q E) (hr : ∀ φ, r φ = support K φ) : + ∃ B : ℕ → Finset E, Monotone B ∧ + (∀ n, (B n).Nonempty ∧ (B n : Set E) ⊆ K) ∧ + Tendsto (fun n => ofFVL q (finiteSupport (B n))) atTop (𝓝 r) := by + classical + rcases lt_or_eq_of_le (le_top : q.1 ≤ ⊤) with hq | hq + · obtain ⟨L, hL, hdom⟩ := summable_global_domination q r + obtain ⟨hLne, hLa, hLc⟩ := summable_disk_compact q L hL + have hKL : K ⊆ L := by + intro x hx + apply mem_of_abs_eval_le_support L hLne hLa hLc.isClosed x + intro φ + have hx' : |φ x| ≤ support K φ := + le_csSup (hc.image φ.continuous.abs).bddAbove (Set.mem_image_of_mem _ hx) + calc + |φ x| ≤ support K φ := hx' + _ = r φ := (hr φ).symm + _ ≤ |r φ| := le_abs_self _ + _ ≤ support L φ := hdom φ + obtain ⟨s, hs, _, B, hBm, hB, _, hlim⟩ := subsets_summable_disk q hq K L hne hKL hL + have hsr : s = r := by + apply Subtype.ext + apply Subtype.ext + funext φ + exact (hs φ).trans (hr φ).symm + exact ⟨B, hBm, hB, hsr ▸ hlim⟩ + · have heq : q = Exponent.infinity := Subtype.ext hq + subst q + choose A hA hAK hnet using fun n : ℕ => + compact_finite_net K hne hc ((1 / 2 : ℝ) ^ n) (by positivity) + let B (n : ℕ) : Finset E := (Finset.range (n + 1)).biUnion A + have hAB (n : ℕ) : A n ⊆ B n := + Finset.subset_biUnion_of_mem A (Finset.mem_range.mpr (Nat.lt_succ_self n)) + have hBm : Monotone B := fun n m hnm => + Finset.biUnion_subset_biUnion_of_subset_left A + (Finset.range_mono (Nat.add_le_add_right hnm 1)) + have hBn (n : ℕ) : (B n).Nonempty := (hA n).mono (hAB n) + have hBK (n : ℕ) : (B n : Set E) ⊆ K := by + intro x hx + obtain ⟨i, _, hi⟩ := Finset.mem_biUnion.mp hx + exact hAK i hi + refine ⟨B, hBm, fun n => ⟨hBn n, hBK n⟩, ?_⟩ + apply tendsto_iff_norm_sub_tendsto_zero.mpr + apply squeeze_zero (fun n => norm_nonneg _) + (fun n => ?_) summable_geometric_two.tendsto_atTop_zero + rw [norm_sub_rev] + apply finite_net_support_norm K hne hc r hr (B n) (hBn n) (hBK n) _ (by positivity) + intro x hx + obtain ⟨y, hy, hxy⟩ := hnet n x hx + exact ⟨y, hAB n hy, hxy⟩ + +/-- A compact support with q-free norm at most one and infinite p-free norm gives +a positive algebraic sequence decreasing to zero in the p-free lattice. Its images +in the q-free lattice converge in norm to a strictly positive element that is +below every image. This realizes `FVLFailureWitness` for the canonical inclusion. -/ +theorem parameter_failure_witness [CompleteSpace E] {p q : Exponent} (hpq : p < q) + (K : Set E) (hne : K.Nonempty) (hac : AbsConvex ℝ K) (hc : IsCompact K) + (r : Free q E) (hr : ∀ φ, r φ = support K φ) (hrnorm : ‖r‖ ≤ 1) + (hinf : freeNormExt p (support K) = ⊤) : + FVLFailureWitness p q (inclusion (E := E) hpq.le) := by + classical + have hp : p.IsFinite := lt_of_lt_of_le hpq le_top + obtain ⟨B, hBm, hB, hlim⟩ := compact_support_finite_approximation q K hne hc r hr + let s (n : ℕ) := finiteSupport (B n) + have hs (n : ℕ) : 0 ≤ s n := finiteSupport_nonnegative _ + have hsm : Monotone s := fun _ _ hnm => finiteSupport_mono (hBm hnm) + have hpoint (φ : Dual E) : IsLUB (Set.range fun n => fvlFunction (s n) φ) (support K φ) := by + apply isLUB_of_tendsto_atTop + (fun n m hnm => ((ofFVL q).monotone (hsm hnm)) φ) + have hh := ((freeEvalCLM q φ).continuous.tendsto r).comp hlim + change Tendsto (fun n => ofFVL q (s n) φ) atTop (𝓝 (r φ)) at hh + simpa only [hr] using hh + have hupper (n : ℕ) : ofFVL q (s n) ≤ r := by + intro φ + change fvlFunction (finiteSupport (B n)) φ ≤ r φ + rw [finiteSupport_support _ (hB n).1, hr] + exact support_mono_compact (hB n).1.to_set hc (hB n).2 φ + have : Nontrivial E := by + by_contra h + have : Subsingleton E := not_nontrivial_iff_subsingleton.mp h + have hz : support K = (fun _ : Dual E => 0) := by + funext φ + have heq : (fun x : E => |φ x|) '' K = {0} := by + ext t + constructor + · rintro ⟨x, _, rfl⟩ + simp [Subsingleton.elim x 0] + · rintro rfl + exact ⟨0, hac.1.zero_mem hne, by simp⟩ + simp only [support, compactSupport, heq, csSup_singleton] + rw [hz, freeNormExt_zero] at hinf + exact ENNReal.zero_ne_top hinf + obtain ⟨e, he⟩ := exists_norm_eq E (c := 2) (by norm_num) + let f (n : ℕ) : FVL E := (|FVLv.of e| - s n) ⊔ 0 + let G : Free q E := (|delta q e| - r) ⊔ 0 + have hform (t : Exponent) (n : ℕ) : + ofFVL t (f n) = (|delta t e| - ofFVL t (s n)) ⊔ 0 := by + simp only [f, SupHomClass.map_sup, map_sub, VecLatHom.map_abs, ofFVL_of, map_zero] + refine ⟨f, fun _ => le_sup_right, ?_, G, ?_, ?_, ?_⟩ + · have hh := compact_support_order_null p hp K hne hac hc hinf + (fun n => ofFVL p (s n)) (fun n => (ofFVL p).map_nonneg (hs n)) + ((ofFVL p).monotone.comp hsm) hpoint e + simpa only [hform] using hh + · apply lt_iff_le_not_ge.mpr + refine ⟨le_sup_right, fun hG => ?_⟩ + have hle : |delta q e| ≤ r := sub_nonpos.mp (sup_le_iff.mp hG).1 + have hn := norm_le_norm_of_abs_le_abs (hle.trans (le_abs_self _)) + rw [(delta q).norm_map, he] at hn + linarith + · simp_rw [inclusion_ofFVL, hform] + exact (tendsto_const_nhds.sub hlim).sup_nhds tendsto_const_nhds + · intro n + rw [inclusion_ofFVL, hform] + exact sup_le_sup (sub_le_sub_left (hupper n) _) le_rfl + +end FBLOrderContinuousLH diff --git a/LeanPool/FBLOrderContinuity/Parameters.lean b/LeanPool/FBLOrderContinuity/Parameters.lean new file mode 100644 index 0000000000..3e17981ca6 --- /dev/null +++ b/LeanPool/FBLOrderContinuity/Parameters.lean @@ -0,0 +1,525 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + +module + +public import LeanPool.FBLOrderContinuity.ConvexityBound +public import LeanPool.FBLOrderContinuity.HilbertComparison +public import LeanPool.FBLOrderContinuity.ParameterWitness +public import LeanPool.FBLOrderContinuity.BanLat.OrderDense +public import Mathlib.Analysis.InnerProductSpace.l2Space +public import Mathlib.Order.Cofinal + + + +/-! +# Comparison of convexity parameters + +This module formalizes Section 5. For p < q, `cross_parameter_inclusion` proves the +eight equivalent conditions listed in `parameterConditions`: order continuity, +sequential order continuity, surjectivity, equivalence of the algebraic free norms, +q-convexity, majorization, order density, and containment of q-compact disks in +p-compact disks. The target exponent may be infinity. + +`cross_parameter_witness` constructs a compact support and a decreasing algebraic +sequence when surjectivity fails. `cross_parameter_above_two` adds finite-dimensionality +to the equivalences when q > 2. In contrast, `cross_parameter_hilbert` proves that the +canonical maps for ell-two are lattice isomorphisms when 1 ≤ p < q ≤ 2. + +The helper modules `ParameterWitness`, `HilbertComparison`, `EuclideanFamilies`, and +`ConvexityBound` contain the geometric and analytic arguments used here. The auxiliary +`relative_compactness_criterion` retains a reformulation commented out in the revised paper. +-/ + +@[expose] public section + +noncomputable section +open scoped BigOperators ENNReal Topology +open Filter Set +universe u v +namespace FBLOrderContinuousLH + +variable {E : Type u} [NormedAddCommGroup E] [NormedSpace ℝ E] + +/-- A specified canonical map is a bounded lattice isomorphism onto the target. -/ +def IsOntoLatticeIsomorphism {X : Type u} {Y : Type v} + [NormedAddCommGroup X] [Lattice X] [IsOrderedAddMonoid X] [NormedVectorLattice X] + [NormedAddCommGroup Y] [Lattice Y] [IsOrderedAddMonoid Y] [NormedVectorLattice Y] + (T : LatticeOperator X Y) : Prop := + ∃ U : VecLatEquiv X Y, (∀ x, U x = T x) ∧ Continuous U ∧ Continuous U.symm + +/-- Section 5: two-sided equivalence of the actual norms on the same FVL. -/ +def NormsEquivalentOnFVL (p q : Exponent) (E : Type u) + [NormedAddCommGroup E] [NormedSpace ℝ E] : Prop := + ∃ c C : ℝ, 0 < c ∧ 0 < C ∧ ∀ v : FVL E, + c * ‖ofFVL p v‖ ≤ ‖ofFVL q v‖ ∧ ‖ofFVL q v‖ ≤ C * ‖ofFVL p v‖ + +/-- The eight conditions of Theorem 5.1, in the paper’s order: + +1. Order continuity of the canonical inclusion. +2. Sequential order continuity. +3. Surjectivity. +4. Equivalence of the p- and q-free norms on `FVL E`. +5. q-convexity of `Free p E`. +6. Majorization by the range (`IsCofinal`). +7. Order density of the range (`IsOrderDense`). +8. Containment of every q-compact disk in some p-compact disk. + +`cross_parameter_inclusion` proves their equivalence for a Banach space and p < q, +including q = ∞. `List.TFAE.out` uses the same indices starting at 1 as the list above. -/ +def parameterConditions (p q : Exponent) (hpq : p ≤ q) (E : Type u) + [NormedAddCommGroup E] [NormedSpace ℝ E] : List Prop := [ + IsOrderContinuousOp (inclusion (E := E) hpq).toContinuousLinearMap.toLinearMap, + SigmaOrderContinuous (inclusion (E := E) hpq), + Function.Surjective (inclusion (E := E) hpq), + NormsEquivalentOnFVL p q E, + IsPConvex q (Free p E), + IsCofinal (Set.range (inclusion (E := E) hpq)), + IsOrderDense (Set.range (inclusion (E := E) hpq)), + ∀ K : Set E, IsPCompactDisk q K → ∃ L : Set E, IsPCompactDisk p L ∧ K ⊆ L] + +/-- Section 5: the canonical chain of free-norm inequalities. -/ +theorem parameter_norm_inequalities {p q : Exponent} (hpq : p ≤ q) (v : FVL E) : + ‖ofFVL Exponent.infinity v‖ ≤ ‖ofFVL q v‖ ∧ ‖ofFVL q v‖ ≤ ‖ofFVL p v‖ := + ⟨norm_ofFVL_infinity_le q v, norm_ofFVL_mono hpq v⟩ + +/-- Proposition 5.2 (`prop:cross-parameter-witness`): nonsurjectivity for p < q +gives a nonempty absolutely convex compact K whose support has q-free norm at most +one but infinite p-free norm. It also gives a positive algebraic sequence decreasing +to zero in the source with a strictly positive norm limit of its images. The +construction includes q = ∞. -/ +theorem cross_parameter_witness [CompleteSpace E] (p q : Exponent) (hpq : p < q) + (honto : ¬ Function.Surjective (inclusion (E := E) hpq.le)) : + (∃ K : Set E, K.Nonempty ∧ AbsConvex ℝ K ∧ IsCompact K ∧ + ∃ r : Free q E, (∀ φ, r φ = support K φ) ∧ + 0 ≤ r ∧ ‖r‖ ≤ 1 ∧ freeNormExt p (support K) = ⊤) ∧ + FVLFailureWitness p q (inclusion (E := E) hpq.le) := by + obtain ⟨K, hne, hac, hc, r, hr, hpos, hnorm, hinf⟩ := + parameter_support_separation hpq.le honto + exact ⟨⟨K, hne, hac, hc, r, hr, hpos, hnorm, hinf⟩, + parameter_failure_witness hpq K hne hac hc r hr hnorm hinf⟩ + +private theorem inclusion_surjective_iff_boundedBelow {p q : Exponent} (hpq : p ≤ q) : + Function.Surjective (inclusion (E := E) hpq) ↔ + BoundedBelow (inclusion (E := E) hpq) := by + rw [embedding_iff] + constructor + · intro h + exact ⟨(inclusion_properties hpq).2.1, by rw [Set.range_eq_univ.mpr h]; exact isClosed_univ⟩ + · rintro ⟨_, hc⟩ + rw [← Set.range_eq_univ, ← hc.closure_eq] + exact (inclusion_properties hpq).2.2.1.closure_range + +private theorem inclusion_qConvex_of_surjective {p q : Exponent} (hpq : p ≤ q) + (honto : Function.Surjective (inclusion (E := E) hpq)) : IsPConvex q (Free p E) := by + obtain ⟨c, hc, hb⟩ := (inclusion_surjective_iff_boundedBelow hpq).mp honto + let C := max 1 c⁻¹ + have hbound (f : Free p E) : ‖f‖ ≤ C * ‖inclusion hpq f‖ := by + have hh := mul_le_mul_of_nonneg_left (hb f) (inv_nonneg.mpr hc.le) + have hh' : ‖f‖ ≤ c⁻¹ * ‖inclusion hpq f‖ := by + simpa only [← mul_assoc, inv_mul_cancel₀ hc.ne', one_mul] using hh + exact hh'.trans (mul_le_mul_of_nonneg_right (le_max_right _ _) (norm_nonneg _)) + refine ⟨C, le_max_left _ _, fun n f => ?_⟩ + have hmap : inclusion hpq (latticePSum q f) = + latticePSum q (fun i => inclusion hpq (f i)) := by + apply Subtype.ext + apply Subtype.ext + funext φ + rw [inclusion_apply, latticePSum_apply, latticePSum_apply] + simp only [inclusion_apply] + have hnorm (i : Fin n) : ‖inclusion hpq (f i)‖ ≤ ‖f i‖ := + ((inclusion hpq).toContinuousLinearMap.le_opNorm _).trans + (mul_le_of_le_one_left (norm_nonneg _) (inclusion_properties hpq).1) + have hconv := (free_pConvex q).2 n (fun i => inclusion hpq (f i)) + simp only [one_mul] at hconv + calc + _ ≤ C * ‖inclusion hpq (latticePSum q f)‖ := hbound _ + _ = C * ‖latticePSum q (fun i => inclusion hpq (f i))‖ := by rw [hmap] + _ ≤ C * scalarPSum q (fun i => ‖inclusion hpq (f i)‖) := + mul_le_mul_of_nonneg_left hconv (le_trans zero_le_one (le_max_left _ _)) + _ ≤ C * scalarPSum q (fun i => ‖f i‖) := + mul_le_mul_of_nonneg_left + (scalarPSum_mono_abs q _ _ (fun i => by simpa only [abs_norm] using hnorm i)) + (le_trans zero_le_one (le_max_left _ _)) + +private theorem inclusion_surjective_of_qConvex {p q : Exponent} (hpq : p ≤ q) + (h : IsPConvex q (Free p E)) : Function.Surjective (inclusion (E := E) hpq) := by + obtain ⟨S, hS, _, _⟩ := universal_property q h (delta p (E := E)).toContinuousLinearMap + let J := inclusion (E := E) hpq + let A : LatticeOperator (Free q E) (Free q E) := + { toContinuousLinearMap := J.toContinuousLinearMap.comp S.toContinuousLinearMap + map_sup' := by intro f g; simp only [ContinuousLinearMap.comp_apply, S.map_sup', J.map_sup'] + map_inf' := by intro f g; simp only [ContinuousLinearMap.comp_apply, S.map_inf', J.map_inf'] } + let I : LatticeOperator (Free q E) (Free q E) := + { toContinuousLinearMap := ContinuousLinearMap.id ℝ _ + map_sup' := fun _ _ => rfl + map_inf' := fun _ _ => rfl } + have hAI : A = I := latticeOperator_ext_delta q A I (by + intro x + change J (S (delta q x)) = delta q x + rw [hS] + exact (inclusion_properties hpq).2.2.2 x) + intro g + exact ⟨S g, congrArg (fun T : LatticeOperator (Free q E) (Free q E) => T g) hAI⟩ + +/-- Theorem 5.1 (`thm:cross-parameter-inclusion`): all eight conditions in +`parameterConditions` are equivalent for p < q over a Banach space. In particular, +order continuity of the canonical inclusion is equivalent to its surjectivity. +The proof uses the compact-support witness for the necessary order conditions and +the universal property for the convexity-to-surjectivity implication. -/ +theorem cross_parameter_inclusion [CompleteSpace E] (p q : Exponent) + (hpq : p < q) : + List.TFAE (parameterConditions p q hpq.le E) := by + let J := inclusion (E := E) hpq.le + have hJ : Function.Injective J := (inclusion_properties hpq.le).2.1 + unfold parameterConditions + tfae_have 1 ↔ 2 := sigma_order_continuity p J.toContinuousLinearMap.toLinearMap + (fun _ h => J.toVecLatHom.map_nonneg h) + tfae_have 2 → 3 := by + intro h + by_contra honto + obtain ⟨f, _, hf, G, hG, _, hGlower⟩ := (cross_parameter_witness p q hpq honto).2 + exact hG.not_ge ((h (fun n => ofFVL p (f n)) hf).2.2 + (by rintro _ ⟨n, rfl⟩; exact hGlower n)) + tfae_have 3 → 2 := by + intro honto f hf + refine ⟨J.toVecLatHom.monotone.comp_antitone hf.1, ⟨?_, ?_⟩⟩ + · rintro _ ⟨n, rfl⟩ + exact J.toVecLatHom.map_nonneg (hf.2.1 (Set.mem_range_self n)) + · intro b hb + obtain ⟨a, rfl⟩ := honto b + have ha : a ≤ 0 := hf.2.2 (by + rintro _ ⟨n, rfl⟩ + exact J.toVecLatHom.le_of_map_le hJ (hb (Set.mem_range_self n))) + change J.toVecLatHom a ≤ 0 + simpa only [map_zero] using J.toVecLatHom.monotone ha + tfae_have 3 → 4 := by + intro honto + obtain ⟨c, hc, hb⟩ := (inclusion_surjective_iff_boundedBelow hpq.le).mp honto + exact ⟨c, 1, hc, zero_lt_one, fun v => ⟨by + simpa only [inclusion_ofFVL] using hb (ofFVL p v), + by simpa only [one_mul] using norm_ofFVL_mono hpq.le v⟩⟩ + tfae_have 4 → 3 := by + rintro ⟨c, C, hc, _, hnorm⟩ + apply (inclusion_surjective_iff_boundedBelow hpq.le).mpr + refine ⟨c, hc, fun f => ?_⟩ + exact (denseRange_ofFVL p).induction_on f + (isClosed_le (continuous_const.mul continuous_norm) J.toContinuousLinearMap.continuous.norm) + (fun v => by simpa only [inclusion_ofFVL] using (hnorm v).1) + tfae_have 3 → 5 := inclusion_qConvex_of_surjective hpq.le + tfae_have 5 → 3 := inclusion_surjective_of_qConvex hpq.le + tfae_have 3 → 6 := by + intro honto g + obtain ⟨f, rfl⟩ := honto g + exact ⟨J f, Set.mem_range_self f, le_rfl⟩ + tfae_have 6 → 3 := by + intro hcofinal + by_contra honto + obtain ⟨K, _, _, _, r, hr, hrpos, _, hinf⟩ := + (cross_parameter_witness p q hpq honto).1 + obtain ⟨_, ⟨f, rfl⟩, hrf⟩ := hcofinal r + have hbound : freeNormExt p (support K) ≤ freeNormExt p f := by + apply freeNormExt_mono_abs + intro φ + rw [← hr, abs_of_nonneg (hrpos φ)] + have hh : r φ ≤ f φ := by simpa only [inclusion_apply] using hrf φ + exact hh.trans (le_abs_self _) + rw [hinf, freeNormExt_eq_norm] at hbound + exact ENNReal.ofReal_ne_top (top_le_iff.mp hbound) + tfae_have 3 → 7 := by + intro honto + rw [Set.range_eq_univ.mpr honto] + exact IsOrderDense.univ + tfae_have 7 → 3 := by + intro hdense + by_contra honto + obtain ⟨f, _, hf, G, hG, _, hGlower⟩ := (cross_parameter_witness p q hpq honto).2 + obtain ⟨_, ⟨u, rfl⟩, hu, huG⟩ := hdense hG + have hu0 : u ≤ 0 := hf.2.2 (by + rintro _ ⟨n, rfl⟩ + exact J.toVecLatHom.le_of_map_le hJ (huG.trans (hGlower n))) + apply hu.not_ge + change J.toVecLatHom u ≤ 0 + simpa only [map_zero] using J.toVecLatHom.monotone hu0 + tfae_have 3 → 8 := by + intro honto K hK + obtain ⟨r, hr⟩ := pCompact_support_inFree q K hK + obtain ⟨f, hf⟩ := honto r + obtain ⟨L, hL, hdom⟩ := summable_global_domination p f + obtain ⟨hLne, hLa, hLc⟩ := summable_disk_compact p L hL + have hKc := (summable_disk_compact q K hK).2.2 + refine ⟨L, hL, fun x hx => mem_of_abs_eval_le_support L hLne hLa hLc.isClosed x ?_⟩ + intro φ + have hpoint : f φ = support K φ := + (inclusion_apply hpq.le f φ).symm.trans + ((congrArg (fun g : Free q E => g φ) hf).trans (hr φ)) + calc + |φ x| ≤ support K φ := + le_csSup (hKc.image φ.continuous.abs).bddAbove (Set.mem_image_of_mem _ hx) + _ ≤ |f φ| := by rw [← hpoint]; exact le_abs_self _ + _ ≤ support L φ := hdom φ + tfae_have 8 → 6 := by + intro hdisks g + obtain ⟨K, hK, hg⟩ := summable_global_domination q g + obtain ⟨L, hL, hKL⟩ := hdisks K hK + obtain ⟨f, hf⟩ := pCompact_support_inFree p L hL + obtain ⟨hKne, _, _⟩ := summable_disk_compact q K hK + have hLc := (summable_disk_compact p L hL).2.2 + refine ⟨J f, Set.mem_range_self f, fun φ => ?_⟩ + rw [show J f φ = f φ from inclusion_apply hpq.le f φ, hf] + apply ((le_abs_self _).trans (hg φ)).trans + apply csSup_le (hKne.image _) + rintro _ ⟨x, hx, rfl⟩ + exact le_csSup (hLc.image φ.continuous.abs).bddAbove (Set.mem_image_of_mem _ (hKL hx)) + tfae_finish + +/-- Auxiliary reformulation using relatively compact sets (commented out in the revised paper). -/ +theorem relative_compactness_criterion [CompleteSpace E] (p q : Exponent) + (hpq : p < q) : + IsCofinal (Set.range (inclusion (E := E) hpq.le)) ↔ + ∀ A : Set E, IsRelativelyPCompact q A → IsRelativelyPCompact p A := by + have hi : IsCofinal (Set.range (inclusion (E := E) hpq.le)) ↔ + ∀ K : Set E, IsPCompactDisk q K → ∃ L : Set E, IsPCompactDisk p L ∧ K ⊆ L := + (cross_parameter_inclusion (E := E) p q hpq).out 6 8 + rw [hi] + constructor + · intro h A ⟨K, hK, hAK⟩ + obtain ⟨L, hL, hKL⟩ := h K hK + exact ⟨L, hL, hAK.trans hKL⟩ + · intro h K hK + exact h K ⟨K, hK, Set.Subset.rfl⟩ + +private theorem one_norm_le_of_norming_family {n : ℕ} (x : Fin n → E) + (C : ℝ) (hC : 0 < C) (hx : ∀ i, ‖x i‖ ≤ 1) + (hnorm : ∀ φ : Dual E, ‖φ‖ ≤ C * scalarPSum Exponent.infinity (fun i => φ (x i))) + (v : FVL E) : + ‖ofFVL Exponent.one v‖ ≤ C * n * ‖ofFVL Exponent.infinity v‖ := by + have hsum_one {m : ℕ} (a : Fin m → ℝ) : scalarPSum Exponent.one a = ∑ i, |a i| := by + simp [scalarPSum, Exponent.one] + have hfamily {m : ℕ} (φ : Fin m → Dual E) (hφ : NormAdmissible Exponent.one φ) : + ∑ j, ‖φ j‖ ≤ C * n := by + calc + _ ≤ ∑ j, C * ∑ i, |φ j (x i)| := by + apply Finset.sum_le_sum + intro j _ + apply (hnorm (φ j)).trans + apply mul_le_mul_of_nonneg_left _ hC.le + rw [← hsum_one] + exact scalarPSum_mono_exponent + (show Exponent.one ≤ Exponent.infinity from (show (1 : ℝ≥0∞) ≤ ⊤ from le_top)) _ + _ = C * ∑ i, ∑ j, |φ j (x i)| := by rw [← Finset.mul_sum, Finset.sum_comm] + _ ≤ C * ∑ _ : Fin n, (1 : ℝ) := by + apply mul_le_mul_of_nonneg_left _ hC.le + apply Finset.sum_le_sum + intro i _ + simpa only [hsum_one] using + (normAdmissible_eval_le_norm Exponent.one φ hφ (x i)).trans (hx i) + _ = C * n := by simp + apply (ENNReal.ofReal_le_ofReal_iff (by positivity)).mp + rw [← freeNormExt_eq_norm] + change (⨆ m, ⨆ φ : Fin m → Dual E, ⨆ (_ : NormAdmissible Exponent.one φ), + ENNReal.ofReal (scalarPSum Exponent.one (fun j => ofFVL Exponent.one v (φ j)))) ≤ _ + refine iSup_le fun m => iSup_le fun φ => iSup_le fun hφ => ENNReal.ofReal_le_ofReal ?_ + rw [hsum_one] + calc + _ ≤ ∑ j, ‖φ j‖ * ‖ofFVL Exponent.infinity v‖ := by + apply Finset.sum_le_sum + intro j _ + have hh := hp_apply_abs_le Exponent.infinity (ofFVL Exponent.infinity v).1 (φ j) + change |ofFVL Exponent.infinity v (φ j)| ≤ ‖φ j‖ * ‖ofFVL Exponent.infinity v‖ at hh + simpa only [(model_evaluation Exponent.infinity (0 : E) _ _).2, + (model_evaluation Exponent.one (0 : E) _ _).2] using hh + _ = (∑ j, ‖φ j‖) * ‖ofFVL Exponent.infinity v‖ := (Finset.sum_mul _ _ _).symm + _ ≤ C * n * ‖ofFVL Exponent.infinity v‖ := + mul_le_mul_of_nonneg_right (hfamily φ hφ) (norm_nonneg _) + +/-- Equation (5.1): a finite-dimensional space has a finite family in its +unit ball that norms the dual up to a positive constant C. The same family bounds +the one-free norm by C times its cardinality times the infinity-free norm. +Indexing by `Fin (m + 1)` records that the norming family is nonempty. -/ +theorem finite_dimensional_norming_family [FiniteDimensional ℝ E] : + ∃ (m : ℕ) (x : Fin (m + 1) → E) (C : ℝ), 0 < C ∧ (∀ i, ‖x i‖ ≤ 1) ∧ + (∀ φ : Dual E, ‖φ‖ ≤ C * scalarPSum Exponent.infinity (fun i => φ (x i))) ∧ + ∀ v : FVL E, ‖ofFVL Exponent.one v‖ ≤ + C * (m + 1 : ℝ) * ‖ofFVL Exponent.infinity v‖ := by + classical + let K := Metric.closedBall (0 : E) 1 + have hKne : K.Nonempty := ⟨0, by simp [K]⟩ + have hKac : AbsConvex ℝ K := ⟨balanced_closedBall_zero, convex_closedBall _ _⟩ + obtain ⟨A, hKA, hAK⟩ := outer_polytope_approximation K hKne hKac + (isCompact_closedBall _ _) inferInstance 1 zero_lt_one + have hA : A.Nonempty := by + by_contra h + have hzero := hKA hKne.some_mem + simp only [Finset.not_nonempty_iff_eq_empty.mp h, Finset.coe_empty, + absConvexHull_empty, Set.mem_empty_iff_false] at hzero + let m := A.card - 1 + have hcard : A.card = m + 1 := (Nat.sub_add_cancel (Finset.card_pos.mpr hA)).symm + let e : A ≃ Fin (m + 1) := Fintype.equivFinOfCardEq (by simpa only [Fintype.card_coe] using hcard) + let x (i : Fin (m + 1)) : E := (1 / 2 : ℝ) • (e.symm i : E) + have hx (i : Fin (m + 1)) : ‖x i‖ ≤ 1 := by + obtain ⟨y, hy, heq⟩ := hAK (subset_absConvexHull (e.symm i).2) + have hy' : ‖y‖ ≤ 1 := by simpa only [K, Metric.mem_closedBall, dist_zero_right] using hy + have hxy : x i = y := by + change (1 / 2 : ℝ) • (e.symm i : E) = y + rw [← heq, smul_smul] + norm_num + simpa only [hxy] using hy' + have hnorm (φ : Dual E) : ‖φ‖ ≤ 2 * scalarPSum Exponent.infinity (fun i => φ (x i)) := by + apply φ.opNorm_le_of_unit_norm (mul_nonneg (by norm_num) (scalarPSum_nonneg _ _)) + intro y hy + apply absConvexHull_eval_bound (A : Set E) φ _ ?_ y + (hKA (by simpa only [K, Metric.mem_closedBall, dist_zero_right, hy] using le_rfl)) + intro a ha + let i := e ⟨a, ha⟩ + have hval : |φ a| = 2 * |φ (x i)| := by + simp [x, i, map_smul, smul_eq_mul, abs_mul] + rw [hval] + apply mul_le_mul_of_nonneg_left _ (by norm_num) + rw [scalarPSum_eq_piLp_norm] + exact PiLp.norm_apply_le (WithLp.toLp ⊤ (fun i => φ (x i))) i + refine ⟨m, x, 2, by norm_num, hx, hnorm, fun v => ?_⟩ + simpa only [Nat.cast_add, Nat.cast_one] using + one_norm_le_of_norming_family x 2 (by norm_num) hx hnorm v + +/-- Equation (5.1): over a finite-dimensional space, the one-free norm is bounded +by a fixed positive multiple of the infinity-free norm on the algebraic core. +The zero-dimensional case is included. Together with monotonicity, this makes +all free norms equivalent in finite dimension. -/ +theorem finite_dimensional_norm_comparison [FiniteDimensional ℝ E] : + ∃ C : ℝ, 0 < C ∧ ∀ v : FVL E, + ‖ofFVL Exponent.one v‖ ≤ C * ‖ofFVL Exponent.infinity v‖ := by + cases subsingleton_or_nontrivial E with + | inl h => + let := h + refine ⟨1, zero_lt_one, fun v => ?_⟩ + have hz : ofFVL Exponent.one v = 0 := by + apply Subtype.ext + apply Subtype.ext + funext φ + have hφ : φ = 0 := by + ext x + simp [Subsingleton.elim x 0] + subst φ + change ofFVL Exponent.one v (0 : Dual E) = 0 + have hh := (ofFVL Exponent.one v).1.2.1 0 (le_refl 0) (0 : Dual E) + simpa using hh + rw [hz, norm_zero, one_mul] + exact norm_nonneg _ + | inr h => + let := h + obtain ⟨m, x, C, hC, _, _, hnorm⟩ := finite_dimensional_norming_family (E := E) + exact ⟨C * (m + 1), mul_pos hC (by positivity), hnorm⟩ + +private theorem finite_dimensional_normsEquivalent [FiniteDimensional ℝ E] + {p q : Exponent} (hpq : p ≤ q) : NormsEquivalentOnFVL p q E := by + obtain ⟨C, hC, hnorm⟩ := finite_dimensional_norm_comparison (E := E) + refine ⟨C⁻¹, 1, inv_pos.mpr hC, zero_lt_one, fun v => ⟨?_, ?_⟩⟩ + · have hv : ‖ofFVL p v‖ ≤ C * ‖ofFVL q v‖ := by + calc + _ ≤ ‖ofFVL Exponent.one v‖ := + norm_ofFVL_mono (show Exponent.one ≤ p from p.2) v + _ ≤ C * ‖ofFVL Exponent.infinity v‖ := hnorm v + _ ≤ C * ‖ofFVL q v‖ := + mul_le_mul_of_nonneg_left (norm_ofFVL_infinity_le q v) hC.le + have hh := mul_le_mul_of_nonneg_left hv (inv_nonneg.mpr hC.le) + simpa only [← mul_assoc, inv_mul_cancel₀ hC.ne', one_mul] using hh + · simpa only [one_mul] using norm_ofFVL_mono hpq v + +/-- For infinite-dimensional E and finite p, q-convexity of `Free p E` forces +`q ≤ max 2 p`. Euclidean dual families prove the obstruction when p ≥ 2; the +general case transfers convexity through the inclusion at `max 2 p`. This is +the geometric bound used in Corollary 5.3, also excluding q = ∞. -/ +theorem convexity_parameter_bound (hE : ¬ FiniteDimensional ℝ E) + (p q : Exponent) (hp : p.IsFinite) (h : IsPConvex q (Free p E)) : + q ≤ max Exponent.two p := by + by_contra! hq + let r := max Exponent.two p + have hpr : p ≤ r := le_max_right _ _ + have hrq : r ≤ q := hq.le + have hpq : p ≤ q := hpr.trans hrq + have honto := inclusion_surjective_of_qConvex hpq h + have honto' : Function.Surjective (inclusion (E := E) hrq) := by + intro g + obtain ⟨f, hf⟩ := honto g + refine ⟨inclusion hpr f, ?_⟩ + have hcomp : inclusion hrq (inclusion hpr f) = inclusion hpq f := by + apply Subtype.ext + apply Subtype.ext + funext φ + simp only [inclusion_apply] + exact hcomp.trans hf + have hrfinite : r.IsFinite := by + change max (2 : ℝ≥0∞) p.1 < ⊤ + exact max_lt (by norm_num) hp + exact (not_le_of_gt hq) (ConvexityBound.parameter_bound_ge_two hE r q hrfinite + (le_max_left _ _) (inclusion_qConvex_of_surjective hrq honto')) + +/-- Corollary 5.3 (`cor:cross-parameter-above-two`): for p < q and q > 2, finite +dimensionality of E is equivalent to all eight conditions of Theorem 5.1. Thus +an infinite-dimensional space has a nonsurjective, non-order-continuous inclusion +for these exponents. The target q may be ∞. -/ +theorem cross_parameter_above_two [CompleteSpace E] (p q : Exponent) + (hpq : p < q) (h2 : Exponent.two < q) : + List.TFAE (FiniteDimensional ℝ E :: parameterConditions p q hpq.le E) := by + have ht := cross_parameter_inclusion (E := E) p q hpq + have heq : FiniteDimensional ℝ E ↔ IsPConvex q (Free p E) := by + constructor + · intro h + let := h + exact (ht.out 4 5).mp (finite_dimensional_normsEquivalent hpq.le) + · intro h + by_contra hE + exact (not_le_of_gt (max_lt h2 hpq)) + (convexity_parameter_bound hE p q (lt_of_lt_of_le hpq le_top) h) + exact (List.tfae_cons (b := IsPConvex q (Free p E)) + (by simp [parameterConditions])).mpr ⟨heq, ht⟩ + +private theorem inclusion_onto_lattice_isomorphism {p q : Exponent} (hpq : p ≤ q) + (honto : Function.Surjective (inclusion (E := E) hpq)) : + IsOntoLatticeIsomorphism (inclusion (E := E) hpq) := by + let J := inclusion (E := E) hpq + let e := ContinuousLinearEquiv.ofBijective J.toContinuousLinearMap + (LinearMap.ker_eq_bot.mpr (inclusion_properties hpq).2.1) + (LinearMap.range_eq_top.mpr honto) + let U : VecLatEquiv (Free p E) (Free q E) := + { e.toLinearEquiv with map_sup' := J.map_sup', map_inf' := J.map_inf' } + exact ⟨U, fun _ => rfl, e.continuous, e.symm.continuous⟩ + +/-- The real Hilbert sequence space used in Remark 5.4. -/ +abbrev HilbertSequence : Type := lp (fun _ : ℕ => ℝ) 2 + +/-- Remark 5.4 (`rem:cross-parameter-hilbert`): for the real Hilbert sequence space +ell-two and 1 ≤ p < q ≤ 2, the canonical inclusion is a bounded lattice isomorphism +onto the target and is order continuous. The uniform comparison of the one-free +and two-free norms with constant 3 gives the required equivalence for intermediate +exponents. This shows why the condition q > 2 in Corollary 5.3 is essential. -/ +theorem cross_parameter_hilbert (p q : Exponent) (hpq : p < q) (hq : q ≤ Exponent.two) : + IsOntoLatticeIsomorphism (inclusion (E := HilbertSequence) hpq.le) ∧ + IsOrderContinuousOp + (inclusion (E := HilbertSequence) hpq.le).toContinuousLinearMap.toLinearMap := by + suffices hcomparison : ∃ C : ℝ, 0 < C ∧ ∀ v : FVL HilbertSequence, + ‖ofFVL Exponent.one v‖ ≤ C * ‖ofFVL Exponent.two v‖ by + obtain ⟨C, hC, hcomparison⟩ := hcomparison + have hnorms : NormsEquivalentOnFVL p q HilbertSequence := by + refine ⟨C⁻¹, 1, inv_pos.mpr hC, zero_lt_one, fun v => ⟨?_, ?_⟩⟩ + · have hv : ‖ofFVL p v‖ ≤ C * ‖ofFVL q v‖ := by + calc + _ ≤ ‖ofFVL Exponent.one v‖ := norm_ofFVL_mono (show Exponent.one ≤ p from p.2) v + _ ≤ C * ‖ofFVL Exponent.two v‖ := hcomparison v + _ ≤ C * ‖ofFVL q v‖ := mul_le_mul_of_nonneg_left (norm_ofFVL_mono hq v) hC.le + have hh := mul_le_mul_of_nonneg_left hv (inv_nonneg.mpr hC.le) + simpa only [← mul_assoc, inv_mul_cancel₀ hC.ne', one_mul] using hh + · simpa only [one_mul] using norm_ofFVL_mono hpq.le v + have ht := cross_parameter_inclusion (E := HilbertSequence) p q hpq + have honto : Function.Surjective (inclusion (E := HilbertSequence) hpq.le) := + (ht.out 3 4).mpr hnorms + exact ⟨inclusion_onto_lattice_isomorphism hpq.le honto, + (ht.out 1 3 (a := IsOrderContinuousOp + (inclusion (E := HilbertSequence) hpq.le).toContinuousLinearMap.toLinearMap)).mpr honto⟩ + exact ⟨3, by norm_num, HilbertComparison.hilbert_free_norm_comparison⟩ + +end FBLOrderContinuousLH diff --git a/LeanPool/FBLOrderContinuity/Support.lean b/LeanPool/FBLOrderContinuity/Support.lean new file mode 100644 index 0000000000..c27108063b --- /dev/null +++ b/LeanPool/FBLOrderContinuity/Support.lean @@ -0,0 +1,3070 @@ +/- +Copyright (c) 2026 Raúl E. Pariente-Martín, Pedro Tradacete. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raúl E. Pariente-Martín, Pedro Tradacete +-/ + +module + +public import LeanPool.FBLOrderContinuity.Order +public import Mathlib.Analysis.Normed.Lp.lpSpace +public import Mathlib.Analysis.Convex.Gauge +public import Mathlib.Analysis.Convex.SpecificFunctions.Basic +public import Mathlib.Analysis.Normed.Affine.Convex + + + +/-! +# Support functions, compact disks, and order-continuity witnesses + +This module supplies the geometric tools of Section 4. The absolute support function +`support K` is a continuous seminorm when K is nonempty and bounded. For finite p, +`IsPCompactDisk p K` describes a disk generated by a p-summable sequence; at infinity +it describes a nonempty absolutely convex compact set. + +`majorant_norm` computes the free norm using finite p-sum majorants. `summable_support` +constructs free-lattice elements from summable disks. The support topologies `tauP` +control all free functions through `summable_local_control` and +`summable_global_domination`; `positive_patches` detects nonzero common lower bounds. + +The remaining results give finite-support approximation, the restriction-polar +identity, finite-support majorants, and compact-support order-null sequences. +`seriesDisk_properties` assembles compact witnesses for Extension and Parameters. +The paper calls uniform convergence on norm-compact sets `boundedWeakStar`; topology +comparisons use Lean's reverse ordering of topologies by their open sets. +-/ + +@[expose] public section + +noncomputable section +open scoped BigOperators ENNReal NNReal Topology Pointwise +open Filter Set +universe u v +namespace FBLOrderContinuousLH + +variable {E : Type u} {F : Type v} + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + +/-- The absolute support function of A: the supremum of `|φ x|` over x in A. The +real supremum is conditional, so the seminorm and continuity statements require A to +be nonempty and bounded. Compact and p-compact sets provide these hypotheses below. -/ +def support (A : Set E) (φ : Dual E) : ℝ := compactSupport A φ + +private theorem support_bddAbove (A : Set E) (hb : Bornology.IsBounded A) (φ : Dual E) : + BddAbove ((fun x : E => |φ x|) '' A) := by + obtain ⟨R, hR⟩ := hb.exists_norm_le + refine ⟨‖φ‖ * R, ?_⟩ + rintro _ ⟨x, hx, rfl⟩ + exact (φ.le_opNorm x).trans (mul_le_mul_of_nonneg_left (hR x hx) (norm_nonneg φ)) + +private theorem le_support (A : Set E) (hb : Bornology.IsBounded A) (φ : Dual E) + {x : E} (hx : x ∈ A) : |φ x| ≤ support A φ := + le_csSup (support_bddAbove A hb φ) (mem_image_of_mem _ hx) + +private theorem support_smul (A : Set E) (a : ℝ) (φ : Dual E) : + support A (a • φ) = |a| * support A φ := + compactSupport_smul A a φ + +private theorem support_zero (A : Set E) : support A (0 : Dual E) = 0 := by + simpa only [zero_smul, abs_zero, zero_mul] using support_smul A 0 (0 : Dual E) + +/-- Section 4.1: support as a seminorm, for its specified domain of validity. -/ +def supportSeminorm (A : Set E) (hA : A.Nonempty) (hb : Bornology.IsBounded A) : + Seminorm ℝ (Dual E) where + toFun := support A + map_zero' := by simp [support, compactSupport, hA] + add_le' := by + intro φ ψ + apply csSup_le (hA.image _) + rintro _ ⟨x, hx, rfl⟩ + exact (abs_add_le (φ x) (ψ x)).trans + (add_le_add (le_support A hb φ hx) (le_support A hb ψ hx)) + neg' := by simp [support, compactSupport] + smul' := by simpa only [Real.norm_eq_abs] using support_smul A + +/-- Section 4.1: norm continuity of bounded support functions. -/ +theorem support_continuous (A : Set E) (hA : A.Nonempty) (hb : Bornology.IsBounded A) : + Continuous (support A) := by + obtain ⟨R, hR, hAR⟩ := hb.exists_pos_norm_le + apply Seminorm.continuous_of_continuousAt_zero (p := supportSeminorm A hA hb) + rw [ContinuousAt, map_zero] + apply squeeze_zero (fun φ => apply_nonneg (supportSeminorm A hA hb) φ) + (g := fun φ : Dual E => R * ‖φ‖) + · intro φ + apply csSup_le (hA.image _) + rintro _ ⟨x, hx, rfl⟩ + exact (φ.le_opNorm x).trans (by nlinarith [hAR x hx, norm_nonneg φ]) + · simpa only [norm_zero, mul_zero] using + ((continuous_norm : Continuous (fun φ : Dual E => ‖φ‖)).const_mul R).tendsto 0 + +/-- A norm-compact support function belongs to the endpoint free lattice. -/ +theorem compact_support_inFree_infinity (K : Set E) (hK : IsCompact K) : + InFree Exponent.infinity (support K) := + (infinity_representation (compactSupport K)).mpr + ⟨compactSupport_homogeneous K, compactSupport_continuous hK⟩ + +/-- The auxiliary weak p-norm of a finite family. -/ +def weakPNorm (p : Exponent) {n : ℕ} (φ : Fin n → Dual E) : ℝ := + sSup {r | ∃ x : E, ‖x‖ ≤ 1 ∧ r = scalarPSum p (fun i => φ i x)} + +/-- A full-dual function obtained by applying a continuous positively homogeneous +function of finitely many real coordinates to evaluations at finitely many vectors. +This is the class A_E used in the proof of Lemma 4.2. -/ +def IsFiniteCalculusFunction (f : Dual E → ℝ) : Prop := + ∃ (n : ℕ) (x : Fin n → E) (H : posHomFunctions n), + ∀ φ, f φ = H.1 (fun i => φ (x i)) + +/-- The infimum of the scalar p-sums of vector norms over all finite evaluation +p-sums that dominate the absolute value of f. For finite calculus functions and finite p, +`finite_calculus_membership` identifies this cost with the free norm. -/ +def majorantCost (p : Exponent) (f : Dual E → ℝ) : ℝ := + sInf {r : ℝ | ∃ (m : ℕ) (x : Fin m → E), + r = scalarPSum p (fun i => ‖x i‖) ∧ + ∀ φ, |f φ| ≤ scalarPSum p (fun i => φ (x i))} + +/- The majorant gauge is constructed on the solid ideal of finitely majorized +functions. Its completion is p-convex, so the free universal property compares +this gauge with the free norm. -/ + +private theorem scalarPSum_rpow (p : Exponent) (hp : p.IsFinite) {n : ℕ} + (a : Fin n → ℝ) : (scalarPSum p a) ^ p.1.toReal = ∑ i, |a i| ^ p.1.toReal := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + simp only [scalarPSum, ite_eq_right (ne_of_lt hp), one_div] + exact Real.rpow_inv_rpow + (Finset.sum_nonneg (fun i _ => Real.rpow_nonneg (abs_nonneg _) _)) hp0.ne' + +private theorem scalarPSum_append_rpow (p : Exponent) (hp : p.IsFinite) {n m : ℕ} + (a : Fin n → ℝ) (b : Fin m → ℝ) : + scalarPSum p (Fin.append a b) ^ p.1.toReal = + scalarPSum p a ^ p.1.toReal + scalarPSum p b ^ p.1.toReal := by + simp only [scalarPSum_rpow p hp, Fin.sum_univ_add, Fin.append_left, Fin.append_right] + +private theorem scalarPSum_append_left (p : Exponent) (hp : p.IsFinite) {n m : ℕ} + (a : Fin n → ℝ) (b : Fin m → ℝ) : scalarPSum p a ≤ scalarPSum p (Fin.append a b) := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + apply (Real.rpow_le_rpow_iff (scalarPSum_nonneg ..) (scalarPSum_nonneg ..) hp0).mp + rw [scalarPSum_append_rpow p hp] + exact le_add_of_nonneg_right (Real.rpow_nonneg (scalarPSum_nonneg ..) _) + +private theorem scalarPSum_append_right (p : Exponent) (hp : p.IsFinite) {n m : ℕ} + (a : Fin n → ℝ) (b : Fin m → ℝ) : scalarPSum p b ≤ scalarPSum p (Fin.append a b) := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + apply (Real.rpow_le_rpow_iff (scalarPSum_nonneg ..) (scalarPSum_nonneg ..) hp0).mp + rw [scalarPSum_append_rpow p hp] + exact le_add_of_nonneg_left (Real.rpow_nonneg (scalarPSum_nonneg ..) _) + +/-- Domination in absolute value by evaluations of one finite vector p-sum. -/ +def Majorized (p : Exponent) (f : Dual E → ℝ) : Prop := + ∃ (n : ℕ) (x : Fin n → E), ∀ φ, |f φ| ≤ scalarPSum p (fun i => φ (x i)) + +/-- The order ideal of functions admitting a finite vector p-sum majorant. -/ +def majorantIdeal (p : Exponent) (hp : p.IsFinite) : OrderIdeal (Dual E → ℝ) := + OrderIdeal.ofSolid + { carrier := {f | Majorized p f} + zero_mem' := ⟨1, fun _ => 0, by intro φ; simp [scalarPSum_fin1]⟩ + add_mem' := by + rintro f g ⟨n, x, hx⟩ ⟨m, y, hy⟩ + refine ⟨n + m, fun i => (2 : ℝ) • Fin.append x y i, ?_⟩ + intro φ + have heq : (fun i => φ (Fin.append x y i)) = + Fin.append (fun i => φ (x i)) (fun i => φ (y i)) := by + funext i + exact Fin.addCases (fun j => by simp) (fun j => by simp) i + simp only [Pi.add_apply, map_smul, smul_eq_mul, scalarPSum_smul, + abs_of_nonneg (by norm_num : (0 : ℝ) ≤ 2), heq] + have h₁ := scalarPSum_append_left p hp (fun i => φ (x i)) (fun i => φ (y i)) + have h₂ := scalarPSum_append_right p hp (fun i => φ (x i)) (fun i => φ (y i)) + linarith [abs_add_le (f φ) (g φ), hx φ, hy φ] + smul_mem' := by + rintro c f ⟨n, x, hx⟩ + refine ⟨n, fun i => c • x i, ?_⟩ + intro φ + simp only [Pi.smul_apply, map_smul, smul_eq_mul, scalarPSum_smul, abs_mul] + exact mul_le_mul_of_nonneg_left (hx φ) (abs_nonneg c) } + (by + rintro f g ⟨n, x, hx⟩ hgf + exact ⟨n, x, fun φ => (hgf φ).trans (hx φ)⟩) + +/-- Functions with a finite vector majorant whose p-sum cost is at most one. -/ +def majorantUnit (p : Exponent) (hp : p.IsFinite) : + Set (majorantIdeal (E := E) p hp).toVectorSublattice := + {f | ∃ (n : ℕ) (x : Fin n → E), scalarPSum p (fun i => ‖x i‖) ≤ 1 ∧ + ∀ φ, |f.1 φ| ≤ scalarPSum p (fun i => φ (x i))} + +theorem majorantUnit_balanced (p : Exponent) (hp : p.IsFinite) : + Balanced ℝ (majorantUnit (E := E) p hp) := by + rw [balanced_iff_smul_mem] + rintro c hc f ⟨n, x, hx, hf⟩ + refine ⟨n, fun i => c • x i, ?_, ?_⟩ + · simp only [norm_smul, Real.norm_eq_abs, scalarPSum_smul, abs_abs] + exact (mul_le_of_le_one_left (scalarPSum_nonneg ..) + (by simpa only [Real.norm_eq_abs] using hc)).trans hx + · intro φ + change |c * f.1 φ| ≤ _ + simp only [map_smul, smul_eq_mul, scalarPSum_smul, abs_mul] + exact mul_le_mul_of_nonneg_left (hf φ) (abs_nonneg c) + +private theorem scalarPSum_weighted_append (p : Exponent) (hp : p.IsFinite) + {n m : ℕ} (a : Fin n → ℝ) (b : Fin m → ℝ) {c d : ℝ} + (hc : 0 ≤ c) (hd : 0 ≤ d) : + scalarPSum p (Fin.append (fun i => c ^ (p.1.toReal)⁻¹ * a i) + (fun i => d ^ (p.1.toReal)⁻¹ * b i)) ^ p.1.toReal = + c * scalarPSum p a ^ p.1.toReal + d * scalarPSum p b ^ p.1.toReal := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + rw [scalarPSum_append_rpow p hp, scalarPSum_smul, scalarPSum_smul, + abs_of_nonneg (Real.rpow_nonneg hc _), abs_of_nonneg (Real.rpow_nonneg hd _), + Real.mul_rpow (Real.rpow_nonneg hc _) (scalarPSum_nonneg ..), + Real.mul_rpow (Real.rpow_nonneg hd _) (scalarPSum_nonneg ..), + Real.rpow_inv_rpow hc hp0.ne', Real.rpow_inv_rpow hd hp0.ne'] + +theorem majorantUnit_convex (p : Exponent) (hp : p.IsFinite) : + Convex ℝ (majorantUnit (E := E) p hp) := by + have hp1 : 1 ≤ p.1.toReal := by exact_mod_cast ENNReal.toReal_mono (ne_of_lt hp) p.2 + have hp0 : 0 < p.1.toReal := zero_lt_one.trans_le hp1 + rintro f ⟨n, x, hx, hf⟩ g ⟨m, y, hy, hg⟩ c d hc hd hcd + let z : Fin (n + m) → E := Fin.append (fun i => c ^ (p.1.toReal)⁻¹ • x i) + (fun i => d ^ (p.1.toReal)⁻¹ • y i) + have heval (φ : Dual E) : (fun i => φ (z i)) = + Fin.append (fun i => c ^ (p.1.toReal)⁻¹ * φ (x i)) + (fun i => d ^ (p.1.toReal)⁻¹ * φ (y i)) := by + funext i + exact Fin.addCases (fun j => by simp [z]) (fun j => by simp [z]) i + have hnorm : (fun i => ‖z i‖) = + Fin.append (fun i => c ^ (p.1.toReal)⁻¹ * ‖x i‖) + (fun i => d ^ (p.1.toReal)⁻¹ * ‖y i‖) := by + funext i + exact Fin.addCases + (fun j => by simp [z, norm_smul, Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hc _)]) + (fun j => by simp [z, norm_smul, Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hd _)]) i + refine ⟨n + m, z, ?_, ?_⟩ + · apply (Real.rpow_le_rpow_iff (scalarPSum_nonneg ..) zero_le_one hp0).mp + rw [hnorm, scalarPSum_weighted_append p hp _ _ hc hd, Real.one_rpow] + have hx' := Real.rpow_le_rpow (scalarPSum_nonneg p (fun i => ‖x i‖)) hx hp0.le + have hy' := Real.rpow_le_rpow (scalarPSum_nonneg p (fun i => ‖y i‖)) hy hp0.le + simp only [Real.one_rpow] at hx' hy' + nlinarith + · intro φ + apply (Real.rpow_le_rpow_iff (abs_nonneg _) (scalarPSum_nonneg ..) hp0).mp + rw [heval, scalarPSum_weighted_append p hp _ _ hc hd] + change |c * f.1 φ + d * g.1 φ| ^ p.1.toReal ≤ _ + have habs : |c * f.1 φ + d * g.1 φ| ≤ c * |f.1 φ| + d * |g.1 φ| := by + simpa only [abs_mul, abs_of_nonneg hc, abs_of_nonneg hd] using + abs_add_le (c * f.1 φ) (d * g.1 φ) + refine (Real.rpow_le_rpow (abs_nonneg _) habs hp0.le).trans ?_ + have hconv := (convexOn_rpow hp1).2 (abs_nonneg (f.1 φ)) (abs_nonneg (g.1 φ)) hc hd hcd + simp only [smul_eq_mul] at hconv + exact hconv.trans (add_le_add + (mul_le_mul_of_nonneg_left (Real.rpow_le_rpow (abs_nonneg _) (hf φ) hp0.le) hc) + (mul_le_mul_of_nonneg_left (Real.rpow_le_rpow (abs_nonneg _) (hg φ) hp0.le) hd)) + +theorem majorantUnit_absorbent (p : Exponent) (hp : p.IsFinite) : + Absorbent ℝ (majorantUnit (E := E) p hp) := by + rw [absorbent_iff_eventually_nhdsNE_zero] + intro f + obtain ⟨n, x, hx⟩ := f.2 + have hlim : Tendsto (fun c : ℝ => |c| * scalarPSum p (fun i => ‖x i‖)) + (𝓝[≠] 0) (𝓝 0) := by + simpa only [abs_zero, zero_mul] using + ((continuous_abs.mul_const (scalarPSum p (fun i => ‖x i‖))).tendsto 0).mono_left + nhdsWithin_le_nhds + filter_upwards [hlim.eventually (gt_mem_nhds zero_lt_one)] with c hc + refine ⟨n, fun i => c • x i, ?_, ?_⟩ + · simpa only [norm_smul, Real.norm_eq_abs, scalarPSum_smul, abs_abs] using hc.le + · intro φ + change |c * f.1 φ| ≤ _ + simp only [map_smul, smul_eq_mul, scalarPSum_smul, abs_mul] + exact mul_le_mul_of_nonneg_left (hx φ) (abs_nonneg c) + +/-- The Minkowski gauge of the unit-cost majorants. -/ +def majorantSeminorm (p : Exponent) (hp : p.IsFinite) : + Seminorm ℝ (majorantIdeal (E := E) p hp).toVectorSublattice := + gaugeSeminorm (majorantUnit_balanced p hp) (majorantUnit_convex p hp) + (majorantUnit_absorbent p hp) + +private theorem majorant_eval_bound (p : Exponent) {n : ℕ} (x : Fin n → E) (φ : Dual E) : + scalarPSum p (fun i => φ (x i)) ≤ ‖φ‖ * scalarPSum p (fun i => ‖x i‖) := by + calc + _ ≤ scalarPSum p (fun i => ‖φ‖ * ‖x i‖) := scalarPSum_mono_abs p _ _ (fun i => by + simpa only [Real.norm_eq_abs, + abs_of_nonneg (mul_nonneg (norm_nonneg _) (norm_nonneg _))] using + φ.le_opNorm (x i)) + _ = _ := by rw [scalarPSum_smul, abs_of_nonneg (norm_nonneg _)] + +private theorem majorantUnit_eval_le (p : Exponent) (hp : p.IsFinite) + {f : (majorantIdeal (E := E) p hp).toVectorSublattice} + (hf : f ∈ majorantUnit p hp) (φ : Dual E) : |f.1 φ| ≤ ‖φ‖ := by + obtain ⟨n, x, hx, hf⟩ := hf + exact (hf φ).trans ((majorant_eval_bound p x φ).trans + (mul_le_of_le_one_right (norm_nonneg _) hx)) + +theorem majorantSeminorm_eq_zero (p : Exponent) (hp : p.IsFinite) + (f : (majorantIdeal (E := E) p hp).toVectorSublattice) + (hf : majorantSeminorm p hp f = 0) : f = 0 := by + apply Subtype.ext + funext φ + change f.1 φ = 0 + apply abs_eq_zero.mp + apply le_antisymm ?_ (abs_nonneg _) + apply le_of_forall_pos_le_add + intro ε hε + have hg : gauge (majorantUnit p hp) f < ε / (‖φ‖ + 1) := by + change majorantSeminorm p hp f < _ + rw [hf] + exact div_pos hε (by positivity) + obtain ⟨r, hr, hrt, g, hg, hfg⟩ := + exists_lt_of_gauge_lt (majorantUnit_absorbent (E := E) p hp) hg + have hval : f.1 φ = r * g.1 φ := + congrArg (fun k : (majorantIdeal (E := E) p hp).toVectorSublattice => k.1 φ) hfg.symm + rw [hval, abs_mul, abs_of_pos hr] + have hbound := majorantUnit_eval_le p hp hg φ + have hrt' : r * (‖φ‖ + 1) < ε := (lt_div_iff₀ (by positivity)).mp hrt + nlinarith only [hbound, hrt', hr] + +theorem majorantSeminorm_le (p : Exponent) (hp : p.IsFinite) + (f : (majorantIdeal (E := E) p hp).toVectorSublattice) {n : ℕ} (x : Fin n → E) + (hx : ∀ φ, |f.1 φ| ≤ scalarPSum p (fun i => φ (x i))) : + majorantSeminorm p hp f ≤ scalarPSum p (fun i => ‖x i‖) := by + apply le_of_forall_pos_le_add + intro ε hε + let r := scalarPSum p (fun i => ‖x i‖) + ε + have hr : 0 < r := add_pos_of_nonneg_of_pos (scalarPSum_nonneg ..) hε + change gauge (majorantUnit p hp) f ≤ r + apply gauge_le_of_mem hr.le + refine ⟨r⁻¹ • f, ?_, smul_inv_smul₀ hr.ne' f⟩ + refine ⟨n, fun i => r⁻¹ • x i, ?_, ?_⟩ + · simp only [norm_smul, Real.norm_eq_abs, scalarPSum_smul, + abs_of_pos (inv_pos.mpr hr)] + exact (inv_mul_le_one₀ hr).mpr (le_add_of_nonneg_right hε.le) + · intro φ + change |r⁻¹ * f.1 φ| ≤ _ + simp only [map_smul, smul_eq_mul, scalarPSum_smul, abs_mul] + exact mul_le_mul_of_nonneg_left (hx φ) (abs_nonneg _) + +private theorem majorantCost_bddBelow (p : Exponent) (f : Dual E → ℝ) : + BddBelow {r : ℝ | ∃ (m : ℕ) (x : Fin m → E), + r = scalarPSum p (fun i => ‖x i‖) ∧ + ∀ φ, |f φ| ≤ scalarPSum p (fun i => φ (x i))} := by + refine ⟨0, ?_⟩ + rintro _ ⟨m, x, rfl, _⟩ + exact scalarPSum_nonneg .. + +private theorem majorantSeminorm_eq_cost (p : Exponent) (hp : p.IsFinite) + (f : (majorantIdeal (E := E) p hp).toVectorSublattice) : + majorantSeminorm p hp f = majorantCost p f.1 := by + apply le_antisymm + · apply le_csInf + · obtain ⟨n, x, hx⟩ := f.2 + exact ⟨_, n, x, rfl, hx⟩ + · rintro _ ⟨n, x, rfl, hx⟩ + exact majorantSeminorm_le p hp f x hx + · apply le_of_forall_gt + intro r hr + obtain ⟨t, ht, htr, g, ⟨n, x, hx, hg⟩, hfg⟩ := + exists_lt_of_gauge_lt (majorantUnit_absorbent (E := E) p hp) hr + have hcost : majorantCost p f.1 ≤ scalarPSum p (fun i => ‖t • x i‖) := by + apply csInf_le (majorantCost_bddBelow p f.1) + refine ⟨n, fun i => t • x i, rfl, ?_⟩ + intro φ + rw [← hfg] + change |t * g.1 φ| ≤ _ + simp only [map_smul, smul_eq_mul, scalarPSum_smul, abs_mul] + exact mul_le_mul_of_nonneg_left (hg φ) (abs_nonneg _) + refine hcost.trans_lt (lt_of_le_of_lt ?_ htr) + simp only [norm_smul, Real.norm_eq_abs, scalarPSum_smul, abs_of_pos ht] + exact mul_le_of_le_one_right ht.le hx + +theorem majorantSeminorm_solid (p : Exponent) (hp : p.IsFinite) + (f g : (majorantIdeal (E := E) p hp).toVectorSublattice) (hfg : |f| ≤ |g|) : + majorantSeminorm p hp f ≤ majorantSeminorm p hp g := by + rw [majorantSeminorm_eq_cost p hp g] + apply le_csInf + · obtain ⟨n, x, hx⟩ := g.2 + exact ⟨_, n, x, rfl, hx⟩ + · rintro _ ⟨n, x, rfl, hx⟩ + exact majorantSeminorm_le p hp f x (fun φ => (hfg φ).trans (hx φ)) + +/-- The normed vector lattice of functions with finite p-sum majorants. -/ +def MajorantSpace (p : Exponent) (hp : p.IsFinite) : Type u := + (majorantIdeal (E := E) p hp).toVectorSublattice + +instance (p : Exponent) (hp : p.IsFinite) : AddCommGroup (MajorantSpace (E := E) p hp) := + inferInstanceAs (AddCommGroup (majorantIdeal (E := E) p hp).toVectorSublattice) +instance (p : Exponent) (hp : p.IsFinite) : Module ℝ (MajorantSpace (E := E) p hp) := + inferInstanceAs (Module ℝ (majorantIdeal (E := E) p hp).toVectorSublattice) +instance (p : Exponent) (hp : p.IsFinite) : Lattice (MajorantSpace (E := E) p hp) := + inferInstanceAs (Lattice (majorantIdeal (E := E) p hp).toVectorSublattice) +instance (p : Exponent) (hp : p.IsFinite) : + IsOrderedAddMonoid (MajorantSpace (E := E) p hp) := + inferInstanceAs (IsOrderedAddMonoid (majorantIdeal (E := E) p hp).toVectorSublattice) +instance (p : Exponent) (hp : p.IsFinite) : VectorLattice (MajorantSpace (E := E) p hp) := + inferInstanceAs (VectorLattice (majorantIdeal (E := E) p hp).toVectorSublattice) +instance (p : Exponent) (hp : p.IsFinite) : Norm (MajorantSpace (E := E) p hp) := + ⟨majorantSeminorm p hp⟩ + +instance (p : Exponent) (hp : p.IsFinite) : + NormedAddCommGroup (MajorantSpace (E := E) p hp) := + NormedAddCommGroup.ofCore (𝕜 := ℝ) { + norm_nonneg := fun f => apply_nonneg (majorantSeminorm p hp) f + norm_smul := fun c f => map_smul_eq_mul (majorantSeminorm p hp) c f + norm_triangle := fun f g => map_add_le_add (majorantSeminorm p hp) f g + norm_eq_zero_iff := fun f => ⟨majorantSeminorm_eq_zero p hp f, fun hf => by + subst f + exact map_zero (majorantSeminorm p hp)⟩ } + +instance (p : Exponent) (hp : p.IsFinite) : + NormedVectorLattice (MajorantSpace (E := E) p hp) where + toVectorLattice := inferInstance + solid := majorantSeminorm_solid p hp + norm_smul := fun c f => map_smul_eq_mul (majorantSeminorm p hp) c f + +private theorem posHom_apply_bound {n : ℕ} (H : posHomFunctions n) (a : Fin n → ℝ) : + |H a| ≤ ‖H‖ * ∑ i, |a i| := by + have hsum : 0 ≤ ∑ i, |a i| := Finset.sum_nonneg (fun i _ => abs_nonneg _) + have hnorm : ‖a‖ ≤ ∑ i, |a i| := by + rw [pi_norm_le_iff_of_nonneg hsum] + intro i + exact Finset.single_le_sum (fun j _ => abs_nonneg (a j)) (Finset.mem_univ i) + by_cases ha : a = 0 + · subst a + simp [PosHomFunction.map_zero] + · let b : PosHomFunction.ellInfinityUnitSphere n := ⟨‖a‖⁻¹ • a, by + rw [PosHomFunction.ellInfinityUnitSphere, Metric.mem_sphere, dist_zero_right] + simp [norm_smul, norm_ne_zero_iff.mpr ha]⟩ + have heq : ‖a‖ • (b : Fin n → ℝ) = a := by + change ‖a‖ • (‖a‖⁻¹ • a) = a + rw [smul_inv_smul₀ (norm_ne_zero_iff.mpr ha)] + have hH := PosHomFunction.map_smul_of_nonneg H ‖a‖ (norm_nonneg _) b + rw [heq] at hH + rw [hH, smul_eq_mul, abs_mul, abs_of_nonneg (norm_nonneg _)] + calc + _ ≤ ‖a‖ * ‖H‖ := mul_le_mul_of_nonneg_left + (PosHomFunction.abs_apply_le_norm H b) (norm_nonneg _) + _ ≤ ‖H‖ * ∑ i, |a i| := by nlinarith [norm_nonneg H] + +/-- Evaluate a majorized function as a lattice homomorphism. -/ +def majorantEvaluation (p : Exponent) (hp : p.IsFinite) (φ : Dual E) : + VecLatHom (MajorantSpace (E := E) p hp) ℝ where + toFun f := f.1 φ + map_add' := by intros; rfl + map_smul' := by intros; rfl + map_sup' := by intros; rfl + map_inf' := by intros; rfl + +/-- The pointwise homogeneous functional calculus on the majorant space. -/ +def majorantCalculus (p : Exponent) (hp : p.IsFinite) {n : ℕ} + (f : Fin n → MajorantSpace (E := E) p hp) : + VecLatHom (posHomFunctions n) (MajorantSpace (E := E) p hp) where + toFun H := ⟨fun φ => H (fun i => (f i).1 φ), by + let G : MajorantSpace (E := E) p hp := ‖H‖ • ∑ i, |f i| + apply (majorantIdeal p hp).mem_of_abs_le_abs G.2 + intro φ + have hbound := posHom_apply_bound H (fun i => (f i).1 φ) + change |H (fun i => (f i).1 φ)| ≤ |majorantEvaluation p hp φ G| + simp only [G, map_smul, map_sum, VecLatHom.map_abs, smul_eq_mul] + change |H (fun i => (f i).1 φ)| ≤ |‖H‖ * (∑ i, |(f i).1 φ|)| + rw [abs_of_nonneg (mul_nonneg (norm_nonneg _) + (Finset.sum_nonneg (fun i _ => abs_nonneg _)))] + exact hbound⟩ + map_add' := by intros; rfl + map_smul' := by intros; rfl + map_sup' := by intros; rfl + map_inf' := by intros; rfl + +private theorem majorantSpace_near (p : Exponent) (hp : p.IsFinite) + (f : MajorantSpace (E := E) p hp) (ε : ℝ) (hε : 0 < ε) : + ∃ (n : ℕ) (x : Fin n → E), scalarPSum p (fun i => ‖x i‖) < ‖f‖ + ε ∧ + ∀ φ, |f.1 φ| ≤ scalarPSum p (fun i => φ (x i)) := by + have hne : {r : ℝ | ∃ (n : ℕ) (x : Fin n → E), + r = scalarPSum p (fun i => ‖x i‖) ∧ + ∀ φ, |f.1 φ| ≤ scalarPSum p (fun i => φ (x i))}.Nonempty := by + obtain ⟨n, x, hx⟩ := f.2 + exact ⟨_, n, x, rfl, hx⟩ + have hlt : majorantCost p f.1 < ‖f‖ + ε := by + rw [← majorantSeminorm_eq_cost p hp f] + exact lt_add_of_pos_right _ hε + obtain ⟨r, ⟨n, x, rfl, hx⟩, hr⟩ := exists_lt_of_csInf_lt hne hlt + exact ⟨n, x, hr, hx⟩ + +private theorem scalarPSum_flatten (p : Exponent) (hp : p.IsFinite) {n : ℕ} + (m : Fin n → ℕ) (a : ∀ i, Fin (m i) → ℝ) : + let e := (Fintype.equivFin (Σ i, Fin (m i))).symm + scalarPSum p (fun j => a (e j).1 (e j).2) = scalarPSum p (fun i => scalarPSum p (a i)) := by + classical + dsimp only + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + apply Real.rpow_left_injOn hp0.ne' (scalarPSum_nonneg ..) (scalarPSum_nonneg ..) + simp only [scalarPSum_rpow p hp, abs_of_nonneg (scalarPSum_nonneg p _)] + simpa only [Fintype.sum_sigma] using + (Fintype.equivFin (Σ i, Fin (m i))).symm.sum_comp + (fun j => |a j.1 j.2| ^ p.1.toReal) + +private theorem majorantCalculus_pSum_bound (p : Exponent) (hp : p.IsFinite) {n : ℕ} + (f : Fin n → MajorantSpace (E := E) p hp) : + ‖majorantCalculus p hp f (pSumFunction p n)‖ ≤ scalarPSum p (fun i => ‖f i‖) := by + classical + apply le_of_forall_pos_le_add + intro ε hε + let δ := ε / (n + 1) + have hδ : 0 < δ := div_pos hε (by positivity) + choose m x hx hbound using fun i => majorantSpace_near p hp (f i) δ hδ + let e := (Fintype.equivFin (Σ i, Fin (m i))).symm + let z : Fin (Fintype.card (Σ i, Fin (m i))) → E := fun j => x (e j).1 (e j).2 + have hdom (φ : Dual E) : + |(majorantCalculus p hp f (pSumFunction p n)).1 φ| ≤ scalarPSum p (fun j => φ (z j)) := by + change |scalarPSum p (fun i => (f i).1 φ)| ≤ _ + rw [abs_of_nonneg (scalarPSum_nonneg ..)] + have heq := scalarPSum_flatten p hp m (fun i j => φ (x i j)) + change scalarPSum p (fun j => φ (z j)) = _ at heq + rw [heq] + apply scalarPSum_mono_abs + intro i + simpa only [abs_of_nonneg (scalarPSum_nonneg ..)] using hbound i φ + have hnorm := majorantSeminorm_le p hp + (majorantCalculus p hp f (pSumFunction p n)) z hdom + have heq := scalarPSum_flatten p hp m (fun i j => ‖x i j‖) + change scalarPSum p (fun j => ‖z j‖) = _ at heq + rw [heq] at hnorm + refine hnorm.trans ?_ + calc + _ ≤ scalarPSum p (fun i => ‖f i‖ + δ) := by + apply scalarPSum_mono_abs + intro i + rw [abs_of_nonneg (scalarPSum_nonneg ..), abs_of_nonneg (by positivity)] + exact (hx i).le + _ ≤ scalarPSum p (fun i => ‖f i‖) + scalarPSum p (fun _ : Fin n => δ) := + scalarPSum_add_le p _ _ + _ ≤ scalarPSum p (fun i => ‖f i‖) + ε := by + have hle := scalarPSum_mono_exponent (show Exponent.one ≤ p from p.2) (fun _ : Fin n => δ) + have hid : (n : ℝ) * δ ≤ ε := by + have : ((n : ℝ) + 1) * δ = ε := by dsimp [δ]; field_simp + nlinarith + have hsum : scalarPSum Exponent.one (fun _ : Fin n => δ) = n * δ := by + simp [scalarPSum, Exponent.one, abs_of_pos hδ] + rw [hsum] at hle + linarith + +/-- Substitute selected coordinates into a positively homogeneous function. -/ +def posHomReindex {n m : ℕ} (r : Fin n → Fin m) : + VecLatHom (posHomFunctions n) (posHomFunctions m) where + toFun H := ⟨⟨fun a => H (fun i => a (r i)), + H.1.continuous.comp (continuous_pi (fun i => continuous_apply (r i)))⟩, by + intro c hc a + exact PosHomFunction.map_smul_of_nonneg H c hc (fun i => a (r i))⟩ + map_add' := by intros; rfl + map_smul' := by intros; rfl + map_sup' := by intros; rfl + map_inf' := by intros; rfl + +private theorem posHomCalculus_reindex {X : Type u} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [BanachLattice X] {n m : ℕ} + (r : Fin n → Fin m) (x : Fin m → X) (H : posHomFunctions n) : + letI := isUniformlyCompleteVectorLattice_of_banachLattice X + PosHomFunction.functionalCalculus x (posHomReindex r H) = + PosHomFunction.functionalCalculus (fun i => x (r i)) H := by + let := isUniformlyCompleteVectorLattice_of_banachLattice X + have heq := PosHomFunction.eq_functionalCalculus_of_map_coordinate (fun i => x (r i)) + ((PosHomFunction.functionalCalculus x).comp (posHomReindex r)) (by + intro i + change PosHomFunction.functionalCalculus x (PosHomFunction.coordinate (r i)) = _ + exact PosHomFunction.functionalCalculus_coordinate x (r i)) + exact DFunLike.congr_fun heq H + +private theorem latticePSum_abs_sub_le {X : Type u} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [BanachLattice X] (p : Exponent) {n : ℕ} (x y : Fin n → X) : + |latticePSum p x - latticePSum p y| ≤ ∑ i, |x i - y i| := by + let := isUniformlyCompleteVectorLattice_of_banachLattice X + let L : posHomFunctions (n + n) := posHomReindex (Fin.castAdd n) (pSumFunction p n) + let R : posHomFunctions (n + n) := posHomReindex (Fin.natAdd n) (pSumFunction p n) + let D : Fin n → posHomFunctions (n + n) := fun i => + PosHomFunction.coordinate (Fin.castAdd n i) - PosHomFunction.coordinate (Fin.natAdd n i) + have hscalar : |L - R| ≤ ∑ i, |D i| := by + intro a + change |scalarPSum p (fun i => a (Fin.castAdd n i)) - + scalarPSum p (fun i => a (Fin.natAdd n i))| ≤ _ + have hnorm := abs_norm_sub_norm_le + (WithLp.toLp p.1 (fun i => a (Fin.castAdd n i))) + (WithLp.toLp p.1 (fun i => a (Fin.natAdd n i))) + have hle := scalarPSum_mono_exponent (show Exponent.one ≤ p from p.2) + (fun i => a (Fin.castAdd n i) - a (Fin.natAdd n i)) + rw [scalarPSum_eq_piLp_norm] at hle + rw [scalarPSum_eq_piLp_norm, scalarPSum_eq_piLp_norm] + refine hnorm.trans (hle.trans_eq ?_) + simp only [AddSubmonoidClass.coe_finsetSum, ContinuousMap.toFun_eq_coe, + ContinuousMap.coe_sum, Finset.sum_apply] + change scalarPSum Exponent.one + (fun i => a (Fin.castAdd n i) - a (Fin.natAdd n i)) = + ∑ i, |a (Fin.castAdd n i) - a (Fin.natAdd n i)| + simp [scalarPSum, Exponent.one] + have htransfer := (PosHomFunction.functionalCalculus (Fin.append x y)).monotone hscalar + have hL : PosHomFunction.functionalCalculus (Fin.append x y) L = latticePSum p x := by + rw [posHomCalculus_reindex] + simp only [Fin.append_left, latticePSum] + have hR : PosHomFunction.functionalCalculus (Fin.append x y) R = latticePSum p y := by + rw [posHomCalculus_reindex] + simp only [Fin.append_right, latticePSum] + have hD (i : Fin n) : PosHomFunction.functionalCalculus (Fin.append x y) (D i) = x i - y i := by + simp only [D, map_sub, PosHomFunction.functionalCalculus_coordinate, Fin.append_left, + Fin.append_right] + simpa only [VecLatHom.map_abs, map_sub, map_sum, hL, hR, hD] using htransfer + +private theorem latticePSum_continuous {X : Type u} [NormedAddCommGroup X] [Lattice X] + [IsOrderedAddMonoid X] [BanachLattice X] (p : Exponent) (n : ℕ) : + Continuous (latticePSum p : (Fin n → X) → X) := by + have hnorm (x y : Fin n → X) : ‖latticePSum p x - latticePSum p y‖ ≤ + ∑ i, ‖x i - y i‖ := by + calc + _ ≤ ‖∑ i, |x i - y i|‖ := HasSolidNorm.solid + ((latticePSum_abs_sub_le p x y).trans (le_abs_self _)) + _ ≤ ∑ i, ‖|x i - y i|‖ := norm_sum_le _ _ + _ = _ := by simp only [norm_abs_eq_norm] + apply LipschitzWith.continuous (K := (n : ℝ≥0)) + apply lipschitzWith_iff_norm_sub_le.mpr + intro x y + refine (hnorm x y).trans ?_ + calc + _ ≤ ∑ _i : Fin n, ‖x - y‖ := Finset.sum_le_sum (fun i _ => norm_le_pi_norm (x - y) i) + _ = (n : ℝ≥0) * ‖x - y‖ := by simp + +private theorem majorantCompletion_calculus (p : Exponent) (hp : p.IsFinite) {n : ℕ} + (f : Fin n → MajorantSpace (E := E) p hp) (H : posHomFunctions n) : + letI := isUniformlyCompleteVectorLattice_of_banachLattice + (UniformSpace.Completion (MajorantSpace (E := E) p hp)) + (majorantCalculus p hp f H : UniformSpace.Completion (MajorantSpace (E := E) p hp)) = + PosHomFunction.functionalCalculus + (fun i => (f i : UniformSpace.Completion (MajorantSpace (E := E) p hp))) H := by + let := isUniformlyCompleteVectorLattice_of_banachLattice + (UniformSpace.Completion (MajorantSpace (E := E) p hp)) + have heq := PosHomFunction.eq_functionalCalculus_of_map_coordinate + (fun i => (f i : UniformSpace.Completion (MajorantSpace (E := E) p hp))) + (toCompletionVecLatHom.comp (majorantCalculus p hp f)) (by + intro i + change ((majorantCalculus p hp f (PosHomFunction.coordinate i)) : + UniformSpace.Completion (MajorantSpace (E := E) p hp)) = _ + rfl) + exact DFunLike.congr_fun heq H + +private theorem majorantCompletion_pConvex (p : Exponent) (hp : p.IsFinite) : + ConvexWith p 1 (UniformSpace.Completion (MajorantSpace (E := E) p hp)) := by + constructor + · rfl + · intro n x + have hd (i : Fin n) : ∃ f : ℕ → MajorantSpace (E := E) p hp, + Tendsto (fun k => (f k : UniformSpace.Completion (MajorantSpace (E := E) p hp))) + atTop (𝓝 (x i)) := by + obtain ⟨z, hz, hlim⟩ := mem_closure_iff_seq_limit.mp + (UniformSpace.Completion.denseRange_coe (α := MajorantSpace (E := E) p hp) (x i)) + choose f hf using hz + exact ⟨f, by simpa only [hf] using hlim⟩ + choose f hf using hd + let z : ℕ → Fin n → UniformSpace.Completion (MajorantSpace (E := E) p hp) := + fun k i => (f i k : UniformSpace.Completion (MajorantSpace (E := E) p hp)) + have hz : Tendsto z atTop (𝓝 x) := tendsto_pi_nhds.mpr hf + have hleft := ((latticePSum_continuous p n).norm.tendsto x).comp hz + have hnorm : Tendsto (fun k i => ‖z k i‖) atTop (𝓝 (fun i => ‖x i‖)) := + tendsto_pi_nhds.mpr (fun i => (hf i).norm) + have hright := ((pSumFunction p n).1.continuous.tendsto (fun i => ‖x i‖)).comp hnorm + rw [one_mul] + refine le_of_tendsto_of_tendsto' hleft hright ?_ + intro k + have heq := majorantCompletion_calculus p hp (fun i => f i k) (pSumFunction p n) + change (majorantCalculus p hp (fun i => f i k) (pSumFunction p n) : + UniformSpace.Completion (MajorantSpace (E := E) p hp)) = latticePSum p (z k) at heq + change ‖latticePSum p (z k)‖ ≤ scalarPSum p (fun i => ‖z k i‖) + rw [← heq, UniformSpace.Completion.norm_coe] + simpa only [z, UniformSpace.Completion.norm_coe] using + majorantCalculus_pSum_bound p hp (fun i => f i k) + +/-- The bounded evaluation map from the generating space into the majorant space. -/ +def majorantDelta (p : Exponent) (hp : p.IsFinite) : + E →L[ℝ] MajorantSpace (E := E) p hp := by + let L : E →ₗ[ℝ] MajorantSpace (E := E) p hp := + { toFun x := + (⟨fun φ => φ x, 1, fun _ => x, by intro φ; simp [scalarPSum_fin1]⟩ : MajorantSpace p hp) + map_add' := by intro x y; apply Subtype.ext; funext φ; exact map_add φ x y + map_smul' := by intro c x; apply Subtype.ext; funext φ; exact map_smul φ c x } + refine L.mkContinuous 1 ?_ + intro x + have h := majorantSeminorm_le p hp (L x) + (fun _ : Fin 1 => x) (by intro φ; change |φ x| ≤ _; simp [scalarPSum_fin1]) + change majorantSeminorm p hp (L x) ≤ 1 * ‖x‖ + simpa only [scalarPSum_fin1, abs_of_nonneg (norm_nonneg _), one_mul] using h + +private theorem majorantDelta_norm_le (p : Exponent) (hp : p.IsFinite) : + ‖majorantDelta (E := E) p hp‖ ≤ 1 := by + apply (majorantDelta p hp).opNorm_le_bound zero_le_one + intro x + change majorantSeminorm p hp _ ≤ 1 * ‖x‖ + simpa only [scalarPSum_fin1, abs_of_nonneg (norm_nonneg _), one_mul] using + majorantSeminorm_le p hp (majorantDelta p hp x) (fun _ : Fin 1 => x) + (by intro φ; change |φ x| ≤ _; simp [scalarPSum_fin1]) + +/-- Evaluation on a free lattice as a lattice homomorphism. -/ +abbrev freeEvaluation (p : Exponent) (φ : Dual E) : VecLatHom (Free p E) ℝ := + evalVecLatHom p φ + +/-- Evaluation at a vector as a homomorphism of homogeneous-function lattices. -/ +abbrev posHomEvaluation {n : ℕ} (a : Fin n → ℝ) : VecLatHom (posHomFunctions n) ℝ := + realPosHomEval a + +private theorem freeCalculus_apply (p : Exponent) {n : ℕ} (f : Fin n → Free p E) + (H : posHomFunctions n) (φ : Dual E) : + letI := isUniformlyCompleteVectorLattice_of_banachLattice (Free p E) + PosHomFunction.functionalCalculus f H φ = H (fun i => f i φ) := by + let := isUniformlyCompleteVectorLattice_of_banachLattice (Free p E) + let := isUniformlyCompleteVectorLattice_of_banachLattice ℝ + have hleft := PosHomFunction.eq_functionalCalculus_of_map_coordinate + (fun i => f i φ) ((freeEvaluation p φ).comp (PosHomFunction.functionalCalculus f)) + (by + intro i + simp only [VecLatHom.comp_apply, PosHomFunction.functionalCalculus_coordinate] + rfl) + have hright := PosHomFunction.eq_functionalCalculus_of_map_coordinate + (fun i => f i φ) (posHomEvaluation (fun i => f i φ)) (by intro i; rfl) + exact DFunLike.congr_fun (hleft.trans hright.symm) H + +private theorem finite_calculus_membership_proof (p : Exponent) (hp : p.IsFinite) + (f : Dual E → ℝ) (hf : IsFiniteCalculusFunction f) : + InFree p f ∧ freeNormExt p f = ENNReal.ofReal (majorantCost p f) := by + obtain ⟨n, x, H, hf⟩ := hf + let := isUniformlyCompleteVectorLattice_of_banachLattice (Free p E) + let g := PosHomFunction.functionalCalculus (fun i => delta p (x i)) H + have hg : ∀ φ, g φ = f φ := fun φ => (freeCalculus_apply p _ H φ).trans (hf φ).symm + refine ⟨⟨g, hg⟩, ?_⟩ + have hfun : f = (g : Dual E → ℝ) := funext (fun φ => (hg φ).symm) + rw [hfun, freeNormExt_eq_norm] + apply congrArg ENNReal.ofReal + have hu : ‖g‖ ≤ majorantCost p (g : Dual E → ℝ) := by + apply le_csInf + · have hG := (majorantCalculus p hp (fun i => majorantDelta p hp (x i)) H).2 + obtain ⟨m, y, hy⟩ := hG + refine ⟨_, m, y, rfl, ?_⟩ + intro φ + rw [hg φ, hf φ] + exact hy φ + · rintro _ ⟨m, y, rfl, hy⟩ + have hle : |g| ≤ latticePSum p (fun i => delta p (y i)) := by + apply (free_le_iff p _ _).mpr + intro φ + rw [latticePSum_apply] + exact hy φ + calc + ‖g‖ ≤ ‖latticePSum p (fun i => delta p (y i))‖ := + HasSolidNorm.solid (hle.trans (le_abs_self _)) + _ ≤ scalarPSum p (fun i => ‖y i‖) := by + simpa only [one_mul, LinearIsometry.norm_map] using + (free_pConvex p (E := E)).2 m (fun i => delta p (y i)) + apply le_antisymm hu + let X := UniformSpace.Completion (MajorantSpace (E := E) p hp) + let completion : MajorantSpace (E := E) p hp →ₗᵢ[ℝ] X := UniformSpace.Completion.toComplₗᵢ + let S : E →L[ℝ] X := completion.toContinuousLinearMap.comp (majorantDelta p hp) + have hS : ‖S‖ ≤ 1 := by + apply S.opNorm_le_bound zero_le_one + intro y + change ‖(majorantDelta p hp y : X)‖ ≤ 1 * ‖y‖ + rw [UniformSpace.Completion.norm_coe] + exact ((majorantDelta p hp).le_opNorm y).trans + (mul_le_mul_of_nonneg_right (majorantDelta_norm_le p hp) (norm_nonneg _)) + obtain ⟨T, hT, hnT, _⟩ := universal_property_of_fvl_bound p S 1 zero_le_one (by + intro v + have h := fvl_lift_pConvex_norm_le p (majorantCompletion_pConvex p hp) S v + exact h.trans (mul_le_mul_of_nonneg_right (by simpa only [one_mul] using hS) (norm_nonneg _))) + let G := majorantCalculus p hp (fun i => majorantDelta p hp (x i)) H + have hG : majorantCost p (g : Dual E → ℝ) = ‖G‖ := by + change _ = majorantSeminorm p hp G + erw [majorantSeminorm_eq_cost] + congr 1 + exact funext (fun φ => (hg φ).trans (hf φ)) + have hTG : T g = (G : X) := by + let := isUniformlyCompleteVectorLattice_of_banachLattice X + have heq := PosHomFunction.eq_functionalCalculus_of_map_coordinate + (fun i => S (x i)) + (T.toVecLatHom.comp (PosHomFunction.functionalCalculus (fun i => delta p (x i)))) + (by + intro i + rw [VecLatHom.comp_apply, PosHomFunction.functionalCalculus_coordinate] + exact hT (x i)) + rw [show T g = PosHomFunction.functionalCalculus (fun i => S (x i)) H from + DFunLike.congr_fun heq H] + exact (majorantCompletion_calculus p hp _ H).symm + rw [hG, ← UniformSpace.Completion.norm_coe, ← hTG] + exact (T.toContinuousLinearMap.le_opNorm g).trans + (by simpa only [one_mul] using mul_le_mul_of_nonneg_right hnT (norm_nonneg g)) + +private theorem fvl_finite_calculus (p : Exponent) (v : FVL E) : + IsFiniteCalculusFunction (fvlFunction v) := by + obtain ⟨n, x, e, he⟩ := FVLv.exists_eval_of_eq v + refine ⟨n, x, LLexpr.eval PosHomFunction.coordinate e, ?_⟩ + intro φ + change freeEvaluation p φ (ofFVL p v) = + posHomEvaluation (fun i => φ (x i)) (LLexpr.eval PosHomFunction.coordinate e) + rw [← he, LLexpr.map_eval, LLexpr.map_eval, LLexpr.map_eval] + congr 1 + funext i + change ofFVL p (FVLv.of (x i)) φ = φ (x i) + rw [ofFVL_of] + rfl + +private theorem majorant_norm_proof (p : Exponent) (hp : p.IsFinite) (v : FVL E) : + ‖ofFVL p v‖ = majorantCost p (fvlFunction v) := by + have h := (finite_calculus_membership_proof p hp (fvlFunction v) (fvl_finite_calculus p v)).2 + change freeNormExt p (ofFVL p v) = _ at h + rw [freeNormExt_eq_norm] at h + have hc : 0 ≤ majorantCost p (fvlFunction v) := by + apply Real.sInf_nonneg + rintro _ ⟨m, x, rfl, _⟩ + exact scalarPSum_nonneg .. + have hreal := congrArg ENNReal.toReal h + simpa only [ENNReal.toReal_ofReal (norm_nonneg _), ENNReal.toReal_ofReal hc] using hreal + + +/-- The functional-calculus embedding assertion used by the majorant-norm proof. -/ +theorem finite_calculus_membership (p : Exponent) (hp : p.IsFinite) + (f : Dual E → ℝ) (hf : IsFiniteCalculusFunction f) : + InFree p f ∧ freeNormExt p f = ENNReal.ofReal (majorantCost p f) := + finite_calculus_membership_proof p hp f hf + +/-- Lemma 4.2, equation (4.1): the free p-norm of an algebraic element is the infimum +of the costs of finite p-sum majorants. A majorant is a finite family of vectors whose +evaluation p-sum dominates the element on the whole dual; its cost is the p-sum of +the vector norms. The exponent p is finite. -/ +theorem majorant_norm (p : Exponent) (hp : p.IsFinite) (v : FVL E) : + ‖ofFVL p v‖ = sInf {r : ℝ | ∃ (m : ℕ) (x : Fin m → E), + r = scalarPSum p (fun i => ‖x i‖) ∧ + ∀ φ : Dual E, |fvlFunction v φ| ≤ scalarPSum p (fun i => φ (x i))} := + majorant_norm_proof p hp v + +/-- Conjugate exponent, including p'=infinity when p=1. -/ +def conjugate (p : Exponent) : Exponent := ⟨(1 - p.1⁻¹)⁻¹, ENNReal.one_le_inv.mpr tsub_le_self⟩ + +/-- Equation (4.2): the image of the conjugate-exponent unit ball under the series map. +Using `HasSum` records convergence, including for arbitrary input sequences. -/ +def diskOfSequence (p : Exponent) (x : ℕ → E) : Set E := + {y | ∃ t : lp (fun _ : ℕ => ℝ) (conjugate p).1, + ‖t‖ ≤ 1 ∧ HasSum (fun n => t n • x n) y} + +/-- Section 4.1: summable disks for finite p; nonempty absolutely convex compact sets +at the endpoint p = infinity. -/ +def IsPCompactDisk (p : Exponent) (K : Set E) : Prop := + (p.IsFinite ∧ ∃ x : ℕ → E, + Summable (fun n => ‖x n‖ ^ p.1.toReal) ∧ K = diskOfSequence p x) ∨ + (p = Exponent.infinity ∧ K.Nonempty ∧ AbsConvex ℝ K ∧ IsCompact K) + +/-- For finite exponents, the revised definition retains the summable-sequence model. -/ +theorem isPCompactDisk_iff_of_finite (p : Exponent) (hp : p.IsFinite) (K : Set E) : + IsPCompactDisk p K ↔ ∃ x : ℕ → E, + Summable (fun n => ‖x n‖ ^ p.1.toReal) ∧ K = diskOfSequence p x := by + constructor + · rintro (⟨_, h⟩ | ⟨rfl, _⟩) + · exact h + · exact (lt_irrefl _ hp).elim + · exact fun h => Or.inl ⟨hp, h⟩ + +/-- Infinity-compact disks are precisely nonempty absolutely convex compact sets. -/ +theorem isPCompactDisk_infinity_iff (K : Set E) : + IsPCompactDisk Exponent.infinity K ↔ K.Nonempty ∧ AbsConvex ℝ K ∧ IsCompact K := by + simp [IsPCompactDisk, Exponent.IsFinite, Exponent.infinity] + +/-- Closing the absolutely convex hull of a nonempty compact set preserves its support. -/ +theorem compact_support_closedAbsConvexHull [CompleteSpace E] (K : Set E) + (hne : K.Nonempty) (hK : IsCompact K) : + IsPCompactDisk Exponent.infinity (closedAbsConvexHull ℝ K) ∧ + ∀ φ, support (closedAbsConvexHull ℝ K) φ = support K φ := by + have hc : IsCompact (closedAbsConvexHull ℝ K) := + isCompact_closedAbsConvexHull_of_totallyBounded hK.totallyBounded + have hn : (closedAbsConvexHull ℝ K).Nonempty := hne.mono subset_closedAbsConvexHull + refine ⟨(isPCompactDisk_infinity_iff _).mpr ⟨hn, absConvex_convexClosedHull, hc⟩, ?_⟩ + intro φ + apply le_antisymm + · have hsub : K ⊆ φ.toSeminorm.closedBall 0 (support K φ) := by + intro x hx + change ‖φ (x - 0)‖ ≤ support K φ + simpa only [sub_zero, Real.norm_eq_abs] using le_support K hK.isBounded φ hx + have hclosed : IsClosed (φ.toSeminorm.closedBall 0 (support K φ)) := by + change IsClosed {x | ‖φ (x - 0)‖ ≤ support K φ} + simpa only [sub_zero] using isClosed_le φ.continuous.norm continuous_const + have hbound := closedAbsConvexHull_min hsub + ⟨φ.toSeminorm.balanced_closedBall_zero _, φ.toSeminorm.convex_closedBall 0 _⟩ hclosed + apply csSup_le (hn.image _) + rintro _ ⟨x, hx, rfl⟩ + have hb := hbound hx + change ‖φ (x - 0)‖ ≤ support K φ at hb + simpa only [sub_zero, Real.norm_eq_abs] using hb + · apply csSup_le (hne.image _) + rintro _ ⟨x, hx, rfl⟩ + exact le_support _ hc.isBounded φ (subset_closedAbsConvexHull hx) + +/-- Auxiliary notion: subsets contained in a p-compact disk, for any exponent. -/ +def IsRelativelyPCompact (p : Exponent) (A : Set E) : Prop := + ∃ K : Set E, IsPCompactDisk p K ∧ A ⊆ K + +/-- The scalar series norm used by equation (4.3). -/ +def seriesPSum (p : Exponent) (a : ℕ → ℝ) : ℝ := + (∑' n, |a n| ^ p.1.toReal) ^ (1 / p.1.toReal) + +/-- Section 4.1: summability justifies the disk's series formula. -/ +theorem disk_series_summable [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (x : ℕ → E) (hx : Summable (fun n => ‖x n‖ ^ p.1.toReal)) + (t : lp (fun _ : ℕ => ℝ) (conjugate p).1) : + Summable (fun n => t n • x n) := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + by_cases hp1 : p.1 = 1 + · have hx' : Summable (fun n => ‖x n‖) := by simpa [hp1] using hx + apply Summable.of_norm + apply Summable.of_nonneg_of_le (fun n => norm_nonneg _) ?_ (hx'.mul_left ‖t‖) + intro n + rw [norm_smul] + exact mul_le_mul_of_nonneg_right + (lp.norm_apply_le_norm (ne_of_gt (zero_lt_one.trans_le (conjugate p).2)) t n) + (norm_nonneg _) + · have hp1' : 1 < p.1.toReal := by + exact_mod_cast (ENNReal.toReal_lt_toReal ENNReal.one_ne_top (ne_of_lt hp)).mpr + (lt_of_le_of_ne p.2 (Ne.symm hp1)) + have hconj : p.1.toReal.HolderConjugate (conjugate p).1.toReal := + (ENNReal.HolderConjugate.toReal_iff hp1').mpr + (ENNReal.HolderConjugate.inv_one_sub_inv' p.2) + let a : lp (fun _ : ℕ => ℝ) p.1 := + ⟨fun n => ‖x n‖, (memℓp_gen_iff hp0).mpr (by simpa using hx)⟩ + apply Summable.of_norm + convert (lp.summable_mul hconj a t) using 1 + ext n + simp [a, norm_smul, mul_comm] + +private theorem conjugate_holder (p : Exponent) (hp : p.IsFinite) (hp1 : p.1 ≠ 1) : + p.1.toReal.HolderConjugate (conjugate p).1.toReal := by + apply ENNReal.HolderConjugate.toReal_iff _ |>.mpr + (ENNReal.HolderConjugate.inv_one_sub_inv' p.2) + exact_mod_cast (ENNReal.toReal_lt_toReal ENNReal.one_ne_top (ne_of_lt hp)).mpr + (lt_of_le_of_ne p.2 hp1.symm) + +private theorem conjugate_mul_bound (p : Exponent) (hp : p.IsFinite) + (a : lp (fun _ : ℕ => ℝ) p.1) (t : lp (fun _ : ℕ => ℝ) (conjugate p).1) : + Summable (fun n => ‖t n‖ * ‖a n‖) ∧ + ∑' n, ‖t n‖ * ‖a n‖ ≤ ‖t‖ * ‖a‖ := by + by_cases hp1 : p.1 = 1 + · have ha : Summable (fun n => ‖a n‖) := by + simpa [hp1] using (lp.memℓp a).summable (by simp [hp1]) + have hpoint (n : ℕ) : ‖t n‖ * ‖a n‖ ≤ ‖t‖ * ‖a n‖ := + mul_le_mul_of_nonneg_right + (lp.norm_apply_le_norm (ne_of_gt (zero_lt_one.trans_le (conjugate p).2)) t n) + (norm_nonneg _) + refine ⟨Summable.of_nonneg_of_le (fun n => by positivity) hpoint (ha.mul_left ‖t‖), ?_⟩ + calc + _ ≤ ∑' n, ‖t‖ * ‖a n‖ := + Summable.tsum_le_tsum hpoint + (Summable.of_nonneg_of_le (fun n => by positivity) hpoint (ha.mul_left ‖t‖)) + (ha.mul_left ‖t‖) + _ = ‖t‖ * ‖a‖ := by + rw [tsum_mul_left, lp.norm_eq_tsum_rpow (by simp [hp1]) a] + simp [hp1] + · exact lp.tsum_mul_le_mul_norm (conjugate_holder p hp hp1).symm t a + +/-- The unit ball of the conjugate sequence space, on the common sequence carrier. -/ +def coefficientBall (q : Exponent) : Set (ℕ → ℝ) := + {t | ∃ a : lp (fun _ : ℕ => ℝ) q.1, ‖a‖ ≤ 1 ∧ ⇑a = t} + +private theorem coefficientBall_finite (q : Exponent) (hq : q.IsFinite) : + coefficientBall q = {t | ∀ s : Finset ℕ, ∑ i ∈ s, ‖t i‖ ^ q.1.toReal ≤ 1} := by + have hq0 : 0 < q.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le q.2)) (ne_of_lt hq) + ext t + constructor + · rintro ⟨a, ha, rfl⟩ s + exact (lp.sum_rpow_le_norm_rpow hq0 a s).trans + (by simpa using Real.rpow_le_rpow (norm_nonneg a) ha hq0.le) + · intro ht + have hs : Summable (fun i => ‖t i‖ ^ q.1.toReal) := + summable_of_sum_le (fun i => Real.rpow_nonneg (norm_nonneg _) _) ht + refine ⟨⟨t, (memℓp_gen_iff hq0).mpr hs⟩, ?_, rfl⟩ + exact lp.norm_le_of_forall_sum_le hq0 zero_le_one (by simpa using ht) + +private theorem coefficientBall_infinity : + coefficientBall Exponent.infinity = {t | ∀ i, ‖t i‖ ≤ 1} := by + ext t + constructor + · rintro ⟨a, ha, rfl⟩ i + exact (lp.norm_apply_le_norm (by simp [Exponent.infinity]) a i).trans ha + · intro ht + refine ⟨⟨t, memℓp_infty_iff.mpr ⟨1, ?_⟩⟩, ?_, rfl⟩ + · rintro _ ⟨i, rfl⟩ + exact ht i + · exact lp.norm_le_of_forall_le zero_le_one ht + +private theorem coefficientBall_compact (q : Exponent) : IsCompact (coefficientBall q) := by + have hclosed : IsClosed (coefficientBall q) := by + by_cases hq : q.1 = ⊤ + · have hq' : q = Exponent.infinity := Subtype.ext hq + rw [hq', coefficientBall_infinity] + simp_rw [ofPred_forall] + exact isClosed_iInter fun i => isClosed_le (continuous_apply i).norm continuous_const + · rw [coefficientBall_finite q (lt_top_iff_ne_top.mpr hq)] + simp_rw [ofPred_forall] + apply isClosed_iInter + intro s + exact isClosed_le (continuous_finsetSum _ (fun i _ => + (continuous_apply i).norm.rpow_const (fun _ => Or.inr ENNReal.toReal_nonneg))) + continuous_const + apply (isCompact_pi_infinite (fun _ : ℕ => + isCompact_Icc (a := (-1 : ℝ)) (b := 1))).of_isClosed_subset hclosed + rintro t ⟨a, ha, rfl⟩ i + exact abs_le.mp ((lp.norm_apply_le_norm (ne_of_gt (zero_lt_one.trans_le q.2)) a i).trans ha) + +section DiskSeries +variable [CompleteSpace E] + +private theorem coefficient_series_bound (p : Exponent) (hp : p.IsFinite) + (x : lp (fun _ : ℕ => E) p.1) (t : coefficientBall (conjugate p)) : + Summable (fun n => t.1 n • x n) ∧ ‖∑' n, t.1 n • x n‖ ≤ ‖x‖ := by + obtain ⟨a, ha, hta⟩ := t.2 + have h := conjugate_mul_bound p hp (lp.toNorm x) a + have hs : Summable (fun n => ‖a n • x n‖) := by + simpa [norm_smul, lp.toNorm] using h.1 + have htn : Summable (fun n => ‖t.1 n • x n‖) := by + simpa only [hta] using hs + have htx : Summable (fun n => t.1 n • x n) := by + simpa only [hta] using hs.of_norm + refine ⟨htx, ?_⟩ + calc + ‖∑' n, t.1 n • x n‖ ≤ ∑' n, ‖t.1 n • x n‖ := norm_tsum_le_tsum_norm htn + _ ≤ ‖a‖ * ‖x‖ := by + have h' := h.2 + rw [lp.norm_toNorm] at h' + simpa [norm_smul, lp.toNorm, hta] using h' + _ ≤ ‖x‖ := mul_le_of_le_one_left (norm_nonneg _) ha + +/-- Sum a sequence against a coefficient vector in the conjugate unit ball. -/ +def coefficientSeries (p : Exponent) (hp : p.IsFinite) + (t : coefficientBall (conjugate p)) : lp (fun _ : ℕ => E) p.1 →L[ℝ] E := + LinearMap.mkContinuous + { toFun := fun x => ∑' n, t.1 n • x n + map_add' := by + intro x y + simpa only [lp.coeFn_add, Pi.add_apply, smul_add] using + ((coefficient_series_bound p hp x t).1.tsum_add + (coefficient_series_bound p hp y t).1) + map_smul' := by + intro c x + change (∑' n, t.1 n • (c • x n)) = c • ∑' n, t.1 n • x n + calc + _ = ∑' n, c • (t.1 n • x n) := tsum_congr (fun n => smul_comm ..) + _ = _ := (coefficient_series_bound p hp x t).1.tsum_const_smul c } + 1 (fun x => by + change ‖∑' n, t.1 n • x n‖ ≤ 1 * ‖x‖ + simpa only [one_mul] using (coefficient_series_bound p hp x t).2) + +private theorem coefficientSeries_single (p : Exponent) (hp : p.IsFinite) + (t : coefficientBall (conjugate p)) (i : ℕ) (x : E) : + coefficientSeries p hp t (lp.single p.1 i x) = t.1 i • x := by + change (∑' n, t.1 n • (lp.single (E := fun _ : ℕ => E) p.1 i x) n) = _ + have h : (fun n => t.1 n • (lp.single (E := fun _ : ℕ => E) p.1 i x) n) = + Pi.single i (t.1 i • x) := by + ext n + by_cases hni : n = i + · subst n + simp + · simp [Pi.single_eq_of_ne hni] + rw [h] + rw [tsum_eq_single i (fun n hn => Pi.single_eq_of_ne hn _), Pi.single_eq_same] + +private theorem coefficientSeries_continuous (p : Exponent) (hp : p.IsFinite) + (x : lp (fun _ : ℕ => E) p.1) : + Continuous (fun t : coefficientBall (conjugate p) => coefficientSeries p hp t x) := by + let xN (N : ℕ) : lp (fun _ : ℕ => E) p.1 := + ∑ n ∈ Finset.range N, lp.single p.1 n (x n) + have hlim : Tendsto xN atTop (𝓝 x) := + (lp.hasSum_single (ne_of_lt hp) x).tendsto_sum_nat + have hcont (N : ℕ) : Continuous (fun t : coefficientBall (conjugate p) => + coefficientSeries p hp t (xN N)) := by + simp only [xN, map_sum, coefficientSeries_single] + exact continuous_finsetSum _ (fun n _ => + ((continuous_apply n).comp continuous_subtype_val).smul continuous_const) + have hu : TendstoUniformly (fun N (t : coefficientBall (conjugate p)) => + coefficientSeries p hp t (xN N)) (fun t => coefficientSeries p hp t x) atTop := by + apply Metric.tendstoUniformly_iff.mpr + intro ε hε + have hn : Tendsto (fun N => ‖x - xN N‖) atTop (𝓝 0) := by + simpa only [sub_self, norm_zero] using (tendsto_const_nhds (x := x) |>.sub hlim).norm + filter_upwards [hn.eventually_lt_const hε] with N hN t + rw [dist_eq_norm, ← map_sub] + exact (coefficient_series_bound p hp (x - xN N) t).2.trans_lt hN + exact hu.continuous (Frequently.of_forall hcont) + +end DiskSeries + +/-- Section 4.1: p-compact disks really are nonempty, absolutely convex and compact. -/ +theorem summable_disk_compact [CompleteSpace E] (p : Exponent) (K : Set E) + (hK : IsPCompactDisk p K) : K.Nonempty ∧ AbsConvex ℝ K ∧ IsCompact K := by + rcases hK with hK | ⟨_, hK⟩ + swap + · exact hK + obtain ⟨hp, x, hx, rfl⟩ := hK + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + let a : lp (fun _ : ℕ => E) p.1 := ⟨x, (memℓp_gen_iff hp0).mpr hx⟩ + have heq : diskOfSequence p x = + range (fun t : coefficientBall (conjugate p) => coefficientSeries p hp t a) := by + ext y + constructor + · rintro ⟨t, ht, hty⟩ + refine ⟨⟨t, t, ht, rfl⟩, ?_⟩ + exact hty.tsum_eq + · rintro ⟨t, rfl⟩ + obtain ⟨b, hb, hbt⟩ := t.2 + refine ⟨b, hb, ?_⟩ + change HasSum (fun n => b n • a n) (∑' n, t.1 n • a n) + simpa only [hbt] using (coefficient_series_bound p hp a t).1.hasSum + refine ⟨?_, ?_, ?_⟩ + · exact ⟨0, 0, by simp, by simp⟩ + · constructor + · intro c hc y hy + obtain ⟨z, ⟨t, ht, htz⟩, rfl⟩ := hy + refine ⟨c • t, ?_, ?_⟩ + · simpa only [norm_smul, mul_one] using + (mul_le_mul hc ht (norm_nonneg t) zero_le_one) + · simpa only [lp.coeFn_smul, Pi.smul_apply, smul_smul, smul_eq_mul] using htz.const_smul c + · intro y hy z hz c d hc hd hcd + obtain ⟨t, ht, hty⟩ := hy + obtain ⟨s, hs, hsz⟩ := hz + refine ⟨c • t + d • s, ?_, ?_⟩ + · refine (norm_add_le _ _).trans ?_ + rw [norm_smul, norm_smul, Real.norm_eq_abs, Real.norm_eq_abs, + abs_of_nonneg hc, abs_of_nonneg hd] + nlinarith + · simpa only [lp.coeFn_add, lp.coeFn_smul, Pi.add_apply, Pi.smul_apply, + add_smul, smul_smul, smul_eq_mul] using (hty.const_smul c).add (hsz.const_smul d) + · rw [heq] + let : CompactSpace (coefficientBall (conjugate p)) := + isCompact_iff_compactSpace.mp (coefficientBall_compact (conjugate p)) + exact isCompact_range (coefficientSeries_continuous p hp a) + +private theorem exists_conjugate_norming (p : Exponent) (hp : p.IsFinite) + (a : lp (fun _ : ℕ => ℝ) p.1) : + ∃ t : lp (fun _ : ℕ => ℝ) (conjugate p).1, + ‖t‖ ≤ 1 ∧ ∑' n, t n * a n = ‖a‖ := by + have hsign (r : ℝ) : ‖(SignType.sign r : ℝ)‖ ≤ 1 := by + rcases lt_trichotomy r 0 with h | rfl | h <;> simp_all + by_cases hp1 : p.1 = 1 + · have hq : (conjugate p).1 = ⊤ := by simp [conjugate, hp1] + let t : lp (fun _ : ℕ => ℝ) (conjugate p).1 := + ⟨fun n => (SignType.sign (a n) : ℝ), by + change Memℓp (fun n => (SignType.sign (a n) : ℝ)) _ + rw [hq, memℓp_infty_iff] + exact ⟨1, by rintro _ ⟨n, rfl⟩; exact hsign _⟩⟩ + refine ⟨t, ?_, ?_⟩ + · have hbound {q : ℝ≥0∞} (hq : q = ⊤) (t : lp (fun _ : ℕ => ℝ) q) + (ht : ∀ n, ‖t n‖ ≤ 1) : ‖t‖ ≤ 1 := by + subst q + exact lp.norm_le_of_forall_le zero_le_one ht + exact hbound hq t (fun n => hsign _) + · change (∑' n, (SignType.sign (a n) : ℝ) * a n) = ‖a‖ + simp only [sign_mul_self] + rw [lp.norm_eq_tsum_rpow (by simp [hp1]) a] + simp [hp1] + · by_cases ha : a = 0 + · subst a + exact ⟨0, by simp, by simp⟩ + have ha0 : 0 < ‖a‖ := norm_pos_iff.mpr ha + have hpq := conjugate_holder p hp hp1 + let b : lp (fun _ : ℕ => ℝ) p.1 := ‖a‖⁻¹ • a + have hb : ‖b‖ = 1 := by + simp [b, norm_smul, ha0.ne'] + let f (n : ℕ) : ℝ := (SignType.sign (b n) : ℝ) * |b n| ^ (p.1.toReal - 1) + have hf (n : ℕ) : ‖f n‖ = ‖b n‖ ^ (p.1.toReal - 1) := by + rcases lt_trichotomy (b n) 0 with hn | hn | hn + · simp [f, hn, abs_of_nonneg (Real.rpow_nonneg (abs_nonneg _) _)] + · simp [f, hn, Real.zero_rpow (sub_pos.mpr hpq.lt).ne'] + · simp [f, hn, abs_of_nonneg (Real.rpow_nonneg (abs_nonneg _) _)] + have hfp (n : ℕ) : ‖f n‖ ^ (conjugate p).1.toReal = ‖b n‖ ^ p.1.toReal := by + rw [hf, ← Real.rpow_mul (norm_nonneg _), hpq.sub_one_mul_conj] + let t : lp (fun _ : ℕ => ℝ) (conjugate p).1 := + ⟨f, (memℓp_gen_iff hpq.symm.pos).mpr (by + simpa only [hfp] using (lp.memℓp b).summable hpq.pos)⟩ + have ht : ‖t‖ = 1 := by + rw [lp.norm_eq_tsum_rpow hpq.symm.pos] + change (∑' n, ‖f n‖ ^ (conjugate p).1.toReal) ^ (1 / (conjugate p).1.toReal) = 1 + simp_rw [hfp] + rw [← lp.norm_rpow_eq_tsum hpq.pos b, hb] + simp + refine ⟨t, ht.le, ?_⟩ + have hprod (n : ℕ) : t n * b n = ‖b n‖ ^ p.1.toReal := by + change ((SignType.sign (b n) : ℝ) * |b n| ^ (p.1.toReal - 1)) * b n = _ + rw [mul_right_comm, sign_mul_self, mul_comm] + simpa only [sub_add_cancel, Real.norm_eq_abs] using + (Real.rpow_add_one' (y := p.1.toReal - 1) (abs_nonneg (b n)) + (by simpa only [sub_add_cancel] using hpq.ne_zero)).symm + have hab (n : ℕ) : a n = ‖a‖ * b n := by + simp [b, lp.coeFn_smul, smul_eq_mul, ha0.ne'] + calc + _ = ∑' n, ‖a‖ * (t n * b n) := tsum_congr (fun n => by rw [hab n]; ring) + _ = ‖a‖ * (∑' n, ‖b n‖ ^ p.1.toReal) := by simp_rw [hprod]; rw [tsum_mul_left] + _ = ‖a‖ := by rw [← lp.norm_rpow_eq_tsum hpq.pos b, hb]; simp + +/-- Apply a continuous dual functional coordinatewise to a p-summable vector sequence. -/ +def lpDualImage (p : Exponent) (x : lp (fun _ : ℕ => E) p.1) (φ : Dual E) : + lp (fun _ : ℕ => ℝ) p.1 := + ⟨fun n => φ (x n), ((lp.memℓp x).norm.const_mul ‖φ‖).mono (fun n => φ.le_opNorm (x n))⟩ + +private theorem lpSupport_freeNorm_le (p : Exponent) (hp : p.IsFinite) + (x : lp (fun _ : ℕ => E) p.1) : + freeNormExt p (fun φ => ‖lpDualImage p x φ‖) ≤ ENNReal.ofReal ‖x‖ := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + rw [freeNormExt, ite_eq_right (ne_of_lt hp)] + refine iSup_le fun n => iSup_le fun φ => iSup_le fun hφ => ENNReal.ofReal_le_ofReal ?_ + apply (Real.rpow_le_rpow_iff (scalarPSum_nonneg ..) (norm_nonneg x) hp0).mp + rw [scalarPSum_rpow p hp] + simp only [abs_norm, lp.norm_rpow_eq_tsum hp0] + have hs (i : Fin n) : Summable (fun k => ‖lpDualImage p x (φ i) k‖ ^ p.1.toReal) := + (lp.memℓp (lpDualImage p x (φ i))).summable hp0 + rw [← Summable.tsum_finsetSum (fun i _ => hs i)] + apply Summable.tsum_le_tsum ?_ (summable_sum (fun i _ => hs i)) ((lp.memℓp x).summable hp0) + intro k + change (∑ i, |φ i (x k)| ^ p.1.toReal) ≤ ‖x k‖ ^ p.1.toReal + rw [← scalarPSum_rpow p hp] + exact Real.rpow_le_rpow (scalarPSum_nonneg ..) + (normAdmissible_eval_le_norm p φ hφ (x k)) hp0.le + +private theorem support_disk_norm [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (x : lp (fun _ : ℕ => E) p.1) (φ : Dual E) : + support (diskOfSequence p x) φ = ‖lpDualImage p x φ‖ := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + have hx := (lp.memℓp x).summable hp0 + have hK := summable_disk_compact p (diskOfSequence p x) (Or.inl ⟨hp, x, hx, rfl⟩) + apply le_antisymm + · apply csSup_le (hK.1.image _) + rintro _ ⟨y, ⟨t, ht, hty⟩, rfl⟩ + have hval : φ y = ∑' n, t n * φ (x n) := by + simpa only [map_smul, smul_eq_mul] using (φ.hasSum hty).tsum_eq.symm + have hmul := conjugate_mul_bound p hp (lpDualImage p x φ) t + change |φ y| ≤ _ + rw [hval, ← Real.norm_eq_abs] + calc + _ ≤ ∑' n, ‖t n‖ * ‖φ (x n)‖ := by + simpa only [norm_mul] using + norm_tsum_le_tsum_norm (f := fun n => t n * φ (x n)) + (by simpa [norm_mul, lpDualImage] using hmul.1) + _ ≤ ‖t‖ * ‖lpDualImage p x φ‖ := hmul.2 + _ ≤ ‖lpDualImage p x φ‖ := mul_le_of_le_one_left (norm_nonneg _) ht + · obtain ⟨t, ht, hta⟩ := exists_conjugate_norming p hp (lpDualImage p x φ) + have htx := disk_series_summable p hp x hx t + have hy : (∑' n, t n • x n) ∈ diskOfSequence p x := ⟨t, ht, htx.hasSum⟩ + have hval : φ (∑' n, t n • x n) = ‖lpDualImage p x φ‖ := by + rw [φ.map_tsum htx] + simpa only [map_smul, smul_eq_mul, lpDualImage] using hta + simpa only [hval, abs_of_nonneg (norm_nonneg _)] using + le_support _ hK.2.2.isBounded φ hy + +/-- The homogeneous function given by the p-norm of a sequence’s dual evaluations. -/ +def lpSupport (p : Exponent) (hp : p.IsFinite) (x : lp (fun _ : ℕ => E) p.1) : + HP p E := + ⟨fun φ => ‖lpDualImage p x φ‖, by + constructor + · intro c hc φ + have heq : lpDualImage p x (c • φ) = c • lpDualImage p x φ := by + ext n + rfl + change ‖lpDualImage p x (c • φ)‖ = c * ‖lpDualImage p x φ‖ + rw [heq, norm_smul, Real.norm_eq_abs, abs_of_nonneg hc] + · exact (lpSupport_freeNorm_le p hp x).trans_lt ENNReal.ofReal_lt_top⟩ + +private theorem lpSupport_norm_le (p : Exponent) (hp : p.IsFinite) + (x : lp (fun _ : ℕ => E) p.1) : ‖lpSupport p hp x‖ ≤ ‖x‖ := + ENNReal.toReal_le_of_le_ofReal (norm_nonneg _) (lpSupport_freeNorm_le p hp x) + +private theorem lpSupport_lipschitz (p : Exponent) (hp : p.IsFinite) : + LipschitzWith 1 (lpSupport (E := E) p hp) := by + apply lipschitzWith_iff_norm_sub_le.mpr + intro x y + simp only [NNReal.coe_one, one_mul] + apply ENNReal.toReal_le_of_le_ofReal (norm_nonneg _) + refine (freeNormExt_mono_abs p (f := (lpSupport p hp x - lpSupport p hp y : HP p E)) + (g := fun φ => ‖lpDualImage p (x - y) φ‖) ?_).trans (lpSupport_freeNorm_le p hp (x - y)) + intro φ + have heq : lpDualImage p (x - y) φ = lpDualImage p x φ - lpDualImage p y φ := by + ext n + exact map_sub φ (x n) (y n) + change |‖lpDualImage p x φ‖ - ‖lpDualImage p y φ‖| ≤ |‖lpDualImage p (x - y) φ‖| + rw [abs_norm, heq] + exact abs_norm_sub_norm_le _ _ + +private theorem lpSupport_finite (p : Exponent) (hp : p.IsFinite) (x : ℕ → E) (N : ℕ) : + lpSupport p hp (∑ n ∈ Finset.range N, lp.single p.1 n (x n)) = + (latticePSum p (fun i : Fin N => delta p (x i))).1 := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + apply Subtype.ext + funext φ + change ‖lpDualImage p (∑ n ∈ Finset.range N, lp.single p.1 n (x n)) φ‖ = _ + rw [latticePSum_apply] + have heq : lpDualImage p (∑ n ∈ Finset.range N, lp.single p.1 n (x n)) φ = + ∑ n ∈ Finset.range N, lp.single p.1 n (φ (x n)) := by + ext k + change φ ((∑ n ∈ Finset.range N, lp.single p.1 n (x n)) k) = _ + simp only [lp.coeFn_sum, lp.coeFn_single, Finset.sum_apply, Finset.sum_pi_single] + split_ifs <;> simp + rw [heq] + change ‖∑ n ∈ Finset.range N, lp.single p.1 n (φ (x n))‖ = + scalarPSum p (fun i : Fin N => φ (x i)) + apply Real.rpow_left_injOn hp0.ne' (norm_nonneg _) (scalarPSum_nonneg ..) + dsimp only + rw [lp.norm_sum_single hp0, scalarPSum_rpow p hp] + simpa only [Real.norm_eq_abs] using + (Fin.sum_univ_eq_sum_range (fun n => |φ (x n)| ^ p.1.toReal) N).symm + +/-- Equation (4.3), including the free norm estimate and norm convergence of finite p-sums. -/ +theorem summable_support [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (x : ℕ → E) (hx : Summable (fun n => ‖x n‖ ^ p.1.toReal)) : + ∃ h : Free p E, + (∀ φ, h φ = support (diskOfSequence p x) φ ∧ h φ = seriesPSum p (fun n => φ (x n))) ∧ + ‖h‖ ≤ seriesPSum p (fun n => ‖x n‖) ∧ + Tendsto (fun N => latticePSum p (fun i : Fin N => delta p (x i))) atTop (𝓝 h) := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + let a : lp (fun _ : ℕ => E) p.1 := ⟨x, (memℓp_gen_iff hp0).mpr hx⟩ + have hlim : Tendsto + (fun N => (latticePSum p (fun i : Fin N => delta p (x i))).1) + atTop (𝓝 (lpSupport p hp a)) := by + simp_rw [← lpSupport_finite p hp] + exact (lpSupport_lipschitz p hp).continuous.tendsto a |>.comp + ((lp.hasSum_single (ne_of_lt hp) a).tendsto_sum_nat) + have hmem : lpSupport p hp a ∈ freeSublattice p E := + (VectorSublattice.isClosed_topologicalClosure _).mem_of_tendsto hlim + (Eventually.of_forall fun N => (latticePSum p (fun i : Fin N => delta p (x i))).2) + let h : Free p E := ⟨lpSupport p hp a, hmem⟩ + refine ⟨h, ?_, ?_, ?_⟩ + · intro φ + constructor + · exact (support_disk_norm p hp a φ).symm + · change ‖lpDualImage p a φ‖ = _ + rw [lp.norm_eq_tsum_rpow hp0] + rfl + · change ‖lpSupport p hp a‖ ≤ _ + have hnorm : ‖a‖ = seriesPSum p (fun n => ‖x n‖) := by + rw [lp.norm_eq_tsum_rpow hp0] + simp only [seriesPSum, abs_norm] + rfl + exact (lpSupport_norm_le p hp a).trans_eq hnorm + · exact tendsto_subtype_rng.mpr hlim + +/-- Section 4.1: continuous linear images of p-compact disks. -/ +theorem pCompactDisk_image [CompleteSpace F] + (p : Exponent) (K : Set F) (hK : IsPCompactDisk p K) (T : F →L[ℝ] E) : + IsPCompactDisk p (T '' K) := by + rcases hK with hK | ⟨rfl, hne, hac, hc⟩ + swap + · apply (isPCompactDisk_infinity_iff _).mpr + refine ⟨hne.image T, ⟨?_, hac.2.linear_image T.toLinearMap⟩, hc.image T.continuous⟩ + rw [balanced_iff_smul_mem] + rintro c hc y ⟨x, hx, rfl⟩ + exact ⟨c • x, hac.1.smul_mem hc hx, T.map_smul c x⟩ + obtain ⟨hp, x, hx, rfl⟩ := hK + apply Or.inl + refine ⟨hp, fun n => T (x n), ?_, ?_⟩ + · apply Summable.of_nonneg_of_le (fun n => Real.rpow_nonneg (norm_nonneg _) _) + (fun n => ?_) (hx.mul_left (‖T‖ ^ p.1.toReal)) + simpa only [Real.mul_rpow (norm_nonneg T) (norm_nonneg (x n))] using + Real.rpow_le_rpow (norm_nonneg _) (T.le_opNorm (x n)) ENNReal.toReal_nonneg + · ext y + constructor + · rintro ⟨z, ⟨t, ht, htz⟩, rfl⟩ + exact ⟨t, ht, by simpa using T.hasSum htz⟩ + · rintro ⟨t, ht, hty⟩ + have htx := disk_series_summable p hp x hx t + refine ⟨∑' n, t n • x n, ⟨t, ht, htx.hasSum⟩, ?_⟩ + exact (by simpa using T.hasSum htx.hasSum : + HasSum (fun n => t n • T (x n)) (T (∑' n, t n • x n))).unique hty + +/-- Section 4.1: one-dimensional disks and their support functions. -/ +private theorem segment_summableDisk [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) (x : E) : + IsPCompactDisk p {y | ∃ t : ℝ, |t| ≤ 1 ∧ y = t • x} ∧ + ∀ φ, support {y | ∃ t : ℝ, |t| ≤ 1 ∧ y = t • x} φ = |φ x| := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + have hq0 : 0 < (conjugate p).1 := zero_lt_one.trans_le (conjugate p).2 + have hsum (t : lp (fun _ : ℕ => ℝ) (conjugate p).1) : + HasSum (fun n => t n • (Pi.single 0 x : ℕ → E) n) (t 0 • x) := by + simpa using hasSum_single (f := fun n => t n • (Pi.single 0 x : ℕ → E) n) 0 + (fun n hn => by rw [Pi.single_eq_of_ne hn]; exact smul_zero _) + have heq : diskOfSequence p (Pi.single 0 x) = {y | ∃ t : ℝ, |t| ≤ 1 ∧ y = t • x} := by + ext y + constructor + · rintro ⟨t, ht, hty⟩ + exact ⟨t 0, (lp.norm_apply_le_norm hq0.ne' t 0).trans ht, hty.unique (hsum t)⟩ + · rintro ⟨c, hc, rfl⟩ + refine ⟨lp.single (conjugate p).1 0 c, ?_, ?_⟩ + · simpa only [lp.norm_single hq0, Real.norm_eq_abs] using hc + · simpa using hsum (lp.single (conjugate p).1 0 c) + have hK : IsPCompactDisk p {y | ∃ t : ℝ, |t| ≤ 1 ∧ y = t • x} := by + refine Or.inl ⟨hp, Pi.single 0 x, ?_, heq.symm⟩ + exact (lp.memℓp (lp.single (E := fun _ : ℕ => E) p.1 0 x)).summable hp0 + refine ⟨hK, ?_⟩ + intro φ + have hc := summable_disk_compact p _ hK + apply le_antisymm + · apply csSup_le (hc.1.image _) + rintro _ ⟨y, ⟨t, ht, rfl⟩, rfl⟩ + simpa only [map_smul, smul_eq_mul, abs_mul, one_mul] using + mul_le_mul_of_nonneg_right ht (abs_nonneg (φ x)) + · exact le_support _ hc.2.2.isBounded φ ⟨1, by norm_num, by simp⟩ + +/-- Every exponent admits line segments as compact disks, with the same support formula. -/ +theorem segment_pCompactDisk [CompleteSpace E] (p : Exponent) (x : E) : + IsPCompactDisk p {y | ∃ t : ℝ, |t| ≤ 1 ∧ y = t • x} ∧ + ∀ φ, support {y | ∃ t : ℝ, |t| ≤ 1 ∧ y = t • x} φ = |φ x| := by + by_cases hp : p.IsFinite + · exact segment_summableDisk p hp x + · have hpinf : p = Exponent.infinity := Subtype.ext (eq_top_iff.mpr (not_lt.mp hp)) + subst p + have hseg := segment_summableDisk Exponent.one (by simp [Exponent.IsFinite, Exponent.one]) x + exact ⟨(isPCompactDisk_infinity_iff _).mpr (summable_disk_compact _ _ hseg.1), hseg.2⟩ + +private theorem support_disk_rpow [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (x : ℕ → E) (hx : Summable (fun n => ‖x n‖ ^ p.1.toReal)) (φ : Dual E) : + support (diskOfSequence p x) φ ^ p.1.toReal = ∑' n, |φ (x n)| ^ p.1.toReal := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + let b : lp (fun _ : ℕ => E) p.1 := ⟨x, (memℓp_gen_iff hp0).mpr hx⟩ + rw [show support (diskOfSequence p x) φ = ‖lpDualImage p b φ‖ from support_disk_norm p hp b φ, + lp.norm_rpow_eq_tsum hp0] + rfl + +/-- Section 4.1: finite p-sums and positive multiples of support functions remain supports. -/ +theorem pCompactDisk_support_combination [CompleteSpace E] (p : Exponent) + (hp : p.IsFinite) (m : ℕ) (K : Fin m → Set E) + (hK : ∀ i, IsPCompactDisk p (K i)) (a : Fin m → ℝ) (ha : ∀ i, 0 ≤ a i) : + ∃ L : Set E, IsPCompactDisk p L ∧ + ∀ φ, support L φ = scalarPSum p (fun i => a i * support (K i) φ) := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + cases m with + | zero => + refine ⟨_, (segment_pCompactDisk p (0 : E)).1, ?_⟩ + intro φ + rw [(segment_pCompactDisk p (0 : E)).2 φ] + simp [scalarPSum, ne_of_lt hp, Real.zero_rpow (inv_ne_zero hp0.ne')] + | succ m => + choose x hx hKx using fun i => (isPCompactDisk_iff_of_finite p hp (K i)).mp (hK i) + let e : ℕ ≃ Fin (m + 1) × ℕ := Classical.choice inferInstance + let z (n : ℕ) : E := a (e n).1 • x (e n).1 (e n).2 + have hrow (i : Fin (m + 1)) : Summable (fun n => ‖a i • x i n‖ ^ p.1.toReal) := by + simpa only [norm_smul, Real.norm_eq_abs, abs_of_nonneg (ha i), + Real.mul_rpow (ha i) (norm_nonneg _)] using (hx i).mul_left (a i ^ p.1.toReal) + have hz : Summable (fun n => ‖z n‖ ^ p.1.toReal) := by + apply (e.summable_iff (f := fun k => ‖a k.1 • x k.1 k.2‖ ^ p.1.toReal)).mpr + exact (summable_prod_of_nonneg (fun _ => by positivity)).mpr + ⟨hrow, (hasSum_fintype _).summable⟩ + refine ⟨diskOfSequence p z, (Or.inl ⟨hp, z, hz, rfl⟩), ?_⟩ + intro φ + have hcomp := summable_disk_compact p (diskOfSequence p z) (Or.inl ⟨hp, z, hz, rfl⟩) + apply Real.rpow_left_injOn hp0.ne' + (apply_nonneg (supportSeminorm _ hcomp.1 hcomp.2.2.isBounded) φ) (scalarPSum_nonneg ..) + change support (diskOfSequence p z) φ ^ p.1.toReal = + (scalarPSum p (fun i => a i * support (K i) φ)) ^ p.1.toReal + rw [support_disk_rpow p hp z hz, scalarPSum_rpow p hp] + have hs : Summable (fun k : Fin (m + 1) × ℕ => |φ (a k.1 • x k.1 k.2)| ^ p.1.toReal) := by + apply e.summable_iff.mp + let b : lp (fun _ : ℕ => E) p.1 := ⟨z, (memℓp_gen_iff hp0).mpr hz⟩ + simpa only [Function.comp_def, lpDualImage, Real.norm_eq_abs] using + (lp.memℓp (lpDualImage p b φ)).summable hp0 + change (∑' n, |φ (a (e n).1 • x (e n).1 (e n).2)| ^ p.1.toReal) = _ + rw [e.tsum_eq (fun k => |φ (a k.1 • x k.1 k.2)| ^ p.1.toReal), hs.tsum_prod, tsum_fintype] + apply Finset.sum_congr rfl + intro i _ + have hci := summable_disk_compact p (K i) (hK i) + have hpos : 0 ≤ support (K i) φ := + apply_nonneg (supportSeminorm _ hci.1 hci.2.2.isBounded) φ + simp only [map_smul, smul_eq_mul, abs_mul, abs_of_nonneg (ha i), abs_of_nonneg hpos, + Real.mul_rpow (ha i) (abs_nonneg _), Real.mul_rpow (ha i) hpos, tsum_mul_left] + rw [hKx i, support_disk_rpow p hp (x i) (hx i)] + +private theorem seminorm_generate_eq {V ι : Type*} [AddCommGroup V] [Module ℝ V] + (q : SeminormFamily ℝ V ι) : + TopologicalSpace.generateFrom {U | ∃ i x r, 0 < r ∧ U = (q i).ball x r} = + q.moduleFilterBasis.topology := by + let t := TopologicalSpace.generateFrom {U | ∃ i x r, 0 < r ∧ U = (q i).ball x r} + let : TopologicalSpace V := q.moduleFilterBasis.topology + have hq : WithSeminorms q := ⟨rfl⟩ + let : IsTopologicalAddGroup V := hq.isTopologicalAddGroup + apply le_antisymm + · intro U hU + obtain hballs := (hq.isOpen_iff_mem_balls U).mp hU + let : TopologicalSpace V := t + change @IsOpen V t U + apply @isOpen_iff_forall_mem_open V t U |>.mpr + intro x hx + obtain ⟨s, r, hr, hsub⟩ := hballs x hx + refine ⟨(s.sup q).ball x r, hsub, ?_, (s.sup q).mem_ball_self hr⟩ + rw [Seminorm.ball_finset_sup_eq_iInter q s x hr] + apply isOpen_biInter_finset + intro i hi + exact TopologicalSpace.isOpen_generateFrom_of_mem ⟨i, x, r, hr, rfl⟩ + · apply TopologicalSpace.le_generateFrom_iff_subset_isOpen.mpr + rintro U ⟨i, x, r, hr, rfl⟩ + exact isOpen_lt + ((hq.continuous_seminorm i).comp (continuous_id.sub continuous_const)) continuous_const + +/-- The topology generated by translated support-seminorm balls. -/ +@[reducible] def supportTopology (D : Set (Set E)) : TopologicalSpace (Dual E) := + TopologicalSpace.generateFrom {U | ∃ K ∈ D, ∃ (φ : Dual E) (ε : ℝ), + 0 < ε ∧ U = {ψ | support K (ψ - φ) < ε}} + +/-- Section 4.1: uniform convergence on p-compact disks. -/ +@[reducible] def tauP (p : Exponent) (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] : + TopologicalSpace (Dual E) := supportTopology {K | IsPCompactDisk p K} + +/-- Section 4.1: uniform convergence on norm-compact sets, called bw* in the paper. -/ +@[reducible] def boundedWeakStar (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] : + TopologicalSpace (Dual E) := supportTopology {K | K.Nonempty ∧ IsCompact K} + +/-- The weak-star topology on the continuous dual, transported from Mathlib’s `WeakDual` +to the common carrier `Dual E` for comparison with `tauP` and `boundedWeakStar`. -/ +@[reducible] def weakStar (E : Type u) [NormedAddCommGroup E] [NormedSpace ℝ E] : + TopologicalSpace (Dual E) := + TopologicalSpace.induced (StrongDual.toWeakDual : Dual E → WeakDual ℝ E) inferInstance + +private theorem support_ball_open (D : Set (Set E)) (K : Set E) (hK : K ∈ D) + (φ : Dual E) (r : ℝ) (hr : 0 < r) : + @IsOpen (Dual E) (supportTopology D) {ψ | support K (ψ - φ) < r} := + TopologicalSpace.isOpen_generateFrom_of_mem ⟨K, hK, φ, r, hr, rfl⟩ + +/-- Section 4.1: topology containment; Lean orders topologies by reverse inclusion of opens. -/ +theorem topology_comparisons [CompleteSpace E] (p : Exponent) : + boundedWeakStar E ≤ tauP p E ∧ tauP p E ≤ weakStar E := by + constructor + · apply TopologicalSpace.generateFrom_anti + rintro U ⟨K, hK, φ, r, hr, rfl⟩ + have hc := summable_disk_compact p K hK + exact ⟨K, ⟨hc.1, hc.2.2⟩, φ, r, hr, rfl⟩ + · change tauP p E ≤ TopologicalSpace.induced StrongDual.toWeakDual _ + rw [← continuous_iff_le_induced] + let : TopologicalSpace (Dual E) := tauP p E + apply WeakDual.continuous_of_continuous_eval + intro x + change Continuous (fun φ : Dual E => φ x) + rw [continuous_iff_continuousAt] + intro φ₀ + rw [ContinuousAt, Metric.tendsto_nhds] + intro ε hε + have hseg := segment_pCompactDisk p x + have hopen := support_ball_open {K | IsPCompactDisk p K} _ hseg.1 φ₀ ε hε + have hmem := hopen.mem_nhds (show support {y | ∃ t : ℝ, |t| ≤ 1 ∧ y = t • x} + (φ₀ - φ₀) < ε by simpa only [sub_self, support_zero] using hε) + filter_upwards [hmem] with φ hφ + simpa only [mem_ofPred_eq, hseg.2, sub_apply, Real.dist_eq] using hφ + +/-- At the endpoint, the disk topology is uniform convergence on norm-compact sets. -/ +theorem tauP_infinity_eq_boundedWeakStar [CompleteSpace E] : + tauP Exponent.infinity E = boundedWeakStar E := by + apply le_antisymm + · apply TopologicalSpace.generateFrom_anti + rintro U ⟨K, ⟨hne, hK⟩, φ, r, hr, rfl⟩ + have hhull := compact_support_closedAbsConvexHull K hne hK + refine ⟨closedAbsConvexHull ℝ K, hhull.1, φ, r, hr, ?_⟩ + simp only [hhull.2] + · exact (topology_comparisons (E := E) Exponent.infinity).1 + +/-- Section 4.1: the support topology is a locally convex vector-space topology. -/ +theorem tauP_locallyConvex [CompleteSpace E] (p : Exponent) : + letI := tauP p E + IsTopologicalAddGroup (Dual E) ∧ ContinuousSMul ℝ (Dual E) ∧ + LocallyConvexSpace ℝ (Dual E) := by + let q : SeminormFamily ℝ (Dual E) {K : Set E // IsPCompactDisk p K} := + fun K => supportSeminorm K.1 (summable_disk_compact p K.1 K.2).1 + (summable_disk_compact p K.1 K.2).2.2.isBounded + have heq : tauP p E = q.moduleFilterBasis.topology := by + rw [← seminorm_generate_eq q] + unfold tauP supportTopology + congr 1 + ext U + constructor + · rintro ⟨K, hK, φ, r, hr, rfl⟩ + exact ⟨⟨K, hK⟩, φ, r, hr, rfl⟩ + · rintro ⟨K, φ, r, hr, rfl⟩ + exact ⟨K.1, K.2, φ, r, hr, rfl⟩ + let : TopologicalSpace (Dual E) := tauP p E + have hq : WithSeminorms q := ⟨heq⟩ + exact ⟨hq.isTopologicalAddGroup, hq.continuousSMul, hq.toLocallyConvexSpace⟩ + +private theorem disk_dominates_finite_families [CompleteSpace E] + (p : Exponent) (hp : p.IsFinite) (m : ℕ → ℕ) (x : ∀ n, Fin (m n) → E) + (hx : Summable (fun n => (scalarPSum p (fun i => ‖x n i‖)) ^ p.1.toReal)) : + ∃ K : Set E, IsPCompactDisk p K ∧ + ∀ n φ, scalarPSum p (fun i => φ (x n i)) ≤ support K φ := by + classical + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + let I := Σ n : ℕ, Fin (m n + 1) + let y : I → E := fun a => Fin.lastCases 0 (x a.1) a.2 + let e : ℕ ≃ I := Classical.choice inferInstance + let z : ℕ → E := y ∘ e + have hrow (n : ℕ) : (∑' j : Fin (m n + 1), ‖y ⟨n, j⟩‖ ^ p.1.toReal) = + scalarPSum p (fun i => ‖x n i‖) ^ p.1.toReal := by + simp only [tsum_fintype, Fin.sum_univ_castSucc, y, Fin.lastCases_castSucc, + Fin.lastCases_last, norm_zero, Real.zero_rpow hp0.ne', add_zero, + scalarPSum_rpow p hp, abs_norm] + have hy : Summable (fun a : I => ‖y a‖ ^ p.1.toReal) := by + apply (summable_sigma_of_nonneg (fun _ => by positivity)).mpr + exact ⟨fun _ => (hasSum_fintype _).summable, by simpa only [hrow] using hx⟩ + have hz : Summable (fun n => ‖z n‖ ^ p.1.toReal) := e.summable_iff.mpr hy + have hK : IsPCompactDisk p (diskOfSequence p z) := (Or.inl ⟨hp, z, hz, rfl⟩) + refine ⟨diskOfSequence p z, hK, ?_⟩ + intro n φ + have hc := summable_disk_compact p _ hK + apply (Real.rpow_le_rpow_iff (scalarPSum_nonneg ..) + (apply_nonneg (supportSeminorm _ hc.1 hc.2.2.isBounded) φ) hp0).mp + change (scalarPSum p (fun i => φ (x n i))) ^ p.1.toReal ≤ + support (diskOfSequence p z) φ ^ p.1.toReal + rw [support_disk_rpow p hp z hz] + have hφ : Summable (fun a : I => |φ (y a)| ^ p.1.toReal) := by + apply e.summable_iff.mp + let b : lp (fun _ : ℕ => E) p.1 := ⟨z, (memℓp_gen_iff hp0).mpr hz⟩ + have hh := (lp.memℓp (lpDualImage p b φ)).summable hp0 + change Summable (fun k => ‖φ (z k)‖ ^ p.1.toReal) at hh + simpa only [Real.norm_eq_abs, z, Function.comp_def] using hh + change _ ≤ ∑' k, |φ (y (e k))| ^ p.1.toReal + rw [e.tsum_eq (fun a : I => |φ (y a)| ^ p.1.toReal), hφ.tsum_sigma] + have hrowφ (n : ℕ) : (∑' j : Fin (m n + 1), |φ (y ⟨n, j⟩)| ^ p.1.toReal) = + scalarPSum p (fun i => φ (x n i)) ^ p.1.toReal := by + simp only [tsum_fintype, Fin.sum_univ_castSucc, y, Fin.lastCases_castSucc, + Fin.lastCases_last, map_zero, abs_zero, Real.zero_rpow hp0.ne', add_zero, + scalarPSum_rpow p hp] + rw [← hrowφ n] + exact hφ.sigma.le_tsum n (fun k _ => tsum_nonneg (fun j => by positivity)) + +/-- Every algebraic free-lattice element has a finite p-sum majorant when p is finite. +Consequently the set of costs in `majorant_norm` is nonempty and its infimum is meaningful. -/ +theorem fvl_majorant_nonempty (p : Exponent) (hp : p.IsFinite) (v : FVL E) : + {r : ℝ | ∃ (m : ℕ) (x : Fin m → E), r = scalarPSum p (fun i => ‖x i‖) ∧ + ∀ φ, |fvlFunction v φ| ≤ scalarPSum p (fun i => φ (x i))}.Nonempty := by + obtain ⟨n, x, H, hf⟩ := fvl_finite_calculus p v + obtain ⟨m, y, hy⟩ := (majorantCalculus p hp (fun i => majorantDelta p hp (x i)) H).2 + refine ⟨_, m, y, rfl, ?_⟩ + intro φ + rw [hf φ] + exact hy φ + +/-- Continuous evaluation on the free lattice at an arbitrary dual functional. -/ +def freeEvaluationCLM (p : Exponent) (φ : Dual E) : Free p E →L[ℝ] ℝ := + (hpEvaluation p φ).comp (freeSublattice p E).toSubmodule.subtypeL + +private theorem norm_sub_lt_quarter_step {X : Type*} [SeminormedAddCommGroup X] + (f : ℕ → X) (g : X) + (hf : ∀ n, ‖f n - g‖ < (1 / 16 : ℝ) * (1 / 4 : ℝ) ^ n) (n : ℕ) : + ‖f (n + 1) - f n‖ < (1 / 4 : ℝ) ^ (n + 1) := by + have hsub : f (n + 1) - f n = (f (n + 1) - g) - (f n - g) := by abel + rw [hsub] + have hnorm := norm_sub_le (f (n + 1) - g) (f n - g) + have h₁ := hf (n + 1) + have h₂ := hf n + rw [pow_succ] at h₁ ⊢ + nlinarith only [hnorm, h₁, h₂, pow_pos (by norm_num : (0 : ℝ) < 1 / 4) n] + +private theorem rapid_fvl_approximation (p : Exponent) (g : Free p E) : + ∃ V : ℕ → FVL E, Tendsto (fun n => ofFVL p (V n)) atTop (𝓝 g) ∧ + ∀ n, ‖ofFVL p (V (n + 1) - V n)‖ < (1 / 4 : ℝ) ^ (n + 1) := by + have hv (n : ℕ) : ∃ v : FVL E, ‖ofFVL p v - g‖ < (1 / 16 : ℝ) * (1 / 4 : ℝ) ^ n := by + obtain ⟨_, ⟨v, rfl⟩, hv⟩ := Metric.mem_closure_iff.mp (denseRange_ofFVL p g) + ((1 / 16 : ℝ) * (1 / 4 : ℝ) ^ n) (by positivity) + exact ⟨v, by simpa only [dist_eq_norm, norm_sub_rev] using hv⟩ + choose V hV using hv + have hVlim : Tendsto (fun n => ofFVL p (V n)) atTop (𝓝 g) := by + apply tendsto_iff_norm_sub_tendsto_zero.mpr + apply squeeze_zero (fun _ => norm_nonneg _) (fun n => (hV n).le) + simpa using (tendsto_pow_atTop_nhds_zero_of_lt_one (by norm_num : (0 : ℝ) ≤ 1 / 4) + (by norm_num : (1 / 4 : ℝ) < 1)).const_mul (1 / 16 : ℝ) + have hd (n : ℕ) : ‖ofFVL p (V (n + 1) - V n)‖ < (1 / 4 : ℝ) ^ (n + 1) := by + rw [map_sub] + exact norm_sub_lt_quarter_step (fun n => ofFVL p (V n)) g hV n + exact ⟨V, hVlim, hd⟩ + +private theorem geometric_approximation [CompleteSpace E] (p : Exponent) + (hp : p.IsFinite) (g : Free p E) : + ∃ (V : ℕ → FVL E) (K : Set E), IsPCompactDisk p K ∧ + ∀ n φ, |g φ - fvlFunction (V n) φ| ≤ (1 / 2 : ℝ) ^ n * support K φ := by + obtain ⟨V, hVlim, hd⟩ := rapid_fvl_approximation p g + have hm (n : ℕ) : ∃ (m : ℕ) (x : Fin m → E), + scalarPSum p (fun i => ‖x i‖) < (1 / 4 : ℝ) ^ (n + 1) ∧ + ∀ φ, |fvlFunction (V (n + 1) - V n) φ| ≤ scalarPSum p (fun i => φ (x i)) := by + obtain ⟨r, ⟨m, x, rfl, hx⟩, hr⟩ := exists_lt_of_csInf_lt + (fvl_majorant_nonempty p hp (V (n + 1) - V n)) + (by rw [← majorant_norm p hp]; exact hd n) + exact ⟨m, x, hr, hx⟩ + choose m x hx hdom using hm + let y : ∀ n, Fin (m n) → E := fun n i => (2 : ℝ) ^ (n + 1) • x n i + have hy (n : ℕ) : scalarPSum p (fun i => ‖y n i‖) ≤ (1 / 2 : ℝ) ^ (n + 1) := by + simp only [y, norm_smul, Real.norm_eq_abs, abs_of_pos (pow_pos (by norm_num : (0 : ℝ) < 2) _), + scalarPSum_smul] + calc + _ ≤ (2 : ℝ) ^ (n + 1) * (1 / 4 : ℝ) ^ (n + 1) := + mul_le_mul_of_nonneg_left (hx n).le (by positivity) + _ = _ := by rw [← mul_pow]; norm_num + have hp1 : 1 ≤ p.1.toReal := by exact_mod_cast ENNReal.toReal_mono (ne_of_lt hp) p.2 + have hysum : Summable (fun n => scalarPSum p (fun i => ‖y n i‖) ^ p.1.toReal) := by + apply Summable.of_nonneg_of_le (fun n => Real.rpow_nonneg (scalarPSum_nonneg ..) _) ?_ + (summable_geometric_two.mul_right (1 / 2 : ℝ)) + intro n + have hb : scalarPSum p (fun i => ‖y n i‖) ≤ 1 := (hy n).trans + (pow_le_one₀ (by norm_num) (by norm_num)) + exact (Real.rpow_le_self_of_le_one (scalarPSum_nonneg ..) hb hp1).trans + (by simpa only [pow_succ] using hy n) + obtain ⟨K, hK, hKbound⟩ := disk_dominates_finite_families p hp m y hysum + refine ⟨V, K, hK, ?_⟩ + intro n φ + have hstep (k : ℕ) : dist (fvlFunction (V k) φ) (fvlFunction (V (k + 1)) φ) ≤ + (1 / 2 : ℝ) ^ (k + 1) * support K φ := by + have hbound := hKbound k φ + simp only [y, map_smul, smul_eq_mul, scalarPSum_smul, + abs_of_pos (pow_pos (by norm_num : (0 : ℝ) < 2) _)] at hbound + have hvalue : fvlFunction (V (k + 1) - V k) φ = + fvlFunction (V (k + 1)) φ - fvlFunction (V k) φ := by + change ofFVL p (V (k + 1) - V k) φ = _ + rw [map_sub] + rfl + have hh := (mul_le_mul_of_nonneg_left (hdom k φ) + (by positivity : (0 : ℝ) ≤ 2 ^ (k + 1))).trans hbound + rw [hvalue] at hh + rw [Real.dist_eq, abs_sub_comm] + have hid : (1 / 2 : ℝ) ^ (k + 1) * 2 ^ (k + 1) = 1 := by rw [← mul_pow]; norm_num + have hmul := mul_le_mul_of_nonneg_left hh (by positivity : (0 : ℝ) ≤ (1 / 2 : ℝ) ^ (k + 1)) + simpa only [← mul_assoc, hid, one_mul] using hmul + have hlim : Tendsto (fun k => fvlFunction (V k) φ) atTop (𝓝 (g φ)) := + ((freeEvaluationCLM p φ).continuous.tendsto g).comp hVlim + have hsum : Summable (fun k => (1 / 2 : ℝ) ^ (k + 1) * support K φ) := by + simpa only [pow_succ, mul_assoc] using + summable_geometric_two.mul_right ((1 / 2 : ℝ) * support K φ) + have htail := dist_le_tsum_of_dist_le_of_tendsto _ hstep hsum hlim n + have htailval : (∑' k, (1 / 2 : ℝ) ^ (n + k + 1) * support K φ) = + (1 / 2 : ℝ) ^ n * support K φ := by + simp only [pow_succ, pow_add, mul_assoc] + rw [tsum_mul_left, tsum_mul_right, tsum_geometric_two] + ring + rw [htailval] at htail + simpa only [Real.dist_eq, abs_sub_comm] using htail + +private theorem scalarPSum_coord_le (p : Exponent) {n : ℕ} (a : Fin n → ℝ) (i : Fin n) : + |a i| ≤ scalarPSum p a := by + rw [scalarPSum_eq_piLp_norm] + exact PiLp.norm_apply_le (WithLp.toLp p.1 a) i + +private theorem finite_family_pCompactDisk [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + {n : ℕ} (x : Fin n → E) : ∃ K : Set E, IsPCompactDisk p K ∧ + ∀ φ, support K φ = scalarPSum p (fun i => φ (x i)) := by + let K : Fin n → Set E := fun i => {y | ∃ t : ℝ, |t| ≤ 1 ∧ y = t • x i} + obtain ⟨L, hL, hsup⟩ := pCompactDisk_support_combination p hp n K + (fun i => (segment_pCompactDisk p (x i)).1) (fun _ => 1) (fun _ => zero_le_one) + refine ⟨L, hL, ?_⟩ + intro φ + rw [hsup] + simp only [one_mul, K, (segment_pCompactDisk p _).2 φ, scalarPSum_abs] + +private theorem finite_calculus_local_control [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (v : FVL E) (φ₀ : Dual E) (ε : ℝ) (hε : 0 < ε) : + ∃ K : Set E, IsPCompactDisk p K ∧ + ∀ φ, support K (φ - φ₀) < 1 → |fvlFunction v φ - fvlFunction v φ₀| < ε := by + obtain ⟨n, x, H, hv⟩ := fvl_finite_calculus p v + obtain ⟨δ, hδ, hH⟩ := Metric.continuousAt_iff.mp + (H.1.continuous.continuousAt (x := fun i => φ₀ (x i))) ε hε + obtain ⟨K, hK, hsupport⟩ := finite_family_pCompactDisk p hp (fun i => δ⁻¹ • x i) + refine ⟨K, hK, ?_⟩ + intro φ hφ + rw [hv φ, hv φ₀] + apply (show dist (H (fun i => φ (x i))) (H (fun i => φ₀ (x i))) < ε from hH ?_) + rw [dist_eq_norm, pi_norm_lt_iff hδ] + intro i + rw [hsupport] at hφ + have hi := scalarPSum_coord_le p (fun j => (φ - φ₀) (δ⁻¹ • x j)) i + have hilt := hi.trans_lt hφ + simp only [map_smul, smul_eq_mul, sub_apply, abs_mul, abs_of_pos (inv_pos.mpr hδ)] at hilt + change |φ (x i) - φ₀ (x i)| < δ + exact (inv_mul_lt_one₀ hδ).mp hilt + +private theorem pair_support_domination [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (K L : Set E) (hK : IsPCompactDisk p K) (hL : IsPCompactDisk p L) : + ∃ D : Set E, IsPCompactDisk p D ∧ + ∀ φ, support K φ ≤ support D φ ∧ support L φ ≤ support D φ := by + obtain ⟨D, hD, hs⟩ := pCompactDisk_support_combination p hp 2 ![K, L] + (by intro i; fin_cases i <;> assumption) (fun _ => 1) (fun _ => zero_le_one) + refine ⟨D, hD, ?_⟩ + intro φ + rw [hs] + constructor + · simpa only [one_mul, Matrix.cons_val_zero] using + (le_abs_self (support K φ)).trans (scalarPSum_coord_le p (fun i => support (![K, L] i) φ) 0) + · simpa only [one_mul, Matrix.cons_val_one, Matrix.head_cons] using + (le_abs_self (support L φ)).trans (scalarPSum_coord_le p (fun i => support (![K, L] i) φ) 1) + +private theorem compact_local_control (p : Exponent) (f : Free p E) + (φ₀ : Dual E) (ε : ℝ) (hε : 0 < ε) : + ∃ K : Set E, K.Nonempty ∧ IsCompact K ∧ + ∀ φ, support K (φ - φ₀) < 1 → |f φ - f φ₀| < ε := by + let D : Set (WeakDual ℝ E) := {ψ | ε ≤ |f (ψ.toStrongDual + φ₀) - f φ₀|} + have hD (r : ℝ) : IsClosed (D ∩ weakDualNormBall r) := by + have hb : IsClosed (weakDualNormBall (E := E) r) := by + convert WeakDual.isClosed_closedBall (0 : Dual E) r using 1 + ext φ + simp [weakDualNormBall, Metric.mem_closedBall, dist_zero_right] + have hc : ContinuousOn (fun ψ : WeakDual ℝ E => f (ψ.toStrongDual + φ₀)) + (weakDualNormBall r) := by + exact (weakStar_continuous_bounded p f (r + ‖φ₀‖)).comp + ((continuous_id.add continuous_const : + Continuous (fun ψ : WeakDual ℝ E => ψ + StrongDual.toWeakDual φ₀)).continuousOn) + (fun ψ hψ => (norm_add_le _ _).trans (add_le_add hψ le_rfl)) + have hclosed : IsClosed {ψ : WeakDual ℝ E | ψ ∈ weakDualNormBall r ∧ + ε ≤ |f (ψ.toStrongDual + φ₀) - f φ₀|} := + hb.isClosed_le (f := fun _ => ε) continuousOn_const (hc.sub continuousOn_const).abs + convert hclosed using 1 + ext ψ + exact and_comm + have h0 : (0 : WeakDual ℝ E) ∉ D := by + change ¬ ε ≤ |f (0 + φ₀) - f φ₀| + simpa only [zero_add, sub_self, abs_zero] using hε.not_ge + obtain ⟨K, hK, hsep⟩ := weakDual_exists_compact_separator D hD h0 + refine ⟨insert 0 K, Set.insert_nonempty _ _, hK.insert 0, ?_⟩ + intro φ hφ + by_contra hn + have hd : StrongDual.toWeakDual (φ - φ₀) ∈ D := by + change ε ≤ |f ((φ - φ₀) + φ₀) - f φ₀| + simpa only [sub_add_cancel] using le_of_not_gt hn + obtain ⟨x, hx, hgt⟩ := hsep _ hd + have hle := le_support (insert 0 K) (hK.insert 0).isBounded (φ - φ₀) + (mem_insert_of_mem 0 hx) + exact hgt.not_ge (hle.trans hφ.le) + +/-- The finite-exponent case of the local-control lemma. -/ +private theorem finite_summable_local_control [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (g : Free p E) (φ₀ : Dual E) (ε : ℝ) (hε : 0 < ε) : + ∃ K : Set E, IsPCompactDisk p K ∧ + ∀ φ, support K (φ - φ₀) < 1 → |g φ - g φ₀| < ε := by + obtain ⟨V, K, hK, happrox⟩ := geometric_approximation p hp g + have hlim : Tendsto (fun n => (1 / 2 : ℝ) ^ n * (2 * support K φ₀ + 1)) + atTop (𝓝 0) := by + simpa only [zero_mul] using + summable_geometric_two.tendsto_atTop_zero.mul_const (2 * support K φ₀ + 1) + obtain ⟨N, hN⟩ := (hlim.eventually (gt_mem_nhds (half_pos hε))).exists + obtain ⟨L, hL, hlocal⟩ := finite_calculus_local_control p hp (V N) φ₀ (ε / 2) (half_pos hε) + obtain ⟨D, hD, hdom⟩ := pair_support_domination p hp K L hK hL + refine ⟨D, hD, ?_⟩ + intro φ hφ + have hρ : support K (φ - φ₀) < 1 := ((hdom _).1).trans_lt hφ + have hV := hlocal φ (((hdom _).2).trans_lt hφ) + have hc := summable_disk_compact p K hK + have hs := map_add_le_add (supportSeminorm K hc.1 hc.2.2.isBounded) (φ - φ₀) φ₀ + change support K ((φ - φ₀) + φ₀) ≤ support K (φ - φ₀) + support K φ₀ at hs + rw [sub_add_cancel] at hs + have htail := happrox N φ + have htail₀ := happrox N φ₀ + have htriangle := abs_sub_le (g φ) (fvlFunction (V N) φ) (g φ₀) + have htriangle' := abs_sub_le (fvlFunction (V N) φ) (fvlFunction (V N) φ₀) (g φ₀) + rw [abs_sub_comm (fvlFunction (V N) φ₀) (g φ₀)] at htriangle' + have hpw : 0 ≤ (1 / 2 : ℝ) ^ N := by positivity + nlinarith only [hN, hρ, hV, hs, htail, htail₀, htriangle, htriangle', hpw] + +/-- Lemma 4.3 (`lem:summable-local-control`): at any dual point and positive `epsilon`, +an element of `Free p E` is controlled on a neighborhood defined by one p-compact support +seminorm. The result includes p = ∞ and yields continuity for the topology `tauP p E`. -/ +theorem summable_local_control [CompleteSpace E] (p : Exponent) + (g : Free p E) (φ₀ : Dual E) (ε : ℝ) (hε : 0 < ε) : + ∃ K : Set E, IsPCompactDisk p K ∧ + ∀ φ, support K (φ - φ₀) < 1 → |g φ - g φ₀| < ε := by + by_cases hp : p.IsFinite + · exact finite_summable_local_control p hp g φ₀ ε hε + · have hpinf : p = Exponent.infinity := Subtype.ext (eq_top_iff.mpr (not_lt.mp hp)) + subst p + obtain ⟨K, hne, hK, hbound⟩ := compact_local_control Exponent.infinity g φ₀ ε hε + have hhull := compact_support_closedAbsConvexHull K hne hK + refine ⟨closedAbsConvexHull ℝ K, hhull.1, ?_⟩ + intro φ hφ + exact hbound φ (by simpa only [hhull.2] using hφ) + +/-- Every free-lattice function is continuous for uniform convergence on p-compact +disks. The local support bound from Lemma 4.3 gives a basic neighborhood for each +positive tolerance, including at the infinity endpoint. -/ +theorem free_tauP_continuous [CompleteSpace E] (p : Exponent) + (g : Free p E) : @Continuous (Dual E) ℝ (tauP p E) inferInstance g := by + let : TopologicalSpace (Dual E) := tauP p E + rw [continuous_iff_continuousAt] + intro φ₀ + rw [ContinuousAt, Metric.tendsto_nhds] + intro ε hε + obtain ⟨K, hK, hbound⟩ := summable_local_control p g φ₀ ε hε + have hopen := support_ball_open {K | IsPCompactDisk p K} K hK φ₀ 1 zero_lt_one + have hmem := hopen.mem_nhds (x := φ₀) + (by simp only [mem_ofPred_eq, sub_self, support_zero]; norm_num) + filter_upwards [hmem] with φ hφ + simpa only [Real.dist_eq] using hbound φ hφ + +/-- The support function of a p-compact disk belongs to the free lattice. -/ +theorem pCompact_support_inFree [CompleteSpace E] (p : Exponent) (K : Set E) + (hK : IsPCompactDisk p K) : InFree p (support K) := by + rcases hK with hK | ⟨rfl, _, _, hc⟩ + swap + · exact compact_support_inFree_infinity K hc + obtain ⟨hp, x, hx, rfl⟩ := hK + obtain ⟨h, hh, _, _⟩ := summable_support p hp x hx + exact ⟨h, fun φ => (hh φ).1⟩ + +/-- Corollary 4.4 (`cor:summable-approximation`): a homogeneous function belongs to +`Free p E`, for finite p, exactly when it can be uniformly approximated by +elements of the free vector lattice, with normalizer the support of a p-compact disk. -/ +theorem summable_approximation [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (g : Dual E → ℝ) (hg : PosHomogeneous g) : + InFree p g ↔ ∃ (V : ℕ → FVL E) (K : Set E) (ε : ℕ → ℝ), + IsPCompactDisk p K ∧ (∀ n, 0 < ε n) ∧ Tendsto ε atTop (𝓝 0) ∧ + ∀ n φ, |g φ - fvlFunction (V n) φ| ≤ ε n * support K φ := by + constructor + · rintro ⟨f, hf⟩ + obtain ⟨V, K, hK, hbound⟩ := geometric_approximation p hp f + exact ⟨V, K, (fun n => (1 / 2 : ℝ) ^ n), hK, (fun n => by positivity), + summable_geometric_two.tendsto_atTop_zero, fun n φ => by rw [← hf φ]; exact hbound n φ⟩ + · rintro ⟨V, K, ε, hK, hε, hlim, hbound⟩ + obtain ⟨h, hh⟩ := pCompact_support_inFree p K hK + let W : Free p E := ε 0 • h + |ofFVL p (V 0)| + have hfinite : freeNormExt p g < ⊤ := by + have hmono : freeNormExt p g ≤ freeNormExt p W := by + apply freeNormExt_mono_abs + intro φ + have hb := hbound 0 φ + have ht := abs_add_le (g φ - fvlFunction (V 0) φ) (fvlFunction (V 0) φ) + rw [sub_add_cancel] at ht + refine (ht.trans (add_le_add hb le_rfl)).trans ?_ + change ε 0 * support K φ + |fvlFunction (V 0) φ| ≤ + |ε 0 * h φ + (|fvlFunction (V 0) φ|)| + rw [hh] + exact le_abs_self _ + exact hmono.trans_lt (by rw [freeNormExt_eq_norm]; exact ENNReal.ofReal_lt_top) + let G : HP p E := ⟨g, hg, hfinite⟩ + have hnorm (n : ℕ) : ‖G - (ofFVL p (V n)).1‖ ≤ ε n * ‖h‖ := by + have hsolid : |G - (ofFVL p (V n)).1| ≤ |ε n • h.1| := by + intro φ + change |g φ - fvlFunction (V n) φ| ≤ |ε n * h φ| + rw [hh] + exact (hbound n φ).trans (le_abs_self _) + have hb := HasSolidNorm.solid hsolid + rw [norm_smul, Real.norm_eq_abs, abs_of_pos (hε n)] at hb + exact hb + have hGlim : Tendsto (fun n => (ofFVL p (V n)).1) atTop (𝓝 G) := by + apply tendsto_iff_norm_sub_tendsto_zero.mpr + apply squeeze_zero (fun n => norm_nonneg _) + (fun n => by simpa only [norm_sub_rev] using hnorm n) + simpa only [zero_mul] using hlim.mul_const ‖h‖ + have hG : G ∈ freeSublattice p E := + (VectorSublattice.isClosed_topologicalClosure _).mem_of_tendsto hGlim + (Filter.Eventually.of_forall (fun n => (ofFVL p (V n)).2)) + exact ⟨⟨G, hG⟩, fun φ => rfl⟩ + +/-- The final clause of Corollary 4.4: geometric errors may be prescribed. -/ +theorem summable_approximation_geometric [CompleteSpace E] (p : Exponent) + (hp : p.IsFinite) (g : Free p E) : + ∃ (V : ℕ → FVL E) (K : Set E), IsPCompactDisk p K ∧ + ∀ n φ, |g φ - fvlFunction (V n) φ| ≤ (2 : ℝ) ^ (-(n : ℤ)) * support K φ := by + obtain ⟨V, K, hK, hbound⟩ := geometric_approximation p hp g + refine ⟨V, K, hK, ?_⟩ + simpa only [zpow_neg, zpow_natCast, one_div, inv_pow] using hbound + +/-- Corollary 4.5 (`cor:summable-global-domination`): the absolute value of every + element of `Free p E` is dominated on the entire dual by the support of one p-compact +disk. Positive homogeneity turns local control at zero into this global estimate. +The statement also holds at the infinity endpoint. -/ +theorem summable_global_domination [CompleteSpace E] (p : Exponent) + (g : Free p E) : ∃ K : Set E, IsPCompactDisk p K ∧ ∀ φ, |g φ| ≤ support K φ := by + obtain ⟨K, hK, hbound⟩ := summable_local_control p g 0 1 zero_lt_one + refine ⟨K, hK, ?_⟩ + intro φ + have hc := summable_disk_compact p K hK + have hn : 0 ≤ support K φ := apply_nonneg (supportSeminorm K hc.1 hc.2.2.isBounded) φ + apply le_of_forall_gt + intro t ht + have ht0 : 0 < t := hn.trans_lt ht + have hb := hbound (t⁻¹ • φ) (by + rw [sub_zero, support_smul, abs_of_pos (inv_pos.mpr ht0)] + exact (inv_mul_lt_one₀ ht0).mpr ht) + have hg0 : g (0 : Dual E) = 0 := by + have h := g.1.2.1 0 (le_refl 0) (0 : Dual E) + simpa only [zero_smul, zero_mul] using h + rw [hg0, sub_zero, g.1.2.1 _ (inv_nonneg.mpr ht0.le), abs_mul, + abs_of_pos (inv_pos.mpr ht0)] at hb + exact (inv_mul_lt_one₀ ht0).mp hb + +/-- A family of free functions has a common positive patch if one positive lower +bound holds for all its members on a neighborhood of a dual point defined by the +support of a p-compact disk. `positive_patches` converts this local condition into +a strictly positive common lattice minorant for a nonempty positive family. -/ +def HasPositivePatch (p : Exponent) (A : Set (Free p E)) : Prop := + ∃ (φ₀ : Dual E) (ε : ℝ) (K : Set E), 0 < ε ∧ IsPCompactDisk p K ∧ + ∀ f ∈ A, ∀ φ, support K (φ - φ₀) < 1 → ε ≤ f φ + +private theorem patch_function_inFree [CompleteSpace E] (p : Exponent) (K : Set E) + (hK : IsPCompactDisk p K) (e : E) (φ₀ : Dual E) (ε : ℝ) : + InFree p (fun ψ => ε * max (ψ e - support ((fun x : E => x - φ₀ x • e) '' K) ψ) 0) := by + let Q : E →L[ℝ] E := ContinuousLinearMap.id ℝ E - φ₀.smulRight e + obtain ⟨s, hs⟩ := pCompact_support_inFree p (Q '' K) (pCompactDisk_image p K hK Q) + refine ⟨ε • ((delta p e - s) ⊔ 0), ?_⟩ + intro ψ + change ε * max (ψ e - s ψ) 0 = _ + rw [hs] + rfl + +/-- The explicit minorant `ε * max (ψ e - support (Q(K)) ψ) 0`, where +`Q x = x - φ₀ x • e`. Its membership in the free lattice uses only the compact-disk +condition. The normalization `φ₀ e = 1` and positivity of ε are retained as arguments +for the nonzero-value and minorization assertions in `patchMinorant_properties`. -/ +def patchMinorant [CompleteSpace E] (p : Exponent) (K : Set E) (hK : IsPCompactDisk p K) + (e : E) (φ₀ : Dual E) (_he : φ₀ e = 1) (ε : ℝ) (_hε : 0 < ε) : Free p E := + ⟨⟨fun ψ => ε * max (ψ e - support ((fun x : E => x - φ₀ x • e) '' K) ψ) 0, + by + obtain ⟨h, hh⟩ := patch_function_inFree p K hK e φ₀ ε + have heq : (fun ψ => ε * max (ψ e - support ((fun x : E => x - φ₀ x • e) '' K) ψ) 0) = + h.1.1 := funext (fun ψ => (hh ψ).symm) + change PosHomogeneous _ ∧ freeNormExt p _ < ⊤ + rw [heq] + exact h.1.2⟩, by + obtain ⟨h, hh⟩ := patch_function_inFree p K hK e φ₀ ε + refine Eq.mpr (congrArg (fun f : HP p E => f ∈ freeSublattice p E) ?_) h.2 + exact Subtype.ext (funext (fun ψ => (hh ψ).symm))⟩ + +/-- Proposition 4.6's constructive implication, with the claimed nonzero value. -/ +theorem patchMinorant_properties [CompleteSpace E] (p : Exponent) + (K : Set E) (hK : IsPCompactDisk p K) (e : E) (φ₀ : Dual E) (he : φ₀ e = 1) + (ε : ℝ) (hε : 0 < ε) : + patchMinorant p K hK e φ₀ he ε hε φ₀ = ε ∧ + 0 < patchMinorant p K hK e φ₀ he ε hε ∧ + ∀ f : Free p E, 0 ≤ f → + (∀ ψ, support K (ψ - φ₀) < 1 → ε ≤ f ψ) → + patchMinorant p K hK e φ₀ he ε hε ≤ f := by + let Q : E →L[ℝ] E := ContinuousLinearMap.id ℝ E - φ₀.smulRight e + let L := Q '' K + have hL := summable_disk_compact p L (pCompactDisk_image p K hK Q) + have hcK := summable_disk_compact p K hK + have hval (ψ : Dual E) : patchMinorant p K hK e φ₀ he ε hε ψ = + ε * max (ψ e - support L ψ) 0 := rfl + have hs₀ : support L φ₀ = 0 := by + apply le_antisymm + · apply csSup_le (hL.1.image _) + rintro _ ⟨_, ⟨x, hx, rfl⟩, rfl⟩ + simp [Q, he] + · exact apply_nonneg (supportSeminorm L hL.1 hL.2.2.isBounded) φ₀ + have hval₀ : patchMinorant p K hK e φ₀ he ε hε φ₀ = ε := by + simp [hval, he, hs₀] + refine ⟨hval₀, ?_, ?_⟩ + · apply lt_iff_le_not_ge.mpr + constructor + · apply (free_le_iff p _ _).mpr + intro ψ + change 0 ≤ patchMinorant p K hK e φ₀ he ε hε ψ + rw [hval] + exact mul_nonneg hε.le (le_max_right _ _) + · intro hle + have hb := (free_le_iff p _ _).mp hle φ₀ + change patchMinorant p K hK e φ₀ he ε hε φ₀ ≤ 0 at hb + rw [hval₀] at hb + exact hε.not_ge hb + · intro f hf hpatch + apply (free_le_iff p _ _).mpr + intro ψ + rw [hval] + by_cases hpos : 0 < ψ e - support L ψ + · have hspos : 0 ≤ support L ψ := + apply_nonneg (supportSeminorm L hL.1 hL.2.2.isBounded) ψ + have ht : 0 < ψ e := by linarith + have hpatch' : ε ≤ f ((ψ e)⁻¹ • ψ) := by + apply hpatch + calc + support K ((ψ e)⁻¹ • ψ - φ₀) ≤ (ψ e)⁻¹ * support L ψ := by + apply csSup_le (hcK.1.image _) + rintro _ ⟨x, hx, rfl⟩ + have hb := le_support L hL.2.2.isBounded ψ (mem_image_of_mem Q hx) + have heq : (((ψ e)⁻¹ • ψ) - φ₀) x = (ψ e)⁻¹ * ψ (Q x) := by + simp only [Q, sub_apply, ContinuousLinearMap.id_apply, + ContinuousLinearMap.smulRight_apply, map_sub, map_smul, smul_apply, smul_eq_mul] + field_simp + change |(((ψ e)⁻¹ • ψ) - φ₀) x| ≤ _ + rw [heq, abs_mul, abs_of_pos (inv_pos.mpr ht)] + exact mul_le_mul_of_nonneg_left hb (inv_nonneg.mpr ht.le) + _ < 1 := (inv_mul_lt_one₀ ht).mpr (by linarith) + have hhom := f.1.2.1 ((ψ e)⁻¹) (inv_nonneg.mpr ht.le) ψ + have hbound : ε * ψ e ≤ f ψ := by + rw [hhom] at hpatch' + have hh := mul_le_mul_of_nonneg_left hpatch' ht.le + simpa only [← mul_assoc, mul_inv_cancel₀ ht.ne', one_mul, mul_comm (ψ e) ε] using hh + rw [max_eq_left hpos.le] + exact (mul_le_mul_of_nonneg_left (by linarith) hε.le).trans hbound + · rw [max_eq_right (le_of_not_gt hpos), mul_zero] + exact (free_le_iff p _ _).mp hf ψ + +/-- Proposition 4.6 (`prop:positive-patches`): a nonempty family of positive free +functions has a strictly positive common lattice minorant exactly when it has a +common positive patch in the support topology. `patchMinorant` gives an explicit +minorant from the patch data, for every exponent including ∞. -/ +theorem positive_patches [CompleteSpace E] (p : Exponent) + (A : Set (Free p E)) (hne : A.Nonempty) (hpos : ∀ f ∈ A, 0 ≤ f) : + (∃ h : Free p E, 0 < h ∧ ∀ f ∈ A, h ≤ f) ↔ HasPositivePatch p A := by + constructor + · rintro ⟨h, hh, hbound⟩ + have hpoint : ∃ φ₀ : Dual E, 0 < h φ₀ := by + by_contra! hn + exact hh.not_ge ((free_le_iff p _ _).mpr hn) + obtain ⟨φ₀, hφ₀⟩ := hpoint + obtain ⟨K, hK, hlocal⟩ := summable_local_control p h φ₀ (h φ₀ / 2) (half_pos hφ₀) + refine ⟨φ₀, h φ₀ / 2, K, half_pos hφ₀, hK, ?_⟩ + intro f hf φ hφ + have hb := (free_le_iff p _ _).mp (hbound f hf) φ + have hd := (abs_lt.mp (hlocal φ hφ)).1 + linarith + · rintro ⟨φ₀, ε, K, hε, hK, hpatch⟩ + have hφ₀ : φ₀ ≠ 0 := by + intro hz + obtain ⟨f, hf⟩ := hne + have hb := hpatch f hf φ₀ (by simpa only [sub_self, support_zero] using zero_lt_one) + have hzero := f.1.2.1 0 (le_refl 0) (0 : Dual E) + rw [hz] at hb + simp only [zero_smul, zero_mul] at hzero + exact hε.not_ge (by simpa only [hzero] using hb) + obtain ⟨x, hx⟩ : ∃ x : E, φ₀ x ≠ 0 := by + by_contra! hx + exact hφ₀ (ContinuousLinearMap.ext hx) + let e : E := (φ₀ x)⁻¹ • x + have he : φ₀ e = 1 := by simp only [e, map_smul, smul_eq_mul, inv_mul_cancel₀ hx] + have hminor := patchMinorant_properties p K hK e φ₀ he ε hε + exact ⟨patchMinorant p K hK e φ₀ he ε hε, hminor.2.1, + fun f hf => hminor.2.2 f (hpos f hf) (hpatch f hf)⟩ + +/-- The net conclusion of Proposition 4.6 for a nonempty preordered index type. -/ +theorem positive_patches_net [CompleteSpace E] (p : Exponent) + {ι : Type v} [Preorder ι] [Nonempty ι] + (f : ι → Free p E) (hmono : Antitone f) (hpos : ∀ i, 0 ≤ f i) : + DecreasesToZero f ↔ ¬ HasPositivePatch p (Set.range f) := by + have hpatch := positive_patches p (Set.range f) (Set.range_nonempty f) + (by rintro _ ⟨i, rfl⟩; exact hpos i) + constructor + · intro hf hpch + obtain ⟨h, hh, hbound⟩ := hpatch.mpr hpch + exact hh.not_ge (hf.2.2 hbound) + · intro hnone + refine ⟨hmono, ⟨?_, ?_⟩⟩ + · rintro _ ⟨i, rfl⟩ + exact hpos i + · intro h hh + by_contra hn + apply hnone + apply hpatch.mp + refine ⟨h ⊔ 0, lt_iff_le_not_ge.mpr ⟨le_sup_right, ?_⟩, ?_⟩ + · exact fun hle => hn (le_sup_left.trans hle) + · rintro _ ⟨i, rfl⟩ + exact sup_le (hh (Set.mem_range_self i)) (hpos i) + +/-- Finite absolute suprema of evaluations in BanLat's free vector lattice. -/ +def finiteSupport (A : Finset E) : FVL E := + if h : A.Nonempty then A.sup' h (fun a => |FVLv.of a|) else 0 + +private theorem finiteSupport_apply (A : Finset E) (hA : A.Nonempty) (φ : Dual E) : + fvlFunction (finiteSupport A) φ = A.sup' hA (fun a => |φ a|) := by + classical + change (freeEvaluation Exponent.one φ) (ofFVL Exponent.one (finiteSupport A)) = _ + rw [finiteSupport, dite_eq_left hA, map_finset_sup', map_finset_sup'] + congr 1 + funext a + change (freeEvaluation Exponent.one φ) (ofFVL Exponent.one |FVLv.of a|) = |φ a| + rw [VecLatHom.map_abs, ofFVL_of, VecLatHom.map_abs] + rfl + +/-- A nonempty finite absolute supremum is the support of its generating finite set. -/ +theorem finiteSupport_support (A : Finset E) (hA : A.Nonempty) (φ : Dual E) : + fvlFunction (finiteSupport A) φ = support (A : Set E) φ := by + rw [finiteSupport_apply A hA] + apply le_antisymm + · exact Finset.sup'_le _ _ (fun a ha => le_support _ A.finite_toSet.isBounded φ ha) + · apply csSup_le (hA.to_set.image _) + rintro _ ⟨a, ha, rfl⟩ + exact Finset.le_sup' (fun a => |φ a|) ha + +private theorem ofFVL_map (p : Exponent) (T : F →L[ℝ] E) (v : FVL F) : + ofFVL p (FVLv.map T.toLinearMap v) = induced p T (ofFVL p v) := by + have heq : (ofFVL p).comp (FVLv.map T.toLinearMap) = + (induced p T).toVecLatHom.comp (ofFVL p) := by + apply FVLv.hom_ext + intro x + simp only [VecLatHom.comp_apply, FVLv.map_of, ofFVL_of] + exact ((induced_norm_generators p T).2 x).symm + exact DFunLike.congr_fun heq v + +/-- A finite family of vectors generates a p-compact disk contained in its linear span. +The disk’s support at φ is exactly the scalar p-sum of the values of φ on that family. +This supplies compact, finite-dimensional support majorants for algebraic free elements. -/ +theorem finite_family_disk_in_span (p : Exponent) (hp : p.IsFinite) + {n : ℕ} (x : Fin n → E) : ∃ K : Set E, IsPCompactDisk p K ∧ + K ⊆ Submodule.span ℝ (Set.range x) ∧ + ∀ φ, support K φ = scalarPSum p (fun i => φ (x i)) := by + let N := Submodule.span ℝ (Set.range x) + let : FiniteDimensional ℝ N := FiniteDimensional.span_of_finite (K := ℝ) (Set.finite_range x) + let y : Fin n → N := fun i => ⟨x i, Submodule.subset_span (Set.mem_range_self i)⟩ + obtain ⟨L, hL, hsupport⟩ := finite_family_pCompactDisk p hp y + refine ⟨N.subtypeL '' L, pCompactDisk_image p L hL N.subtypeL, ?_, ?_⟩ + · rintro _ ⟨a, _, rfl⟩ + exact a.2 + · intro φ + rw [support, compactSupport, Set.image_image] + exact hsupport (φ.comp N.subtypeL) + +/-- A bound on the absolute value of a linear functional on A extends to the absolutely +convex hull of A. This is the support estimate used when replacing finite sets by disks. -/ +theorem absConvexHull_eval_bound (A : Set E) (φ : Dual E) (r : ℝ) + (h : ∀ a ∈ A, |φ a| ≤ r) : ∀ a ∈ absConvexHull ℝ A, |φ a| ≤ r := by + have hsub : A ⊆ φ.toSeminorm.closedBall 0 r := by + intro a ha + change ‖φ (a - 0)‖ ≤ r + simpa only [sub_zero, Real.norm_eq_abs] using h a ha + intro a ha + have hmem := absConvexHull_min hsub + ⟨φ.toSeminorm.balanced_closedBall_zero r, φ.toSeminorm.convex_closedBall 0 r⟩ ha + change ‖φ (a - 0)‖ ≤ r at hmem + simpa only [sub_zero, Real.norm_eq_abs] using hmem + +private theorem bounded_coordinates_finite_net {ι : Type*} {N : ℕ} + (f : ι → Fin N → ℝ) (hf : ∀ i j, |f i j| ≤ 1) (ε : ℝ) (hε : 0 < ε) : + ∃ B : Finset ι, ∀ i, ∃ j ∈ B, ∀ k, |f i k - f j k| < ε := by + classical + have hb : Set.range f ⊆ Metric.closedBall 0 1 := by + rintro _ ⟨i, rfl⟩ + rw [Metric.mem_closedBall, dist_zero_right, pi_norm_le_iff_of_nonneg zero_le_one] + intro j + exact hf i j + have hc : IsCompact (closure (Set.range f)) := + (isCompact_closedBall (0 : Fin N → ℝ) 1).of_isClosed_subset isClosed_closure + (closure_minimal hb Metric.isClosed_closedBall) + obtain ⟨B, hB⟩ := hc.elim_finite_subcover (fun i => Metric.ball (f i) ε) + (fun _ => Metric.isOpen_ball) (by + intro a ha + obtain ⟨_, ⟨i, rfl⟩, hi⟩ := Metric.mem_closure_iff.mp ha ε hε + exact Set.mem_iUnion.mpr ⟨i, hi⟩) + refine ⟨B, ?_⟩ + intro i + obtain ⟨j, hj, hij⟩ := Set.mem_iUnion₂.mp (hB (subset_closure (Set.mem_range_self i))) + refine ⟨j, hj, fun k => ?_⟩ + exact (dist_le_pi_dist (f i) (f j) k).trans_lt hij + +private theorem coefficientSeries_eval_le [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (x : lp (fun _ : ℕ => E) p.1) (t : coefficientBall (conjugate p)) (φ : Dual E) : + |φ (coefficientSeries p hp t x)| ≤ lpSupport p hp x φ := by + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + have hK := summable_disk_compact p (diskOfSequence p x) + (Or.inl ⟨hp, x, (lp.memℓp x).summable hp0, rfl⟩) + change |φ (coefficientSeries p hp t x)| ≤ ‖lpDualImage p x φ‖ + rw [← support_disk_norm p hp x φ] + apply le_support _ hK.2.2.isBounded φ + obtain ⟨b, hb, hbt⟩ := t.2 + refine ⟨b, hb, ?_⟩ + change HasSum (fun n => b n • x n) (∑' n, t.1 n • x n) + simpa only [hbt] using (coefficient_series_bound p hp x t).1.hasSum + +private theorem finite_subset_support_approx [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (A K : Set E) (hA : A.Nonempty) (hAK : A ⊆ K) (hK : IsPCompactDisk p K) + (ε : ℝ) (hε : 0 < ε) : + ∃ B : Finset E, B.Nonempty ∧ (↑B : Set E) ⊆ A ∧ ∃ W : HP p E, + ‖W‖ < ε ∧ ∀ φ, |support A φ - fvlFunction (finiteSupport B) φ| ≤ W φ := by + classical + obtain ⟨x, hx, rfl⟩ := (isPCompactDisk_iff_of_finite p hp K).mp hK + have hp0 : 0 < p.1.toReal := ENNReal.toReal_pos + (ne_of_gt (zero_lt_one.trans_le p.2)) (ne_of_lt hp) + let a : lp (fun _ : ℕ => E) p.1 := ⟨x, (memℓp_gen_iff hp0).mpr hx⟩ + have hrep (b : A) : ∃ t : coefficientBall (conjugate p), + coefficientSeries p hp t a = (b : E) := by + obtain ⟨t, ht, htb⟩ := hAK b.2 + exact ⟨⟨t, t, ht, rfl⟩, htb.tsum_eq⟩ + choose t ht using hrep + let aN (N : ℕ) : lp (fun _ : ℕ => E) p.1 := ∑ i : Fin N, lp.single p.1 i (a i) + have hlim : Tendsto aN atTop (𝓝 a) := by + have heq (N : ℕ) : aN N = ∑ i ∈ Finset.range N, lp.single p.1 i (a i) := + Fin.sum_univ_eq_sum_range (fun i => lp.single p.1 i (a i)) N + change Tendsto (fun N => aN N) atTop (𝓝 a) + simp_rw [heq] + exact (lp.hasSum_single (ne_of_lt hp) a).tendsto_sum_nat + have htail : Tendsto (fun N => ‖a - aN N‖) atTop (𝓝 0) := by + simpa only [sub_self, norm_zero] using ((tendsto_const_nhds (x := a)).sub hlim).norm + obtain ⟨N, hN⟩ := (htail.eventually_lt_const (by positivity : 0 < ε / 4)).exists + let z := a - aN N + let S : ℝ := ∑ i : Fin N, ‖a i‖ + have hS : 0 ≤ S := Finset.sum_nonneg (fun _ _ => norm_nonneg _) + let η := ε / (2 * (S + 1)) + have hη : 0 < η := div_pos hε (mul_pos (by norm_num) (by linarith)) + obtain ⟨B, hB⟩ := bounded_coordinates_finite_net + (fun b : A => fun i : Fin N => (t b).1 i) (fun b i => by + obtain ⟨c, hc, hct⟩ := (t b).2 + rw [← hct] + exact (lp.norm_apply_le_norm (ne_of_gt (zero_lt_one.trans_le (conjugate p).2)) c i).trans hc) + η hη + have hBne : B.Nonempty := by + obtain ⟨b, hb, _⟩ := hB ⟨hA.some, hA.some_mem⟩ + exact ⟨b, hb⟩ + let C := B.image (fun b : A => (b : E)) + have hC : C.Nonempty := hBne.image _ + have hCA : (↑C : Set E) ⊆ A := by + rintro _ hc + obtain ⟨b, _, rfl⟩ := Finset.mem_image.mp hc + exact b.2 + let U : Free p E := ∑ i : Fin N, |delta p (a i)| + let W : HP p E := η • U.1 + (2 : ℝ) • lpSupport p hp z + refine ⟨C, hC, hCA, W, ?_, ?_⟩ + · have hU : ‖U‖ ≤ S := by + calc + ‖U‖ ≤ ∑ i : Fin N, ‖|delta p (a i)|‖ := norm_sum_le _ _ + _ = S := by simp only [norm_abs_eq_norm, LinearIsometry.norm_map, S] + have hηS : η * S < ε / 2 := by + have heq : η * (S + 1) = ε / 2 := by dsimp [η]; field_simp + nlinarith + have hb := norm_add_le (η • U.1) ((2 : ℝ) • lpSupport p hp z) + rw [norm_smul, norm_smul, Real.norm_eq_abs, abs_of_pos hη] at hb + have hz := lpSupport_norm_le p hp z + change ‖z‖ < ε / 4 at hN + change ‖U.1‖ ≤ S at hU + norm_num only [Real.norm_eq_abs, abs_of_pos (by norm_num : (0 : ℝ) < 2)] at hb + exact hb.trans_lt (by nlinarith [mul_le_mul_of_nonneg_left hU hη.le]) + · intro φ + have hW : W φ = η * (∑ i : Fin N, |φ (a i)|) + 2 * lpSupport p hp z φ := by + have hU : U φ = ∑ i : Fin N, |φ (a i)| := by + change freeEvaluation p φ (∑ i : Fin N, |delta p (a i)|) = _ + rw [map_sum] + apply Finset.sum_congr rfl + intro i _ + rw [VecLatHom.map_abs] + rfl + change η * U φ + 2 * lpSupport p hp z φ = _ + rw [hU] + have hdec (b : A) : φ (b : E) = + (∑ i : Fin N, (t b).1 i * φ (a i)) + φ (coefficientSeries p hp (t b) z) := by + calc + φ (b : E) = φ (coefficientSeries p hp (t b) (aN N + z)) := by + rw [show aN N + z = a by dsimp [z]; abel, ht b] + _ = _ := by + simp only [map_add, aN, map_sum, coefficientSeries_single, map_smul, smul_eq_mul] + have hclose (b c : A) (hbc : ∀ i : Fin N, |(t b).1 i - (t c).1 i| < η) : + |φ (b : E) - φ (c : E)| ≤ W φ := by + have hh : |(∑ i : Fin N, (t b).1 i * φ (a i)) - + (∑ i : Fin N, (t c).1 i * φ (a i))| ≤ η * ∑ i : Fin N, |φ (a i)| := by + rw [← Finset.sum_sub_distrib, Finset.mul_sum] + apply (Finset.abs_sum_le_sum_abs _ _).trans + apply Finset.sum_le_sum + intro i _ + rw [← sub_mul, abs_mul] + exact mul_le_mul_of_nonneg_right (hbc i).le (abs_nonneg _) + have htb := coefficientSeries_eval_le p hp z (t b) φ + have htc := coefficientSeries_eval_le p hp z (t c) φ + rw [hdec b, hdec c, hW] + have htri := abs_add_le + ((∑ i : Fin N, (t b).1 i * φ (a i)) - (∑ i : Fin N, (t c).1 i * φ (a i))) + (φ (coefficientSeries p hp (t b) z) - φ (coefficientSeries p hp (t c) z)) + have httri := abs_sub (φ (coefficientSeries p hp (t b) z)) + (φ (coefficientSeries p hp (t c) z)) + have heq : ((∑ i : Fin N, (t b).1 i * φ (a i)) + φ (coefficientSeries p hp (t b) z)) - + ((∑ i : Fin N, (t c).1 i * φ (a i)) + φ (coefficientSeries p hp (t c) z)) = + ((∑ i : Fin N, (t b).1 i * φ (a i)) - (∑ i : Fin N, (t c).1 i * φ (a i))) + + (φ (coefficientSeries p hp (t b) z) - φ (coefficientSeries p hp (t c) z)) := by ring + rw [heq] + linarith + have hAbounded : Bornology.IsBounded A := + (summable_disk_compact p _ (Or.inl ⟨hp, x, hx, rfl⟩)).2.2.isBounded.subset hAK + have hbelow : fvlFunction (finiteSupport C) φ ≤ support A φ := by + rw [finiteSupport_apply C hC] + exact Finset.sup'_le _ _ (fun c hc => le_support A hAbounded φ (hCA hc)) + rw [abs_of_nonneg (sub_nonneg.mpr hbelow)] + apply sub_le_iff_le_add.mpr + apply csSup_le (hA.image _) + rintro _ ⟨b, hb, rfl⟩ + obtain ⟨c, hc, hbc⟩ := hB ⟨b, hb⟩ + have hcC : (c : E) ∈ C := Finset.mem_image.mpr ⟨c, hc, rfl⟩ + have hfc : |φ (c : E)| ≤ fvlFunction (finiteSupport C) φ := by + rw [finiteSupport_apply C hC] + exact Finset.le_sup' (fun c => |φ c|) hcC + have hd := hclose ⟨b, hb⟩ c hbc + have htri := abs_sub_le (φ b) (φ (c : E)) 0 + simp only [sub_zero] at htri + linarith + +/-- Lemma 4.7 (`lem:subsets-summable-disk`): the support of a nonempty subset A of +a p-compact disk belongs to `Free p E` for finite p. It lies in the norm-closed +sublattice generated by evaluations at A and is the supremum and norm limit of +increasing finite-support functions with generators in A. -/ +theorem subsets_summable_disk [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) (A K : Set E) + (hA : A.Nonempty) (hAK : A ⊆ K) (hK : IsPCompactDisk p K) : + ∃ h : Free p E, (∀ φ, h φ = support A φ) ∧ + h ∈ (VectorSublattice.generated (delta p '' A)).topologicalClosure ∧ + ∃ B : ℕ → Finset E, Monotone B ∧ + (∀ n, (B n).Nonempty ∧ (↑(B n) : Set E) ⊆ A) ∧ + IsLUB (Set.range fun n => ofFVL p (finiteSupport (B n))) h ∧ + Tendsto (fun n => ofFVL p (finiteSupport (B n))) atTop (𝓝 h) := by + classical + have hcK := summable_disk_compact p K hK + have hbA := hcK.2.2.isBounded.subset hAK + have hmono (φ : Dual E) : support A φ ≤ support K φ := by + apply csSup_le (hA.image _) + rintro _ ⟨a, ha, rfl⟩ + exact le_support K hcK.2.2.isBounded φ (hAK ha) + obtain ⟨H, hH⟩ := pCompact_support_inFree p K hK + have hfinite : freeNormExt p (support A) < ⊤ := by + apply lt_of_le_of_lt (b := freeNormExt p H) + · apply freeNormExt_mono_abs + intro φ + have hnonneg : 0 ≤ support A φ := apply_nonneg (supportSeminorm A hA hbA) φ + rw [abs_of_nonneg hnonneg] + exact (hmono φ).trans (by rw [hH]; exact le_abs_self _) + · rw [freeNormExt_eq_norm] + exact ENNReal.ofReal_lt_top + let G : HP p E := ⟨support A, (by + intro c hc φ + rw [support_smul, abs_of_nonneg hc]), hfinite⟩ + let ε : ℕ → ℝ := fun n => (1 / 2 : ℝ) ^ n + have hε (n : ℕ) : 0 < ε n := by dsimp [ε]; positivity + have hεlim : Tendsto ε atTop (𝓝 0) := summable_geometric_two.tendsto_atTop_zero + choose C hC hCA W hW happrox using + fun n => finite_subset_support_approx p hp A K hA hAK hK (ε n) (hε n) + let B (n : ℕ) : Finset E := (Finset.range (n + 1)).biUnion C + have hCB (n : ℕ) : C n ⊆ B n := + Finset.subset_biUnion_of_mem C (Finset.mem_range.mpr (Nat.lt_succ_self n)) + have hBm : Monotone B := fun n m hnm => + Finset.biUnion_subset_biUnion_of_subset_left C (Finset.range_mono (Nat.add_le_add_right hnm 1)) + have hBn (n : ℕ) : (B n).Nonempty := (hC n).mono (hCB n) + have hBA (n : ℕ) : (↑(B n) : Set E) ⊆ A := by + intro a ha + obtain ⟨i, _, hi⟩ := Finset.mem_biUnion.mp ha + exact hCA i hi + let V (n : ℕ) : Free p E := ofFVL p (finiteSupport (B n)) + have hVle (n : ℕ) (φ : Dual E) : V n φ ≤ support A φ := by + change fvlFunction (finiteSupport (B n)) φ ≤ _ + rw [finiteSupport_apply _ (hBn n)] + exact Finset.sup'_le _ _ (fun b hb => le_support A hbA φ (hBA n hb)) + have hVm : Monotone V := by + intro n m hnm + apply (free_le_iff p _ _).mpr + intro φ + change fvlFunction (finiteSupport (B n)) φ ≤ fvlFunction (finiteSupport (B m)) φ + rw [finiteSupport_apply _ (hBn n), finiteSupport_apply _ (hBn m)] + exact Finset.sup'_le _ _ (fun b hb => Finset.le_sup' (fun b => |φ b|) (hBm hnm hb)) + have hnorm (n : ℕ) : ‖G - (V n).1‖ < ε n := by + apply lt_of_le_of_lt (b := ‖W n‖) ?_ (hW n) + apply HasSolidNorm.solid + intro φ + change |support A φ - V n φ| ≤ |W n φ| + rw [abs_of_nonneg (sub_nonneg.mpr (hVle n φ))] + have hCV : fvlFunction (finiteSupport (C n)) φ ≤ V n φ := by + change fvlFunction (finiteSupport (C n)) φ ≤ fvlFunction (finiteSupport (B n)) φ + rw [finiteSupport_apply _ (hC n), finiteSupport_apply _ (hBn n)] + exact Finset.sup'_le _ _ (fun c hc => Finset.le_sup' (fun c => |φ c|) (hCB n hc)) + exact (sub_le_sub_left hCV _).trans ((le_abs_self _).trans + ((happrox n φ).trans (le_abs_self _))) + have hlim : Tendsto (fun n => (V n).1) atTop (𝓝 G) := by + apply tendsto_iff_norm_sub_tendsto_zero.mpr + apply squeeze_zero (fun n => norm_nonneg _) (fun n => ?_) hεlim + simpa only [norm_sub_rev] using (hnorm n).le + have hG : G ∈ freeSublattice p E := + (VectorSublattice.isClosed_topologicalClosure _).mem_of_tendsto hlim + (Eventually.of_forall (fun n => (V n).2)) + let g : Free p E := ⟨G, hG⟩ + have hVlim : Tendsto V atTop (𝓝 g) := tendsto_subtype_rng.mpr hlim + let L := VectorSublattice.generated (delta p '' A) + have hVL (n : ℕ) : V n ∈ L := by + dsimp [V] + rw [finiteSupport, dite_eq_left (hBn n), map_finset_sup'] + apply Finset.sup'_mem (L : Set (Free p E)) (fun _ ha _ hb => L.sup_mem ha hb) + intro a ha + change ofFVL p |FVLv.of a| ∈ L + rw [VecLatHom.map_abs, ofFVL_of] + apply L.abs_mem + exact VectorSublattice.subset_generated _ (Set.mem_image_of_mem _ (hBA n ha)) + refine ⟨g, fun _ => rfl, ?_, B, hBm, fun n => ⟨hBn n, hBA n⟩, ?_, hVlim⟩ + · exact (VectorSublattice.isClosed_topologicalClosure L).mem_of_tendsto hVlim + (Eventually.of_forall (fun n => L.le_topologicalClosure (hVL n))) + · refine ⟨?_, ?_⟩ + · rintro _ ⟨n, rfl⟩ + exact (free_le_iff p _ _).mpr (hVle n) + · intro u hu + exact le_of_tendsto hVlim (Eventually.of_forall (fun n => hu (Set.mem_range_self n))) + +private theorem seminorm_bound_of_unit_ball {V : Type*} [AddCommGroup V] [Module ℝ V] + (q r : Seminorm ℝ V) (C : ℝ) (hC : 0 < C) + (hbound : ∀ v, q v < 1 → r v ≤ C) (v : V) : r v ≤ C * q v := by + apply le_of_forall_pos_le_add + intro ε hε + let t := q v + ε / C + have ht : 0 < t := add_pos_of_nonneg_of_pos (apply_nonneg q v) (div_pos hε hC) + have hb := hbound (t⁻¹ • v) (by + rw [map_smul_eq_mul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr ht)] + exact (inv_mul_lt_one₀ ht).mpr (lt_add_of_pos_right _ (div_pos hε hC))) + rw [map_smul_eq_mul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr ht)] at hb + have hmul := mul_le_mul_of_nonneg_left hb ht.le + rw [← mul_assoc, mul_inv_cancel₀ ht.ne', one_mul] at hmul + refine hmul.trans_eq ?_ + dsimp [t] + field_simp + +private theorem compact_submodule_section (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) + (K : Set E) (hne : K.Nonempty) (ha : AbsConvex ℝ K) (hk : IsCompact K) : + {x : M | (x : E) ∈ K}.Nonempty ∧ IsCompact {x : M | (x : E) ∈ K} := by + have hzero : (0 : E) ∈ K := by + simpa only [zero_smul] using ha.1.smul_mem (a := (0 : ℝ)) (by simp) hne.some_mem + refine ⟨⟨0, hzero⟩, Topology.IsEmbedding.subtypeVal.isCompact_iff.mpr ?_⟩ + have heq : ((↑) : M → E) '' {x : M | (x : E) ∈ K} = K ∩ (M : Set E) := by + ext x + constructor + · rintro ⟨y, hy, rfl⟩; exact ⟨hy, y.2⟩ + · rintro ⟨hx, hm⟩; exact ⟨⟨x, hm⟩, hx, rfl⟩ + rw [heq] + exact hk.inter_right hM + +private theorem compact_support_extension_approx (M : Submodule ℝ E) + (hM : IsClosed (M : Set E)) (K : Set E) (hne : K.Nonempty) + (ha : AbsConvex ℝ K) (hk : IsCompact K) (ψ : Dual M) (r : ℝ) + (hr : support {x : M | (x : E) ∈ K} ψ < r) : + ∃ φ : Dual E, φ.comp M.subtypeL = ψ ∧ support K φ ≤ r := by + let S : Set M := {x | (x : E) ∈ K} + obtain ⟨hSne, hSc⟩ := compact_submodule_section M hM K hne ha hk + have hr0 : 0 < r := (apply_nonneg (supportSeminorm S hSne hSc.isBounded) ψ).trans_lt hr + obtain ⟨θ, hθ, _⟩ := exists_extension_norm_eq M ψ + let U : Set E := {x | |θ x| < r} ∪ (M : Set E)ᶜ + have hU : IsOpen U := (isOpen_lt θ.continuous.abs continuous_const).union hM.isOpen_compl + have hKU : K ⊆ U := by + intro x hx + by_cases hm : x ∈ M + · left + change |θ x| < r + rw [show θ x = ψ (⟨x, hm⟩ : M) from hθ ⟨x, hm⟩] + exact (le_support S hSc.isBounded ψ hx).trans_lt hr + · exact Or.inr hm + obtain ⟨δ, hδ, hδU⟩ := hk.exists_thickening_subset_open hU hKU + let A := K + Metric.ball (0 : E) δ + have hzero : (0 : E) ∈ K := by + simpa only [zero_smul] using ha.1.smul_mem (a := (0 : ℝ)) (by simp) hne.some_mem + have hball : Metric.ball (0 : E) δ ⊆ A := fun x hx => ⟨0, hzero, x, hx, zero_add x⟩ + have hAneigh : A ∈ 𝓝 (0 : E) := mem_of_superset (Metric.ball_mem_nhds _ hδ) hball + have hA : AbsConvex ℝ A := ⟨ha.1.add balanced_ball_zero, ha.2.add (convex_ball _ _)⟩ + have hA0 : (0 : E) ∈ A := hball (by simpa using hδ) + have hAabs : Absorbent ℝ A := absorbent_nhds_zero hAneigh + let q : Seminorm ℝ E := gaugeSeminorm hA.1 hA.2 hAabs + have hunit (m : M) (hm : (q.comp M.subtype) m < 1) : ψ.toSeminorm m ≤ r := by + have hmA : (m : E) ∈ A := setOfPred_gauge_lt_one_subset_self hA.2 hA0 hAabs hm + obtain ⟨k, hk, b, hb, heq⟩ := hmA + have hnear : (m : E) ∈ Metric.thickening δ K := by + apply Metric.mem_thickening_iff.mpr + refine ⟨k, hk, ?_⟩ + rw [← heq, dist_eq_norm, add_sub_cancel_left] + simpa only [Metric.mem_ball, dist_zero_right] using hb + have hu : |θ m| < r := (hδU hnear).resolve_right (by exact not_not.mpr m.2) + rw [hθ m] at hu + exact hu.le + have hψ := seminorm_bound_of_unit_ball (q.comp M.subtype) ψ.toSeminorm r hr0 hunit + let cr : ℝ≥0 := ⟨r, hr0.le⟩ + let rq : Seminorm ℝ E := cr • q + have hrqc : Continuous rq := by + exact (continuous_gauge hA.2 hAneigh).const_smul cr + obtain ⟨φ, hφ, hφbound⟩ := Module.Dual.exists_continuous_extension_of_le_seminorm_real + M ψ.toLinearMap (p := rq) hrqc (fun m => (le_abs_self (ψ m)).trans (hψ m)) + refine ⟨φ, ContinuousLinearMap.ext hφ, ?_⟩ + apply csSup_le (hne.image _) + rintro _ ⟨x, hx, rfl⟩ + have hxA : x ∈ A := ⟨x, hx, 0, by simpa using hδ, add_zero x⟩ + have hq : q x ≤ 1 := gauge_le_one_of_mem hxA + exact (hφbound x).trans (mul_le_of_le_one_right hr0.le hq) + +/-- Lemma 4.8 (`lem:restriction-polar`): the norm closure of restrictions to a closed +subspace M of the strict polar of K equals the closed polar of the section K ∩ M. +Here K is nonempty, absolutely convex, and compact; the section and its support +are formed in M’s own normed-space type. -/ +theorem restriction_polar (M : Submodule ℝ E) + (hM : IsClosed (M : Set E)) (K : Set E) (hne : K.Nonempty) + (ha : AbsConvex ℝ K) (hk : IsCompact K) : + closure ((fun φ : Dual E => φ.comp M.subtypeL) '' {φ | support K φ < 1}) = + {ψ : Dual M | support {x : M | (x : E) ∈ K} ψ ≤ 1} := by + let S : Set M := {x | (x : E) ∈ K} + obtain ⟨hSne, hSc⟩ := compact_submodule_section M hM K hne ha hk + apply Set.Subset.antisymm + · apply closure_minimal ?_ + (isClosed_le (support_continuous S hSne hSc.isBounded) continuous_const) + rintro _ ⟨φ, hφ, rfl⟩ + change support S (φ.comp M.subtypeL) ≤ 1 + apply csSup_le (hSne.image _) + rintro _ ⟨x, hx, rfl⟩ + exact (le_support K hk.isBounded φ hx).trans hφ.le + · intro ψ hψ + let a : ℕ → ℝ := fun n => (1 / 2 : ℝ) ^ n + have ha0 (n : ℕ) : 0 < a n := by dsimp [a]; positivity + have halim : Tendsto a atTop (𝓝 0) := summable_geometric_two.tendsto_atTop_zero + have htlim : Tendsto (fun n => 1 + a n) atTop (𝓝 1) := by + simpa only [add_zero] using tendsto_const_nhds.add halim + have hψlim : Tendsto (fun n => (1 + a n)⁻¹ • ψ) atTop (𝓝 ψ) := by + simpa only [inv_one, one_smul] using (htlim.inv₀ one_ne_zero).smul + (tendsto_const_nhds : Tendsto (fun _ : ℕ => ψ) atTop (𝓝 ψ)) + apply isClosed_closure.mem_of_tendsto hψlim + apply Filter.Eventually.of_forall + intro n + apply subset_closure + obtain ⟨φ, hφ, hcost⟩ := compact_support_extension_approx M hM K hne ha hk ψ + (1 + a n / 2) (by change support S ψ < _; exact lt_of_le_of_lt hψ (by linarith [ha0 n])) + refine ⟨(1 + a n)⁻¹ • φ, ?_, ?_⟩ + · change support K ((1 + a n)⁻¹ • φ) < 1 + have ht : 0 < 1 + a n := by linarith [ha0 n] + rw [support_smul, abs_of_pos (inv_pos.mpr ht)] + apply (inv_mul_lt_one₀ ht).mpr + exact hcost.trans_lt (by linarith [ha0 n]) + · ext x + have heq := DFunLike.congr_fun hφ x + change (1 + a n)⁻¹ * φ x = (1 + a n)⁻¹ * ψ x + rw [show φ x = ψ x from heq] + +/-- Equation `eq:finite-support-extension`: the support cost of a functional on +K ∩ M is the infimum of the costs of its continuous extensions to E. The paper uses +finite-dimensional disks; that hypothesis is retained, although the proof via +`compact_support_extension_approx` works for any nonempty absolutely convex compact K. -/ +theorem finite_support_extension (M : Submodule ℝ E) + (hM : IsClosed (M : Set E)) (K : Set E) (hne : K.Nonempty) + (ha : AbsConvex ℝ K) (hk : IsCompact K) + (_hfd : FiniteDimensional ℝ (Submodule.span ℝ K)) (ψ : Dual M) : + support {x : M | (x : E) ∈ K} ψ = + sInf {r | ∃ φ : Dual E, φ.comp M.subtypeL = ψ ∧ r = support K φ} := by + let S : Set M := {x | (x : E) ∈ K} + obtain ⟨hSne, hSc⟩ := compact_submodule_section M hM K hne ha hk + have hneCost : {r | ∃ φ : Dual E, φ.comp M.subtypeL = ψ ∧ r = support K φ}.Nonempty := by + obtain ⟨φ, hφ, _⟩ := compact_support_extension_approx M hM K hne ha hk ψ + (support S ψ + 1) (lt_add_one _) + exact ⟨_, φ, hφ, rfl⟩ + have hbelow : BddBelow {r | ∃ φ : Dual E, φ.comp M.subtypeL = ψ ∧ r = support K φ} := by + refine ⟨0, ?_⟩ + rintro _ ⟨φ, _, rfl⟩ + exact apply_nonneg (supportSeminorm K hne hk.isBounded) φ + apply le_antisymm + · apply le_csInf hneCost + rintro _ ⟨φ, hφ, rfl⟩ + apply csSup_le (hSne.image _) + rintro _ ⟨x, hx, rfl⟩ + have heq : φ x = ψ x := DFunLike.congr_fun hφ x + change |ψ x| ≤ support K φ + rw [← heq] + exact le_support K hk.isBounded φ hx + · apply le_of_forall_pos_le_add + intro ε hε + obtain ⟨φ, hφ, hb⟩ := compact_support_extension_approx M hM K hne ha hk ψ + (support S ψ + ε) (lt_add_of_pos_right _ hε) + exact (csInf_le hbelow ⟨φ, hφ, rfl⟩).trans hb + +private theorem outer_polytope_proof (K : Set E) (hne : K.Nonempty) + (ha : AbsConvex ℝ K) (hk : IsCompact K) + (hfd : FiniteDimensional ℝ (Submodule.span ℝ K)) (θ : ℝ) (hθ : 0 < θ) : + ∃ A : Finset E, K ⊆ absConvexHull ℝ (A : Set E) ∧ + absConvexHull ℝ (A : Set E) ⊆ (1 + θ) • K := by + classical + let M := Submodule.span ℝ K + let : FiniteDimensional ℝ M := hfd + let S : Set M := {x | (x : E) ∈ K} + have hSimage : M.subtype '' S = K := by + ext x + constructor + · rintro ⟨y, hy, rfl⟩; exact hy + · intro hx + exact ⟨⟨x, Submodule.subset_span hx⟩, hx, rfl⟩ + have hScompact : IsCompact S := Topology.IsEmbedding.subtypeVal.isCompact_iff.mpr (by + change IsCompact (M.subtype '' S) + rw [hSimage] + exact hk) + have hS : AbsConvex ℝ S := by + constructor + · rw [balanced_iff_smul_mem] + intro c hc x hx + exact ha.1.smul_mem hc hx + · intro x hx y hy a b ha' hb hab + exact ha.2 hx hy ha' hb hab + have hzeroK : (0 : E) ∈ K := by + simpa only [zero_smul] using ha.1.smul_mem (a := (0 : ℝ)) (by simp) hne.some_mem + have hzero : (0 : M) ∈ S := hzeroK + have hspan : Submodule.span ℝ S = ⊤ := by + apply Submodule.map_injective_of_injective M.injective_subtype + rw [Submodule.map_span, hSimage, Submodule.map_top, Submodule.range_subtype] + have haff : affineSpan ℝ S = ⊤ := by + apply SetLike.coe_injective + calc + (affineSpan ℝ S : Set M) = (affineSpan ℝ (insert 0 S) : Set M) := by + rw [insert_eq_of_mem hzero] + _ = (Submodule.span ℝ S : Set M) := + congrArg (fun A : AffineSubspace ℝ M => (A : Set M)) (affineSpan_insert_zero S) + _ = (⊤ : AffineSubspace ℝ M) := by rw [hspan]; rfl + obtain ⟨a, haint⟩ := hS.2.interior_nonempty_iff_affineSpan_eq_top.mpr haff + have h0int : (0 : M) ∈ interior S := by + have h := hS.2.combo_interior_self_mem_interior haint + (hS.1.neg_mem_iff.mpr (interior_subset haint)) + (by norm_num : (0 : ℝ) < 1 / 2) (by norm_num : (0 : ℝ) ≤ 1 / 2) (by norm_num) + simpa only [smul_neg, add_neg_cancel] using h + have ht : 0 < 1 + θ := by linarith + have hti : (1 + θ)⁻¹ < 1 := (inv_lt_one₀ ht).mpr (by linarith) + have hnbhd : (1 + θ) • S ∈ 𝓝ˢ S := by + apply subset_interior_iff_mem_nhdsSet.mp + intro x hx + rw [interior_smul₀ ht.ne'] + refine ⟨(1 + θ)⁻¹ • x, ?_, smul_inv_smul₀ ht.ne' x⟩ + have h := hS.2.combo_interior_self_mem_interior h0int hx + (sub_pos.mpr hti) (inv_nonneg.mpr ht.le) (sub_add_cancel 1 ((1 + θ)⁻¹)) + simpa only [smul_zero, zero_add] using h + obtain ⟨B, hB, hBbound⟩ := + hS.2.exists_subset_interior_convexHull_finset_of_isCompact hScompact hnbhd + refine ⟨B.image M.subtype, ?_, ?_⟩ + · intro x hx + let y : M := ⟨x, Submodule.subset_span hx⟩ + have hy : y ∈ convexHull ℝ (B : Set M) := interior_subset (hB hx) + have himage : M.subtype '' convexHull ℝ (B : Set M) = + convexHull ℝ (M.subtype '' (B : Set M)) := by + exact M.subtype.image_convexHull (B : Set M) + have hymem : x ∈ convexHull ℝ (↑(B.image M.subtype) : Set E) := by + rw [Finset.coe_image, ← himage] + exact ⟨y, hy, rfl⟩ + exact convexHull_min subset_absConvexHull convex_absConvexHull hymem + · apply absConvexHull_min + · rintro x hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨z, hz, hzy⟩ := hBbound (subset_convexHull ℝ (B : Set M) hy) + exact ⟨(z : E), hz, congrArg Subtype.val hzy⟩ + · exact ⟨ha.1.smul _, ha.2.smul _⟩ + +/-- The finite-dimensional outer polytope approximation used in Lemma 4.10. -/ +theorem outer_polytope_approximation (K : Set E) (hne : K.Nonempty) + (ha : AbsConvex ℝ K) (hk : IsCompact K) + (hfd : FiniteDimensional ℝ (Submodule.span ℝ K)) (θ : ℝ) (hθ : 0 < θ) : + ∃ A : Finset E, K ⊆ absConvexHull ℝ (A : Set E) ∧ + absConvexHull ℝ (A : Set E) ⊆ (1 + θ) • K := + outer_polytope_proof K hne ha hk hfd θ hθ + +private theorem finite_support_image_norm_le (p : Exponent) (hp : p.IsFinite) + (M : Submodule ℝ E) {n : ℕ} (x : Fin n → E) (K : Set E) (hKc : IsCompact K) + (hsupport : ∀ φ, support K φ = scalarPSum p (fun i => φ (x i))) + (L : Set M) (hLK : ∀ {a : M}, a ∈ L → (a : E) ∈ K) + (A : Finset M) (hA : A.Nonempty) (t : ℝ) (ht : 0 < t) + (hAL : absConvexHull ℝ (A : Set M) ⊆ t • L) : + ‖induced p M.subtypeL (ofFVL p (finiteSupport A))‖ ≤ + t * scalarPSum p (fun i => ‖x i‖) := by + let z : FVL E := FVLv.map M.subtype (finiteSupport A) + have hz : ofFVL p z = induced p M.subtypeL (ofFVL p (finiteSupport A)) := + ofFVL_map p M.subtypeL (finiteSupport A) + have hzbound (φ : Dual E) : |fvlFunction z φ| ≤ + scalarPSum p (fun i => φ (t • x i)) := by + have hzeq : fvlFunction z φ = fvlFunction (finiteSupport A) (φ.comp M.subtypeL) := by + change ofFVL p z φ = ofFVL p (finiteSupport A) (φ.comp M.subtypeL) + rw [hz, canonical_map_formulas] + rw [hzeq, finiteSupport_apply A hA] + have hnonneg : 0 ≤ A.sup' hA (fun a => |(φ.comp M.subtypeL) a|) := + (abs_nonneg _).trans (Finset.le_sup' (fun a => |(φ.comp M.subtypeL) a|) hA.choose_spec) + rw [abs_of_nonneg hnonneg] + simp only [map_smul, smul_eq_mul, scalarPSum_smul, abs_of_pos ht] + apply Finset.sup'_le + intro a ha + obtain ⟨b, hb, heq⟩ := hAL (subset_absConvexHull ha) + rw [← heq] + change |(φ.comp M.subtypeL) (t • b)| ≤ _ + rw [map_smul, smul_eq_mul] + change |t * φ (b : E)| ≤ _ + rw [abs_mul, abs_of_pos ht, ← hsupport φ] + exact mul_le_mul_of_nonneg_left (le_support K hKc.isBounded φ (hLK hb)) ht.le + have hnorm : ‖ofFVL p z‖ ≤ t * scalarPSum p (fun i => ‖x i‖) := by + rw [majorant_norm p hp] + apply csInf_le + · refine ⟨0, ?_⟩ + rintro _ ⟨m, y, rfl, _⟩ + exact scalarPSum_nonneg .. + · refine ⟨n, fun i => t • x i, ?_, hzbound⟩ + simp only [norm_smul, Real.norm_eq_abs, abs_of_pos ht, scalarPSum_smul] + rw [← hz] + exact hnorm + +/-- Lemma 4.10 (`lem:finite-support-majorant`): every element of the free vector lattice +on a closed subspace M has a majorant that is a finite supremum of absolute evaluations +at points of M. After inclusion into the ambient free lattice, the majorant’s norm +is within any prescribed positive error of the original image norm. -/ +theorem finite_support_majorant [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (M : Submodule ℝ E) (hM : IsClosed (M : Set E)) (v : FVL M) + (η : ℝ) (hη : 0 < η) : + ∃ A : Finset M, (∀ ψ, |fvlFunction v ψ| ≤ fvlFunction (finiteSupport A) ψ) ∧ + ‖induced p M.subtypeL (ofFVL p (finiteSupport A))‖ < + ‖induced p M.subtypeL (ofFVL p v)‖ + η := by + classical + let w : FVL E := FVLv.map M.subtype v + have hw : ofFVL p w = induced p M.subtypeL (ofFVL p v) := ofFVL_map p M.subtypeL v + obtain ⟨r, ⟨n, x, rfl, hmajor⟩, hcost⟩ := exists_lt_of_csInf_lt + (fvl_majorant_nonempty p hp w) + (by rw [← majorant_norm p hp]; exact lt_add_of_pos_right ‖ofFVL p w‖ (half_pos hη)) + obtain ⟨K, hK, hKN, hsupport⟩ := finite_family_disk_in_span p hp x + obtain ⟨hKne, hKa, hKc⟩ := summable_disk_compact p K hK + let L : Set M := {m | (m : E) ∈ K} + obtain ⟨hLne, hLc⟩ := compact_submodule_section M hM K hKne hKa hKc + have hLa : AbsConvex ℝ L := by + constructor + · rw [balanced_iff_smul_mem] + intro c hc m hm + exact hKa.1.smul_mem hc hm + · intro a ha b hb s t hs ht hst + exact hKa.2 ha hb hs ht hst + have hLfd : FiniteDimensional ℝ (Submodule.span ℝ L) := by + let N := Submodule.span ℝ (Set.range x) + let : FiniteDimensional ℝ N := FiniteDimensional.span_of_finite (K := ℝ) (Set.finite_range x) + have hspan : Submodule.span ℝ L ≤ N.comap M.subtype := + Submodule.span_le.mpr (fun _ hm => hKN hm) + let j : Submodule.span ℝ L →ₗ[ℝ] N := + LinearMap.codRestrict N (M.subtype.comp (Submodule.span ℝ L).subtype) (fun a => hspan a.2) + apply FiniteDimensional.of_injective j + intro a b hab + apply Subtype.ext + apply Subtype.ext + exact congrArg (fun z : N => (z : E)) hab + have hmajorL (ψ : Dual M) : |fvlFunction v ψ| ≤ support L ψ := by + apply le_of_forall_pos_le_add + intro ε hε + obtain ⟨φ, hφ, hb⟩ := compact_support_extension_approx M hM K hKne hKa hKc ψ + (support L ψ + ε) (lt_add_of_pos_right _ hε) + have hv : fvlFunction w φ = fvlFunction v ψ := by + change ofFVL p w φ = ofFVL p v ψ + rw [hw, canonical_map_formulas, hφ] + rw [← hv] + exact (hmajor φ).trans ((hsupport φ).symm.le.trans hb) + let C := scalarPSum p (fun i => ‖x i‖) + have hC : 0 ≤ C := scalarPSum_nonneg .. + let θ := η / (2 * (C + 1)) + have hθ : 0 < θ := div_pos hη (mul_pos (by norm_num) (by linarith)) + have ht : 0 < 1 + θ := by linarith + have hθC : θ * C < η / 2 := by + have heq : θ * (C + 1) = η / 2 := by + dsimp [θ] + field_simp + nlinarith + have hscaled : (1 + θ) * C < ‖ofFVL p w‖ + η := by + change C < _ at hcost + nlinarith + obtain ⟨A, hLA, hAL⟩ := outer_polytope_approximation L hLne hLa hLc hLfd θ hθ + have hA : A.Nonempty := by + by_contra hn + have he : A = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn + have hmem := hLA hLne.some_mem + simp only [he, Finset.coe_empty, absConvexHull_empty, Set.mem_empty_iff_false] at hmem + refine ⟨A, ?_, ?_⟩ + · intro ψ + apply (hmajorL ψ).trans + apply csSup_le (hLne.image _) + rintro _ ⟨a, ha, rfl⟩ + apply absConvexHull_eval_bound (A : Set M) ψ _ ?_ a (hLA ha) + intro b hb + rw [finiteSupport_apply A hA] + exact Finset.le_sup' (fun b => |ψ b|) hb + · have hnorm := finite_support_image_norm_le p hp M x K hKc hsupport + L (fun ha => ha) A hA (1 + θ) ht hAL + rw [← hw] + exact hnorm.trans_lt hscaled + +/-- If the support of a compact set has infinite free p-norm, any free function +dominating its pointwise minimum with `|delta p e|` must dominate `|delta p e|` itself. +This forces the lower bounds in `compact_support_order_null` to be nonpositive. +Absolute convexity is retained from the paper’s disk setting but is not needed in this step. -/ +theorem compact_support_upper_bound [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (K : Set E) (hne : K.Nonempty) (_ha : AbsConvex ℝ K) (hk : IsCompact K) + (hinf : freeNormExt p (support K) = ⊤) (e : E) (g : Free p E) + (hg : ∀ φ, min |φ e| (support K φ) ≤ g φ) : |delta p e| ≤ g := by + apply (free_le_iff p _ _).mpr + intro φ₀ + change |φ₀ e| ≤ g φ₀ + by_contra hn + have hgap : 0 < (|φ₀ e| - g φ₀) / 4 := div_pos (sub_pos.mpr (lt_of_not_ge hn)) (by norm_num) + let ε := (|φ₀ e| - g φ₀) / 4 + have hε : 0 < ε := hgap + obtain ⟨L, hL, hlocal⟩ := summable_local_control p g φ₀ ε hgap + obtain ⟨D, hD, hdom⟩ := pair_support_domination p hp L + {y | ∃ t : ℝ, |t| ≤ 1 ∧ y = t • (ε⁻¹ • e)} hL + (segment_pCompactDisk p (ε⁻¹ • e)).1 + have hcD := summable_disk_compact p D hD + let q := supportSeminorm D hcD.1 hcD.2.2.isBounded + let r := supportSeminorm K hne hk.isBounded + have hnear (φ : Dual E) (hφ : support D (φ - φ₀) < 1) : support K φ ≤ g φ₀ + ε := by + have hglocal := hlocal φ (((hdom _).1).trans_lt hφ) + have heval := ((hdom (φ - φ₀)).2).trans_lt hφ + rw [(segment_pCompactDisk p (ε⁻¹ • e)).2] at heval + simp only [map_smul, smul_eq_mul, abs_mul, abs_of_pos (inv_pos.mpr hε), sub_apply] at heval + have heval' : |φ e - φ₀ e| < ε := (inv_mul_lt_one₀ hε).mp heval + have habs := abs_abs_sub_abs_le_abs_sub (φ e) (φ₀ e) + have hstrict : g φ < |φ e| := by + have hgupper := (abs_lt.mp hglocal).2 + have helower := (abs_le.mp habs).1 + dsimp [ε] at hgupper heval' + linarith + have hkbound : support K φ ≤ g φ := by + exact (min_le_iff.mp (hg φ)).resolve_left hstrict.not_ge + exact hkbound.trans (by linarith [(abs_lt.mp hglocal).2]) + let C := |g φ₀| + ε + support K φ₀ + 1 + have hC : 0 < C := by + have hs : 0 ≤ support K φ₀ := apply_nonneg r φ₀ + dsimp [C] + positivity + have hunit (ψ : Dual E) (hψ : q ψ < 1) : r ψ ≤ C := by + change support D ψ < 1 at hψ + have hb := hnear (ψ + φ₀) (by simpa only [add_sub_cancel_right] using hψ) + have hsub := map_sub_le_add r (ψ + φ₀) φ₀ + change support K ((ψ + φ₀) - φ₀) ≤ support K (ψ + φ₀) + support K φ₀ at hsub + rw [add_sub_cancel_right] at hsub + change support K ψ ≤ C + dsimp [C] + linarith [le_abs_self (g φ₀)] + have hglobal := seminorm_bound_of_unit_ball q r C hC hunit + obtain ⟨h, hh⟩ := pCompact_support_inFree p D hD + have hnorm : freeNormExt p (support K) ≤ freeNormExt p (C • h : Free p E) := by + apply freeNormExt_mono_abs + intro φ + change |support K φ| ≤ |C * h φ| + rw [abs_of_nonneg (show 0 ≤ support K φ from apply_nonneg r φ)] + rw [hh] + exact (hglobal φ).trans (le_abs_self _) + rw [hinf, freeNormExt_eq_norm] at hnorm + exact (ENNReal.ofReal_lt_top : ENNReal.ofReal ‖C • h‖ < ⊤).not_ge hnorm + +/-- Lemma 4.11 (`lem:compact-support-order-null`): if an increasing sequence has +pointwise supremum equal to a compact support of infinite free p-norm, then the +positive parts `(|delta p e| - q n) ⊔ 0` decrease to zero. This gives the source-side +order-null sequence in the failure witnesses. The retained positivity hypothesis on +q records the paper’s approximation setting; monotonicity and the supremum suffice here. -/ +theorem compact_support_order_null [CompleteSpace E] (p : Exponent) (hp : p.IsFinite) + (K : Set E) (hne : K.Nonempty) (ha : AbsConvex ℝ K) (hk : IsCompact K) + (hinf : freeNormExt p (support K) = ⊤) (q : ℕ → Free p E) + (_hpos : ∀ n, 0 ≤ q n) (hmono : Monotone q) + (hlim : ∀ φ, IsLUB (Set.range fun n => q n φ) (support K φ)) (e : E) : + DecreasesToZero (fun n => (|delta p e| - q n) ⊔ 0) := by + refine ⟨?_, ⟨?_, ?_⟩⟩ + · intro m n hmn + exact sup_le_sup (sub_le_sub_left (hmono hmn) _) le_rfl + · rintro _ ⟨n, rfl⟩ + exact le_sup_right + · intro b hb + let g := |delta p e| - b + have hbound (φ : Dual E) : min |φ e| (support K φ) ≤ g φ := by + have hn (n : ℕ) : min |φ e| (q n φ) ≤ g φ := by + have h := (free_le_iff p _ _).mp (hb (Set.mem_range_self n)) φ + change b φ ≤ max (|φ e| - q n φ) 0 at h + change min |φ e| (q n φ) ≤ |φ e| - b φ + by_cases hle : |φ e| ≤ q n φ + · rw [min_eq_left hle, max_eq_right (sub_nonpos.mpr hle)] at * + linarith + · rw [min_eq_right (le_of_not_ge hle), max_eq_left (sub_nonneg.mpr (le_of_not_ge hle))] at * + linarith + apply le_of_forall_lt + intro t ht + obtain ⟨_, ⟨n, rfl⟩, hnt⟩ := (lt_isLUB_iff (hlim φ)).mp ((lt_min_iff.mp ht).2) + exact (lt_min ((lt_min_iff.mp ht).1) hnt).trans_le (hn n) + have hg := compact_support_upper_bound p hp K hne ha hk hinf e g hbound + apply (free_le_iff p _ _).mpr + intro φ + have h := (free_le_iff p _ _).mp hg φ + change |φ e| ≤ |φ e| - b φ at h + change b φ ≤ 0 + linarith + +/-- The Minkowski series disk used in Propositions 4.12 and 5.2. -/ +def seriesDisk (K : ℕ → Set E) : Set E := + {x | ∃ z : ℕ → E, (∀ n, z n ∈ K n) ∧ HasSum z x} + +/-- For compact absolutely convex disks bounded by a summable sequence of radii, +the set of convergent sums of one point from each disk is again nonempty, absolutely +convex, and compact. Its support is the sum of the individual supports. Used in +Propositions 4.12 and 5.2. The explicit nonnegativity of the radii is retained for +clarity; it also follows from nonemptiness and the norm bounds. -/ +theorem seriesDisk_properties [CompleteSpace E] (K : ℕ → Set E) (c : ℕ → ℝ) + (_hc : ∀ n, 0 ≤ c n) (hs : Summable c) + (hK : ∀ n, (K n).Nonempty ∧ AbsConvex ℝ (K n) ∧ IsCompact (K n)) + (hb : ∀ n, ∀ x ∈ K n, ‖x‖ ≤ c n) : + (seriesDisk K).Nonempty ∧ AbsConvex ℝ (seriesDisk K) ∧ IsCompact (seriesDisk K) ∧ + ∀ φ, support (seriesDisk K) φ = ∑' n, support (K n) φ := by + have hsum (z : ℕ → E) (hz : ∀ n, z n ∈ K n) : Summable z := + Summable.of_norm (Summable.of_nonneg_of_le (fun n => norm_nonneg _) (fun n => hb n _ (hz n)) hs) + have hne : (seriesDisk K).Nonempty := by + choose z hz using fun n => (hK n).1 + exact ⟨∑' n, z n, z, hz, (hsum z hz).hasSum⟩ + have hac : AbsConvex ℝ (seriesDisk K) := by + constructor + · rw [balanced_iff_smul_mem] + rintro a ha y ⟨z, hz, hzy⟩ + exact ⟨fun n => a • z n, fun n => (hK n).2.1.1.smul_mem ha (hz n), hzy.const_smul a⟩ + · rintro y ⟨z, hz, hzy⟩ y' ⟨z', hz', hzy'⟩ a b ha hb hab + exact ⟨fun n => a • z n + b • z' n, + fun n => (hK n).2.1.2 (hz n) (hz' n) ha hb hab, + (hzy.const_smul a).add (hzy'.const_smul b)⟩ + have hcompact : IsCompact (seriesDisk K) := by + let Z := ∀ n, K n + let (n : ℕ) : CompactSpace (K n) := isCompact_iff_compactSpace.mp (hK n).2.2 + let S : Z → E := fun z => ∑' n, (z n : E) + have hS : Continuous S := continuous_tsum + (fun n => continuous_subtype_val.comp (continuous_apply n)) hs (fun n z => hb n _ (z n).2) + have heq : seriesDisk K = Set.range S := by + ext y + constructor + · rintro ⟨z, hz, hzy⟩ + exact ⟨fun n => ⟨z n, hz n⟩, hzy.tsum_eq⟩ + · rintro ⟨z, rfl⟩ + exact ⟨fun n => (z n : E), fun n => (z n).2, (hsum _ (fun n => (z n).2)).hasSum⟩ + rw [heq] + exact isCompact_range hS + refine ⟨hne, hac, hcompact, ?_⟩ + intro φ + have hsupport_nonneg (n : ℕ) : 0 ≤ support (K n) φ := + apply_nonneg (supportSeminorm _ (hK n).1 (hK n).2.2.isBounded) φ + have hsupport_bound (n : ℕ) : support (K n) φ ≤ ‖φ‖ * c n := by + apply csSup_le ((hK n).1.image _) + rintro _ ⟨x, hx, rfl⟩ + exact (φ.le_opNorm x).trans (mul_le_mul_of_nonneg_left (hb n x hx) (norm_nonneg _)) + have hsupp : Summable (fun n => support (K n) φ) := + Summable.of_nonneg_of_le hsupport_nonneg hsupport_bound (hs.mul_left ‖φ‖) + apply le_antisymm + · apply csSup_le (hne.image _) + rintro _ ⟨y, ⟨z, hz, hzy⟩, rfl⟩ + have hnorm : Summable (fun n => ‖φ (z n)‖) := + Summable.of_nonneg_of_le (fun _ => norm_nonneg _) + (fun n => le_support (K n) (hK n).2.2.isBounded φ (hz n)) hsupp + have hφsum := φ.hasSum hzy + change |φ y| ≤ _ + rw [← hφsum.tsum_eq] + calc + _ ≤ ∑' n, ‖φ (z n)‖ := norm_tsum_le_tsum_norm hnorm + _ ≤ ∑' n, support (K n) φ := hnorm.tsum_le_tsum + (fun n => le_support (K n) (hK n).2.2.isBounded φ (hz n)) hsupp + · have hmax (n : ℕ) : ∃ z ∈ K n, φ z = support (K n) φ := by + obtain ⟨x, hx, hmax⟩ := (hK n).2.2.exists_isMaxOn (hK n).1 φ.continuous.abs.continuousOn + have heq : support (K n) φ = |φ x| := by + apply le_antisymm + · apply csSup_le ((hK n).1.image _) + rintro _ ⟨y, hy, rfl⟩ + exact hmax hy + · exact le_support (K n) (hK n).2.2.isBounded φ hx + by_cases hφx : 0 ≤ φ x + · exact ⟨x, hx, by rw [heq, abs_of_nonneg hφx]⟩ + · exact ⟨-x, (hK n).2.1.1.neg_mem_iff.mpr hx, by + rw [map_neg, heq, abs_of_neg (lt_of_not_ge hφx)]⟩ + choose z hz hzval using hmax + have hzmem : (∑' n, z n) ∈ seriesDisk K := ⟨z, hz, (hsum z hz).hasSum⟩ + have hφsum := φ.hasSum (hsum z hz).hasSum + have hval : φ (∑' n, z n) = ∑' n, support (K n) φ := by + rw [← hφsum.tsum_eq] + exact tsum_congr hzval + have hb := le_support (seriesDisk K) hcompact.isBounded φ hzmem + rw [hval, abs_of_nonneg (tsum_nonneg hsupport_nonneg)] at hb + exact hb + +/-- Section 2: bounded weak-star continuity for every parameter. -/ +theorem free_boundedWeakStar_continuous (p : Exponent) (f : Free p E) : + @Continuous (Dual E) ℝ (boundedWeakStar E) inferInstance f := by + let : TopologicalSpace (Dual E) := boundedWeakStar E + rw [continuous_iff_continuousAt] + intro φ₀ + rw [ContinuousAt, Metric.tendsto_nhds] + intro ε hε + obtain ⟨K, hne, hK, hbound⟩ := compact_local_control p f φ₀ ε hε + have hopen := support_ball_open {K : Set E | K.Nonempty ∧ IsCompact K} + K ⟨hne, hK⟩ φ₀ 1 zero_lt_one + have hmem := hopen.mem_nhds (x := φ₀) + (by simp only [mem_ofPred_eq, sub_self, support_zero]; norm_num) + filter_upwards [hmem] with φ hφ + simpa only [Real.dist_eq] using hbound φ hφ + + +end FBLOrderContinuousLH diff --git a/LeanPool/projects/free-banach-lattice-order-continuity.yaml b/LeanPool/projects/free-banach-lattice-order-continuity.yaml new file mode 100644 index 0000000000..70c728e525 --- /dev/null +++ b/LeanPool/projects/free-banach-lattice-order-continuity.yaml @@ -0,0 +1,65 @@ +slug: free-banach-lattice-order-continuity +title: Order continuity of induced homomorphisms between free Banach lattices +summary: Characterizes order continuity of the lattice homomorphism induced by a bounded + operator between real Banach spaces, for every free convexity exponent from one + to infinity. Develops concrete free p-convex Banach lattices, their universal + property, operator-extension criteria, compact-support witnesses, and equivalent + conditions for canonical inclusions between different exponents. +branch: functional analysis +entry_module: LeanPool.FBLOrderContinuity +authors: +- Raúl E. Pariente-Martín +- Pedro Tradacete +- David Muñoz-Lahoz +source: + title: Order continuity of induced homomorphisms between free Banach lattices + authors: + - Raúl E. Pariente-Martín + - Pedro Tradacete + arxiv: '2611.00451' + url: https://github.com/pedrotradacete/FBLOrderContinuousLH/tree/ee3cde5070125ff2356b7144ff7a940a8dff2a54 + github_repo: pedrotradacete/FBLOrderContinuousLH + commit: ee3cde5070125ff2356b7144ff7a940a8dff2a54 +license: Apache-2.0 +status: verified +provenance: AI +main_declarations: +- FBLOrderContinuousLH.intro_infty +- FBLOrderContinuousLH.intro_poe +- FBLOrderContinuousLH.cross_parameter_inclusion +main_results: +- declaration: FBLOrderContinuousLH.intro_infty + informal: At exponent infinity, the induced lattice homomorphism is order continuous + exactly when the original bounded operator is zero or an isomorphic embedding. + source_ref: Theorem 1.1. The public manuscript was submitted on 2026-10-30 at + 23:06:06 UTC; the completed Lean sources were committed earlier that evening + as 167b82ad69724d2ddb2a701fc932e52d445faecc. +- declaration: FBLOrderContinuousLH.intro_poe + informal: For a finite exponent p, the induced homomorphism is order continuous + exactly when the original operator is zero or is an isomorphic embedding whose + range has the POE-p operator-extension property. Equivalently, the induced + homomorphism is zero or an isomorphic lattice embedding. + source_ref: Theorem 1.3. +- declaration: FBLOrderContinuousLH.cross_parameter_inclusion + informal: For p less than q, eight conditions on the canonical inclusion between + the free p-convex and q-convex lattices are equivalent, including order continuity, + surjectivity, equivalence of norms on the algebraic core, and order density. + source_ref: Theorem 5.1. +- declaration: FBLOrderContinuousLH.cross_parameter_above_two + informal: When p is less than q and q exceeds two, these conditions hold exactly + when the generating Banach space is finite dimensional. + source_ref: Corollary 5.3. +- declaration: FBLOrderContinuousLH.cross_parameter_hilbert + informal: For the real Hilbert sequence space and one at most p less than q at + most two, the canonical inclusion is an order-continuous bounded lattice + isomorphism onto its target. + source_ref: Remark 5.4. +tags: +- banach-lattices +- free-banach-lattices +- order-continuity +- operator-extensions +msc: +- 46B42 +- 46A40 +- 47B60