Formalization: Uniform Expected Risk for Distance-Based Boundary Regression Designs
The complete Lean development behind this paper — every definition, lemma, and theorem of its module, including helpers the paper text never cites. Identifiers link within this page, into the Causalean library, or out to the official Mathlib docs.
Basic 30 declarations This module formalizes the random-design regression laws, distance-compressed decision classes, completed and outer risks, and the logarithmic frontier rate.
Bounded uniform logarithmic penalty: common definitions
This module formalizes the random-design regression laws, distance-compressed
decision classes, completed and outer risks, and the logarithmic frontier rate.
The bivariate covariate is represented by EuclideanSpace ℝ (Fin 2), so every
metric and Hölder condition below uses the paper's Euclidean geometry.
def Score
Bivariate random-design covariates with their Euclidean ℓ2 metric.
Definition (Lean source)
def Observation
One observed outcome-covariate pair.
Definition (Lean source)
def Sample
An ordered i.i.d. sample of size n.
Definition (Lean source)
def DistanceSample
The unsigned-distance compressed sample at one query point.
Definition (Lean source)
abbrev DistanceSample (n : ℕ) := Fin n → ℝ × ℝ
A CTY random-design regression law. Its density and conditional-moment fields are pinned to the joint law, rather than supplied as free auxiliaries.
Definition (Lean source)
fields
law :
density :
Score → ℝ
mu :
Score → ℝ
sigmaSq :
Score → ℝ
law_isProbability :
marginal_eq :
@realizes f_P(Lebesgue density of X) @realizes \mathcal{X}_P(density support)
support_eq_marginal_support :
support = (Measure.map snd law).support
@realizes \mathcal{X}_P(exact topological support of the X-marginal)
support_closed :
IsClosed support
density_pos :
∀ x ∈ support, 0 < density x
mu_condMean :
(let _ : IsProbabilityMeasure law := law_isProbability ∀ᵐ x ∂Measure.map snd law, mu x = ∫ y, y ∂(condDistrib fst snd law x))
@realizes \mu_P(conditional mean of Y given X)
sigmaSq_condVar :
(let _ : IsProbabilityMeasure law := law_isProbability ∀ᵐ x ∂Measure.map snd law, sigmaSq x = variance id (condDistrib fst snd law x))
def sampleLaw
The product law of n independent observations from P.
Rectifiability of the support boundary, expressed by a Lipschitz parameterization of the boundary by the unit interval.
Definition (Lean source)
def RectifiableBoundary (S : Set Score) : Prop :=
∃ K : ℝ≥0, ∃ γ : ℝ → Score,
LipschitzOnWith K γ (Icc 0 1) ∧ γ '' Icc 0 1 = frontier S
def scoreCube
The coordinate cube [-r,r]², regarded as a subset of Euclidean space.
The standard Hölder ball formed using the Euclidean norm on the bivariate score carrier.
Definition (Lean source)
def EuclideanHolderBallStd (f : Score → ℝ) (order M : ℝ)
(S : Set Score) : Prop :=
ContDiffOn ℝ (⌈order⌉₊ - 1) f S ∧
(∀ j : ℕ, j ≤ ⌈order⌉₊ - 1 → ∀ x ∈ S, ‖iteratedFDeriv ℝ j f x‖ ≤ M) ∧
(∀ x ∈ S, ∀ y ∈ S,
‖iteratedFDeriv ℝ (⌈order⌉₊ - 1) f x -
iteratedFDeriv ℝ (⌈order⌉₊ - 1) f y‖
≤ M * ‖x - y‖ ^ (order - ((⌈order⌉₊ - 1 : ℕ) : ℝ)))
def CtyNonparametricClass
The CTY nonparametric law class: i.i.d. probability sampling, a compact rectifiable score support with a continuous density bounded between L⁻¹ and L, a q-Hölder regression, and a continuous conditional variance with the same envelope. The fidelity fields of CtyLaw identify all three functions with functionals of the joint law.
Definition (Lean source)
def CtyNonparametricClass (q : ℕ) (L : ℝ) (P : CtyLaw) : Prop :=
1 ≤ q ∧ -- @realizes q(regime q≥1)
4 ≤ L ∧ -- @realizes L(regime L≥4)
ContinuousOn P.density P.support ∧
IsCompact P.support ∧ -- @realizes \mathcal{X}_P(compact)
P.support ⊆ scoreCube L ∧
-- @realizes \mathcal{X}_P(subset of [-L,L]²)
(∀ x ∈ P.support, L⁻¹ ≤ P.density x ∧ P.density x ≤ L) ∧
-- @realizes f_P(range [L⁻¹,L])
RectifiableBoundary P.support ∧ -- @realizes \mathcal{X}_P(rectifiable boundary)
EuclideanHolderBallStd P.mu (q : ℝ) L P.support ∧
-- @realizes \mu_P(q-Hölder ball of radius L)
ContinuousOn P.sigmaSq P.support ∧
∀ x ∈ P.support, L⁻¹ ≤ P.sigmaSq x ∧ P.sigmaSq x ≤ L
def admissibleLaws
The named class as a set of law objects.
Definition (Lean source)
def admissibleLaws (q : ℕ) (L : ℝ) : Set CtyLaw :=
{P | CtyNonparametricClass q L P} -- @realizes \mathcal{P}_{\mathrm{NP}}(set of admissible P)
theorem support_eq_measureSupport
The labelled support is the topological support of the covariate marginal.
Formal statement
hypotheses
Proof (Lean source)
lemma support_eq_measureSupport {q : ℕ} {L : ℝ} (P : CtyLaw)
(_hP : CtyNonparametricClass q L P) :
(Measure.map snd P.law).support = P.support := by
exact P.support_eq_marginal_support.symm
theorem class_pos_on_relopen
Every relatively open neighborhood of a support point has positive covariate-marginal mass.
Formal statement
Proof (Lean source)
lemma class_pos_on_relopen {q : ℕ} {L : ℝ} (P : CtyLaw)
(_hP : CtyNonparametricClass q L P) (U : Set Score)
(hU : IsOpen U) (x : Score) (hx : x ∈ U ∩ P.support) :
0 < Measure.map Prod.snd P.law (U ∩ P.support) := by
let mu := Measure.map Prod.snd P.law
have hxs : x ∈ mu.support := by
simpa [mu, P.support_eq_marginal_support] using hx.2
have hUpos : 0 < mu U :=
(Measure.mem_support_iff_forall x).mp hxs U (hU.mem_nhds hx.1)
rw [show mu (U ∩ P.support) = mu U by
apply measure_congr
filter_upwards [mu.support_mem_ae] with y hy
apply propext
constructor
· exact fun h => h.1
· intro hyU
refine ⟨hyU, ?_⟩
simpa [mu, P.support_eq_marginal_support] using hy]
exact hUpos
theorem continuous_version_unique_on_support
Two continuous versions that agree almost everywhere under an admissible covariate marginal agree at every point of the support, including its boundary.
Formal statement
hypotheses
q :
ℕ
L :
ℝ
P :
hP :
CtyNonparametricClass q L P
f g :
Score → ℝ
hf :
ContinuousOn f P.support
hg :
ContinuousOn g P.support
hfg :
f =ᵐ[Measure.map snd P.law] g
conclusion
∀ x ∈ P.support, f x = g x
Proof (Lean source)
lemma continuous_version_unique_on_support {q : ℕ} {L : ℝ} (P : CtyLaw)
(hP : CtyNonparametricClass q L P) (f g : Score → ℝ)
(hf : ContinuousOn f P.support) (hg : ContinuousOn g P.support)
(hfg : f =ᵐ[Measure.map Prod.snd P.law] g) :
∀ x ∈ P.support, f x = g x := by
let mu := Measure.map Prod.snd P.law
let E : Set Score := {x | x ∈ P.support ∧ f x = g x}
have hnull : mu {x | f x ≠ g x} = 0 := by
exact hfg
have hclosure : P.support ⊆ closure E := by
intro x hx
rw [mem_closure_iff]
intro U hU hxU
have hpos : 0 < mu (U ∩ P.support) := by
exact class_pos_on_relopen P hP U hU x ⟨hxU, hx⟩
by_contra hUE
rw [not_nonempty_iff_eq_empty] at hUE
have hsub : U ∩ P.support ⊆ {y | f y ≠ g y} := by
intro y hy hEq
have : y ∈ U ∩ E := ⟨hy.1, hy.2, hEq⟩
simpa [hUE] using this
exact (ne_of_gt hpos) (measure_mono_null hsub hnull)
exact Set.EqOn.of_subset_closure
(s := E) (t := P.support) (fun _ hx => hx.2) hf hg
(fun _ hx => hx.1) hclosure
The unsigned-distance sample seen at query point x.
Definition (Lean source)
-- @node: def:cty-distance-data
noncomputable def distanceData (n : ℕ) (w : Sample n) (x : Score) : DistanceSample n :=
fun i => ((w i).1, dist (w i).2 x)
theorem measurable_distanceData
For each fixed point, unsigned-distance compression is measurable in the sample.
Formal statement
Proof (Lean source)
lemma measurable_distanceData (n : ℕ) (x : Score) :
Measurable (fun w : Sample n => distanceData n w x) := by
unfold distanceData
fun_prop
def RuleFun
Ambient type of boundary-indexed regression rules.
Generator for a CTY rule: one common measurable map at every point.
Definition (Lean source)
Generator for a point-indexed rule. Only fixed-point sections are required to be measurable; no joint regularity in the query point is imposed.
Definition (Lean source)
parameters
n :
ℕ
fields
map :
Score → DistanceSample n → ℝ
section_measurable :
∀ x, Measurable (map x)
Rules generated, uniformly over admissible laws, by one law-independent measurable map of the unsigned-distance data.
Definition (Lean source)
def CtyDistanceDecisionClass (n q : ℕ) (L : ℝ) : Set (RuleFun n) :=
{rho | ∃ T : CtyRule n, ∀ P, CtyNonparametricClass q L P →
∀ w x, x ∈ frontier P.support → rho w x = T.map (distanceData n w x)}
Rules generated by a law-independent point-indexed family with measurable fixed-point sections and no joint measurability or continuity in the point.
Definition (Lean source)
def PointIndexedDecisionClass (n q : ℕ) (L : ℝ) : Set (RuleFun n) :=
{rho | ∃ T : PIRule n, ∀ P, CtyNonparametricClass q L P →
∀ w x, x ∈ frontier P.support → rho w x = T.map x (distanceData n w x)}
def boundaryLoss
The extended nonnegative uniform boundary loss of a rule under a law.
The common-map minimax risk, using the ordinary nonnegative expectation on the completed sample space.
Definition (Lean source)
noncomputable def ctyDistanceRisk (n q : ℕ) (L : ℝ) : ℝ≥0∞ :=
⨅ rho : RuleFun n, ⨅ (_hrho : rho ∈ CtyDistanceDecisionClass n q L),
⨆ P : CtyLaw, ⨆ (_hP : CtyNonparametricClass q L P),
∫⁻ w, boundaryLoss rho P w ∂(sampleLaw P n).completion
The point-indexed minimax risk, using outer expectation because only the fixed-point rule sections are assumed measurable.
Definition (Lean source)
noncomputable def pointIndexedDistanceRisk (n q : ℕ) (L : ℝ) : ℝ≥0∞ :=
⨅ rho : RuleFun n, ⨅ (_hrho : rho ∈ PointIndexedDecisionClass n q L),
⨆ P : CtyLaw, ⨆ (_hP : CtyNonparametricClass q L P),
outerLIntegral (sampleLaw P n) (boundaryLoss rho P)
The first-order distance rate a_n = (log n / n)^(1/4).
Definition (Lean source)
theorem frontierRate_pos
The frontier rate is positive once n ≥ 2.
Formal statement
Proof (Lean source)
lemma frontierRate_pos {n : ℕ} (hn : 2 ≤ n) : 0 < frontierRate n := by
unfold frontierRate
apply Real.rpow_pos_of_pos
have hn' : (1 : ℝ) < n := by
exact_mod_cast (show 1 < n by omega)
exact div_pos (Real.log_pos hn') (by positivity)
theorem frontierRate_tendsto_zero
The logarithmic distance frontier rate tends to zero.
Formal statement
conclusion
Proof (Lean source)
lemma frontierRate_tendsto_zero :
Tendsto frontierRate atTop (nhds 0) := by
have h : Tendsto
(fun n : ℕ => log (n : ℝ) / (n : ℝ)) atTop (nhds 0) := by
exact Real.isLittleO_log_id_atTop.tendsto_div_nhds_zero.comp
tendsto_natCast_atTop_atTop
convert (Real.continuousAt_rpow_const (0 : ℝ) ((1 : ℝ) / 4)
(inr (by norm_num))).tendsto.comp h using 1 <;> first | rfl | norm_num
A risk normalized by the distance frontier rate.
Definition (Lean source)
noncomputable def normalizedRisk (risk : ℕ → ℝ≥0∞) (n : ℕ) : ℝ≥0∞ :=
risk n / ofReal (frontierRate n)
The multiplier form appearing on the left side of the paper's displayed normalization.
Definition (Lean source)
noncomputable def scaledRisk (risk : ℕ → ℝ≥0∞) (n : ℕ) : ℝ≥0∞ :=
ofReal
(rpow ((n : ℝ) / log (n : ℝ)) ((1 : ℝ) / 4)) * risk n
theorem scaledRisk_eventually_eq_normalizedRisk
The multiplier and quotient normalizations agree once the sample size is at least two.
Formal statement
hypotheses
risk :
ℕ → ℝ≥0∞
conclusion
Proof (Lean source)
lemma scaledRisk_eventually_eq_normalizedRisk (risk : ℕ → ℝ≥0∞) :
(fun n => scaledRisk risk n) =ᶠ[atTop]
(fun n => normalizedRisk risk n) := by
filter_upwards [eventually_ge_atTop (2 : ℕ)] with n hn
unfold scaledRisk normalizedRisk frontierRate
have hn0 : (0 : ℝ) < n := by positivity
have hlog : 0 < log (n : ℝ) := by
apply Real.log_pos
exact_mod_cast (show 1 < n by omega)
rw [ENNReal.div_eq_inv_mul]
congr 1
have hinv :
(ofReal ((log (n : ℝ) / (n : ℝ)).rpow ((1 : ℝ) / 4)))⁻¹ =
ofReal (((log (n : ℝ) / (n : ℝ)).rpow ((1 : ℝ) / 4))⁻¹) :=
(ENNReal.ofReal_inv_of_pos
(rpow_pos_of_pos (div_pos hlog hn0) _)).symm
rw [hinv]
congr 1
calc
((n : ℝ) / log (n : ℝ)).rpow ((1 : ℝ) / 4) =
((log (n : ℝ) / (n : ℝ))⁻¹).rpow ((1 : ℝ) / 4) := by
congr 1
field_simp
_ = ((log (n : ℝ) / (n : ℝ)).rpow ((1 : ℝ) / 4))⁻¹ :=
Real.inv_rpow (le_of_lt (div_pos hlog hn0)) _
Causal.Basic 19 declarations This module introduces the selected-conditional-kernel causal law used by the second half of the paper, together with its known assignment geometry and the signed-distance observation.
CTY Assumptions 1--2: causal world and known geometry
This module introduces the selected-conditional-kernel causal law used by the second half of the paper, together with its known assignment geometry and the signed-distance observation.
def CausalObservation
A potential-outcome observation (Y(0), Y(1), X).
Definition (Lean source)
abbrev CausalObservation := ℝ × ℝ × Score
def CausalSample
An ordered sample of potential-outcome observations.
Definition (Lean source)
def armCoord
Arm t of a potential-outcome observation.
Definition (Lean source)
def causalScore
The score coordinate.
Definition (Lean source)
structure A1A2Law
A decorated causal law carrying one selected arm-indexed regular conditional-kernel witness. Forgetting the decoration recovers the bare data-generating law. Membership in the law class below constrains the carried selected representative pointwise.
Definition (Lean source)
fields
law :
A0_measurable :
@realizes \mathcal{A}_{t,P}(arm-zero region is Borel)
A1_measurable :
@realizes \mathcal{A}_{t,P}(arm-one region is Borel)
assignment_partition :
A0 ∪ A1 = support ∧ Disjoint A0 A1
@realizes \mathcal{A}_{t,P}(Borel partition of the support)
@realizes \mathcal{B}_P(common frontier of the assignment regions)
boundary_subset_interior :
boundary ⊆ interior support
@realizes \mathcal{B}_P(interface lies in the interior support)
density :
Score → ℝ
law_isProbability :
condKer_markov :
∀ t, IsMarkovKernel (condKer t)
marginal_eq :
Measure.map causalScore law
= volume.withDensity (fun x => ofReal (support.indicator density x))
@realizes f_P(Lebesgue density of X) @realizes \mathcal{X}_P(density support)
support_eq_marginal_support :
support = (Measure.map causalScore law).support
@realizes \mathcal{X}_P(exact marginal topological support)
condKer_disint :
∀ t,
(Measure.map causalScore law).compProd (condKer t)
= Measure.map (fun w => (causalScore w, armCoord t w)) law
@realizes Y(t)(selected kernel disintegrates joint arm-score law)
mu_condMean :
∀ t, ∀ᵐ x ∂Measure.map causalScore law, muPO t x = ∫ y, y ∂condKer t x
@realizes \mu_{t,P}(conditional mean under selected kernel)
sigmaSq_condVar :
∀ t, ∀ᵐ x ∂Measure.map causalScore law, sigmaSqPO t x = variance id (condKer t x)
def causalSampleLaw
The n-fold i.i.d. law of potential-outcome observations.
Definition (Lean source)
noncomputable def causalSampleLaw (P : A1A2Law) (n : ℕ) : Measure (CausalSample n) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
exact Measure.pi (fun _ : Fin n => P.law)
def treatment
Treatment is the indicator of the known arm-one region.
Definition (Lean source)
noncomputable def treatment (P : A1A2Law) (w : CausalObservation) : ℝ :=
P.A1.indicator (fun _ => (1 : ℝ)) (causalScore w)
def observedOutcome
The observed outcome obeying consistency.
Definition (Lean source)
noncomputable def observedOutcome (P : A1A2Law) (w : CausalObservation) : ℝ :=
treatment P w * armCoord true w + (1 - treatment P w) * armCoord false w
def tau
The boundary treatment-effect curve.
def condAbsMoment
The selected conditional absolute moment at exponent 2 + ν.
The fixed uniform smoothing kernel 1{|u| ≤ 1}.
Definition (Lean source)
The tuple of geometry known to every causal decision rule.
def knownGeometry
The support, assignment regions, interface, Euclidean metric, and fixed uniform kernel supplied to the estimator.
Definition (Lean source)
noncomputable def knownGeometry (P : A1A2Law) : GeometryData where
support := P.support -- @realizes G_P(support component) @realizes \mathcal{X}_P(known support)
A0 := P.A0 -- @realizes G_P(A₀ component) @realizes \mathcal{A}_{t,P}(known arm zero)
A1 := P.A1 -- @realizes G_P(A₁ component) @realizes \mathcal{A}_{t,P}(known arm one)
boundary := P.boundary
-- @realizes G_P(interface component) @realizes \mathcal{B}_P(known interface)
A0_measurable := P.A0_measurable
A1_measurable := P.A1_measurable
assignment_partition := P.assignment_partition
boundary_eq := P.boundary_eq
boundary_subset_interior := P.boundary_subset_interior
metric := fun x z => dist x z -- @realizes G_P(metric component) @realizes d_P(Euclidean distance)
kernel := uniformKernel
def signedDistance
Signed Euclidean distance computed from a known geometry.
Definition (Lean source)
noncomputable def signedDistance (G : GeometryData) (x z : Score) : ℝ :=
(G.A1.indicator (fun _ => (1 : ℝ)) z -
G.A0.indicator (fun _ => (1 : ℝ)) z) * G.metric z x
def SignedDistanceSample
The observed signed-distance sample.
Definition (Lean source)
abbrev SignedDistanceSample (n : ℕ) := Fin n → ℝ × ℝ
Observed-outcome and signed-distance pairs for an admissible causal law. The first coordinate is the law-indexed observed outcome, so consistency and the assignment partition cannot be bypassed by supplying arbitrary geometry.
Definition (Lean source)
noncomputable def signedDistanceData (n : ℕ) (P : A1A2Law)
(w : CausalSample n) (x : Score) : SignedDistanceSample n :=
fun i => (observedOutcome P (w i),
signedDistance (knownGeometry P) x (causalScore (w i)))
def geometrySignedDistanceData
Geometry-only implementation used by a law-independent rule. Its input type carries the Borel-partition and common-interior-frontier invariants.
Definition (Lean source)
noncomputable def geometrySignedDistanceData (n : ℕ) (G : GeometryData)
(w : CausalSample n) (x : Score) : SignedDistanceSample n :=
fun i =>
(G.A1.indicator (fun _ => armCoord true (w i)) (causalScore (w i)) +
(1 - G.A1.indicator (fun _ => (1 : ℝ)) (causalScore (w i))) *
armCoord false (w i),
signedDistance G x (causalScore (w i)))
def polyBasis
The degree-p monomial basis (1,u,…,u^p).
Causal.CitedInterfaces 21 declarations These three named propositions record external source statements.
Cited CTY interfaces
These three named propositions record external source statements. They are never proved here; every consumer takes an explicit inhabitant.
A metric on the score space which is uniformly equivalent to Euclidean distance on the score support, exactly as in CTY Assumption 2(ii).
Definition (Lean source)
def CtyIdentificationMetric (P : A1A2Law)
(d : Score → Score → ℝ) : Prop :=
(∀ x, d x x = 0) ∧
(∀ x z, 0 ≤ d x z ∧ (d x z = 0 ↔ x = z)) ∧
(∀ x z, d x z = d z x) ∧
(∀ x y z, d x z ≤ d x y + d y z) ∧
∃ c C : ℝ, 0 < c ∧ c ≤ C ∧
∀ x ∈ P.support, ∀ z ∈ P.support,
c * dist x z ≤ d x z ∧ d x z ≤ C * dist x z
def identificationSignedDistance
Signed distance for the general metric admitted by the cited identification theorem.
Definition (Lean source)
noncomputable def identificationSignedDistance (P : A1A2Law)
(d : Score → Score → ℝ) (x z : Score) : ℝ :=
(P.A1.indicator (fun _ => (1 : ℝ)) z -
P.A0.indicator (fun _ => (1 : ℝ)) z) * d z x
def identificationSliceDensityMass
The Hausdorff slice denominator in CTY Assumption 2(v).
Exactly CTY Assumptions 1(i)--(iii) and 2(i), (ii), and (v), with i.i.d. sampling supplied by causalSampleLaw. Armwise potential-outcome integrability records the genuine scope in which the conditional means in Assumption 1(iii) exist. No variance envelope, higher-moment envelope, kernel, Gram, VC, local-mass, or quantitative derivative-envelope clause is imposed.
Definition (Lean source)
def CtyIdentificationAssumptions (p : ℕ) (P : A1A2Law)
(d : Score → Score → ℝ) : Prop :=
(∃ lo hi : ℝ, lo < hi ∧
P.support = {x | ∀ i, lo ≤ x i ∧ x i ≤ hi}) ∧
ContinuousOn P.density P.support ∧
(∀ x ∈ P.support, 0 < P.density x) ∧
(∀ t : Bool, Integrable (armCoord t) P.law) ∧
(∀ t, ∃ U : Set Score, IsOpen U ∧ P.support ⊆ U ∧
∃ g : Score → ℝ, ContDiffOn ℝ (p + 1 : ℕ) g U ∧
EqOn g (P.muPO t) P.support) ∧
RectifiableCurve P.boundary ∧
0 < Measure.hausdorffMeasure 1 P.boundary ∧
CtyIdentificationMetric P d ∧
∀ x ∈ P.boundary, ∀ t : Bool, ∃ ε : ℝ, 0 < ε ∧
∀ s : ℝ, 0 < s → s ≤ ε →
0 < identificationSliceDensityMass P d t x s ∧
identificationSliceDensityMass P d t x s < ∞
One source-coherent selected pair of armwise signed-distance conditional-mean versions. The disintegration identity pins both one-sided functions to one selected conditional law, avoiding arbitrary pointwise choices of condDistrib.
Definition (Lean source)
def SignedDistanceMeanVersions (P : A1A2Law) (d : Score → Score → ℝ) (x : Score)
(θ₁ θ₀ : ℝ → ℝ) : Prop :=
∃ κ : Kernel ℝ ℝ,
IsMarkovKernel κ ∧
(Measure.map (fun w => identificationSignedDistance P d x (causalScore w)) P.law).compProd κ =
Measure.map (fun w =>
(identificationSignedDistance P d x (causalScore w), observedOutcome P w)) P.law ∧
(∀ r, 0 < r → θ₁ r = ∫ y, y ∂κ r) ∧
(∀ r, r < 0 → θ₀ r = ∫ y, y ∂κ r)
Cattaneo, Titiunik, and Yu (2026), Theorem 1, printed p. 4, DOI 10.1016/j.jeconom.2026.106266: under the displayed Assumptions 1(i)--(iii) and 2(i),(ii),(v), there is a selected source-coherent signed-distance conditional-mean version whose one-sided limits identify the boundary effect. The statement does not range over every arbitrary disintegration or version.
Definition (Lean source)
def CtyDistanceIdentification (p : ℕ) (_ν _L : ℝ) : Prop :=
∀ P : A1A2Law, ∀ d : Score → Score → ℝ,
CtyIdentificationAssumptions p P d → ∀ x ∈ P.boundary,
∃ θ₁ θ₀ : ℝ → ℝ, SignedDistanceMeanVersions P d x θ₁ θ₀ ∧
∃ rightLimit leftLimit : ℝ,
Tendsto θ₁ (nhdsWithin 0 (Ioi 0)) (nhds rightLimit) ∧
Tendsto θ₀ (nhdsWithin 0 (Iio 0)) (nhds leftLimit) ∧
P.tau x = rightLimit - leftLimit
A finite set is shattered by the distance balls generated by d, with centres restricted to the score support as in CTY Assumption 2(iii).
The distance-ball family in CTY's uniform-kernel alternative has finite VC index. No Euclidean specialization or fixed numerical index is imposed.
Definition (Lean source)
def CtyMetricBallsVCProperty (P : A1A2Law)
(d : Score → Score → ℝ) : Prop :=
∃ v : ℕ, ∀ S : Finset Score, v ≤ S.card →
¬ ShatteredByMetricBalls P d S
The two kernel alternatives in CTY Assumption 2(iii): a nonnegative, compactly supported Lipschitz kernel, or the uniform kernel together with a finite-VC distance-ball family.
Definition (Lean source)
def CtyUniformBiasKernel (P : A1A2Law) (d : Score → Score → ℝ)
(K : ℝ → ℝ) : Prop :=
(∀ u, 0 ≤ K u) ∧
((HasCompactSupport K ∧ ∃ C : ℝ≥0, LipschitzWith C K) ∨
(K = uniformKernel ∧ CtyMetricBallsVCProperty P d))
def ctyUniformBiasPopulationGram
The population Gram matrix for the general metric/kernel regime of CTY Theorem 2.
Definition (Lean source)
noncomputable def ctyUniformBiasPopulationGram (P : A1A2Law) (p : ℕ)
(d : Score → Score → ℝ) (K : ℝ → ℝ) (t : Bool)
(x : Score) (h : ℝ) : Matrix (Fin (p + 1)) (Fin (p + 1)) ℝ := by
classical
exact fun j k => ∫ w,
h⁻¹ ^ 2 *
(if signedArm t (identificationSignedDistance P d x (causalScore w))
then 1 else 0) *
K (identificationSignedDistance P d x (causalScore w) / h) *
polyBasis p (identificationSignedDistance P d x (causalScore w) / h) j *
polyBasis p (identificationSignedDistance P d x (causalScore w) / h) k ∂P.law
def ctyUniformBiasPopulationScore
The population score in the general metric/kernel normal equations.
Definition (Lean source)
noncomputable def ctyUniformBiasPopulationScore (P : A1A2Law) (p : ℕ)
(d : Score → Score → ℝ) (K : ℝ → ℝ) (t : Bool)
(x : Score) (h : ℝ) : Fin (p + 1) → ℝ := by
classical
exact fun j => ∫ w,
h⁻¹ ^ 2 *
(if signedArm t (identificationSignedDistance P d x (causalScore w))
then 1 else 0) *
K (identificationSignedDistance P d x (causalScore w) / h) *
polyBasis p (identificationSignedDistance P d x (causalScore w) / h) j *
observedOutcome P w ∂P.law
def ctyUniformBiasPopulationCoefficient
The original, unwinsorized population coefficient in CTY's full metric/kernel regime.
Definition (Lean source)
noncomputable def ctyUniformBiasPopulationCoefficient (P : A1A2Law) (p : ℕ)
(d : Score → Score → ℝ) (K : ℝ → ℝ) (t : Bool)
(x : Score) (h : ℝ) : Fin (p + 1) → ℝ :=
mulVec (ctyUniformBiasPopulationGram P p d K t x h)
⁻¹ (ctyUniformBiasPopulationScore P p d K t x h)
def ctyUniformBiasGramFloor
The smallest Rayleigh quotient of the population Gram matrix, represented in ℝ≥0∞ so the infimum is total.
Definition (Lean source)
noncomputable def ctyUniformBiasGramFloor (P : A1A2Law) (p : ℕ)
(d : Score → Score → ℝ) (K : ℝ → ℝ) (t : Bool)
(h : ℝ) : ℝ≥0∞ :=
⨅ x : Score, ⨅ (_hx : x ∈ P.boundary),
⨅ v : Fin (p + 1) → ℝ, ⨅ (_hv : ∑ i, (v i) ^ 2 = 1),
ofReal
(matrixQuadratic (ctyUniformBiasPopulationGram P p d K t x h) v)
def ctyUniformBiasArmLocalMass
Lebesgue mass of a general metric/kernel arm neighborhood.
The source-sized class in CTY Theorem 2. It retains Assumptions 1(i)--(iii), all of Assumption 2, the displayed uniform density and derivative envelopes, and the two genuine liminf small-bandwidth restrictions. It is not the Euclidean/uniform-kernel P₁₂ specialization.
Definition (Lean source)
def CtyUniformBiasLawClass (p : ℕ) (L : ℝ) (P : A1A2Law)
(d : Score → Score → ℝ) (K : ℝ → ℝ) : Prop :=
1 ≤ L ∧
CtyIdentificationAssumptions p P d ∧
P.support ⊆ scoreCube L ∧
(∀ x ∈ P.support, L⁻¹ ≤ P.density x ∧ P.density x ≤ L) ∧
(∀ t, EuclideanCExtEnvelope (P.muPO t) p L P.support) ∧
CtyUniformBiasKernel P d K ∧
(∀ t : Bool, ∃ c : ℝ, 0 < c ∧
ofReal c ≤
liminf (ctyUniformBiasGramFloor P p d K t)
(nhdsWithin 0 (Ioi 0))) ∧
∀ t : Bool,
ofReal L⁻¹ ≤
liminf
(fun h => ⨅ x : Score, ⨅ (_hx : x ∈ P.boundary),
ctyUniformBiasArmLocalMass P d K t x h)
(nhdsWithin 0 (Ioi 0))
def causalUniformBiasRatio
Uniform absolute population-contrast bias normalized by bandwidth over the exact Euclidean/uniform-kernel P₁₂(p,ν,L) specialization used by the upper theorem.
Definition (Lean source)
noncomputable def causalUniformBiasRatio (p : ℕ) (ν L h : ℝ) : ℝ≥0∞ :=
⨆ P : A1A2Law, ⨆ (_hP : A1A2Class p ν L P),
⨆ x : Score, ⨆ (_hx : x ∈ P.boundary), ofReal
(|(populationCoefficient P p true x h 0 -
populationCoefficient P p false x h 0) - P.tau x| / h)
Cattaneo, Titiunik, and Yu (2026), Theorem 2, printed pp. 5--6, DOI 10.1016/j.jeconom.2026.106266: the upper-only corollary used here on the exact P₁₂(p,ν,L) specialization. A constant depending only on p and L controls the finite limsup uniformly in ν, along every positive antitone deterministic bandwidth sequence with h_n → 0 and n h_n² → ∞.
Definition (Lean source)
def CtyUniformFirstOrderBias (p : ℕ) (L : ℝ) : Prop :=
∃ C : ℝ, 0 < C ∧ ∀ ν : ℝ, 2 ≤ ν → ∀ hseq : ℕ → ℝ,
(∀ n : ℕ, 0 < hseq n) → Antitone hseq →
Tendsto hseq atTop (nhds 0) →
Tendsto (fun n : ℕ => (n : ℝ) * (hseq n) ^ 2) atTop atTop →
limsup (fun n => causalUniformBiasRatio p ν L (hseq n)) atTop ≤
ofReal C
def rawEmpiricalScore
The unwinsorized empirical score vector.
Definition (Lean source)
noncomputable def rawEmpiricalScore (n p : ℕ) (t : Bool) (h : ℝ)
(u : SignedDistanceSample n) : Fin (p + 1) → ℝ := by
classical
exact fun j => (n : ℝ)⁻¹ * h⁻¹ ^ 2 * ∑ i,
(if signedArm t (u i).2 then 1 else 0) * uniformKernel ((u i).2 / h) *
polyBasis p ((u i).2 / h) j * (u i).1
def causalGramDeviation
Uniform empirical Gram deviation for one sample.
Definition (Lean source)
noncomputable def causalGramDeviation (n p : ℕ) (P : A1A2Law)
(h : ℝ) (w : CausalSample n) : ℝ≥0∞ :=
⨆ t : Bool, ⨆ x : Score, ⨆ (_hx : x ∈ P.boundary),
⨆ j : Fin (p + 1), ⨆ k : Fin (p + 1), ofReal
|empiricalGram n p t h (signedDistanceData n P w x) j k -
populationGram P p t x h j k|
def causalRawScoreDeviation
Uniform centered raw-score deviation for one sample.
Definition (Lean source)
noncomputable def causalRawScoreDeviation (n p : ℕ) (P : A1A2Law)
(h : ℝ) (w : CausalSample n) : ℝ≥0∞ :=
⨆ t : Bool, ⨆ x : Score, ⨆ (_hx : x ∈ P.boundary),
ofReal ‖rawEmpiricalScore n p t h
(signedDistanceData n P w x) - populationScore P p t x h‖
def CtyExpectedLocalPolynomialMaximalBounds Definition aux_CtyExpectedLocalPolynomialMaximalBounds in the paper ↗
Cattaneo, Titiunik, and Yu (2026), Supplemental Appendix SA-8.3--8.4, printed pp. 32--35, DOI 10.1016/j.jeconom.2026.106266: the expected outer Gram and centered-score suprema satisfy the two displayed maximal bounds in the small-bandwidth regime.
Definition (Lean source)
def CtyExpectedLocalPolynomialMaximalBounds (p : ℕ) (ν L : ℝ) : Prop :=
∃ C : ℝ, 0 < C ∧ ∀ hseq : ℕ → ℝ,
(∀ n : ℕ, 0 < hseq n) → Tendsto hseq atTop (nhds 0) →
Tendsto (fun n : ℕ =>
(n : ℝ) ^ ((1 + ν) / (2 + ν)) * (hseq n) ^ 2 /
log ((hseq n)⁻¹)) atTop atTop →
∀ᶠ n in atTop, ∀ P : A1A2Law, A1A2Class p ν L P →
outerLIntegral (causalSampleLaw P n)
(causalGramDeviation n p P (hseq n)) ≤
ofReal (C * sqrt
(log ((hseq n)⁻¹) / ((n : ℝ) * (hseq n) ^ 2))) ∧
outerLIntegral (causalSampleLaw P n)
(causalRawScoreDeviation n p P (hseq n)) ≤
ofReal (C *
(sqrt (log ((hseq n)⁻¹) / ((n : ℝ) * (hseq n) ^ 2)) +
log ((hseq n)⁻¹) /
((n : ℝ) ^ ((1 + ν) / (2 + ν)) * (hseq n) ^ 2)))
Causal.DecisionClass 6 declarations Only fixed (geometry, point) sections are measurable.
Known-geometry point-indexed causal decision class and outer risk
Only fixed (geometry, point) sections are measurable. No joint regularity in
the interface point is imposed, so the risk uses outer expectation.
def A1A2RuleFun
Ambient causal rules take the sample, the known geometry, and a query point.
Definition (Lean source)
structure A1A2PIRule
A law-independent family of Borel fixed sections.
Definition (Lean source)
Known-geometry point-indexed rules with Borel fixed sections and no joint regularity in the interface index.
Definition (Lean source)
def A1A2PointIndexedDecisionClass (n p : ℕ) (ν L : ℝ) : Set (A1A2RuleFun n) :=
{rho | ∃ T : A1A2PIRule n, ∀ P, A1A2Class p ν L P →
∀ w x, x ∈ P.boundary →
rho w (knownGeometry P) x =
T.map (knownGeometry P) x (signedDistanceData n P w x)}
def a1a2BoundaryLoss
Extended nonnegative interface-supremum loss.
Definition (Lean source)
noncomputable def a1a2BoundaryLoss {n : ℕ} (rho : A1A2RuleFun n)
(P : A1A2Law) (w : CausalSample n) : ℝ≥0∞ :=
⨆ x : Score, ⨆ (_hx : x ∈ P.boundary),
ofReal |rho w (knownGeometry P) x - P.tau x|
The known-geometry point-indexed minimax risk under outer expectation.
Definition (Lean source)
noncomputable def a1a2OuterRisk (n p : ℕ) (ν L : ℝ) : ℝ≥0∞ :=
⨅ rho : A1A2RuleFun n,
⨅ (_hrho : rho ∈ A1A2PointIndexedDecisionClass n p ν L),
⨆ P : A1A2Law, ⨆ (_hP : A1A2Class p ν L P),
outerLIntegral (causalSampleLaw P n) (a1a2BoundaryLoss rho P)
theorem outerLIntegral_eq_outerLIntegral
The local and upstream outer-integral spellings agree definitionally.
Formal statement
hypotheses
conclusion
outerLIntegral μ Z = outerLIntegral μ Z
Proof (Lean source)
lemma MeasureTheory.outerLIntegral_eq_outerLIntegral {Ω : Type*} [MeasurableSpace Ω]
(μ : Measure Ω) (Z : Ω → ℝ≥0∞) :
outerLIntegral μ Z = outerLIntegral μ Z := rfl
Causal.EmpiricalProcess.EntropyChaining 3 declarations The hypotheses below expose exactly the envelope, variance, and polynomial covering information used by the variance-adaptive maximal inequality.
VC entropy and chaining for the bounded score class
The hypotheses below expose exactly the envelope, variance, and polynomial covering information used by the variance-adaptive maximal inequality.
theorem winsorizedScore_hasVCUniformEntropy_at
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
p :
ℕ
ν L R :
ℝ
hR :
0 < R
conclusion
∃ A v C : ℝ,
0 < C ∧
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ h B : ℝ, 0 < h → h < B → 1
≤ B → HasVCUniformEntropy P.law (separableWinsorizedScoreFunction P p h B R) (C * B) (C * h) A v
Proof (Lean source)
lemma winsorizedScore_hasVCUniformEntropy_at
(p : ℕ) (ν L R : ℝ) (hR : 0 < R) :
∃ A v C : ℝ, 0 < C ∧
∀ P : A1A2Law, A1A2Class p ν L P →
∀ h B : ℝ, 0 < h → h < B → 1 ≤ B →
HasVCUniformEntropy P.law (separableWinsorizedScoreFunction P p h B R)
(C * B) (C * h) A v := by
obtain ⟨A₀, v, hA₀, hv, hcover⟩ :=
separableWinsorizedScore_hasUniformPolynomialL2Cover p hR
obtain ⟨C₀, hC₀, hL2⟩ :=
separableWinsorizedScore_hasUniformL2Radius_at p ν L R hR
let c : ℝ := 2 * ((2 : ℝ) ^ p) ^ 2 + 2
let Cenv : ℝ := c * (1 + (p + 1 : ℝ) * R)
let C : ℝ := 1 + max C₀ Cenv
refine ⟨2 * A₀, v, C, ?_, ?_⟩
· have hCenv : 0 ≤ Cenv := by dsimp [Cenv, c]; positivity
have : 0 ≤ max C₀ Cenv := hCenv.trans (le_max_right _ _)
dsimp [C]
linarith
· intro P hP h B hh hhB hB
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hbdy := winsorizedScore_boundary_nonempty p ν L P hP
letI : Nonempty {x : Score // x ∈ P.boundary} := hbdy.to_subtype
letI : Nonempty (SeparableWinsorizedScoreIndex P p h) := ⟨
⟨⟨h, ⟨le_rfl, by linarith⟩⟩,
⟨false, ⟨Classical.arbitrary _, ⟨0, Classical.arbitrary _⟩⟩⟩⟩⟩
obtain ⟨hpoly, hemp⟩ := hcover P hbdy hh (hh.trans hhB)
have hmeas : ∀ i : SeparableWinsorizedScoreIndex P p h,
Measurable (separableWinsorizedScoreFunction P p h B R i) :=
fun i => separableWinsorizedScoreFunction_measurable P p h B R i
have hc : 0 ≤ c := by dsimp [c]; positivity
have hCenv : 0 ≤ Cenv := by dsimp [Cenv]; positivity
have hCB : c * (B + (p + 1 : ℝ) * R) ≤ Cenv * B := by
have hp : 0 ≤ (p : ℝ) := Nat.cast_nonneg p
have hB0 : 0 ≤ B := le_trans (by norm_num) hB
dsimp [Cenv]
have hpr : 0 ≤ (p + 1 : ℝ) * R := by positivity
nlinarith [mul_nonneg hc (sub_nonneg.mpr hB),
mul_nonneg hB0 (add_nonneg (by norm_num : (0 : ℝ) ≤ 1) hpr)]
have henvC : Cenv ≤ C := by
dsimp [C]
exact (le_max_right C₀ Cenv).trans (by linarith)
have hU : c * (B + (p + 1 : ℝ) * R) ≤ C * B :=
hCB.trans (mul_le_mul_of_nonneg_right henvC (le_trans (by norm_num) hB))
have hU' : (2 * ((2 : ℝ) ^ p) ^ 2 + 2) *
(B + ((p + 1 : ℕ) : ℝ) * R) ≤ C * B := by
simpa [c, Nat.cast_add, cast_one] using hU
have hC₀C : C₀ ≤ C := by
dsimp [C]
exact (le_max_left C₀ Cenv).trans (by linarith)
have hCpos : 0 < C := by
have : 0 ≤ max C₀ Cenv := hC₀.le.trans (le_max_left _ _)
dsimp [C]
linarith
refine ⟨mul_pos hCpos hh, mul_lt_mul_of_pos_left hhB hCpos,
hA₀.trans (by nlinarith [Real.exp_pos 1, hA₀]), hv, hmeas, ?_, ?_, ?_⟩
· intro i z
exact (hpoly.envelope i z).trans hU'
· intro i
exact (hL2 P hP h B hh hhB hB i).trans
(mul_le_mul_of_nonneg_right hC₀C hh.le)
· intro g₀
exact pullback
(hemp.enlargeEnvelope hU') hmeas g₀
theorem winsorizedScore_hasVCUniformEntropy_all_nu
The same entropy certificate with all witnesses chosen uniformly before the moment exponent. The L² proof's displayed constant does not depend on that exponent.
Formal statement
hypotheses
p :
ℕ
L R :
ℝ
hR :
0 < R
conclusion
∃ A v C : ℝ,
0 < C ∧
∀ ν : ℝ,
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ h B : ℝ, 0 < h → h < B → 1
≤ B → HasVCUniformEntropy P.law (separableWinsorizedScoreFunction P p h B R) (C * B) (C * h) A v
Proof (Lean source)
-- @node: winsorizedScore_hasVCUniformEntropy_all_nu
lemma winsorizedScore_hasVCUniformEntropy_all_nu
(p : ℕ) (L R : ℝ) (hR : 0 < R) :
∃ A v C : ℝ, 0 < C ∧ ∀ ν : ℝ,
∀ P : A1A2Law, A1A2Class p ν L P →
∀ h B : ℝ, 0 < h → h < B → 1 ≤ B →
HasVCUniformEntropy P.law (separableWinsorizedScoreFunction P p h B R)
(C * B) (C * h) A v := by
obtain ⟨A₀, v, hA₀, hv, hcover⟩ :=
separableWinsorizedScore_hasUniformPolynomialL2Cover p hR
let C₀ : ℝ := 1 + |3 * ((2 : ℝ) ^ p) ^ 2 *
(2 * (1 + L) + ((p + 1 : ℝ) * (2 : ℝ) ^ p * R) ^ 2) * (16 * L)|
let c : ℝ := 2 * ((2 : ℝ) ^ p) ^ 2 + 2
let Cenv : ℝ := c * (1 + (p + 1 : ℝ) * R)
let C : ℝ := 1 + max C₀ Cenv
refine ⟨2 * A₀, v, C, ?_, ?_⟩
· have hCenv : 0 ≤ Cenv := by dsimp [Cenv, c]; positivity
have : 0 ≤ max C₀ Cenv := hCenv.trans (le_max_right _ _)
dsimp [C]
linarith
· intro ν P hP h B hh hhB hB
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hbdy := winsorizedScore_boundary_nonempty p ν L P hP
letI : Nonempty {x : Score // x ∈ P.boundary} := hbdy.to_subtype
letI : Nonempty (SeparableWinsorizedScoreIndex P p h) := ⟨
⟨⟨h, ⟨le_rfl, by linarith⟩⟩,
⟨false, ⟨Classical.arbitrary _, ⟨0, Classical.arbitrary _⟩⟩⟩⟩⟩
obtain ⟨hpoly, hemp⟩ := hcover P hbdy hh (hh.trans hhB)
have hmeas : ∀ i : SeparableWinsorizedScoreIndex P p h,
Measurable (separableWinsorizedScoreFunction P p h B R i) :=
fun i => separableWinsorizedScoreFunction_measurable P p h B R i
have hc : 0 ≤ c := by dsimp [c]; positivity
have hCenv : 0 ≤ Cenv := by dsimp [Cenv]; positivity
have hCB : c * (B + (p + 1 : ℝ) * R) ≤ Cenv * B := by
have hp : 0 ≤ (p : ℝ) := Nat.cast_nonneg p
have hB0 : 0 ≤ B := le_trans (by norm_num) hB
dsimp [Cenv]
have hpr : 0 ≤ (p + 1 : ℝ) * R := by positivity
nlinarith [mul_nonneg hc (sub_nonneg.mpr hB),
mul_nonneg hB0 (add_nonneg (by norm_num : (0 : ℝ) ≤ 1) hpr)]
have henvC : Cenv ≤ C := by
dsimp [C]
exact (le_max_right C₀ Cenv).trans (by linarith)
have hU : c * (B + (p + 1 : ℝ) * R) ≤ C * B :=
hCB.trans (mul_le_mul_of_nonneg_right henvC (le_trans (by norm_num) hB))
have hU' : (2 * ((2 : ℝ) ^ p) ^ 2 + 2) *
(B + ((p + 1 : ℕ) : ℝ) * R) ≤ C * B := by
simpa [c, Nat.cast_add, cast_one] using hU
have hC₀C : C₀ ≤ C := by
dsimp [C]
exact (le_max_left C₀ Cenv).trans (by linarith)
have hCpos : 0 < C := by
have : 0 ≤ max C₀ Cenv := (by positivity : 0 ≤ C₀).trans (le_max_left _ _)
dsimp [C]
linarith
refine ⟨mul_pos hCpos hh, mul_lt_mul_of_pos_left hhB hCpos,
hA₀.trans (by nlinarith [Real.exp_pos 1, hA₀]), hv, hmeas, ?_, ?_, ?_⟩
· intro i z
exact (hpoly.envelope i z).trans hU'
· intro i
exact (separableWinsorizedScore_hasUniformL2Radius_explicit p ν L R hR
P hP h B hh hhB hB i).trans
(mul_le_mul_of_nonneg_right hC₀C hh.le)
· intro g₀
exact pullback
(hemp.enlargeEnvelope hU') hmeas g₀
theorem winsorizedScore_hasVCUniformEntropy
A positive coefficient clipping radius can be chosen together with the uniform entropy witnesses.
Formal statement
hypotheses
p :
ℕ
ν L :
ℝ
conclusion
∃ A v R C : ℝ,
0 < R ∧
0 < C ∧
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ h B : ℝ, 0 < h → h < B → 1
≤ B → HasVCUniformEntropy P.law (separableWinsorizedScoreFunction P p h B R) (C * B) (C * h) A v
Proof (Lean source)
-- @node: winsorizedScore_hasVCUniformEntropy
lemma winsorizedScore_hasVCUniformEntropy
(p : ℕ) (ν L : ℝ) :
∃ A v R C : ℝ, 0 < R ∧ 0 < C ∧
∀ P : A1A2Law, A1A2Class p ν L P →
∀ h B : ℝ, 0 < h → h < B → 1 ≤ B →
HasVCUniformEntropy P.law (separableWinsorizedScoreFunction P p h B R)
(C * B) (C * h) A v := by
obtain ⟨A, v, C, hC, h⟩ :=
winsorizedScore_hasVCUniformEntropy_at p ν L 1 (by norm_num)
exact ⟨A, v, 1, C, by norm_num, hC, h⟩
Causal.EmpiricalProcess.PopulationCoefficient 5 declarations This module bounds the original population score and then uses the class's quadratic-form Gram floor to put every population coefficient in one fixed ball.
Uniform population-coefficient radius
This module bounds the original population score and then uses the class's quadratic-form Gram floor to put every population coefficient in one fixed ball. This is the adapter needed to embed the actual score process into the bounded-coefficient entropy class.
theorem populationScore_apply_uniform_bound
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
Proof (Lean source)
lemma populationScore_apply_uniform_bound (p : ℕ) (ν L : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) (t : Bool) (x : Score) (hx : x ∈ P.boundary)
(h : ℝ) (hh : 0 < h) (hhL : h ≤ L⁻¹) (j : Fin (p + 1)) :
|populationScore P p t x h j| ≤ 16 * L * (2 + L) := by
classical
let d : CausalObservation → ℝ := fun w =>
signedDistance (knownGeometry P) x (causalScore w)
let g : CausalObservation → ℝ := fun w =>
(if signedArm t (d w) then 1 else 0) * uniformKernel (d w / h) *
polyBasis p (d w / h) j * observedOutcome P w
let F : CausalObservation → ℝ := fun w => h⁻¹ ^ 2 * g w
have hpoint (w : CausalObservation) (hw : causalScore w ∈ P.support) :
‖F w‖ₑ ≤ ofReal (h⁻¹ ^ 2) *
(Metric.closedBall x h).indicator (fun _ =>
1 + 2 * ofReal ((armCoord false w) ^ 2) +
2 * ofReal ((armCoord true w) ^ 2)) (causalScore w) := by
let i : WinsorizedScoreIndex p := (t, x, (0, j))
have hsquare := winsorizedScore_sq_pointwise_le P p h
|observedOutcome P w| 0 hh (abs_nonneg _) (le_refl 0) i w hw
have hwinsor : winsorize |observedOutcome P w| (observedOutcome P w) =
observedOutcome P w := by
unfold winsorize
by_cases hy : observedOutcome P w < 0
· simp [hy, abs_of_neg hy]
· by_cases hy0 : observedOutcome P w = 0
· simp [hy0]
· have hypos : 0 < observedOutcome P w := lt_of_le_of_ne (le_of_not_gt hy) (Ne.symm hy0)
simp [hy, hy0, abs_of_pos hypos]
have heq : winsorizedScoreFunction P p h |observedOutcome P w| 0 i w = g w := by
simp [i, g, winsorizedScoreFunction, d, clip, hwinsor]
rw [heq] at hsquare
have habs : |g w| ≤ (Metric.closedBall x h).indicator (fun _ =>
1 + 2 * (armCoord false w) ^ 2 + 2 * (armCoord true w) ^ 2)
(causalScore w) := by
by_cases hb : causalScore w ∈ Metric.closedBall x h
· simp only [indicator_of_mem hb]
simp only [i, indicator_of_mem hb, Nat.cast_add, cast_one, mul_zero,
zero_pow, Fin.isValue, add_zero] at hsquare
nlinarith [sq_abs (g w), sq_nonneg (|g w| - 1),
sq_nonneg (armCoord false w), sq_nonneg (armCoord true w)]
· simp only [indicator_of_notMem hb]
simp only [i, indicator_of_notMem hb, mul_zero] at hsquare
have : g w = 0 := by nlinarith [sq_nonneg (g w)]
simp [this]
rw [← ofReal_norm_eq_enorm, Real.norm_eq_abs]
change ofReal |h⁻¹ ^ 2 * g w| ≤ _
rw [abs_mul, abs_of_nonneg (by positivity : 0 ≤ h⁻¹ ^ 2)]
by_cases hb : causalScore w ∈ Metric.closedBall x h
· simp only [indicator_of_mem hb] at habs ⊢
have hnonneg : 0 ≤ 1 + 2 * (armCoord false w) ^ 2 +
2 * (armCoord true w) ^ 2 := by positivity
calc
ofReal (h⁻¹ ^ 2 * |g w|) ≤
ofReal (h⁻¹ ^ 2 * (1 + 2 * (armCoord false w) ^ 2 +
2 * (armCoord true w) ^ 2)) :=
ENNReal.ofReal_le_ofReal (mul_le_mul_of_nonneg_left habs (by positivity))
_ = ofReal (h⁻¹ ^ 2) *
(1 + 2 * ofReal ((armCoord false w) ^ 2) +
2 * ofReal ((armCoord true w) ^ 2)) := by
rw [← ENNReal.ofReal_one, ← ENNReal.ofReal_ofNat,
← ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 2),
← ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 2),
← ENNReal.ofReal_add (by norm_num : (0 : ℝ) ≤ 1) (by positivity),
← ENNReal.ofReal_add (by positivity) (by positivity),
← ENNReal.ofReal_mul (by positivity : 0 ≤ h⁻¹ ^ 2)]
· simp only [indicator_of_notMem hb]
rw [indicator_of_notMem hb] at habs
have hg0 : |g w| = 0 := le_antisymm habs (abs_nonneg _)
simp [hg0]
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
let S : Set CausalObservation := causalScore ⁻¹' Metric.closedBall x h
let Gc : CausalObservation → ℝ≥0∞ := S.indicator (fun _ => 1)
let G0 : CausalObservation → ℝ≥0∞ := S.indicator
(fun w => ofReal ((armCoord false w) ^ 2))
let G1 : CausalObservation → ℝ≥0∞ := S.indicator
(fun w => ofReal ((armCoord true w) ^ 2))
have hS : MeasurableSet S := Metric.isClosed_closedBall.measurableSet.preimage hscore
have harm (t : Bool) : Measurable (armCoord t) := by
cases t <;> unfold armCoord <;> simp only [Bool.false_eq_true, if_false,
if_true] <;> fun_prop
have hGc : Measurable Gc := Measurable.indicator measurable_const hS
have hG0 : Measurable G0 := Measurable.indicator ((harm false).pow_const 2).ennreal_ofReal hS
have hG1 : Measurable G1 := Measurable.indicator ((harm true).pow_const 2).ennreal_ofReal hS
have htotalMeas : Measurable (fun w =>
(Metric.closedBall x h).indicator (fun _ =>
1 + 2 * ofReal ((armCoord false w) ^ 2) +
2 * ofReal ((armCoord true w) ^ 2)) (causalScore w)) := by
rw [show (fun w => (Metric.closedBall x h).indicator (fun _ =>
1 + 2 * ofReal ((armCoord false w) ^ 2) +
2 * ofReal ((armCoord true w) ^ 2)) (causalScore w)) =
fun w => Gc w + (2 : ENNReal) * G0 w + (2 : ENNReal) * G1 w by
funext w
by_cases hw : causalScore w ∈ Metric.closedBall x h <;>
simp [S, Gc, G0, G1, hw]]
exact (hGc.add (measurable_const.mul hG0)).add (measurable_const.mul hG1)
have hsplit : (∫⁻ w, (Metric.closedBall x h).indicator (fun _ =>
1 + 2 * ofReal ((armCoord false w) ^ 2) +
2 * ofReal ((armCoord true w) ^ 2)) (causalScore w) ∂P.law) =
(Measure.map causalScore P.law) (Metric.closedBall x h) +
2 * (∫⁻ w, G0 w ∂P.law) + 2 * (∫⁻ w, G1 w ∂P.law) := by
have hfun : (fun w => (Metric.closedBall x h).indicator (fun _ =>
1 + 2 * ofReal ((armCoord false w) ^ 2) +
2 * ofReal ((armCoord true w) ^ 2)) (causalScore w)) =
fun w => Gc w + 2 * G0 w + 2 * G1 w := by
funext w
by_cases hw : causalScore w ∈ Metric.closedBall x h <;>
simp [S, Gc, G0, G1, hw]
rw [hfun, lintegral_add_left (hGc.fun_add (measurable_const.fun_mul hG0)),
lintegral_add_left hGc, lintegral_const_mul 2 hG0,
lintegral_const_mul 2 hG1]
have hGcInt : (∫⁻ w, Gc w ∂P.law) =
(Measure.map causalScore P.law) (Metric.closedBall x h) := by
rw [show Gc = S.indicator (fun _ => 1) by rfl,
lintegral_indicator hS, setLIntegral_one]
exact (Measure.map_apply_of_aemeasurable hscore.aemeasurable
Metric.isClosed_closedBall.measurableSet).symm
rw [hGcInt]
have hsuppMap : ∀ᵐ z ∂Measure.map causalScore P.law, z ∈ P.support := by
rw [P.support_eq_marginal_support]
exact Measure.support_mem_ae
have hsupp : ∀ᵐ w ∂P.law, causalScore w ∈ P.support :=
MeasureTheory.ae_of_ae_map hscore.aemeasurable hsuppMap
have hlin : (∫⁻ w, ‖F w‖ₑ ∂P.law) ≤
ofReal (16 * L * (2 + L)) := by
calc
_ ≤ ofReal (h⁻¹ ^ 2) *
(∫⁻ w, (Metric.closedBall x h).indicator (fun _ =>
1 + 2 * ofReal ((armCoord false w) ^ 2) +
2 * ofReal ((armCoord true w) ^ 2))
(causalScore w) ∂P.law) := by
rw [← lintegral_const_mul _ htotalMeas]
exact lintegral_mono_ae (hsupp.mono fun w hw => hpoint w hw)
_ = ofReal (h⁻¹ ^ 2) *
((Measure.map causalScore P.law) (Metric.closedBall x h) +
2 * (∫⁻ w, G0 w ∂P.law) + 2 * (∫⁻ w, G1 w ∂P.law)) := by rw [hsplit]
_ ≤ ofReal (h⁻¹ ^ 2) *
(ofReal (4 * L * h ^ 2) +
2 * ofReal ((1 + L) * (4 * L * h ^ 2)) +
2 * ofReal ((1 + L) * (4 * L * h ^ 2))) := by
gcongr
· exact marginal_closedBall_le p ν L P hP x h hh
· exact localized_arm_sq_lintegral_le p ν L P hP false x h hh
· exact localized_arm_sq_lintegral_le p ν L P hP true x h hh
_ ≤ ofReal (16 * L * (2 + L)) := by
have hL : 0 ≤ L := le_trans (by norm_num) hP.2.1
have hcancel : h⁻¹ ^ 2 * h ^ 2 = 1 := by field_simp
rw [show (2 : ENNReal) * ofReal ((1 + L) * (4 * L * h ^ 2)) =
ofReal (2 * ((1 + L) * (4 * L * h ^ 2))) by
rw [show (2 : ENNReal) = ofReal 2 by norm_num,
← ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 2)],
← ENNReal.ofReal_add (by positivity : 0 ≤ 4 * L * h ^ 2) (by positivity),
← ENNReal.ofReal_add (by positivity) (by positivity),
← ENNReal.ofReal_mul (by positivity : 0 ≤ h⁻¹ ^ 2)]
apply ENNReal.ofReal_le_ofReal
calc
h⁻¹ ^ 2 * (4 * L * h ^ 2 + 2 * ((1 + L) * (4 * L * h ^ 2)) +
2 * ((1 + L) * (4 * L * h ^ 2))) =
(h⁻¹ ^ 2 * h ^ 2) *
(4 * L + 2 * ((1 + L) * (4 * L)) + 2 * ((1 + L) * (4 * L))) := by ring
_ ≤ 16 * L * (2 + L) := by rw [hcancel]; nlinarith
have hi := MeasureTheory.enorm_integral_le_lintegral_enorm F (μ := P.law)
have hE : ofReal |∫ w, F w ∂P.law| ≤
ofReal (16 * L * (2 + L)) := by
simpa [← ofReal_norm_eq_enorm, Real.norm_eq_abs] using hi.trans hlin
have hL : 0 ≤ L := le_trans (by norm_num) hP.2.1
have hreal := (ENNReal.ofReal_le_ofReal_iff
(mul_nonneg (mul_nonneg (by norm_num) hL) (by linarith))).mp hE
have heqint : populationScore P p t x h j = ∫ w, F w ∂P.law := by
simp only [populationScore, F, g, d]
congr 1
funext w
ring
rw [heqint]
exact hreal
theorem populationGram_posDef
The stated bandwidth is strictly positive at every sample size.
Formal statement
Proof (Lean source)
lemma populationGram_posDef (p : ℕ) (ν L : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) (t : Bool) (x : Score) (hx : x ∈ P.boundary)
(h : ℝ) (hh : 0 < h) (hhL : h ≤ L⁻¹) :
(populationGram P p t x h).PosDef := by
apply Matrix.PosDef.of_dotProduct_mulVec_pos
· unfold IsHermitian
ext j k
simp only [Matrix.conjTranspose_apply, starRingEnd_apply, star_trivial]
unfold populationGram
apply integral_congr_ae
filter_upwards with w
ring
· intro v hv
have hfloor := hP.2.2.2.2.2.2.2.2.2.2.2.2.1 t x h hx hh hhL v
obtain ⟨i, hi⟩ : ∃ i, v i ≠ 0 := by
by_contra hn
push_neg at hn
exact hv (funext hn)
have hsum : 0 < ∑ i, (v i) ^ 2 := Finset.sum_pos'
(fun i _ => sq_nonneg (v i)) ⟨i, Finset.mem_univ _, sq_pos_of_ne_zero hi⟩
have hL : 0 < L := lt_of_lt_of_le (by norm_num) hP.2.1
rw [show matrixQuadratic (populationGram P p t x h) v =
dotProduct v (mulVec (populationGram P p t x h) v) by
simp [matrixQuadratic, dotProduct, mulVec, Finset.mul_sum]; ring] at hfloor
exact lt_of_lt_of_le (mul_pos (inv_pos.mpr hL) hsum) hfloor
theorem populationGram_mulVec_populationCoefficient
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
conclusion
mulVec (populationGram P p t x h) (populationCoefficient P p t x h)
= populationScore P p t x h
Proof (Lean source)
lemma populationGram_mulVec_populationCoefficient (p : ℕ) (ν L : ℝ)
(P : A1A2Law) (hP : A1A2Class p ν L P) (t : Bool) (x : Score)
(hx : x ∈ P.boundary) (h : ℝ) (hh : 0 < h) (hhL : h ≤ L⁻¹) :
mulVec (populationGram P p t x h)
(populationCoefficient P p t x h) = populationScore P p t x h := by
have hp := populationGram_posDef p ν L P hP t x hx h hh hhL
rw [populationCoefficient, Matrix.mulVec_mulVec,
Matrix.mul_nonsing_inv _ (isUnit_iff_ne_zero.mpr hp.det_pos.ne')]
simp
theorem populationCoefficient_uniform_bound_explicit
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
p :
ℕ
ν L :
ℝ
conclusion
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ t x h, x ∈ P.boundary → 0 < h → h
≤ L⁻¹ → ∀ j, |populationCoefficient P p t x h j| ≤ 1
+ |L * (p + 1 : ℝ) * (16 * L * (2 + L))|
Proof (Lean source)
lemma populationCoefficient_uniform_bound_explicit (p : ℕ) (ν L : ℝ) :
∀ P : A1A2Law, A1A2Class p ν L P →
∀ t x h, x ∈ P.boundary → 0 < h → h ≤ L⁻¹ →
∀ j, |populationCoefficient P p t x h j| ≤
1 + |L * (p + 1 : ℝ) * (16 * L * (2 + L))| := by
let K : ℝ := 16 * L * (2 + L)
let R : ℝ := 1 + |L * (p + 1 : ℝ) * K|
intro P hP t x h hx hh hhL j
· let A := populationGram P p t x h
let s := populationScore P p t x h
let beta := populationCoefficient P p t x h
obtain ⟨j0, _hj0, hj0max⟩ := Finset.exists_max_image univ
(fun k : Fin (p + 1) => |beta k|) Finset.univ_nonempty
have hnorm : ‖beta‖ = |beta j0| := by
apply le_antisymm
· rw [pi_norm_le_iff_of_nonneg (abs_nonneg (beta j0))]
intro k
simpa [Real.norm_eq_abs] using hj0max k (Finset.mem_univ k)
· simpa [Real.norm_eq_abs] using norm_le_pi_norm beta j0
have hfloor := hP.2.2.2.2.2.2.2.2.2.2.2.2.1 t x h hx hh hhL beta
have hmul := populationGram_mulVec_populationCoefficient p ν L P hP t x hx h hh hhL
have hquad : matrixQuadratic A beta = dotProduct beta s := by
rw [show matrixQuadratic A beta = dotProduct beta (mulVec A beta) by
simp [matrixQuadratic, dotProduct, mulVec, Finset.mul_sum]; ring]
simpa [A, s, beta] using congrArg (dotProduct beta) hmul
have hs (k : Fin (p + 1)) : |s k| ≤ K := by
simpa [s, K] using populationScore_apply_uniform_bound p ν L P hP t x hx h hh hhL k
have hdot : dotProduct beta s ≤ (p + 1 : ℝ) * ‖beta‖ * K := by
calc
dotProduct beta s ≤ |dotProduct beta s| := le_abs_self _
_ ≤ ∑ k, |beta k * s k| := by
unfold dotProduct
exact Finset.abs_sum_le_sum_abs _ _
_ ≤ ∑ _k : Fin (p + 1), ‖beta‖ * K := by
apply Finset.sum_le_sum
intro k _
rw [abs_mul]
exact mul_le_mul (by simpa [Real.norm_eq_abs] using norm_le_pi_norm beta k)
(hs k) (abs_nonneg _) (norm_nonneg _)
_ = (p + 1 : ℝ) * ‖beta‖ * K := by
simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin,
nsmul_eq_mul, Nat.cast_add, cast_one]
ring
have hsum : ‖beta‖ ^ 2 ≤ ∑ k, (beta k) ^ 2 := by
rw [hnorm, sq_abs]
exact Finset.single_le_sum (fun k _ => sq_nonneg (beta k)) (Finset.mem_univ j0)
have hL : 0 < L := lt_of_lt_of_le (by norm_num) hP.2.1
have hmain : L⁻¹ * ‖beta‖ ^ 2 ≤ (p + 1 : ℝ) * ‖beta‖ * K := by
calc
_ ≤ L⁻¹ * ∑ k, (beta k) ^ 2 :=
mul_le_mul_of_nonneg_left hsum (inv_nonneg.mpr hL.le)
_ ≤ matrixQuadratic A beta := by simpa [A, beta] using hfloor
_ = dotProduct beta s := hquad
_ ≤ _ := hdot
have hK : 0 ≤ K := by dsimp [K]; positivity
have hbeta : ‖beta‖ ≤ L * (p + 1 : ℝ) * K := by
by_cases hb0 : ‖beta‖ = 0
· rw [hb0]
positivity
· have hb : 0 < ‖beta‖ := lt_of_le_of_ne (norm_nonneg _) (Ne.symm hb0)
have hLi : L⁻¹ * L = 1 := inv_mul_cancel₀ hL.ne'
nlinarith
calc
|populationCoefficient P p t x h j| ≤ ‖beta‖ := by
simpa [beta, Real.norm_eq_abs] using norm_le_pi_norm beta j
_ ≤ L * (p + 1 : ℝ) * K := hbeta
_ ≤ R := by
dsimp [R, K]
exact (le_abs_self _).trans (by linarith)
theorem populationCoefficient_uniform_bound
The explicit population-coefficient radius in existential form.
Formal statement
hypotheses
p :
ℕ
ν L :
ℝ
conclusion
∃ R : ℝ,
0 < R ∧
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ t x h, x ∈ P.boundary → 0 < h → h
≤ L⁻¹ → ∀ j, |populationCoefficient P p t x h j| ≤ R
Proof (Lean source)
-- @node: populationCoefficient_uniform_bound
lemma populationCoefficient_uniform_bound (p : ℕ) (ν L : ℝ) :
∃ R : ℝ, 0 < R ∧ ∀ P : A1A2Law, A1A2Class p ν L P →
∀ t x h, x ∈ P.boundary → 0 < h → h ≤ L⁻¹ →
∀ j, |populationCoefficient P p t x h j| ≤ R := by
refine ⟨1 + |L * (p + 1 : ℝ) * (16 * L * (2 + L))|, by positivity, ?_⟩
exact populationCoefficient_uniform_bound_explicit p ν L
Causal.EmpiricalProcess.RadialCover 2 declarations This module specializes the neutral moving-center Euclidean radial-polynomial certificate to the paper's signed-distance, uniform-kernel score.
Radial covering adapter for the winsorized score
This module specializes the neutral moving-center Euclidean radial-polynomial certificate to the paper's signed-distance, uniform-kernel score. The proof keeps the strict and non-strict signed arms separate, including the radius-zero trace, so it remains uniform for empirical laws with atoms on moving boundaries.
theorem winsorizedScore_hasUniformPolynomialL2Cover
At every positive coefficient clipping radius there are polynomial covering constants depending only on the degree such that all laws, bandwidths, and positive winsorization levels share both an arbitrary-law L²(Q) certificate and the same empirical covering constants, with envelope B + (p+1)R.
Formal statement
hypotheses
p :
ℕ
R :
ℝ
hR :
0 < R
conclusion
∃ A v : ℝ
and
0 < B
then
HasPolynomialL2Cover (winsorizedScoreFunction P p h B R) (B + ((p + 1 : ℕ) : ℝ) * R) ∧
HasPolynomialEmpiricalL2Cover (winsorizedScoreFunction P p h B R) (B + ((p + 1 : ℕ) : ℝ) * R) A v
Proof (Lean source)
lemma winsorizedScore_hasUniformPolynomialL2Cover
(p : ℕ) {R : ℝ} (hR : 0 < R) :
∃ A v : ℝ, exp 1 ≤ A ∧ 1 ≤ v ∧
∀ (P : A1A2Law) {h B : ℝ}, 0 < h → 0 < B →
HasPolynomialL2Cover (winsorizedScoreFunction P p h B R)
(B + ((p + 1 : ℕ) : ℝ) * R) ∧
HasPolynomialEmpiricalL2Cover (winsorizedScoreFunction P p h B R)
(B + ((p + 1 : ℕ) : ℝ) * R) A v := by
classical
let Arm := Bool × Fin (p + 1)
obtain ⟨C, n, hradial⟩ :=
radialResidualScore_hasUniformPolynomialL2CoverWith
(Ω := CausalObservation) (A := Arm) 2 p
let C₁ := 2 * C
let C₂ := 8 * C₁ * C₁
let n₂ := n + n + 2
let C₃ := 8 * C₂ * C₁
let n₃ := n₂ + n + 2
let C₄ := 8 * C₃ * C₁
let n₄ := n₃ + n + 2
let Cdiag := 2 * C₄
let Cfinal := 4 * Cdiag
refine ⟨max (exp 1) (2 * Cfinal), ((n₄ + 1 : ℕ) : ℝ),
le_max_left _ _, ?_, ?_⟩
· exact_mod_cast Nat.succ_le_succ (zero_le n₄)
· intro P h B hh hB
have hscore : Measurable causalScore := by
unfold causalScore
fun_prop
have htreat : Measurable (treatment P) := by
unfold treatment
exact measurable_const.indicator (P.A1_measurable.preimage hscore)
have harmCoord (t : Bool) : Measurable (armCoord t) := by
cases t <;> unfold armCoord <;> simp only [Bool.false_eq_true, if_false,
if_true] <;> fun_prop
have houtcome : Measurable (observedOutcome P) := by
unfold observedOutcome
exact (htreat.mul (harmCoord true)).add
((measurable_const.sub htreat).mul (harmCoord false))
let response : CausalObservation → ℝ :=
fun w => winsorize B (observedOutcome P w)
have hresponseMeas : Measurable response :=
(winsorize_measurable B).comp houtcome
have hwinsorize (y : ℝ) : |winsorize B y| ≤ B := by
unfold winsorize
split_ifs with hy hy0
· rw [abs_neg, abs_of_nonneg (le_min (abs_nonneg y) hB.le)]
exact min_le_right _ _
· simpa [hy0] using hB.le
· rw [abs_of_nonneg (le_min (abs_nonneg y) hB.le)]
exact min_le_right _ _
have hresponseBound (w : CausalObservation) : |response w| ≤ B :=
hwinsorize _
have hclip (y : ℝ) : |clip R y| ≤ R := by
unfold clip
rw [abs_le]
constructor
· exact le_max_left _ _
· exact max_le (by linarith) (min_le_left _ _)
let posArm : Arm → CausalObservation → ℝ := fun a w =>
if a.1 then P.A1.indicator (fun _ => (1 : ℝ)) (causalScore w) else 0
let negArm : Arm → CausalObservation → ℝ := fun a w =>
if a.1 then 0 else (-1 : ℝ) ^ a.2.1 *
P.A0.indicator (fun _ => (1 : ℝ)) (causalScore w)
let zeroArm : Arm → CausalObservation → ℝ := fun a w =>
(if a.1 then (1 : ℝ) else -1) *
P.A0.indicator (fun _ => (1 : ℝ)) (causalScore w)
let outsideArm : Arm → CausalObservation → ℝ := fun a w =>
if a.1 then (P.A0 ∪ P.A1)ᶜ.indicator (fun _ => (1 : ℝ)) (causalScore w)
else 0
have hposMeas (a : Arm) : Measurable (posArm a) := by
dsimp [posArm]
split
· exact measurable_const.indicator (P.A1_measurable.preimage hscore)
· exact measurable_const
have hnegMeas (a : Arm) : Measurable (negArm a) := by
dsimp [negArm]
split
· exact measurable_const
· exact measurable_const.mul
(measurable_const.indicator (P.A0_measurable.preimage hscore))
have hzeroMeas (a : Arm) : Measurable (zeroArm a) := by
exact measurable_const.mul
(measurable_const.indicator (P.A0_measurable.preimage hscore))
have houtsideMeas (a : Arm) : Measurable (outsideArm a) := by
dsimp [outsideArm]
split
· exact measurable_const.indicator
((P.A0_measurable.union P.A1_measurable).compl.preimage hscore)
· exact measurable_const
have hposBound (a : Arm) (w : CausalObservation) : |posArm a w| ≤ 1 := by
rcases a with ⟨t, j⟩
cases t <;> simp [posArm, indicator] <;> split_ifs <;> norm_num
have hnegBound (a : Arm) (w : CausalObservation) : |negArm a w| ≤ 1 := by
rcases a with ⟨t, j⟩
cases t <;> simp [negArm, indicator] <;> split_ifs <;>
simp [abs_pow]
have hzeroBound (a : Arm) (w : CausalObservation) : |zeroArm a w| ≤ 1 := by
rcases a with ⟨t, j⟩
cases t <;> simp [zeroArm, indicator] <;> split_ifs <;> norm_num
have houtsideBound (a : Arm) (w : CausalObservation) :
|outsideArm a w| ≤ 1 := by
rcases a with ⟨t, j⟩
cases t <;> simp [outsideArm, indicator] <;> split_ifs <;> norm_num
let hboxPos (i : WinsorizedScoreIndex p) :
CoeffBox (Fin (p + 1)) R :=
⟨fun k => clip R (i.2.2.1 k), fun k => hclip _⟩
let hboxNeg (i : WinsorizedScoreIndex p) :
CoeffBox (Fin (p + 1)) R :=
⟨fun k => (-1 : ℝ) ^ k.1 * clip R (i.2.2.1 k), fun k => by
rw [abs_mul, abs_pow, abs_neg, abs_one, one_pow, one_mul]
exact hclip _⟩
have hpos0 := hradial causalScore posArm response
hscore hposMeas hposBound hresponseMeas hresponseBound hh
(by norm_num : (0 : ℝ) ≤ 0) (by norm_num : (0 : ℝ) ≤ 1) hR hB
have hneg0 := hradial causalScore negArm response
hscore hnegMeas hnegBound hresponseMeas hresponseBound hh
(by norm_num : (0 : ℝ) ≤ 0) (by norm_num : (0 : ℝ) ≤ 1) hR hB
have hzero0 := hradial causalScore zeroArm response
hscore hzeroMeas hzeroBound hresponseMeas hresponseBound hh
(by norm_num : (0 : ℝ) ≤ 0) (by norm_num : (0 : ℝ) ≤ 0) hR hB
have hout0 := hradial (fun _ => (0 : Score)) outsideArm response
measurable_const houtsideMeas houtsideBound hresponseMeas hresponseBound hh
(by norm_num : (0 : ℝ) ≤ 0) (by norm_num : (0 : ℝ) ≤ 0) hR hB
let epos : WinsorizedScoreIndex p →
RadialResidualScoreParam 2 p R Arm × Fin (p + 1) := fun i =>
((((i.2.1, hboxPos i)), (i.1, i.2.2.2)), i.2.2.2)
let eneg : WinsorizedScoreIndex p →
RadialResidualScoreParam 2 p R Arm × Fin (p + 1) := fun i =>
((((i.2.1, hboxNeg i)), (i.1, i.2.2.2)), i.2.2.2)
let ezero : WinsorizedScoreIndex p →
RadialResidualScoreParam 2 p R Arm × Fin (p + 1) := fun i =>
((((i.2.1, hboxPos i)), (i.1, i.2.2.2)), i.2.2.2)
let eout : WinsorizedScoreIndex p →
RadialResidualScoreParam 2 p R Arm × Fin (p + 1) := fun i =>
(((((0 : Score), hboxPos i)), (i.1, i.2.2.2)), i.2.2.2)
have hpos := HasPolynomialL2CoverWith.pullback hpos0 epos
have hneg := HasPolynomialL2CoverWith.pullback hneg0 eneg
have hzero := HasPolynomialL2CoverWith.pullback hzero0 ezero
have hout := HasPolynomialL2CoverWith.pullback hout0 eout
have hsum := ((hpos.add hneg).add hzero).add hout
have henvelope : 0 < B + ((p + 1 : ℕ) : ℝ) * R := by positivity
have heq (i : WinsorizedScoreIndex p) (w : CausalObservation) :
winsorizedScoreFunction P p h B R i w =
radialResidualScore 2 p causalScore posArm response h 0 1 R
i.2.2.2 (epos i).1 w +
radialResidualScore 2 p causalScore negArm response h 0 1 R
i.2.2.2 (eneg i).1 w +
radialResidualScore 2 p causalScore zeroArm response h 0 0 R
i.2.2.2 (ezero i).1 w +
radialResidualScore 2 p (fun _ => (0 : Score)) outsideArm response
h 0 0 R i.2.2.2 (eout i).1 w := by
let z := causalScore w
let x := i.2.1
let r := dist z x
have hr0 : 0 ≤ r := dist_nonneg
have hzeroKernel : (0 : ℝ) / h ∈ Icc (-1 : ℝ) 1 := by
simp
have hzeroRadial : (0 : ℝ) * h ≤ 0 ∧ 0 ≤ 0 * h := by simp
have hmulComm (u : ℝ) :
∑ k : Fin (p + 1), u ^ (k : ℕ) * clip R (i.2.2.1 k) =
∑ k : Fin (p + 1), clip R (i.2.2.1 k) * u ^ (k : ℕ) := by
apply Finset.sum_congr rfl
intro k _
ring
have hnegTerm (u : ℝ) (k : Fin (p + 1)) :
(-1 : ℝ) ^ (k : ℕ) * clip R (i.2.2.1 k) * u ^ (k : ℕ) =
(-u) ^ (k : ℕ) * clip R (i.2.2.1 k) := by
rw [neg_pow]
ring
have hnegSum (u : ℝ) :
∑ k : Fin (p + 1),
(-1 : ℝ) ^ (k : ℕ) * clip R (i.2.2.1 k) * u ^ (k : ℕ) =
∑ k : Fin (p + 1), (-u) ^ (k : ℕ) * clip R (i.2.2.1 k) := by
exact Finset.sum_congr rfl fun k _ => hnegTerm u k
have hnegLead (u : ℝ) :
(-1 : ℝ) ^ (i.2.2.2 : ℕ) * u ^ (i.2.2.2 : ℕ) =
(-u) ^ (i.2.2.2 : ℕ) := by
exact (neg_pow u (i.2.2.2 : ℕ)).symm
by_cases hz1 : z ∈ P.A1
· have hz0 : z ∉ P.A0 := fun hz0 =>
P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
have hd : signedDistance (knownGeometry P) x z = r := by
simp [signedDistance, knownGeometry, indicator_of_mem hz1,
indicator_of_notMem hz0, r]
by_cases hr : r ≤ h
· have hdiv : r / h ∈ Icc (-1 : ℝ) 1 := by
constructor
· exact le_trans (by norm_num) (div_nonneg hr0 hh.le)
· exact (div_le_one hh).2 hr
cases hi : i.1 <;>
simp [winsorizedScoreFunction, signedArm, uniformKernel,
radialResidualScore, boundedRadialPolynomial,
radialAnnulusMonomial, polyBasis, response, posArm, negArm,
zeroArm, outsideArm, epos, eneg, ezero, eout, hboxPos,
hboxNeg, z, x, r, hd, hz1, hz0, hr, hdiv, hh.le, hi]
<;> exact inl (hmulComm _)
· have hdiv : r / h ∉ Icc (-1 : ℝ) 1 := by
intro hk
exact hr ((div_le_one hh).1 hk.2)
cases hi : i.1 <;>
simp [winsorizedScoreFunction, signedArm, uniformKernel,
radialResidualScore, boundedRadialPolynomial,
radialAnnulusMonomial, polyBasis, response, posArm, negArm,
zeroArm, outsideArm, epos, eneg, ezero, eout, hboxPos,
hboxNeg, z, x, r, hd, hz1, hz0, hr, hdiv, hh.le, hi]
· by_cases hz0 : z ∈ P.A0
· have hd : signedDistance (knownGeometry P) x z = -r := by
simp [signedDistance, knownGeometry, indicator_of_notMem hz1,
indicator_of_mem hz0, r]
by_cases hre : r = 0
· cases hi : i.1 <;>
simp [winsorizedScoreFunction, signedArm, uniformKernel,
radialResidualScore, boundedRadialPolynomial,
radialAnnulusMonomial, polyBasis, response, posArm, negArm,
zeroArm, outsideArm, epos, eneg, ezero, eout, hboxPos,
hboxNeg, z, x, r, hd, hz1, hz0, hre, hzeroKernel,
hzeroRadial, hmulComm, hnegTerm, hnegSum, hnegLead, hh.le, hi]
· by_cases hr : r ≤ h
· have hdiv : -r / h ∈ Icc (-1 : ℝ) 1 := by
constructor
· rw [neg_div]
exact (neg_le_neg_iff.mpr ((div_le_one hh).2 hr))
· exact le_trans (by
exact div_nonpos_of_nonpos_of_nonneg (neg_nonpos.mpr hr0) hh.le)
(by norm_num)
have hposDiv : r / h ≤ 1 := (div_le_one hh).2 hr
have hdiv' : -(r / h) ∈ Icc (-1 : ℝ) 1 := by
simpa [neg_div] using hdiv
have hzx : z ≠ x := by
intro hzx
apply hre
simp [r, hzx]
cases hi : i.1 <;>
simp [winsorizedScoreFunction, signedArm, uniformKernel,
radialResidualScore, boundedRadialPolynomial,
radialAnnulusMonomial, polyBasis, response, posArm, negArm,
zeroArm, outsideArm, epos, eneg, ezero, eout, hboxPos,
hboxNeg, z, x, r, hd, hz1, hz0, hre, hr, hdiv,
hdiv', hposDiv, hr0, hh.le, hzx, hmulComm, hnegTerm, hnegSum,
hnegLead, neg_div, hi]
· have hdiv : -r / h ∉ Icc (-1 : ℝ) 1 := by
intro hk
apply hr
apply (div_le_one hh).1
-- … truncated; follow the source link for the rest …
theorem winsorizedScore_hasPolynomialL2Cover
For a positive bandwidth, winsorization level, and coefficient clipping radius, the entire finite-arm, finite-coordinate winsorized score class has a uniform polynomial L²(Q) cover over every probability measure Q, with envelope B + (p+1)R.
Formal statement
hypotheses
conclusion
HasPolynomialL2Cover (winsorizedScoreFunction P p h B R) (B + ((p + 1 : ℕ) : ℝ) * R)
Proof (Lean source)
lemma winsorizedScore_hasPolynomialL2Cover
(P : A1A2Law) (p : ℕ) {h B R : ℝ}
(hh : 0 < h) (hB : 0 < B) (hR : 0 < R) :
HasPolynomialL2Cover (winsorizedScoreFunction P p h B R)
(B + ((p + 1 : ℕ) : ℝ) * R) := by
obtain ⟨A, v, hA, hv, hcover⟩ :=
winsorizedScore_hasUniformPolynomialL2Cover p hR
exact (hcover P hh hB).1
Causal.EmpiricalProcess.ScoreL2 10 declarations This module isolates the analytic localization estimate used by the variance-adaptive entropy theorem.
Population L² radius of the winsorized score
This module isolates the analytic localization estimate used by the
variance-adaptive entropy theorem. The Euclidean density bound controls the
probability of a bandwidth ball, while the selected conditional moment bound
controls the winsorized response without introducing the winsorization level
into the population L² radius.
theorem marginal_closedBall_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
conclusion
Proof (Lean source)
lemma marginal_closedBall_le (p : ℕ) (ν L : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) (x : Score) (h : ℝ) (hh : 0 < h) :
Measure.map causalScore P.law (closedBall x h) ≤
ofReal (4 * L * h ^ 2) := by
have hL : 0 ≤ L := le_trans (by norm_num) hP.2.1
rw [P.marginal_eq, withDensity_apply _ Metric.isClosed_closedBall.measurableSet]
calc
(∫⁻ z in closedBall x h,
ofReal (P.support.indicator P.density z) ∂volume) ≤
∫⁻ _z in closedBall x h, ofReal L ∂volume := by
apply lintegral_mono_ae
filter_upwards with z
by_cases hz : z ∈ P.support
· rw [indicator_of_mem hz]
exact ENNReal.ofReal_le_ofReal (hP.2.2.2.2.1 z hz).2
· rw [indicator_of_notMem hz]
simp
_ = ofReal L * volume (closedBall x h) := by
rw [setLIntegral_const]
_ = ofReal (L * (pi * h ^ 2)) := by
rw [EuclideanSpace.volume_closedBall_fin_two,
← ENNReal.ofReal_pow hh.le,
← ENNReal.ofReal_mul (sq_nonneg h), ← ENNReal.ofReal_mul hL]
congr 1
ring
_ ≤ ofReal (4 * L * h ^ 2) := by
apply ENNReal.ofReal_le_ofReal
have hmul := mul_le_mul_of_nonneg_right Real.pi_le_four
(mul_nonneg hL (sq_nonneg h))
nlinarith
theorem localized_arm_sq_lintegral_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
conclusion
≤ ofReal ((1 + L) * (4 * L * h ^ 2))
Proof (Lean source)
lemma localized_arm_sq_lintegral_le (p : ℕ) (ν L : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) (t : Bool) (x : Score) (h : ℝ) (hh : 0 < h) :
(∫⁻ w, (closedBall x h).indicator
(fun _ => ofReal ((armCoord t w) ^ 2)) (causalScore w) ∂P.law) ≤
ofReal ((1 + L) * (4 * L * h ^ 2)) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hK : Nonempty (A1A2KernelWitness P ν L) :=
hP.2.2.2.2.2.2.2.1.1
letI : IsMarkovKernel (selectedA1A2CondKer P ν L t) :=
selectedA1A2CondKer_markov hK t
let μ := Measure.map causalScore P.law
let F : (Score × ℝ) → ENNReal := fun q =>
(closedBall x h).indicator (fun _ => ofReal (q.2 ^ 2)) q.1
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have harm : Measurable (armCoord t) := by
cases t <;> unfold armCoord <;> simp only [Bool.false_eq_true, if_false,
if_true] <;> fun_prop
have hpair : Measurable (fun w => (causalScore w, armCoord t w)) :=
hscore.prodMk harm
have hF : Measurable F := by
apply Measurable.indicator
· fun_prop
· exact Metric.isClosed_closedBall.measurableSet.preimage measurable_fst
have hsupp : ∀ᵐ z ∂μ, z ∈ P.support := by
change ∀ᵐ z ∂Measure.map causalScore P.law, z ∈ P.support
rw [P.support_eq_marginal_support]
exact Measure.support_mem_ae
calc
(∫⁻ w, (closedBall x h).indicator
(fun _ => ofReal ((armCoord t w) ^ 2)) (causalScore w) ∂P.law) =
∫⁻ q, F q ∂Measure.map (fun w => (causalScore w, armCoord t w)) P.law := by
rw [lintegral_map hF hpair]
_ = ∫⁻ z, ∫⁻ y, F (z, y) ∂selectedA1A2CondKer P ν L t z ∂μ := by
rw [← selectedA1A2CondKer_disint hK t, Measure.lintegral_compProd hF]
_ ≤ ∫⁻ z, (closedBall x h).indicator
(fun _ => ofReal (1 + L)) z ∂μ := by
apply lintegral_mono_ae
filter_upwards [hsupp] with z hz
by_cases hzb : z ∈ closedBall x h
· simp only [F, indicator_of_mem hzb]
exact condKer_sq_lintegral_le p ν L P hP t z hz
· simp [F, indicator_of_notMem hzb]
_ = ofReal (1 + L) * μ (closedBall x h) := by
rw [lintegral_indicator Metric.isClosed_closedBall.measurableSet,
setLIntegral_const]
_ ≤ ofReal (1 + L) * ofReal (4 * L * h ^ 2) :=
mul_le_mul_right (marginal_closedBall_le p ν L P hP x h hh) _
_ = ofReal ((1 + L) * (4 * L * h ^ 2)) := by
have hL : 0 ≤ L := le_trans (by norm_num) hP.2.1
rw [← ENNReal.ofReal_mul (by linarith : 0 ≤ 1 + L)]
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
conclusion
(winsorizedScoreFunction P p h B R i w) ^ 2
≤ 2 * (closedBall i.2.1 h).indicator (fun _ => (armCoord false w) ^ 2 + (armCoord true w) ^ 2 + ((p + 1 : ℝ) * R) ^ 2) (causalScore w)
Proof (Lean source)
lemma winsorizedScore_sq_pointwise_le (P : A1A2Law) (p : ℕ)
(h B R : ℝ) (hh : 0 < h) (hB : 0 ≤ B) (hR : 0 ≤ R)
(i : WinsorizedScoreIndex p) (w : CausalObservation)
(hw : causalScore w ∈ P.support) :
(winsorizedScoreFunction P p h B R i w) ^ 2 ≤
2 * (closedBall i.2.1 h).indicator
(fun _ => (armCoord false w) ^ 2 + (armCoord true w) ^ 2 +
((p + 1 : ℝ) * R) ^ 2) (causalScore w) := by
classical
let z := causalScore w
let x := i.2.1
let d := signedDistance (knownGeometry P) x z
have hpart : z ∈ P.A0 ∪ P.A1 := by
rw [P.assignment_partition.1]
exact hw
rcases hpart with hz0 | hz1
· have hz1n : z ∉ P.A1 := fun hz1 => P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
have hd : d = -dist z x := by
simp [d, signedDistance, knownGeometry, indicator_of_mem hz0,
indicator_of_notMem hz1n]
have hout : observedOutcome P w = armCoord false w := by
rw [observedOutcome, treatment,
indicator_of_notMem (by simpa [z] using hz1n)]
ring
by_cases hk : d / h ∈ Icc (-1 : ℝ) 1
· have hu : |d / h| ≤ 1 := by simpa [abs_le] using hk
have hball : z ∈ closedBall x h := by
rw [Metric.mem_closedBall]
rw [hd, abs_div, abs_neg, abs_of_pos hh] at hu
have := (div_le_iff₀ hh).mp hu
simpa [abs_of_nonneg (dist_nonneg : 0 ≤ dist z x)] using this
have hpolyj : |polyBasis p (d / h) i.2.2.2| ≤ 1 := by
unfold polyBasis
rw [abs_pow]
exact pow_le_one₀ (abs_nonneg _) hu
have hsum := poly_clip_sum_abs_le p (d / h) R i.2.2.1 hu hR
have hwin := winsorize_abs_le_abs B (armCoord false w) hB
rw [winsorizedScoreFunction, show observedOutcome P w = armCoord false w from hout,
uniformKernel, indicator_of_mem hk, indicator_of_mem hball]
split_ifs
· have habs : |polyBasis p (d / h) i.2.2.2 *
(winsorize B (armCoord false w) -
∑ k, polyBasis p (d / h) k * clip R (i.2.2.1 k))| ≤
|armCoord false w| + (p + 1 : ℝ) * R := by
rw [abs_mul]
calc
_ ≤ 1 * |winsorize B (armCoord false w) -
∑ k, polyBasis p (d / h) k * clip R (i.2.2.1 k)| :=
mul_le_mul_of_nonneg_right hpolyj (abs_nonneg _)
_ ≤ _ := by
rw [one_mul]
exact (abs_sub _ _).trans (add_le_add hwin hsum)
have hsq := mul_self_le_mul_self (abs_nonneg _) habs
rw [← pow_two, ← pow_two, sq_abs] at hsq
have hfinal : (polyBasis p (d / h) i.2.2.2 *
(winsorize B (armCoord false w) -
∑ k, polyBasis p (d / h) k * clip R (i.2.2.1 k))) ^ 2 ≤
2 * ((armCoord false w) ^ 2 + (armCoord true w) ^ 2 +
((p + 1 : ℝ) * R) ^ 2) := by
nlinarith [sq_abs (armCoord false w), sq_nonneg (armCoord true w),
sq_nonneg (|armCoord false w| - (p + 1 : ℝ) * R)]
simpa [d, z, x] using hfinal
· nlinarith [sq_nonneg (armCoord false w), sq_nonneg (armCoord true w),
sq_nonneg ((p + 1 : ℝ) * R)]
· rw [winsorizedScoreFunction, uniformKernel, indicator_of_notMem hk]
simp
exact indicator_nonneg (fun _ _ => by
nlinarith [sq_nonneg (armCoord false w), sq_nonneg (armCoord true w),
sq_nonneg ((p + 1 : ℝ) * R)]) (causalScore w)
· have hz0n : z ∉ P.A0 := fun hz0 => P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
have hd : d = dist z x := by
simp [d, signedDistance, knownGeometry, indicator_of_mem hz1,
indicator_of_notMem hz0n]
have hout : observedOutcome P w = armCoord true w := by
rw [observedOutcome, treatment,
indicator_of_mem (by simpa [z] using hz1)]
ring
by_cases hk : d / h ∈ Icc (-1 : ℝ) 1
· have hu : |d / h| ≤ 1 := by simpa [abs_le] using hk
have hball : z ∈ closedBall x h := by
rw [Metric.mem_closedBall]
rw [hd, abs_div, abs_of_pos hh] at hu
have := (div_le_iff₀ hh).mp hu
simpa [abs_of_nonneg (dist_nonneg : 0 ≤ dist z x)] using this
have hpolyj : |polyBasis p (d / h) i.2.2.2| ≤ 1 := by
unfold polyBasis
rw [abs_pow]
exact pow_le_one₀ (abs_nonneg _) hu
have hsum := poly_clip_sum_abs_le p (d / h) R i.2.2.1 hu hR
have hwin := winsorize_abs_le_abs B (armCoord true w) hB
rw [winsorizedScoreFunction, show observedOutcome P w = armCoord true w from hout,
uniformKernel, indicator_of_mem hk, indicator_of_mem hball]
split_ifs
· have habs : |polyBasis p (d / h) i.2.2.2 *
(winsorize B (armCoord true w) -
∑ k, polyBasis p (d / h) k * clip R (i.2.2.1 k))| ≤
|armCoord true w| + (p + 1 : ℝ) * R := by
rw [abs_mul]
calc
_ ≤ 1 * |winsorize B (armCoord true w) -
∑ k, polyBasis p (d / h) k * clip R (i.2.2.1 k)| :=
mul_le_mul_of_nonneg_right hpolyj (abs_nonneg _)
_ ≤ _ := by
rw [one_mul]
exact (abs_sub _ _).trans (add_le_add hwin hsum)
have hsq := mul_self_le_mul_self (abs_nonneg _) habs
rw [← pow_two, ← pow_two, sq_abs] at hsq
have hfinal : (polyBasis p (d / h) i.2.2.2 *
(winsorize B (armCoord true w) -
∑ k, polyBasis p (d / h) k * clip R (i.2.2.1 k))) ^ 2 ≤
2 * ((armCoord false w) ^ 2 + (armCoord true w) ^ 2 +
((p + 1 : ℝ) * R) ^ 2) := by
nlinarith [sq_abs (armCoord true w), sq_nonneg (armCoord false w),
sq_nonneg (|armCoord true w| - (p + 1 : ℝ) * R)]
simpa [d, z, x] using hfinal
· nlinarith [sq_nonneg (armCoord false w), sq_nonneg (armCoord true w),
sq_nonneg ((p + 1 : ℝ) * R)]
· rw [winsorizedScoreFunction, uniformKernel, indicator_of_notMem hk]
simp
exact indicator_nonneg (fun _ _ => by
nlinarith [sq_nonneg (armCoord false w), sq_nonneg (armCoord true w),
sq_nonneg ((p + 1 : ℝ) * R)]) (causalScore w)
theorem separableWinsorizedScore_sq_pointwise_le Lemma separableWinsorizedScore_sq_pointwise_le in the paper ↗
The squared separable winsorized score is bounded pointwise by a localized sum of the two arm squares and the clipped polynomial-envelope square.
Formal statement
hypotheses
conclusion
(separableWinsorizedScoreFunction P p h B R i w) ^ 2
≤ 3 * ((2 : ℝ) ^ p) ^ 2 * (closedBall i.2.2.1.1 (2 * h)).indicator (fun _ => (armCoord false w) ^ 2 + (armCoord true w) ^ 2 + ((p + 1 : ℝ) * (2 : ℝ) ^ p * R) ^ 2) (causalScore w)
Proof (Lean source)
lemma separableWinsorizedScore_sq_pointwise_le
(P : A1A2Law) (p : ℕ) (h B R : ℝ) (hh : 0 < h) (hB : 0 ≤ B)
(hR : 0 ≤ R)
(i : SeparableWinsorizedScoreIndex P p h)
(w : CausalObservation) (hw : causalScore w ∈ P.support) :
(separableWinsorizedScoreFunction P p h B R i w) ^ 2 ≤
3 * ((2 : ℝ) ^ p) ^ 2 *
(closedBall i.2.2.1.1 (2 * h)).indicator
(fun _ => (armCoord false w) ^ 2 + (armCoord true w) ^ 2 +
((p + 1 : ℝ) * (2 : ℝ) ^ p * R) ^ 2)
(causalScore w) := by
let d := signedDistance (knownGeometry P) i.2.2.1.1 (causalScore w)
have hq : 0 < i.1.1 := lt_of_lt_of_le hh i.1.2.1
have habs : |d| = dist (causalScore w) i.2.2.1.1 := by
rcases (show causalScore w ∈ P.A0 ∪ P.A1 by
simpa [P.assignment_partition.1] using hw) with hw0 | hw1
· have hw1n : causalScore w ∉ P.A1 := fun hw1 =>
P.assignment_partition.2.le_bot ⟨hw0, hw1⟩
simp [d, signedDistance, knownGeometry, indicator_of_mem hw0,
indicator_of_notMem hw1n]
· have hw0n : causalScore w ∉ P.A0 := fun hw0 =>
P.assignment_partition.2.le_bot ⟨hw0, hw1⟩
simp [d, signedDistance, knownGeometry, indicator_of_mem hw1,
indicator_of_notMem hw0n]
by_cases hactive : |d| ≤ i.1.1
· have hdist2 : dist (causalScore w) i.2.2.1.1 ≤ 2 * h := by
rw [← habs]
exact hactive.trans i.1.2.2.le
have hball : causalScore w ∈ closedBall i.2.2.1.1 (2 * h) := by
simpa [Metric.mem_closedBall, dist_comm] using hdist2
have hbound := separableWinsorizedScoreFunction_bound P p h B R hh hB hR i w
rw [indicator_of_mem hball]
have ha0 : 0 ≤ |armCoord false w| := abs_nonneg _
have ha1 : 0 ≤ |armCoord true w| := abs_nonneg _
let c₀ : ℝ := (p + 1 : ℝ) * (2 : ℝ) ^ p * R
have hbound' :
|separableWinsorizedScoreFunction P p h B R i w| ≤
(2 : ℝ) ^ p *
(|armCoord false w| + |armCoord true w| + c₀) := by
simpa [c₀] using hbound
have hc : 0 ≤ c₀ := by dsimp [c₀]; positivity
have hM : 0 ≤ (2 : ℝ) ^ p := by positivity
have hsquare := (sq_le_sq₀ (abs_nonneg _)
(mul_nonneg hM (add_nonneg (add_nonneg ha0 ha1) hc))).2 hbound'
rw [sq_abs] at hsquare
nlinarith [sq_nonneg (|armCoord false w| - |armCoord true w|),
sq_nonneg (|armCoord false w| - c₀),
sq_nonneg (|armCoord true w| - c₀), sq_abs (armCoord false w),
sq_abs (armCoord true w)]
· have hk : uniformKernel (d / i.1.1) = 0 := by
rw [uniformKernel_div_eq_if_abs_le d i.1.1 hq, if_neg hactive]
simp [separableWinsorizedScoreFunction, d, hk]
apply mul_nonneg
· positivity
· by_cases hball : causalScore w ∈ closedBall i.2.2.1.1 (2 * h)
· rw [indicator_of_mem hball]
positivity
· rw [indicator_of_notMem hball]
theorem separableWinsorizedScore_abs_le_envelope Lemma separableWinsorizedScore_abs_le_envelope in the paper ↗
The absolute separable winsorized score is uniformly bounded by the winsorization level plus the clipped polynomial envelope.
Formal statement
hypotheses
P :
p :
ℕ
h B R :
ℝ
hh :
0 < h
hB :
0 ≤ B
hR :
0 ≤ R
i :
conclusion
|separableWinsorizedScoreFunction P p h B R i w|
≤ (2 : ℝ) ^ p * (B + (p + 1 : ℝ) * (2 : ℝ) ^ p * R)
Proof (Lean source)
lemma separableWinsorizedScore_abs_le_envelope
(P : A1A2Law) (p : ℕ) (h B R : ℝ) (hh : 0 < h) (hB : 0 ≤ B)
(hR : 0 ≤ R)
(i : SeparableWinsorizedScoreIndex P p h) (w : CausalObservation) :
|separableWinsorizedScoreFunction P p h B R i w| ≤
(2 : ℝ) ^ p * (B + (p + 1 : ℝ) * (2 : ℝ) ^ p * R) := by
classical
let d := signedDistance (knownGeometry P) i.2.2.1.1 (causalScore w)
have hq : 0 < i.1.1 := lt_of_lt_of_le hh i.1.2.1
simp only [separableWinsorizedScoreFunction]
rw [show uniformKernel (d / i.1.1) = if |d| ≤ i.1.1 then 1 else 0 from
uniformKernel_div_eq_if_abs_le d i.1.1 hq]
by_cases hdq : |d| ≤ i.1.1
· rw [if_pos hdq]
have hu : |d / h| ≤ 2 := by
rw [abs_div, abs_of_pos hh]
exact (div_le_div_of_nonneg_right hdq hh.le).trans
((div_lt_iff₀ hh).2 i.1.2.2).le
have hpoly (k : Fin (p + 1)) : |polyBasis p (d / h) k| ≤ (2 : ℝ) ^ p := by
unfold polyBasis
rw [abs_pow]
exact (pow_le_pow_left₀ (abs_nonneg _) hu k).trans
(pow_le_pow_right₀ (by norm_num) (Nat.le_of_lt_succ k.isLt))
have hsum : |∑ k, polyBasis p (d / h) k * clip R (i.2.2.2.1 k)| ≤
(p + 1 : ℝ) * (2 : ℝ) ^ p * R := by
calc
_ ≤ ∑ k, |polyBasis p (d / h) k * clip R (i.2.2.2.1 k)| :=
Finset.abs_sum_le_sum_abs _ _
_ ≤ ∑ _k : Fin (p + 1), (2 : ℝ) ^ p * R := by
apply Finset.sum_le_sum
intro k _
rw [abs_mul]
exact mul_le_mul (hpoly k) (abs_clip_le R _ hR)
(abs_nonneg _) (by positivity)
_ = _ := by
simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin,
nsmul_eq_mul, Nat.cast_add, cast_one]
ring
have hwin := winsorize_abs_le B (observedOutcome P w) hB
split_ifs
· simp only [one_mul, abs_mul]
exact mul_le_mul (hpoly _) ((abs_sub _ _).trans (add_le_add hwin hsum))
(abs_nonneg _) (by positivity)
· simp
positivity
· have hdq' : ¬ |signedDistance (knownGeometry P) i.2.2.1.1
(causalScore w)| ≤ i.1.1 := by simpa [d] using hdq
rw [if_neg hdq']
simp only [mul_zero, zero_mul, abs_zero]
exact mul_nonneg (by positivity) (add_nonneg hB (by positivity))
theorem separableWinsorizedScore_hasUniformL2Radius_explicit
The one-sided bandwidth enlargement has population L² radius O(h). The proof uses the defining bound q < 2h to localize every nonzero score in the radius-2h Euclidean ball.
Formal statement
hypotheses
p :
ℕ
ν L R :
ℝ
hR :
0 < R
conclusion
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ h B : ℝ, 0 < h → h < B → 1
≤ B → ∀ i : SeparableWinsorizedScoreIndex P p h, measureL2Dist P.law (separableWinsorizedScoreFunction P p h B R i) (fun _ => 0) ≤ (1 + |3 * ((2 : ℝ) ^ p) ^ 2 * (2 * (1 + L) + ((p + 1 : ℝ) * (2 : ℝ) ^ p * R) ^ 2) * (16 * L)|) * h
Proof (Lean source)
-- @node: separableWinsorizedScore_hasUniformL2Radius_explicit
lemma separableWinsorizedScore_hasUniformL2Radius_explicit
(p : ℕ) (ν L R : ℝ) (hR : 0 < R) :
∀ P : A1A2Law, A1A2Class p ν L P →
∀ h B : ℝ, 0 < h → h < B → 1 ≤ B →
∀ i : SeparableWinsorizedScoreIndex P p h,
measureL2Dist P.law
(separableWinsorizedScoreFunction P p h B R i)
(fun _ => 0) ≤
(1 + |3 * ((2 : ℝ) ^ p) ^ 2 *
(2 * (1 + L) + ((p + 1 : ℝ) * (2 : ℝ) ^ p * R) ^ 2) *
(16 * L)|) * h := by
let M : ℝ := (2 : ℝ) ^ p
let q : ℝ := (p + 1 : ℝ) * M * R
let K : ℝ := 3 * M ^ 2 * (2 * (1 + L) + q ^ 2) * (16 * L)
intro P hP h B hh _hhB hB i
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hB0 : 0 ≤ B := le_trans (by norm_num) hB
have hL : 0 ≤ L := le_trans (by norm_num) hP.2.1
have hM : 0 ≤ M := by dsimp [M]; positivity
have hq : 0 ≤ q := by dsimp [q]; positivity
let f := separableWinsorizedScoreFunction P p h B R i
have hfmeas : Measurable f :=
separableWinsorizedScoreFunction_measurable P p h B R i
have hfint : Integrable (fun w => (f w) ^ 2) P.law := by
let U := M * (B + (p + 1 : ℝ) * M * R)
apply Integrable.of_bound (hfmeas.pow_const 2).aestronglyMeasurable (U ^ 2)
filter_upwards with w
have hf := separableWinsorizedScore_abs_le_envelope P p h B R hh hB0 hR.le i w
rw [Real.norm_eq_abs, abs_of_nonneg (sq_nonneg _)]
have hU : 0 ≤ U := by dsimp [U]; positivity
have hs := (sq_le_sq₀ (abs_nonneg (f w)) hU).2 (by
simpa [f, U, M] using hf)
simpa [sq_abs] using hs
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have hsmeas : MeasurableSet P.support := by
rw [P.support_eq_marginal_support]
exact Measure.isClosed_support.measurableSet
have hsuppMap : ∀ᵐ z ∂Measure.map causalScore P.law, z ∈ P.support := by
rw [P.support_eq_marginal_support]
exact Measure.support_mem_ae
have hsupp : ∀ᵐ w ∂P.law, causalScore w ∈ P.support :=
(ae_map_iff hscore.aemeasurable hsmeas).mp hsuppMap
let g0 : CausalObservation → ENNReal := fun w =>
(closedBall i.2.2.1.1 (2 * h)).indicator
(fun _ => ofReal ((armCoord false w) ^ 2)) (causalScore w)
let g1 : CausalObservation → ENNReal := fun w =>
(closedBall i.2.2.1.1 (2 * h)).indicator
(fun _ => ofReal ((armCoord true w) ^ 2)) (causalScore w)
let gc : CausalObservation → ENNReal := fun w =>
(closedBall i.2.2.1.1 (2 * h)).indicator
(fun _ => ofReal (q ^ 2)) (causalScore w)
have hg0 : Measurable g0 := by
apply Measurable.indicator
· have harm : Measurable (armCoord false) := by
unfold armCoord; simp only [Bool.false_eq_true, if_false]; fun_prop
exact (harm.pow_const 2).ennreal_ofReal
· exact Metric.isClosed_closedBall.measurableSet.preimage hscore
have hg1 : Measurable g1 := by
apply Measurable.indicator
· have harm : Measurable (armCoord true) := by
unfold armCoord; simp only [if_true]; fun_prop
exact (harm.pow_const 2).ennreal_ofReal
· exact Metric.isClosed_closedBall.measurableSet.preimage hscore
have hgc : Measurable gc := by
apply Measurable.indicator measurable_const
exact Metric.isClosed_closedBall.measurableSet.preimage hscore
have hlin : (∫⁻ w, ofReal ((f w) ^ 2) ∂P.law) ≤
ofReal (K * h ^ 2) := by
calc
(∫⁻ w, ofReal ((f w) ^ 2) ∂P.law) ≤
∫⁻ w, ofReal (3 * M ^ 2) * (g0 w + g1 w + gc w) ∂P.law := by
apply lintegral_mono_ae
filter_upwards [hsupp] with w hw
have hp := separableWinsorizedScore_sq_pointwise_le
P p h B R hh hB0 hR.le i w hw
apply ENNReal.ofReal_le_ofReal at hp
by_cases hball : causalScore w ∈ closedBall i.2.2.1.1 (2 * h)
· simpa [f, g0, g1, gc, q, M, indicator_of_mem hball,
ENNReal.ofReal_mul (by positivity : 0 ≤ 3 * ((2 : ℝ) ^ p) ^ 2),
ENNReal.ofReal_add (sq_nonneg (armCoord false w))
(sq_nonneg (armCoord true w)),
ENNReal.ofReal_add
(add_nonneg (sq_nonneg (armCoord false w)) (sq_nonneg (armCoord true w)))
(sq_nonneg ((p + 1 : ℝ) * (2 : ℝ) ^ p * R))] using hp
· simpa [f, g0, g1, gc, indicator_of_notMem hball] using hp
_ = ofReal (3 * M ^ 2) *
((∫⁻ w, g0 w ∂P.law) + (∫⁻ w, g1 w ∂P.law) +
(∫⁻ w, gc w ∂P.law)) := by
rw [lintegral_const_mul (ofReal (3 * M ^ 2))
((hg0.fun_add hg1).fun_add hgc),
lintegral_add_left (hg0.fun_add hg1), lintegral_add_left hg0]
_ ≤ ofReal (3 * M ^ 2) *
(ofReal ((1 + L) * (4 * L * (2 * h) ^ 2)) +
ofReal ((1 + L) * (4 * L * (2 * h) ^ 2)) +
ofReal (q ^ 2 * (4 * L * (2 * h) ^ 2))) := by
gcongr
· exact localized_arm_sq_lintegral_le p ν L P hP false
i.2.2.1.1 (2 * h) (by positivity)
· exact localized_arm_sq_lintegral_le p ν L P hP true
i.2.2.1.1 (2 * h) (by positivity)
· exact localized_const_sq_lintegral_le p ν L P hP
i.2.2.1.1 (2 * h) q (by positivity)
_ = ofReal (K * h ^ 2) := by
have hA : 0 ≤ (1 + L) * (4 * L * (2 * h) ^ 2) := by positivity
have hD : 0 ≤ q ^ 2 * (4 * L * (2 * h) ^ 2) := by positivity
rw [← ENNReal.ofReal_add hA hA,
← ENNReal.ofReal_add (add_nonneg hA hA) hD,
← ENNReal.ofReal_mul (by positivity : 0 ≤ 3 * M ^ 2)]
congr 1
dsimp [K]
ring
have hK : 0 ≤ K := by dsimp [K]; positivity
have hint : ∫ w, (f w) ^ 2 ∂P.law ≤ K * h ^ 2 := by
rw [← ENNReal.ofReal_le_ofReal_iff (mul_nonneg hK (sq_nonneg h))]
rw [ofReal_integral_eq_lintegral_ofReal hfint
(ae_of_all _ fun w => sq_nonneg (f w))]
exact hlin
unfold measureL2Dist
simp only [sub_zero]
have hsqrt := Real.sqrt_le_sqrt hint
rw [Real.sqrt_mul hK (h ^ 2), Real.sqrt_sq_eq_abs, abs_of_pos hh] at hsqrt
have hsqrtK : sqrt K ≤ 1 + K := by
nlinarith [Real.sq_sqrt hK, Real.sqrt_nonneg K,
sq_nonneg (sqrt K - 1)]
have hKabs : |K| = K := abs_of_nonneg hK
simpa only [f, K, M, q, hKabs] using
hsqrt.trans (mul_le_mul_of_nonneg_right hsqrtK hh.le)
theorem separableWinsorizedScore_hasUniformL2Radius_at
The explicit separable score radius packaged in the existential form used by the entropy layer.
Formal statement
hypotheses
p :
ℕ
ν L R :
ℝ
hR :
0 < R
conclusion
∃ C : ℝ,
0 < C ∧
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ h B : ℝ, 0 < h → h < B → 1
≤ B → ∀ i : SeparableWinsorizedScoreIndex P p h, measureL2Dist P.law (separableWinsorizedScoreFunction P p h B R i) (fun _ => 0) ≤ C * h
Proof (Lean source)
-- @node: separableWinsorizedScore_hasUniformL2Radius_at
lemma separableWinsorizedScore_hasUniformL2Radius_at
(p : ℕ) (ν L R : ℝ) (hR : 0 < R) :
∃ C : ℝ, 0 < C ∧
∀ P : A1A2Law, A1A2Class p ν L P →
∀ h B : ℝ, 0 < h → h < B → 1 ≤ B →
∀ i : SeparableWinsorizedScoreIndex P p h,
measureL2Dist P.law
(separableWinsorizedScoreFunction P p h B R i)
(fun _ => 0) ≤ C * h := by
refine ⟨1 + |3 * ((2 : ℝ) ^ p) ^ 2 *
(2 * (1 + L) + ((p + 1 : ℝ) * (2 : ℝ) ^ p * R) ^ 2) *
(16 * L)|, by positivity, ?_⟩
exact separableWinsorizedScore_hasUniformL2Radius_explicit p ν L R hR
theorem separableWinsorizedScore_hasUniformL2Radius
The unit-radius specialization of the separable population L² bound.
Formal statement
hypotheses
p :
ℕ
ν L :
ℝ
conclusion
∃ C : ℝ,
0 < C ∧
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ h B : ℝ, 0 < h → h < B → 1
≤ B → ∀ i : SeparableWinsorizedScoreIndex P p h, measureL2Dist P.law (separableWinsorizedScoreFunction P p h B 1 i) (fun _ => 0) ≤ C * h
Proof (Lean source)
-- @node: separableWinsorizedScore_hasUniformL2Radius
lemma separableWinsorizedScore_hasUniformL2Radius
(p : ℕ) (ν L : ℝ) :
∃ C : ℝ, 0 < C ∧
∀ P : A1A2Law, A1A2Class p ν L P →
∀ h B : ℝ, 0 < h → h < B → 1 ≤ B →
∀ i : SeparableWinsorizedScoreIndex P p h,
measureL2Dist P.law
(separableWinsorizedScoreFunction P p h B 1 i)
(fun _ => 0) ≤ C * h := by
exact separableWinsorizedScore_hasUniformL2Radius_at p ν L 1 (by norm_num)
theorem winsorizedScore_hasUniformL2Radius_at
At every positive coefficient clipping radius, admissible winsorized scores have population L² norm at most C h, uniformly over centers, arms, coordinates, and winsorization levels B > h with B ≥ 1.
Formal statement
hypotheses
p :
ℕ
ν L R :
ℝ
hR :
0 < R
conclusion
∃ C : ℝ,
0 < C ∧
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ h B : ℝ, 0 < h → h < B → 1
≤ B → ∀ i : WinsorizedScoreIndex p, measureL2Dist P.law (winsorizedScoreFunction P p h B R i) (fun _ => 0) ≤ C * h
Proof (Lean source)
-- @node: winsorizedScore_hasUniformL2Radius_at
lemma winsorizedScore_hasUniformL2Radius_at
(p : ℕ) (ν L R : ℝ) (hR : 0 < R) :
∃ C : ℝ, 0 < C ∧
∀ P : A1A2Law, A1A2Class p ν L P →
∀ h B : ℝ, 0 < h → h < B → 1 ≤ B →
∀ i : WinsorizedScoreIndex p,
measureL2Dist P.law (winsorizedScoreFunction P p h B R i)
(fun _ => 0) ≤ C * h := by
let q : ℝ := p + 1
let K : ℝ := 2 * (2 * (1 + L) + (q * R) ^ 2) * (4 * L)
refine ⟨1 + |K|, by positivity, ?_⟩
intro P hP h B hh _hhB hB i
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hB0 : 0 ≤ B := le_trans (by norm_num) hB
have hL : 0 ≤ L := le_trans (by norm_num) hP.2.1
have hq : 0 ≤ q := by positivity
let f := winsorizedScoreFunction P p h B R i
have hfmeas : Measurable f := winsorizedScoreFunction_measurable P p h B R i
have hfint : Integrable (fun w => (f w) ^ 2) P.law := by
apply Integrable.of_bound (hfmeas.pow_const 2).aestronglyMeasurable
((B + q * R) ^ 2)
filter_upwards with w
have hf := winsorizedScore_abs_le_envelope P p h B R hB0 hR.le i w
have henv : B + (p + 1 : ℝ) * R = B + q * R := by simp [q]
rw [Real.norm_eq_abs, abs_of_nonneg (sq_nonneg _)]
simpa [sq_abs] using
(sq_le_sq₀ (abs_nonneg _) (add_nonneg hB0 (mul_nonneg hq hR.le))).2
(by simpa only [henv] using hf)
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have hsmeas : MeasurableSet P.support := by
rw [P.support_eq_marginal_support]
exact Measure.isClosed_support.measurableSet
have hsuppMap : ∀ᵐ z ∂Measure.map causalScore P.law, z ∈ P.support := by
rw [P.support_eq_marginal_support]
exact Measure.support_mem_ae
have hsupp : ∀ᵐ w ∂P.law, causalScore w ∈ P.support :=
(ae_map_iff hscore.aemeasurable hsmeas).mp hsuppMap
let g0 : CausalObservation → ENNReal := fun w =>
(closedBall i.2.1 h).indicator
(fun _ => ofReal ((armCoord false w) ^ 2)) (causalScore w)
let g1 : CausalObservation → ENNReal := fun w =>
(closedBall i.2.1 h).indicator
(fun _ => ofReal ((armCoord true w) ^ 2)) (causalScore w)
let gc : CausalObservation → ENNReal := fun w =>
(closedBall i.2.1 h).indicator
(fun _ => ofReal ((q * R) ^ 2)) (causalScore w)
have hg0 : Measurable g0 := by
apply Measurable.indicator
· have harm : Measurable (armCoord false) := by
unfold armCoord
simp only [Bool.false_eq_true, if_false]
fun_prop
exact (harm.pow_const 2).ennreal_ofReal
· exact Metric.isClosed_closedBall.measurableSet.preimage hscore
have hg1 : Measurable g1 := by
apply Measurable.indicator
· have harm : Measurable (armCoord true) := by
unfold armCoord
simp only [if_true]
fun_prop
exact (harm.pow_const 2).ennreal_ofReal
· exact Metric.isClosed_closedBall.measurableSet.preimage hscore
have hgc : Measurable gc := by
apply Measurable.indicator measurable_const
exact Metric.isClosed_closedBall.measurableSet.preimage hscore
have hlin : (∫⁻ w, ofReal ((f w) ^ 2) ∂P.law) ≤
ofReal (K * h ^ 2) := by
calc
(∫⁻ w, ofReal ((f w) ^ 2) ∂P.law) ≤
∫⁻ w, 2 * (g0 w + g1 w + gc w) ∂P.law := by
apply lintegral_mono_ae
filter_upwards [hsupp] with w hw
have hp := winsorizedScore_sq_pointwise_le P p h B R hh hB0 hR.le i w hw
apply ENNReal.ofReal_le_ofReal at hp
by_cases hball : causalScore w ∈ closedBall i.2.1 h
· simpa [f, g0, g1, gc, q, indicator_of_mem hball,
ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 2),
ENNReal.ofReal_add (sq_nonneg (armCoord false w))
(sq_nonneg (armCoord true w)),
ENNReal.ofReal_add
(add_nonneg (sq_nonneg (armCoord false w)) (sq_nonneg (armCoord true w)))
(by positivity : 0 ≤ ((p + 1 : ℝ) * R) ^ 2)] using hp
· simpa [f, g0, g1, gc, q, indicator_of_notMem hball] using hp
_ = 2 * ((∫⁻ w, g0 w ∂P.law) + (∫⁻ w, g1 w ∂P.law) +
(∫⁻ w, gc w ∂P.law)) := by
rw [lintegral_const_mul 2 ((hg0.fun_add hg1).fun_add hgc),
lintegral_add_left (hg0.fun_add hg1),
lintegral_add_left hg0]
_ ≤ 2 * (ofReal ((1 + L) * (4 * L * h ^ 2)) +
ofReal ((1 + L) * (4 * L * h ^ 2)) +
ofReal ((q * R) ^ 2 * (4 * L * h ^ 2))) := by
gcongr
· exact localized_arm_sq_lintegral_le p ν L P hP false i.2.1 h hh
· exact localized_arm_sq_lintegral_le p ν L P hP true i.2.1 h hh
· exact localized_const_sq_lintegral_le p ν L P hP i.2.1 h (q * R) hh
_ = ofReal (K * h ^ 2) := by
have hA : 0 ≤ (1 + L) * (4 * L * h ^ 2) := by positivity
have hD : 0 ≤ (q * R) ^ 2 * (4 * L * h ^ 2) := by positivity
have htwo : (2 : ENNReal) = ofReal 2 := by norm_num
rw [htwo, ← ENNReal.ofReal_add hA hA,
← ENNReal.ofReal_add (add_nonneg hA hA) hD,
← ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 2)]
congr 1
dsimp [K]
ring
have hK : 0 ≤ K := by
dsimp [K]
positivity
have hint : ∫ w, (f w) ^ 2 ∂P.law ≤ K * h ^ 2 := by
rw [← ENNReal.ofReal_le_ofReal_iff (mul_nonneg hK (sq_nonneg h))]
rw [ofReal_integral_eq_lintegral_ofReal hfint
(ae_of_all _ fun w => sq_nonneg (f w))]
exact hlin
unfold measureL2Dist
simp only [sub_zero]
have hsqrt : sqrt (∫ w, (f w) ^ 2 ∂P.law) ≤ sqrt K * h := by
have hsqrtMono := Real.sqrt_le_sqrt hint
rw [Real.sqrt_mul hK (h ^ 2), Real.sqrt_sq_eq_abs,
abs_of_pos hh] at hsqrtMono
exact hsqrtMono
have hsqrtK : sqrt K ≤ 1 + K := by
nlinarith [Real.sq_sqrt hK, Real.sqrt_nonneg K, sq_nonneg (sqrt K - 1)]
have hKabs : |K| = K := abs_of_nonneg hK
simpa only [f, q, K, hKabs] using
hsqrt.trans (mul_le_mul_of_nonneg_right hsqrtK hh.le)
theorem winsorizedScore_hasUniformL2Radius
For every fixed polynomial degree and law-class envelope there are a positive coefficient clipping radius and a positive constant such that every admissible winsorized score has population L² norm at most C h, uniformly over centers, arms, coordinates, and all winsorization levels B > h with B ≥ 1.
Formal statement
hypotheses
p :
ℕ
ν L :
ℝ
conclusion
∃ R C : ℝ,
0 < R ∧
0 < C ∧
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ h B : ℝ, 0 < h → h < B → 1
≤ B → ∀ i : WinsorizedScoreIndex p, measureL2Dist P.law (winsorizedScoreFunction P p h B R i) (fun _ => 0) ≤ C * h
Proof (Lean source)
lemma winsorizedScore_hasUniformL2Radius
(p : ℕ) (ν L : ℝ) :
∃ R C : ℝ, 0 < R ∧ 0 < C ∧
∀ P : A1A2Law, A1A2Class p ν L P →
∀ h B : ℝ, 0 < h → h < B → 1 ≤ B →
∀ i : WinsorizedScoreIndex p,
measureL2Dist P.law (winsorizedScoreFunction P p h B R i)
(fun _ => 0) ≤ C * h := by
obtain ⟨C, hC, hbound⟩ :=
winsorizedScore_hasUniformL2Radius_at p ν L 1 (by norm_num)
exact ⟨1, C, by norm_num, hC, hbound⟩
Causal.EmpiricalProcess.Separability 14 declarations This is the bounded residual identified in round 13.
Countable reduction for the winsorized score class
This is the bounded residual identified in round 13. The property below says that a continuum-indexed empirical-process supremum has a fixed countable pointwise-dense subfamily. It is the bridge from outer expectation to the countable-index concentration API.
def WinsorizedScoreIndex
Index (arm, center, coefficient vector, coordinate) for the enlarged winsorized score class.
Definition (Lean source)
def SeparableWinsorizedScoreIndex
Index for the separable one-sided bandwidth enlargement. Centers are restricted to the treatment boundary and the support bandwidth approaches the target bandwidth h from the half-open interval [h,2h).
def winsorizedScoreFunction
One scalar coordinate of the enlarged bounded-coefficient winsorized score class. Coefficients are clipped componentwise at the supplied radius, so this is a genuine constant-envelope class.
Definition (Lean source)
noncomputable def winsorizedScoreFunction (P : A1A2Law) (p : ℕ)
(h B C : ℝ) (i : WinsorizedScoreIndex p) (z : CausalObservation) : ℝ := by
classical
let t := i.1
let x := i.2.1
let b := i.2.2.1
let j := i.2.2.2
let d := signedDistance (knownGeometry P) x (causalScore z)
exact (if signedArm t d then 1 else 0) *
uniformKernel (d / h) * polyBasis p (d / h) j *
(winsorize B (observedOutcome P z) -
∑ k, polyBasis p (d / h) k * clip C (b k))
def separableWinsorizedScoreFunction
The one-sided support-bandwidth enlargement of the fixed-bandwidth score. The polynomial arguments remain normalized by h; only the closed kernel support uses q. Thus the fixed class embeds at q=h, while rational bandwidths decreasing to h resolve sample points on moving ball boundaries.
Definition (Lean source)
noncomputable def separableWinsorizedScoreFunction (P : A1A2Law) (p : ℕ)
(h B C : ℝ) (i : SeparableWinsorizedScoreIndex P p h)
(z : CausalObservation) : ℝ := by
classical
let q := i.1.1
let t := i.2.1
let x := i.2.2.1.1
let b := i.2.2.2.1
let j := i.2.2.2.2
let d := signedDistance (knownGeometry P) x (causalScore z)
exact (if signedArm t d then 1 else 0) *
uniformKernel (d / q) * polyBasis p (d / h) j *
(winsorize B (observedOutcome P z) -
∑ k, polyBasis p (d / h) k * clip C (b k))
theorem winsorizedScore_boundary_volume_zero
The centered empirical average of a real-valued function.
Formal statement
Proof (Lean source)
lemma winsorizedScore_boundary_volume_zero (p : ℕ) (ν L : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) :
volume P.boundary = 0 := by
rcases hP with ⟨hν, hL, hrect, hdcont, hdbd, hmu, hsig, hmean, hvar,
hmom, hgeom, hvc, hgram, hlocal, hslice⟩
rcases hgeom with ⟨hA0, hA1, hpart, hdisj, hbdy, hbcompact, hbsub,
hbrect, hH1lo, hH1hi⟩
have hH1 : Measure.hausdorffMeasure 1 P.boundary ≠ ∞ :=
ne_top_of_le_ne_top ENNReal.ofReal_ne_top hH1hi
have hH2 : Measure.hausdorffMeasure 2 P.boundary = 0 :=
(Measure.hausdorffMeasure_zero_or_top (by norm_num : (1 : ℝ) < 2) P.boundary).resolve_right hH1
have hdim : finrank ℝ Score = 2 := by simp
letI : Measure.IsAddHaarMeasure (Measure.hausdorffMeasure 2 : Measure Score) := by
have h := MeasureTheory.isAddHaarMeasure_hausdorffMeasure (E := Score)
rw [hdim] at h
simp only [Nat.cast_ofNat] at h
exact h
have hvolEq : (volume : Measure Score) =
Measure.addHaarScalarFactor (volume : Measure Score)
(Measure.hausdorffMeasure 2 : Measure Score) •
(Measure.hausdorffMeasure 2 : Measure Score) := by
exact Measure.isAddLeftInvariant_eq_smul (volume : Measure Score)
(Measure.hausdorffMeasure 2 : Measure Score)
rw [hvolEq, Measure.smul_apply, hH2]
simp
theorem winsorizedScore_boundary_nonempty
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
Proof (Lean source)
lemma winsorizedScore_boundary_nonempty (p : ℕ) (ν L : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) : P.boundary.Nonempty := by
rcases hP with ⟨hν, hL, hrect, hdcont, hdbd, hmu, hsig, hmean, hvar,
hmom, hgeom, hvc, hgram, hlocal, hslice⟩
rcases hgeom with ⟨hA0, hA1, hpart, hdisj, hbdy, hbcompact, hbsub,
hbrect, hH1lo, hH1hi⟩
by_contra hn
rw [not_nonempty_iff_eq_empty.mp hn, measure_empty] at hH1lo
have hLpos : 0 < L := by linarith
exact (not_lt_of_ge hH1lo) (ENNReal.ofReal_pos.2 (inv_pos.2 hLpos))
theorem winsorizedScore_boundary_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
Proof (Lean source)
lemma winsorizedScore_boundary_measurable (p : ℕ) (ν L : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) : MeasurableSet P.boundary := by
rcases hP with ⟨hν, hL, hrect, hdcont, hdbd, hmu, hsig, hmean, hvar,
hmom, hgeom, hvc, hgram, hlocal, hslice⟩
exact hgeom.2.2.2.2.2.1.measurableSet
theorem uniformKernel_div_eq_if_abs_le
The two stated constructions agree under the theorem's assumptions.
Formal statement
Proof (Lean source)
lemma uniformKernel_div_eq_if_abs_le (d q : ℝ) (hq : 0 < q) :
uniformKernel (d / q) = if |d| ≤ q then 1 else 0 := by
unfold uniformKernel
have heq : d / q ∈ Icc (-1 : ℝ) 1 ↔ |d| ≤ q := by
rw [abs_le]
constructor
· rintro ⟨hlo, hhi⟩
constructor
· have := (le_div_iff₀ hq).mp hlo
nlinarith
· exact (div_le_iff₀ hq).mp hhi |>.trans_eq (one_mul q)
· rintro ⟨hlo, hhi⟩
constructor
· apply (le_div_iff₀ hq).2
nlinarith
· exact (div_le_iff₀ hq).2 (by simpa using hhi)
split_ifs with hu
· rw [indicator_of_mem (heq.mpr hu)]
· rw [indicator_of_notMem (fun hd => hu (heq.mp hd))]
theorem separableWinsorizedScoreFunction_bound Lemma separableWinsorizedScoreFunction_bound in the paper ↗
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
P :
p :
ℕ
h B C :
ℝ
hh :
0 < h
hB :
0 ≤ B
hC :
0 ≤ C
i :
conclusion
|separableWinsorizedScoreFunction P p h B C i z|
Proof (Lean source)
lemma separableWinsorizedScoreFunction_bound (P : A1A2Law) (p : ℕ) (h B C : ℝ)
(hh : 0 < h) (hB : 0 ≤ B) (hC : 0 ≤ C)
(i : SeparableWinsorizedScoreIndex P p h) (z : CausalObservation) :
|separableWinsorizedScoreFunction P p h B C i z| ≤
(2 : ℝ) ^ p *
(|armCoord false z| + |armCoord true z| +
(p + 1 : ℝ) * (2 : ℝ) ^ p * C) := by
classical
let d := signedDistance (knownGeometry P) i.2.2.1.1 (causalScore z)
have hq : 0 < i.1.1 := lt_of_lt_of_le hh i.1.2.1
dsimp [separableWinsorizedScoreFunction]
rw [show uniformKernel (d / i.1.1) = if |d| ≤ i.1.1 then 1 else 0 from
uniformKernel_div_eq_if_abs_le d i.1.1 hq]
by_cases hdq : |d| ≤ i.1.1
· rw [if_pos hdq]
have hu : |d / h| ≤ 2 := by
rw [abs_div, abs_of_pos hh]
have hqh : i.1.1 / h < 2 := (div_lt_iff₀ hh).2 i.1.2.2
exact (div_le_div_of_nonneg_right hdq hh.le).trans hqh.le
have hpoly (k : Fin (p + 1)) : |polyBasis p (d / h) k| ≤ (2 : ℝ) ^ p := by
unfold polyBasis
rw [abs_pow]
exact (pow_le_pow_left₀ (abs_nonneg _) hu k).trans
(pow_le_pow_right₀ (by norm_num) (Nat.le_of_lt_succ k.isLt))
have hclip (y : ℝ) : |clip C y| ≤ C := by
unfold clip
rw [abs_le]
constructor
· exact le_max_left _ _
· exact max_le (by linarith) (min_le_left _ _)
have hsum : |∑ k, polyBasis p (d / h) k * clip C (i.2.2.2.1 k)| ≤
(p + 1 : ℝ) * (2 : ℝ) ^ p * C := by
calc
_ ≤ ∑ k, |polyBasis p (d / h) k * clip C (i.2.2.2.1 k)| :=
Finset.abs_sum_le_sum_abs _ _
_ ≤ ∑ _k : Fin (p + 1), (2 : ℝ) ^ p * C := by
apply Finset.sum_le_sum
intro k _
rw [abs_mul]
exact mul_le_mul (hpoly k) (hclip _) (abs_nonneg _) (by positivity)
_ = (p + 1 : ℝ) * (2 : ℝ) ^ p * C := by
simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin,
nsmul_eq_mul, Nat.cast_add, cast_one]
ring
have hwin : |winsorize B (observedOutcome P z)| ≤
|armCoord false z| + |armCoord true z| := by
have hw : |winsorize B (observedOutcome P z)| ≤ |observedOutcome P z| := by
unfold winsorize
split_ifs with hy hy0
· rw [abs_neg, abs_of_nonneg (le_min (abs_nonneg _) hB)]
exact min_le_left _ _
· simp [hy0]
· rw [abs_of_nonneg (le_min (abs_nonneg _) hB)]
exact min_le_left _ _
refine hw.trans ?_
unfold observedOutcome treatment
by_cases hz1 : causalScore z ∈ P.A1
· simp [indicator_of_mem hz1]
· simp [indicator_of_notMem hz1]
have hres : |winsorize B (observedOutcome P z) -
∑ k, polyBasis p (d / h) k * clip C (i.2.2.2.1 k)| ≤
|armCoord false z| + |armCoord true z| +
(p + 1 : ℝ) * (2 : ℝ) ^ p * C :=
(abs_sub _ _).trans (add_le_add hwin hsum)
rw [abs_mul, abs_mul, abs_mul]
split_ifs
· simp only [abs_one, one_mul]
exact mul_le_mul (hpoly i.2.2.2.2) hres (abs_nonneg _) (by positivity)
· simp
positivity
· rw [if_neg hdq]
simp [d, uniformKernel_div_eq_if_abs_le, hq, hdq]
positivity
theorem separableWinsorizedScoreFunction_measurable Lemma separableWinsorizedScoreFunction_measurable in the paper ↗
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (separableWinsorizedScoreFunction P p h B C i)
Proof (Lean source)
lemma separableWinsorizedScoreFunction_measurable (P : A1A2Law) (p : ℕ)
(h B C : ℝ) (i : SeparableWinsorizedScoreIndex P p h) :
Measurable (separableWinsorizedScoreFunction P p h B C i) := by
classical
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have htreat : Measurable (treatment P) := by
unfold treatment
exact measurable_const.indicator (P.A1_measurable.preimage hscore)
have harm (t : Bool) : Measurable (armCoord t) := by
cases t <;> unfold armCoord <;> simp only [Bool.false_eq_true, if_false,
if_true] <;> fun_prop
have hout : Measurable (observedOutcome P) := by
unfold observedOutcome
exact (htreat.mul (harm true)).add
((measurable_const.sub htreat).mul (harm false))
have hd : Measurable (fun z => signedDistance (knownGeometry P)
i.2.2.1.1 (causalScore z)) := by
have hi1 : Measurable (fun z => P.A1.indicator (fun _ => (1 : ℝ))
(causalScore z)) := measurable_const.indicator (P.A1_measurable.preimage hscore)
have hi0 : Measurable (fun z => P.A0.indicator (fun _ => (1 : ℝ))
(causalScore z)) := measurable_const.indicator (P.A0_measurable.preimage hscore)
have hdist : Measurable (fun z => dist (causalScore z) i.2.2.1.1) :=
hscore.dist measurable_const
exact (hi1.sub hi0).mul hdist
have hsigned : Measurable (fun z => if signedArm i.2.1
(signedDistance (knownGeometry P) i.2.2.1.1 (causalScore z))
then (1 : ℝ) else 0) := by
cases i.2.1
· exact Measurable.ite (measurableSet_lt hd measurable_const)
measurable_const measurable_const
· exact Measurable.ite (measurableSet_le measurable_const hd)
measurable_const measurable_const
unfold separableWinsorizedScoreFunction
dsimp only
exact (((hsigned.mul (uniformKernel_measurable.comp (hd.div_const i.1.1))).mul
((polyBasis_apply_measurable p i.2.2.2.2).comp (hd.div_const h))).mul
(((winsorize_measurable B).comp hout).sub
(measurable_sum _ fun k _ =>
((polyBasis_apply_measurable p k).comp (hd.div_const h)).mul
measurable_const)))
theorem separableWinsorizedScoreIndex_exists_approximating_sequence Lemma separableWinsorizedScoreIndex_exists_approximating_sequence in the paper ↗
The stated finite approximation exists with the asserted properties.
Formal statement
hypotheses
Proof (Lean source)
lemma separableWinsorizedScoreIndex_exists_approximating_sequence
(P : A1A2Law) (p : ℕ) (h : ℝ) (hh : 0 < h)
(g0 : ℕ → SeparableWinsorizedScoreIndex P p h) (hdense : DenseRange g0)
(i : SeparableWinsorizedScoreIndex P p h) :
∃ kseq : ℕ → ℕ,
Tendsto (fun m => g0 (kseq m)) atTop (nhds i) ∧
∀ m, i.1.1 + dist
((g0 (kseq m)).2.2.1.1)
i.2.2.1.1 <
(g0 (kseq m)).1.1 := by
let I := SeparableWinsorizedScoreIndex P p h
let δ : ℕ → ℝ := fun m => (2 * h - i.1.1) / (16 * (m + 1 : ℕ))
have hδ (m : ℕ) : 0 < δ m := by
dsimp [δ]
apply div_pos
· exact sub_pos.2 i.1.2.2
· positivity
let a : ℕ → I := fun m =>
⟨⟨i.1.1 + 4 * δ m, by
constructor
· nlinarith [i.1.2.1, hδ m]
· have hm : (1 : ℝ) ≤ (m + 1 : ℕ) := by exact_mod_cast Nat.succ_le_succ (zero_le m)
have hnum : 0 < 2 * h - i.1.1 := sub_pos.2 i.1.2.2
dsimp [δ]
have hden : 0 < (16 : ℝ) * (m + 1 : ℕ) := by positivity
have hle : (4 : ℝ) * ((2 * h - i.1.1) /
(16 * (m + 1 : ℕ))) ≤ (2 * h - i.1.1) / 4 := by
calc
_ = (2 * h - i.1.1) / (4 * (m + 1 : ℕ)) := by ring
_ ≤ (2 * h - i.1.1) / 4 := by
apply (div_le_div_iff_of_pos_left hnum
(by positivity) (by norm_num)).2
nlinarith
nlinarith⟩,
⟨i.2.1, ⟨i.2.2.1, ⟨i.2.2.2.1, i.2.2.2.2⟩⟩⟩⟩
let U : ℕ → Set I := fun m => {u |
dist u.2.2.1.1 i.2.2.1.1 < δ m ∧
|u.1.1 - (i.1.1 + 4 * δ m)| < δ m ∧
(∀ k, |u.2.2.2.1 k - i.2.2.2.1 k| < δ m) ∧
u.2.1 = i.2.1 ∧ u.2.2.2.2 = i.2.2.2.2}
have hUopen (m : ℕ) : IsOpen (U m) := by
have hxcont : Continuous (fun u : I => (u.2.2.1.1 : Score)) := by
dsimp [I]
fun_prop
have hqcont : Continuous (fun u : I => (u.1.1 : ℝ)) := by
dsimp [I]
fun_prop
have hbcont (k : Fin (p + 1)) : Continuous (fun u : I => u.2.2.2.1 k) := by
dsimp [I]
fun_prop
have htcont : Continuous (fun u : I => u.2.1) := by
dsimp [I]
fun_prop
have hjcont : Continuous (fun u : I => u.2.2.2.2) := by
dsimp [I]
fun_prop
have hcoeff : IsOpen {u : I |
∀ k, |u.2.2.2.1 k - i.2.2.2.1 k| < δ m} := by
rw [show {u : I | ∀ k, |u.2.2.2.1 k - i.2.2.2.1 k| < δ m} =
⋂ k : Fin (p + 1), {u : I |
|u.2.2.2.1 k - i.2.2.2.1 k| < δ m} by ext u; simp]
exact isOpen_iInter_of_finite fun k =>
isOpen_lt ((hbcont k).sub continuous_const |>.abs) continuous_const
dsimp [U]
refine (isOpen_lt (hxcont.dist continuous_const) continuous_const).and ?_
refine (isOpen_lt (hqcont.sub continuous_const |>.abs) continuous_const).and ?_
refine hcoeff.and ?_
exact (htcont.isOpen_preimage {i.2.1} (isOpen_discrete _)).and
(hjcont.isOpen_preimage {i.2.2.2.2} (isOpen_discrete _))
have haU (m : ℕ) : a m ∈ U m := by
dsimp [U, a]
simp only [dist_self, sub_self, abs_zero]
refine ⟨hδ m, hδ m, ?_, trivial, trivial⟩
intro k
simpa using hδ m
have hex (m : ℕ) : ∃ k : ℕ, g0 k ∈ U m := by
exact hdense.exists_mem_open (hUopen m) ⟨a m, haU m⟩
choose kseq hkseq using hex
refine ⟨kseq, ?_, ?_⟩
· have hδ0 : Tendsto δ atTop (nhds 0) := by
dsimp [δ]
have hbase := (tendsto_const_div_atTop_nhds_zero_nat
((2 * h - i.1.1) / 16 : ℝ)).comp (tendsto_add_atTop_nat 1)
simpa [Function.comp_def, Nat.add_comm, Nat.cast_add, div_eq_mul_inv,
mul_assoc, mul_left_comm, mul_comm] using hbase
have hq : Tendsto (fun m => (g0 (kseq m)).1.1) atTop (nhds i.1.1) := by
rw [Metric.tendsto_atTop]
intro ε hε
rcases eventually_atTop.1
(hδ0.eventually (gt_mem_nhds (show 0 < ε / 5 by positivity))) with ⟨N, hN⟩
refine ⟨N, fun m hmN => ?_⟩
have hm := hN m hmN
have hu := (hkseq m).2.1
rw [abs_lt] at hu
rw [Real.dist_eq, abs_lt]
constructor <;> nlinarith [hδ m]
have hx : Tendsto (fun m => (g0 (kseq m)).2.2.1.1) atTop
(nhds i.2.2.1.1) := by
rw [Metric.tendsto_atTop]
intro ε hε
rcases eventually_atTop.1 (hδ0.eventually (gt_mem_nhds hε)) with ⟨N, hN⟩
refine ⟨N, fun m hmN => ?_⟩
have hm := hN m hmN
exact (hkseq m).1.trans hm
have hb : Tendsto (fun m => (g0 (kseq m)).2.2.2.1) atTop
(nhds i.2.2.2.1) := by
rw [tendsto_pi_nhds]
intro k
rw [Metric.tendsto_atTop]
intro ε hε
rcases eventually_atTop.1 (hδ0.eventually (gt_mem_nhds hε)) with ⟨N, hN⟩
refine ⟨N, fun m hmN => ?_⟩
have hm := hN m hmN
simpa [Real.dist_eq] using ((hkseq m).2.2.1 k).trans hm
have ht : Tendsto (fun m => (g0 (kseq m)).2.1) atTop (nhds i.2.1) := by
apply tendsto_atTop_of_eventually_const (i₀ := 0)
intro m _
exact (hkseq m).2.2.2.1
have hj : Tendsto (fun m => (g0 (kseq m)).2.2.2.2) atTop
(nhds i.2.2.2.2) := by
apply tendsto_atTop_of_eventually_const (i₀ := 0)
intro m _
exact (hkseq m).2.2.2.2
have hcenter := tendsto_subtype_rng.2 hx
rw [nhds_prod_eq, Filter.tendsto_prod_iff']
refine ⟨tendsto_subtype_rng.2 hq, ?_⟩
rw [nhds_prod_eq, Filter.tendsto_prod_iff']
refine ⟨ht, ?_⟩
rw [nhds_prod_eq, Filter.tendsto_prod_iff']
refine ⟨hcenter, ?_⟩
rw [nhds_prod_eq, Filter.tendsto_prod_iff']
exact ⟨hb, hj⟩
· intro m
have hx := (hkseq m).1
have hq := (hkseq m).2.1
rw [abs_lt] at hq
nlinarith [hδ m]
theorem separableWinsorizedScoreFunction_tendsto Lemma separableWinsorizedScoreFunction_tendsto in the paper ↗
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
P :
p :
ℕ
h B C :
ℝ
hh :
0 < h
i :
u :
ℕ → SeparableWinsorizedScoreIndex P p h
habove :
∀ m, i.1.1 + dist (u m).2.2.1.1 i.2.2.1.1 < (u m).1.1
hzsup :
causalScore z ∈ P.support
hznb :
causalScore z ∉ P.boundary
conclusion
Tendsto (fun m => separableWinsorizedScoreFunction P p h B C (u m) z) atTop (nhds (separableWinsorizedScoreFunction P p h B C i z))
Proof (Lean source)
lemma separableWinsorizedScoreFunction_tendsto
(P : A1A2Law) (p : ℕ) (h B C : ℝ) (hh : 0 < h)
(i : SeparableWinsorizedScoreIndex P p h)
(u : ℕ → SeparableWinsorizedScoreIndex P p h)
(hu : Tendsto u atTop (nhds i))
(habove : ∀ m, i.1.1 + dist (u m).2.2.1.1 i.2.2.1.1 < (u m).1.1)
(z : CausalObservation) (hzsup : causalScore z ∈ P.support)
(hznb : causalScore z ∉ P.boundary) :
Tendsto (fun m => separableWinsorizedScoreFunction P p h B C (u m) z)
atTop (nhds (separableWinsorizedScoreFunction P p h B C i z)) := by
classical
let dseq : ℕ → ℝ := fun m =>
signedDistance (knownGeometry P) (u m).2.2.1.1 (causalScore z)
let d := signedDistance (knownGeometry P) i.2.2.1.1 (causalScore z)
have hq : Tendsto (fun m => (u m).1.1) atTop (nhds i.1.1) :=
((by fun_prop : Continuous (fun a : SeparableWinsorizedScoreIndex P p h =>
(a.1.1 : ℝ))).continuousAt.tendsto).comp hu
have hx : Tendsto (fun m => (u m).2.2.1.1) atTop (nhds i.2.2.1.1) :=
((by fun_prop : Continuous (fun a : SeparableWinsorizedScoreIndex P p h =>
(a.2.2.1.1 : Score))).continuousAt.tendsto).comp hu
have hb (k : Fin (p + 1)) : Tendsto (fun m => (u m).2.2.2.1 k)
atTop (nhds (i.2.2.2.1 k)) :=
((by fun_prop : Continuous (fun a : SeparableWinsorizedScoreIndex P p h =>
a.2.2.2.1 k)).continuousAt.tendsto).comp hu
have htlim : Tendsto (fun m => (u m).2.1) atTop (nhds i.2.1) :=
((by fun_prop : Continuous (fun a : SeparableWinsorizedScoreIndex P p h =>
a.2.1)).continuousAt.tendsto).comp hu
have hjlim : Tendsto (fun m => (u m).2.2.2.2) atTop (nhds i.2.2.2.2) :=
((by fun_prop : Continuous (fun a : SeparableWinsorizedScoreIndex P p h =>
a.2.2.2.2)).continuousAt.tendsto).comp hu
have ht : ∀ᶠ m in atTop, (u m).2.1 = i.2.1 := by
simpa [nhds_discrete] using htlim
have hj : ∀ᶠ m in atTop, (u m).2.2.2.2 = i.2.2.2.2 := by
simpa [nhds_discrete] using hjlim
have hdist : Tendsto (fun m => dist (causalScore z) (u m).2.2.1.1)
atTop (nhds (dist (causalScore z) i.2.2.1.1)) :=
tendsto_const_nhds.dist hx
have hd : Tendsto dseq atTop (nhds d) := by
dsimp [dseq, d, signedDistance, knownGeometry]
exact tendsto_const_nhds.mul hdist
have hkernel : ∀ᶠ m in atTop,
uniformKernel (dseq m / (u m).1.1) = uniformKernel (d / i.1.1) := by
have hqm (m : ℕ) : 0 < (u m).1.1 := lt_of_lt_of_le hh (u m).1.2.1
have hqi : 0 < i.1.1 := lt_of_lt_of_le hh i.1.2.1
rw [uniformKernel_div_eq_if_abs_le d i.1.1 hqi]
simp_rw [uniformKernel_div_eq_if_abs_le (dseq _) _ (hqm _)]
by_cases hinside : |d| ≤ i.1.1
· have hall : ∀ m, |dseq m| ≤ (u m).1.1 := by
intro m
have htri := dist_triangle (causalScore z) i.2.2.1.1 (u m).2.2.1.1
have hab := habove m
have habs : |dseq m| = dist (causalScore z) (u m).2.2.1.1 := by
dsimp [dseq, signedDistance, knownGeometry]
rcases (show causalScore z ∈ P.A0 ∪ P.A1 by simpa [P.assignment_partition.1]
using hzsup) with hz0 | hz1
· have hz1n : causalScore z ∉ P.A1 := fun hz1 =>
P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
simp [indicator_of_mem hz0, indicator_of_notMem hz1n]
· have hz0n : causalScore z ∉ P.A0 := fun hz0 =>
P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
simp [indicator_of_mem hz1, indicator_of_notMem hz0n]
have habsi : |d| = dist (causalScore z) i.2.2.1.1 := by
dsimp [d, signedDistance, knownGeometry]
rcases (show causalScore z ∈ P.A0 ∪ P.A1 by simpa [P.assignment_partition.1]
using hzsup) with hz0 | hz1
· have hz1n : causalScore z ∉ P.A1 := fun hz1 =>
P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
simp [indicator_of_mem hz0, indicator_of_notMem hz1n]
· have hz0n : causalScore z ∉ P.A0 := fun hz0 =>
P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
simp [indicator_of_mem hz1, indicator_of_notMem hz0n]
rw [habsi] at hinside
rw [habs]
have hab' : i.1.1 + dist i.2.2.1.1 (u m).2.2.1.1 < (u m).1.1 := by
simpa [dist_comm] using hab
nlinarith
exact Eventually.of_forall fun m => by simp [hinside, hall m]
· have hout : i.1.1 < |d| := lt_of_not_ge hinside
have hev : ∀ᶠ m in atTop, (u m).1.1 < |dseq m| :=
Filter.Tendsto.eventually_lt hq hd.abs hout
exact hev.mono fun m hm => by simp [hinside, not_le_of_gt hm]
have hpoly (k : Fin (p + 1)) : Tendsto (fun m => polyBasis p (dseq m / h) k)
atTop (nhds (polyBasis p (d / h) k)) := by
unfold polyBasis
exact (hd.div_const h).pow _
have hclip (k : Fin (p + 1)) : Tendsto (fun m => clip C ((u m).2.2.2.1 k))
atTop (nhds (clip C (i.2.2.2.1 k))) := by
exact ((by unfold clip; fun_prop : Continuous (clip C))).continuousAt.tendsto.comp (hb k)
have hsum : Tendsto (fun m => ∑ k,
polyBasis p (dseq m / h) k * clip C ((u m).2.2.2.1 k)) atTop
(nhds (∑ k, polyBasis p (d / h) k * clip C (i.2.2.2.1 k))) := by
apply tendsto_finset_sum
intro k _
exact (hpoly k).mul (hclip k)
have hcore : Tendsto (fun m => polyBasis p (dseq m / h) (u m).2.2.2.2 *
(winsorize B (observedOutcome P z) - ∑ k,
polyBasis p (dseq m / h) k * clip C ((u m).2.2.2.1 k))) atTop
(nhds (polyBasis p (d / h) i.2.2.2.2 *
(winsorize B (observedOutcome P z) - ∑ k,
polyBasis p (d / h) k * clip C (i.2.2.2.1 k)))) := by
have heq : ∀ᶠ m in atTop,
polyBasis p (dseq m / h) (u m).2.2.2.2 *
(winsorize B (observedOutcome P z) - ∑ k,
polyBasis p (dseq m / h) k * clip C ((u m).2.2.2.1 k)) =
polyBasis p (dseq m / h) i.2.2.2.2 *
(winsorize B (observedOutcome P z) - ∑ k,
polyBasis p (dseq m / h) k * clip C ((u m).2.2.2.1 k)) :=
hj.mono fun m hm => by rw [hm]
have heqsym := heq.mono fun m hm => hm.symm
exact Tendsto.congr' heqsym
((hpoly i.2.2.2.2).mul (tendsto_const_nhds.sub hsum))
have harm : ∀ᶠ m in atTop,
(if signedArm (u m).2.1 (dseq m) then (1 : ℝ) else 0) =
(if signedArm i.2.1 d then 1 else 0) := by
filter_upwards [ht] with m htm
rw [htm]
have hxmn : causalScore z ≠ (u m).2.2.1.1 := fun heq =>
hznb (heq ▸ (u m).2.2.1.2)
have hxin : causalScore z ≠ i.2.2.1.1 := fun heq => hznb (heq ▸ i.2.2.1.2)
rcases (show causalScore z ∈ P.A0 ∪ P.A1 by simpa [P.assignment_partition.1]
using hzsup) with hz0 | hz1
· have hz1n : causalScore z ∉ P.A1 := fun hz1 =>
P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
cases hit : i.2.1 <;>
simp [dseq, d, signedDistance, knownGeometry, indicator_of_mem hz0,
indicator_of_notMem hz1n, signedArm, hit, hxmn, hxin, dist_nonneg]
· have hz0n : causalScore z ∉ P.A0 := fun hz0 =>
P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
cases hit : i.2.1 <;>
simp [dseq, d, signedDistance, knownGeometry, indicator_of_mem hz1,
indicator_of_notMem hz0n, signedArm, hit, hxmn, hxin] <;>
split_ifs <;> linarith [
(dist_nonneg : 0 ≤ dist (causalScore z) (u m).2.2.1.1),
(dist_nonneg : 0 ≤ dist (causalScore z) i.2.2.1.1)]
have hfull : ∀ᶠ m in atTop,
separableWinsorizedScoreFunction P p h B C (u m) z =
(if signedArm i.2.1 d then (1 : ℝ) else 0) *
uniformKernel (d / i.1.1) *
(polyBasis p (dseq m / h) (u m).2.2.2.2 *
(winsorize B (observedOutcome P z) - ∑ k,
polyBasis p (dseq m / h) k * clip C ((u m).2.2.2.1 k))) := by
filter_upwards [harm, hkernel] with m hm hkm
dsimp [separableWinsorizedScoreFunction, dseq]
rw [hm, hkm]
ring
have hbase : Tendsto (fun m =>
(if signedArm i.2.1 d then (1 : ℝ) else 0) *
uniformKernel (d / i.1.1) *
(polyBasis p (dseq m / h) (u m).2.2.2.2 *
(winsorize B (observedOutcome P z) - ∑ k,
polyBasis p (dseq m / h) k * clip C ((u m).2.2.2.1 k)))) atTop
(nhds ((if signedArm i.2.1 d then (1 : ℝ) else 0) *
uniformKernel (d / i.1.1) *
(polyBasis p (d / h) i.2.2.2.2 *
(winsorize B (observedOutcome P z) - ∑ k,
polyBasis p (d / h) k * clip C (i.2.2.2.1 k))))) :=
(tendsto_const_nhds.mul tendsto_const_nhds).mul hcore
have hfullsym := hfull.mono fun m hm => hm.symm
apply Tendsto.congr' hfullsym
convert hbase using 1 <;>
simp only [separableWinsorizedScoreFunction, d] <;> ring_nf
theorem winsorizedScore_hasCountableEmpiricalSupReduction_at
The rational-center/rational-bandwidth enlargement of the bounded winsorized signed-distance score class has an almost-sure countable supremum reduction. A single conull set excludes observations whose score lies on the treatment boundary; closed kernel endpoints are approached from bandwidths in [h,2h).
Formal statement
hypotheses
p :
ℕ
ν L C :
ℝ
hC :
0 < C
conclusion
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ h B : ℝ, 0 < h → 1
≤ B → HasCountableEmpiricalSupReduction P.law (separableWinsorizedScoreFunction P p h B C)
Proof (Lean source)
-- @node: winsorizedScore_hasCountableEmpiricalSupReduction_at
lemma winsorizedScore_hasCountableEmpiricalSupReduction_at
(p : ℕ) (ν L C : ℝ) (hC : 0 < C) :
∀ P : A1A2Law, A1A2Class p ν L P →
∀ h B : ℝ, 0 < h → 1 ≤ B →
HasCountableEmpiricalSupReduction P.law
(separableWinsorizedScoreFunction P p h B C) := by
intro P hP h B hh hB
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hbne := winsorizedScore_boundary_nonempty p ν L P hP
letI : Nonempty {x : Score // x ∈ P.boundary} := hbne.to_subtype
let I := SeparableWinsorizedScoreIndex P p h
have hI : Nonempty I := by
exact ⟨⟨⟨h, ⟨le_rfl, by linarith⟩⟩,
⟨false, ⟨Classical.arbitrary _, ⟨0, Classical.arbitrary _⟩⟩⟩⟩⟩
letI : Nonempty I := hI
let g0 : ℕ → I := TopologicalSpace.denseSeq I
have hdense : DenseRange g0 := TopologicalSpace.denseRange_denseSeq I
let S : Set CausalObservation :=
{z | causalScore z ∈ P.support ∧ causalScore z ∉ P.boundary}
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have hsuppMap : ∀ᵐ x ∂Measure.map causalScore P.law, x ∈ P.support := by
rw [P.support_eq_marginal_support]
exact Measure.support_mem_ae
have hsupp : ∀ᵐ z ∂P.law, causalScore z ∈ P.support :=
MeasureTheory.ae_of_ae_map hscore.aemeasurable hsuppMap
have hbvol : volume P.boundary = 0 := by
exact winsorizedScore_boundary_volume_zero p ν L P hP
have hbmeas : MeasurableSet P.boundary :=
winsorizedScore_boundary_measurable p ν L P hP
have hbmap : (Measure.map causalScore P.law) P.boundary = 0 := by
rw [P.marginal_eq, withDensity_apply _ hbmeas]
exact setLIntegral_measure_zero P.boundary _ hbvol
have hnbMap : ∀ᵐ x ∂Measure.map causalScore P.law, x ∉ P.boundary :=
measure_eq_zero_iff_ae_notMem.mp hbmap
have hnb : ∀ᵐ z ∂P.law, causalScore z ∉ P.boundary :=
MeasureTheory.ae_of_ae_map hscore.aemeasurable hnbMap
have hS : ∀ᵐ z ∂P.law, z ∈ S := hsupp.and hnb
have hmeas : ∀ i : I, Measurable
(separableWinsorizedScoreFunction P p h B C i) :=
fun i => separableWinsorizedScoreFunction_measurable P p h B C i
let G : CausalObservation → ℝ := fun z =>
(2 : ℝ) ^ p * (|armCoord false z| + |armCoord true z| +
(p + 1 : ℝ) * (2 : ℝ) ^ p * C)
have hexp : 1 ≤ ofReal (2 + ν) := by
rw [ENNReal.one_le_ofReal]
linarith [hP.1]
have hi0 : Integrable (armCoord false) P.law :=
(P.memLp_armCoord_of_condAbsMoment_le p ν L hP false).integrable hexp
have hi1 : Integrable (armCoord true) P.law :=
(P.memLp_armCoord_of_condAbsMoment_le p ν L hP true).integrable hexp
have hG : Integrable G P.law := by
exact ((hi0.abs.add hi1.abs).add (integrable_const
((p + 1 : ℝ) * (2 : ℝ) ^ p * C))).const_mul ((2 : ℝ) ^ p)
apply hasCountableEmpiricalSupReduction_of_pointwise_dense P.law
(separableWinsorizedScoreFunction P p h B C) g0 S hS
· intro i
obtain ⟨kseq, hlim, habove⟩ :=
separableWinsorizedScoreIndex_exists_approximating_sequence
P p h hh g0 hdense i
refine ⟨kseq, fun z hz => ?_⟩
exact separableWinsorizedScoreFunction_tendsto P p h B C hh i
(fun m => g0 (kseq m)) hlim
habove z hz.1 hz.2
· exact hmeas
· refine ⟨G, hG, ?_⟩
intro i z
exact separableWinsorizedScoreFunction_bound P p h B C hh (by linarith) hC.le i z
theorem winsorizedScore_hasCountableEmpiricalSupReduction
The countable reduction at the canonical unit coefficient radius.
Formal statement
hypotheses
p :
ℕ
ν L :
ℝ
conclusion
∃ C : ℝ,
0 < C ∧
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ h B : ℝ, 0 < h → 1
≤ B → HasCountableEmpiricalSupReduction P.law (separableWinsorizedScoreFunction P p h B C)
Proof (Lean source)
-- @node: winsorizedScore_hasCountableEmpiricalSupReduction
lemma winsorizedScore_hasCountableEmpiricalSupReduction
(p : ℕ) (ν L : ℝ) :
∃ C : ℝ, 0 < C ∧ ∀ P : A1A2Law, A1A2Class p ν L P →
∀ h B : ℝ, 0 < h → 1 ≤ B →
HasCountableEmpiricalSupReduction P.law
(separableWinsorizedScoreFunction P p h B C) := by
exact ⟨1, by norm_num, winsorizedScore_hasCountableEmpiricalSupReduction_at
p ν L 1 (by norm_num)⟩
Causal.EmpiricalProcess.SeparableCover 1 declarations This file inserts the independently parameterized closed-ball support into the fixed-normalization radial-polynomial cover.
Polynomial covering for the one-sided bandwidth enlargement
This file inserts the independently parameterized closed-ball support into the fixed-normalization radial-polynomial cover. The diagonal pullback then ties the ball center to the polynomial center. The degree-zero term off the known assignment support is kept separate because signed distance is identically zero there.
theorem separableWinsorizedScore_hasUniformPolynomialL2Cover Lemma separableWinsorizedScore_hasUniformPolynomialL2Cover in the paper ↗
The separable score class, whose kernel bandwidth ranges over [h,2h), has polynomial covering witnesses uniform in the law, bandwidth, and winsorization level.
Formal statement
hypotheses
p :
ℕ
R :
ℝ
hR :
0 < R
conclusion
∃ A v : ℝ,
exp 1 ≤ A ∧
1 ≤ v ∧
∀ (P : A1A2Law),
P.boundary.Nonempty → ∀ {h B : ℝ}, 0 < h → 0 < B → HasPolynomialL2Cover (separableWinsorizedScoreFunction P p h B R) ((2 * ((2 : ℝ) ^ p) ^ 2 + 2) * (B + ((p + 1 : ℕ) : ℝ) * R)) ∧ HasPolynomialEmpiricalL2Cover (separableWinsorizedScoreFunction P p h B R) ((2 * ((2 : ℝ) ^ p) ^ 2 + 2) * (B + ((p + 1 : ℕ) : ℝ) * R)) A v
Proof (Lean source)
-- @node: separableWinsorizedScore_hasUniformPolynomialL2Cover
lemma separableWinsorizedScore_hasUniformPolynomialL2Cover
(p : ℕ) {R : ℝ} (hR : 0 < R) :
∃ A v : ℝ, exp 1 ≤ A ∧ 1 ≤ v ∧
∀ (P : A1A2Law), P.boundary.Nonempty → ∀ {h B : ℝ}, 0 < h → 0 < B →
HasPolynomialL2Cover
(separableWinsorizedScoreFunction P p h B R)
((2 * ((2 : ℝ) ^ p) ^ 2 + 2) *
(B + ((p + 1 : ℕ) : ℝ) * R)) ∧
HasPolynomialEmpiricalL2Cover
(separableWinsorizedScoreFunction P p h B R)
((2 * ((2 : ℝ) ^ p) ^ 2 + 2) *
(B + ((p + 1 : ℕ) : ℝ) * R)) A v := by
classical
let Arm := Bool × Fin (p + 1)
obtain ⟨C, n, hradial⟩ :=
radialResidualScore_hasUniformPolynomialL2CoverWith
(Ω := CausalObservation) (A := Arm) 2 p
let Cball : ℝ := 16
let nball : ℕ := 8 * ((2 + 2) + 1)
let Cmul := 8 * C * Cball
let nmul := n + nball + 2
let C₁ := 2 * Cmul
let C₂ := 8 * C₁ * C₁
let n₂ := nmul + nmul + 2
let C₃ := 8 * C₂ * (2 * C)
let n₃ := n₂ + n + 2
let C₄ := 8 * C₃ * (2 * C)
let n₄ := n₃ + n + 2
let M : ℝ := (2 : ℝ) ^ p
let c : ℝ := 2 * M ^ 2 + 2
let Cfinal := 2 * C₄
refine ⟨max (exp 1) (2 * Cfinal), ((n₄ + 1 : ℕ) : ℝ),
le_max_left _ _, ?_, ?_⟩
· exact_mod_cast Nat.succ_le_succ (zero_le n₄)
· intro P hbdy h B hh hB
letI : Nonempty {x : Score // x ∈ P.boundary} := hbdy.to_subtype
letI : Nonempty (SeparableWinsorizedScoreIndex P p h) := ⟨
⟨⟨h, ⟨le_rfl, by linarith⟩⟩,
⟨false, ⟨Classical.arbitrary _, ⟨0, Classical.arbitrary _⟩⟩⟩⟩⟩
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have htreat : Measurable (treatment P) := by
unfold treatment
exact measurable_const.indicator (P.A1_measurable.preimage hscore)
have harmCoord (t : Bool) : Measurable (armCoord t) := by
cases t <;> unfold armCoord <;> simp only [Bool.false_eq_true, if_false,
if_true] <;> fun_prop
have houtcome : Measurable (observedOutcome P) := by
unfold observedOutcome
exact (htreat.mul (harmCoord true)).add
((measurable_const.sub htreat).mul (harmCoord false))
let response : CausalObservation → ℝ := fun w =>
winsorize B (observedOutcome P w)
have hresponseMeas : Measurable response :=
(winsorize_measurable B).comp houtcome
have hwinsorize (y : ℝ) : |winsorize B y| ≤ B := by
unfold winsorize
split_ifs with hy hy0
· rw [abs_neg, abs_of_nonneg (le_min (abs_nonneg y) hB.le)]
exact min_le_right _ _
· simpa [hy0] using hB.le
· rw [abs_of_nonneg (le_min (abs_nonneg y) hB.le)]
exact min_le_right _ _
have hresponseBound (w : CausalObservation) : |response w| ≤ B := hwinsorize _
have hclip (y : ℝ) : |clip R y| ≤ R := by
unfold clip
rw [abs_le]
exact ⟨le_max_left _ _, max_le (by linarith) (min_le_left _ _)⟩
let posArm : Arm → CausalObservation → ℝ := fun a w =>
if a.1 then P.A1.indicator (fun _ => (1 : ℝ)) (causalScore w) else 0
let negArm : Arm → CausalObservation → ℝ := fun a w =>
if a.1 then 0 else (-1 : ℝ) ^ a.2.1 *
P.A0.indicator (fun _ => (1 : ℝ)) (causalScore w)
let zeroArm : Arm → CausalObservation → ℝ := fun a w =>
(if a.1 then (1 : ℝ) else -1) *
P.A0.indicator (fun _ => (1 : ℝ)) (causalScore w)
let outsideArm : Arm → CausalObservation → ℝ := fun a w =>
if a.1 then (P.A0 ∪ P.A1)ᶜ.indicator (fun _ => (1 : ℝ)) (causalScore w)
else 0
have hposMeas (a : Arm) : Measurable (posArm a) := by
dsimp [posArm]
split
· exact measurable_const.indicator (P.A1_measurable.preimage hscore)
· exact measurable_const
have hnegMeas (a : Arm) : Measurable (negArm a) := by
dsimp [negArm]
split
· exact measurable_const
· exact measurable_const.mul
(measurable_const.indicator (P.A0_measurable.preimage hscore))
have hzeroMeas (a : Arm) : Measurable (zeroArm a) := by
exact measurable_const.mul
(measurable_const.indicator (P.A0_measurable.preimage hscore))
have houtsideMeas (a : Arm) : Measurable (outsideArm a) := by
dsimp [outsideArm]
split
· exact measurable_const.indicator
((P.A0_measurable.union P.A1_measurable).compl.preimage hscore)
· exact measurable_const
have hposBound (a : Arm) (w : CausalObservation) : |posArm a w| ≤ 1 := by
rcases a with ⟨t, j⟩; cases t <;>
simp [posArm, indicator] <;> split_ifs <;> norm_num
have hnegBound (a : Arm) (w : CausalObservation) : |negArm a w| ≤ 1 := by
rcases a with ⟨t, j⟩; cases t <;>
simp [negArm, indicator] <;> split_ifs <;> simp [abs_pow]
have hzeroBound (a : Arm) (w : CausalObservation) : |zeroArm a w| ≤ 1 := by
rcases a with ⟨t, j⟩; cases t <;>
simp [zeroArm, indicator] <;> split_ifs <;> norm_num
have houtsideBound (a : Arm) (w : CausalObservation) :
|outsideArm a w| ≤ 1 := by
rcases a with ⟨t, j⟩; cases t <;>
simp [outsideArm, indicator] <;> split_ifs <;> norm_num
let ballIndicator : ClosedBallParam 2 → CausalObservation → ℝ :=
fun cr w => if euclideanClosedBallClassifier 2 cr (causalScore w) then 1 else 0
have hball : HasPolynomialL2CoverWith ballIndicator 1 Cball nball := by
have hpdim := HasPseudoDimAtMost.compDomain
(HasVCAtMost.indicatorClass_hasPseudoDimAtMost
(euclideanClosedBallClassifier 2) (2 + 2)
(euclideanClosedBall_hasVCAtMost 2)) causalScore
simpa [ballIndicator, Cball, nball] using hpdim.hasPolynomialL2CoverWith
(fun cr => by
simpa [euclideanClosedBallClassifier] using
Measurable.ite
(measurableSet_le (hscore.nndist measurable_const) measurable_const)
measurable_const measurable_const)
(by norm_num : (0 : ℝ) < 1)
(fun cr w => by cases euclideanClosedBallClassifier 2 cr (causalScore w) <;> simp)
let hboxPos (i : SeparableWinsorizedScoreIndex P p h) :
CoeffBox (Fin (p + 1)) R :=
⟨fun k => clip R (i.2.2.2.1 k), fun k => hclip _⟩
let hboxNeg (i : SeparableWinsorizedScoreIndex P p h) :
CoeffBox (Fin (p + 1)) R :=
⟨fun k => (-1 : ℝ) ^ k.1 * clip R (i.2.2.2.1 k), fun k => by
rw [abs_mul, abs_pow, abs_neg, abs_one, one_pow, one_mul]
exact hclip _⟩
have hpos0 := hradial causalScore posArm response
hscore hposMeas hposBound hresponseMeas hresponseBound hh
(by norm_num : (0 : ℝ) ≤ 0) (by norm_num : (0 : ℝ) ≤ 2) hR hB
have hneg0 := hradial causalScore negArm response
hscore hnegMeas hnegBound hresponseMeas hresponseBound hh
(by norm_num : (0 : ℝ) ≤ 0) (by norm_num : (0 : ℝ) ≤ 2) hR hB
have hzero0 := hradial causalScore zeroArm response
hscore hzeroMeas hzeroBound hresponseMeas hresponseBound hh
(by norm_num : (0 : ℝ) ≤ 0) (by norm_num : (0 : ℝ) ≤ 0) hR hB
have hout0 := hradial (fun _ => (0 : Score)) outsideArm response
measurable_const houtsideMeas houtsideBound hresponseMeas hresponseBound hh
(by norm_num : (0 : ℝ) ≤ 0) (by norm_num : (0 : ℝ) ≤ 0) hR hB
let ballParam (i : SeparableWinsorizedScoreIndex P p h) : ClosedBallParam 2 :=
⟨i.2.2.1.1, ⟨i.1.1, (lt_of_lt_of_le hh i.1.2.1).le⟩⟩
let epos (i : SeparableWinsorizedScoreIndex P p h) :=
(((((i.2.2.1.1, hboxPos i)), (i.2.1, i.2.2.2.2)), i.2.2.2.2), ballParam i)
let eneg (i : SeparableWinsorizedScoreIndex P p h) :=
(((((i.2.2.1.1, hboxNeg i)), (i.2.1, i.2.2.2.2)), i.2.2.2.2), ballParam i)
let ezero (i : SeparableWinsorizedScoreIndex P p h) :
RadialResidualScoreParam 2 p R Arm × Fin (p + 1) :=
((((i.2.2.1.1, hboxPos i)), (i.2.1, i.2.2.2.2)), i.2.2.2.2)
let eout (i : SeparableWinsorizedScoreIndex P p h) :
RadialResidualScoreParam 2 p R Arm × Fin (p + 1) :=
(((((0 : Score), hboxPos i)), (i.2.1, i.2.2.2.2)), i.2.2.2.2)
have hpos := HasPolynomialL2CoverWith.pullback (hpos0.mul hball) epos
have hneg := HasPolynomialL2CoverWith.pullback (hneg0.mul hball) eneg
have hzero := HasPolynomialL2CoverWith.pullback hzero0 ezero
have hout := HasPolynomialL2CoverWith.pullback hout0 eout
have hsum := ((hpos.add hneg).add hzero).add hout
have hV : 0 < B + ((p + 1 : ℕ) : ℝ) * R := by positivity
have hM : 1 ≤ M := by dsimp [M]; exact one_le_pow₀ (by norm_num)
have hc : 1 ≤ c := by dsimp [c]; nlinarith [sq_nonneg M]
have henvLe :
(radialResidualScoreEnvelope 2 p R B * 1 +
radialResidualScoreEnvelope 2 p R B * 1 +
radialResidualScoreEnvelope 0 p R B +
radialResidualScoreEnvelope 0 p R B) ≤
c * (B + ((p + 1 : ℕ) : ℝ) * R) := by
have htwo : radialMonomialEnvelope 2 p = M := by
simp [radialMonomialEnvelope, M, max_eq_right hM]
have hzero : radialMonomialEnvelope 0 p = 1 := by
simp [radialMonomialEnvelope]
simp only [radialResidualScoreEnvelope, radialPolynomialEnvelope]
simp_rw [htwo, hzero]
dsimp [c]
have hB0 := hB.le
have hpR : 0 ≤ ((p + 1 : ℕ) : ℝ) * R := by positivity
have hM0 : 0 ≤ (2 : ℝ) ^ p := by positivity
nlinarith [mul_nonneg hB0 hM0, mul_nonneg hpR hM0,
mul_nonneg (add_nonneg hB0 hpR) (sq_nonneg ((2 : ℝ) ^ p))]
have hrelaxed := hsum.enlargeEnvelope henvLe
have heq (i : SeparableWinsorizedScoreIndex P p h) (w : CausalObservation) :
separableWinsorizedScoreFunction P p h B R i w =
(radialResidualScore 2 p causalScore posArm response h 0 2 R
i.2.2.2.2 (epos i).1.1 w * ballIndicator (epos i).2 w +
radialResidualScore 2 p causalScore negArm response h 0 2 R
i.2.2.2.2 (eneg i).1.1 w * ballIndicator (eneg i).2 w) +
radialResidualScore 2 p causalScore zeroArm response h 0 0 R
i.2.2.2.2 (ezero i).1 w +
radialResidualScore 2 p (fun _ => (0 : Score)) outsideArm response
h 0 0 R i.2.2.2.2 (eout i).1 w := by
let z := causalScore w
let x := i.2.2.1.1
let q := i.1.1
let r := dist z x
have hq : 0 < q := lt_of_lt_of_le hh i.1.2.1
have hq2 : q < 2 * h := i.1.2.2
have hr0 : 0 ≤ r := dist_nonneg
have hballEq : ballIndicator (ballParam i) w = if r ≤ q then 1 else 0 := by
simp only [ballIndicator, ballParam, euclideanClosedBallClassifier,
Bool.decide_coe, decide_eq_true_eq]
change (if dist z x ≤ q then 1 else 0) = if r ≤ q then 1 else 0
rfl
have hkpos : uniformKernel (r / q) = if r ≤ q then 1 else 0 := by
rw [uniformKernel_div_eq_if_abs_le r q hq, abs_of_nonneg hr0]
have hkneg : uniformKernel (-r / q) = if r ≤ q then 1 else 0 := by
rw [uniformKernel_div_eq_if_abs_le (-r) q hq, abs_neg,
abs_of_nonneg hr0]
have hkneg' : uniformKernel (-(r / q)) = if r ≤ q then 1 else 0 := by
simpa [neg_div] using hkneg
have hkzero : uniformKernel 0 = 1 := by simp [uniformKernel]
have hzeroKernel : (0 : ℝ) / h ∈ Icc (-1 : ℝ) 1 := by simp
have hzeroRadial : (0 : ℝ) * h ≤ 0 ∧ 0 ≤ 0 * h := by simp
have hmulComm (u : ℝ) :
∑ k : Fin (p + 1), u ^ (k : ℕ) * clip R (i.2.2.2.1 k) =
∑ k : Fin (p + 1), clip R (i.2.2.2.1 k) * u ^ (k : ℕ) := by
apply Finset.sum_congr rfl; intro k _; ring
have hnegTerm (u : ℝ) (k : Fin (p + 1)) :
(-1 : ℝ) ^ (k : ℕ) * clip R (i.2.2.2.1 k) * u ^ (k : ℕ) =
(-u) ^ (k : ℕ) * clip R (i.2.2.2.1 k) := by rw [neg_pow]; ring
have hnegSum (u : ℝ) :
∑ k : Fin (p + 1), (-1 : ℝ) ^ (k : ℕ) *
clip R (i.2.2.2.1 k) * u ^ (k : ℕ) =
∑ k : Fin (p + 1), (-u) ^ (k : ℕ) * clip R (i.2.2.2.1 k) :=
Finset.sum_congr rfl fun k _ => hnegTerm u k
have hnegLead (u : ℝ) :
(-1 : ℝ) ^ (i.2.2.2.2 : ℕ) * u ^ (i.2.2.2.2 : ℕ) =
(-u) ^ (i.2.2.2.2 : ℕ) := (neg_pow u _).symm
by_cases hz1 : z ∈ P.A1
· have hz0 : z ∉ P.A0 := fun hz0 =>
P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
have hd : signedDistance (knownGeometry P) x z = r := by
simp [signedDistance, knownGeometry, indicator_of_mem hz1,
indicator_of_notMem hz0, r]
by_cases hr : r ≤ q
· have hr2 : r ≤ 2 * h := hr.trans hq2.le
cases hi : i.2.1 <;>
simp [separableWinsorizedScoreFunction, signedArm,
radialResidualScore, boundedRadialPolynomial, radialAnnulusMonomial,
polyBasis, response, posArm, negArm, zeroArm, outsideArm,
ballParam, epos, eneg,
ezero, eout, hboxPos, hboxNeg, z, x, q, r, hd, hz1, hz0, hr,
-- … truncated; follow the source link for the rest …
Causal.EmpiricalProcess.VCExpectedMaximal 4 declarations This is an in-run lemma assembled from the proved Causalean symmetrization, Dudley/VC entropy, and localized critical-radius layers.
Variance-adaptive expected maximal inequality
This is an in-run lemma assembled from the proved Causalean symmetrization, Dudley/VC entropy, and localized critical-radius layers. It replaces the retired external assumption: consumers call this theorem and carry no additional empirical-process binder.
theorem outerLIntegral_le_lintegral_of_ae_eq_measurable Lemma outerLIntegral_le_lintegral_of_ae_eq_measurable in the paper ↗
An a.e. equality with a measurable representative bounds the pointwise-majorant outer integral by the representative's lower integral.
Formal statement
hypotheses
conclusion
outerLIntegral μ f ≤ ∫⁻ x, g x ∂μ
Proof (Lean source)
lemma outerLIntegral_le_lintegral_of_ae_eq_measurable
{Ω : Type*} [MeasurableSpace Ω] (μ : Measure Ω)
{f g : Ω → ℝ≥0∞} (hg : Measurable g) (hfg : f =ᵐ[μ] g) :
outerLIntegral μ f ≤ ∫⁻ x, g x ∂μ := by
classical
let s : Set Ω := {x | f x ≠ g x}
have hs0 : μ s = 0 := by
rw [measure_eq_zero_iff_ae_notMem]
simpa [s, EventuallyEq] using hfg
obtain ⟨t, hst, htmeas, ht0⟩ := exists_measurable_superset_of_null hs0
let G : Ω → ℝ≥0∞ := fun x => if x ∈ t then ∞ else g x
have hGmeas : Measurable G := by
exact Measurable.ite htmeas measurable_const hg
have hfG : f ≤ G := by
intro x
by_cases hxt : x ∈ t
· simp [G, hxt]
· have hxs : x ∉ s := fun hxs => hxt (hst hxs)
have hxfg : f x = g x := by simpa [s] using hxs
simp [G, hxt, hxfg]
rw [outerLIntegral]
refine (iInf_le_of_le G (iInf_le_of_le hGmeas (iInf_le_of_le hfG ?_)))
apply le_of_eq
apply lintegral_congr_ae
filter_upwards [measure_eq_zero_iff_ae_notMem.mp ht0] with x hxt
simp [G, hxt]
def empiricalProcessSup
Pointwise supremum of the centered empirical process.
Definition (Lean source)
noncomputable def empiricalProcessSup {Ω ι : Type*} [MeasurableSpace Ω]
(μ : Measure Ω) (g : ι → Ω → ℝ) {n : ℕ} (w : Fin n → Ω) : ℝ≥0∞ :=
⨆ i : ι, ofReal |centeredEmpiricalAverage μ w (g i)|
theorem vcExpectedMaximalInequality_explicit Lemma vcExpectedMaximalInequality_explicit in the paper ↗
The continuum outer integral obeys the explicit variance-adaptive VC rate before the logarithm is normalized to a problem-specific ratio.
Formal statement
hypotheses
conclusion
∀ n : ℕ
if
1 ≤ n
then
Proof (Lean source)
-- @node: vcExpectedMaximalInequality_explicit
lemma vcExpectedMaximalInequality_explicit
{Ω ι : Type*} [MeasurableSpace Ω] (μ : Measure Ω)
[IsProbabilityMeasure μ]
(g : ι → Ω → ℝ) (U σ A v : ℝ)
(hsep : HasCountableEmpiricalSupReduction μ g)
(hent : HasVCUniformEntropy μ g U σ A v) :
∀ n : ℕ, 1 ≤ n →
outerLIntegral (Measure.pi (fun _ : Fin n => μ))
(empiricalProcessSup μ g) ≤
ofReal (varianceAdaptiveVCConstant *
vcExpectedMaximalRate U σ A v n) := by
rcases hsep with ⟨hmeas, g0, hreduce⟩
rcases hent with ⟨hσ, hσU, hA, hv, _hmeas', henv, hL2, hcover⟩
intro n hn
have hn0 : 0 < n := Nat.zero_lt_of_lt hn
let F : ℕ → Ω → ℝ := fun k => g (g0 k)
let μn : Measure (Fin n → Ω) := Measure.pi (fun _ : Fin n => μ)
have hFmeas : ∀ k, Measurable (F k) := fun k => hmeas (g0 k)
have hFenv : ∀ k x, |F k x| ≤ U := fun k x => henv (g0 k) x
have hmain := varianceAdaptiveExpectedMaximal_le μ F hσ hσU hA hv
hFmeas hFenv (fun k => hL2 (g0 k)) (hcover g0) n hn0
have hdevMeas : Measurable (fun w : Fin n → Ω => countableEmpiricalSup μ F w) := by
exact uniformDeviation_measurable id hFmeas
have hU : 0 < U := hσ.trans hσU
have hdevBound : ∀ w : Fin n → Ω, countableEmpiricalSup μ F w ≤ 2 * U := by
intro w
unfold countableEmpiricalSup uniformDeviation
apply ciSup_le
intro k
have hint : Integrable (F k) μ :=
Integrable.of_bound (hFmeas k).aestronglyMeasurable U
(ae_of_all _ fun x => by simpa [Real.norm_eq_abs] using hFenv k x)
have hmean : |∫ x, F k x ∂μ| ≤ U := by
calc
|∫ x, F k x ∂μ| ≤ ∫ x, |F k x| ∂μ := abs_integral_le_integral_abs
_ ≤ ∫ _x, U ∂μ := integral_mono hint.abs (integrable_const U) (hFenv k)
_ = U := by simp
have havg : |(n : ℝ)⁻¹ * ∑ i, F k (w i)| ≤ U := by
calc
_ = (n : ℝ)⁻¹ * |∑ i, F k (w i)| := by
rw [abs_mul, abs_of_pos (inv_pos.mpr (Nat.cast_pos.mpr hn0))]
_ ≤ (n : ℝ)⁻¹ * ∑ i, |F k (w i)| := by
gcongr
exact Finset.abs_sum_le_sum_abs _ _
_ ≤ (n : ℝ)⁻¹ * ∑ _i : Fin n, U := by
gcongr with i
exact hFenv k (w i)
_ = U := by
simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul]
field_simp
change |(n : ℝ)⁻¹ * ∑ i, F k (w i) - ∫ x, F k x ∂μ| ≤ 2 * U
exact (abs_sub _ _).trans (by linarith)
have hdevNonneg : ∀ w : Fin n → Ω, 0 ≤ countableEmpiricalSup μ F w := by
intro w
exact Real.iSup_nonneg fun k => abs_nonneg _
have hdevInt : Integrable (fun w : Fin n → Ω => countableEmpiricalSup μ F w) μn :=
Integrable.of_bound hdevMeas.aestronglyMeasurable (2 * U)
(ae_of_all _ fun w => by
rw [Real.norm_eq_abs, abs_of_nonneg (hdevNonneg w)]
exact hdevBound w)
have hcountEq (w : Fin n → Ω) :
ofReal (countableEmpiricalSup μ F w) =
⨆ k : ℕ, ofReal |centeredEmpiricalAverage μ w (g (g0 k))| := by
unfold countableEmpiricalSup uniformDeviation
change ofReal
(⨆ k : ℕ, |centeredEmpiricalAverage μ w (F k)|) =
⨆ k : ℕ, ofReal |centeredEmpiricalAverage μ w (F k)|
refine (Monotone.map_ciSup_of_continuousAt
(g := fun k : ℕ => |centeredEmpiricalAverage μ w (F k)|)
ENNReal.continuous_ofReal.continuousAt ENNReal.ofReal_mono (bdd := ?_))
refine ⟨2 * U, ?_⟩
rintro _ ⟨k, rfl⟩
have hint : Integrable (F k) μ :=
Integrable.of_bound (hFmeas k).aestronglyMeasurable U
(ae_of_all _ fun x => by simpa [Real.norm_eq_abs] using hFenv k x)
have hmean : |∫ x, F k x ∂μ| ≤ U := by
calc
|∫ x, F k x ∂μ| ≤ ∫ x, |F k x| ∂μ := abs_integral_le_integral_abs
_ ≤ ∫ _x, U ∂μ := integral_mono hint.abs (integrable_const U) (hFenv k)
_ = U := by simp
have havg : |(n : ℝ)⁻¹ * ∑ i, F k (w i)| ≤ U := by
calc
_ = (n : ℝ)⁻¹ * |∑ i, F k (w i)| := by
rw [abs_mul, abs_of_pos (inv_pos.mpr (Nat.cast_pos.mpr hn0))]
_ ≤ (n : ℝ)⁻¹ * ∑ i, |F k (w i)| := by
gcongr
exact Finset.abs_sum_le_sum_abs _ _
_ ≤ (n : ℝ)⁻¹ * ∑ _i : Fin n, U := by
gcongr with i
exact hFenv k (w i)
_ = U := by
simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul]
field_simp
change |(n : ℝ)⁻¹ * ∑ i, F k (w i) - ∫ x, F k x ∂μ| ≤ 2 * U
exact (abs_sub _ _).trans (by linarith)
have hsupMeas : Measurable
(fun w : Fin n → Ω => ofReal (countableEmpiricalSup μ F w)) :=
ENNReal.measurable_ofReal.comp hdevMeas
calc
outerLIntegral μn (empiricalProcessSup μ g) ≤
∫⁻ w, ofReal (countableEmpiricalSup μ F w) ∂μn :=
outerLIntegral_le_lintegral_of_ae_eq_measurable μn hsupMeas (by
filter_upwards [hreduce n] with w hw
rw [empiricalProcessSup, hw]
exact (hcountEq w).symm)
_ = ofReal (∫ w, countableEmpiricalSup μ F w ∂μn) := by
rw [ofReal_integral_eq_lintegral_ofReal hdevInt (ae_of_all _ hdevNonneg)]
_ ≤ ofReal (varianceAdaptiveVCConstant *
vcExpectedMaximalRate U σ A v n) := ENNReal.ofReal_le_ofReal hmain
theorem vcExpectedMaximalInequality
A countably reducible VC-type class obeys the variance-adaptive two-term expected maximal inequality.
Formal statement
hypotheses
conclusion
∃ C : ℝ
if
0 < C ∧ ∀ n : ℕ, 1 ≤ n
then
Proof (Lean source)
lemma vcExpectedMaximalInequality
{Ω ι : Type*} [MeasurableSpace Ω] (μ : Measure Ω)
[IsProbabilityMeasure μ]
(g : ι → Ω → ℝ) (U σ A v : ℝ)
(hsep : HasCountableEmpiricalSupReduction μ g)
(hent : HasVCUniformEntropy μ g U σ A v) :
∃ C : ℝ, 0 < C ∧ ∀ n : ℕ, 1 ≤ n →
outerLIntegral (Measure.pi (fun _ : Fin n => μ))
(empiricalProcessSup μ g) ≤
ofReal (C *
(σ * sqrt (log (U / σ) / n) +
U * log (U / σ) / n)) := by
rcases hsep with ⟨hmeas, g0, hreduce⟩
rcases vcEntropy_chaining_bound μ g g0 U σ A v hent with
⟨C, hC, hbound⟩
refine ⟨C, hC, ?_⟩
intro n hn
have hg_meas : ∀ k, Measurable (g (g0 k)) := fun k => hmeas (g0 k)
have havg_meas : ∀ k,
Measurable (fun w : Fin n → Ω =>
centeredEmpiricalAverage μ w (g (g0 k))) := by
intro k
unfold centeredEmpiricalAverage
fun_prop
have hsup_meas : Measurable
(countableEmpiricalProcessSup μ g g0 : (Fin n → Ω) → ℝ≥0∞) := by
unfold countableEmpiricalProcessSup
fun_prop
exact (outerLIntegral_le_lintegral_of_ae_eq_measurable
(Measure.pi (fun _ : Fin n => μ)) hsup_meas (hreduce n)).trans (hbound n hn)
Causal.Estimator 26 declarations This module defines the empirical Gram and score, the guarded inverse, the clipped contrast, the population coefficient used by the cited bias theorem, and the pointwise selected-kernel winsorization bias lemma.
Winsorized stabilized signed-distance local polynomial estimator
This module defines the empirical Gram and score, the guarded inverse, the clipped contrast, the population coefficient used by the cited bias theorem, and the pointwise selected-kernel winsorization bias lemma.
def estimatorMatrixMeasurableSpace
Equip estimator matrices with the product measurable structure.
Definition (Lean source)
local instance estimatorMatrixMeasurableSpace (q : ℕ) :
MeasurableSpace (Matrix (Fin q) (Fin q) ℝ) :=
pi
theorem estimatorMatrixBorelSpace
The estimator-matrix measurable structure is its Borel structure.
Formal statement
Proof (Lean source)
local instance estimatorMatrixBorelSpace (q : ℕ) :
BorelSpace (Matrix (Fin q) (Fin q) ℝ) :=
⟨by
change pi = borel (Fin q → Fin q → ℝ)
exact BorelSpace.measurable_eq⟩
Arm membership for a signed distance.
def empiricalGram
Empirical local-polynomial Gram matrix from compressed observations.
Definition (Lean source)
noncomputable def empiricalGram (n p : ℕ) (t : Bool) (h : ℝ)
(u : SignedDistanceSample n) : Matrix (Fin (p + 1)) (Fin (p + 1)) ℝ := by
classical
exact fun j k => (n : ℝ)⁻¹ * h⁻¹ ^ 2 * ∑ i,
(if signedArm t (u i).2 then 1 else 0) *
uniformKernel ((u i).2 / h) * polyBasis p ((u i).2 / h) j *
polyBasis p ((u i).2 / h) k
def empiricalScore
Winsorized empirical local-polynomial score.
Definition (Lean source)
noncomputable def empiricalScore (n p : ℕ) (t : Bool) (h B : ℝ)
(u : SignedDistanceSample n) : Fin (p + 1) → ℝ := by
classical
exact fun j => (n : ℝ)⁻¹ * h⁻¹ ^ 2 * ∑ i,
(if signedArm t (u i).2 then 1 else 0) * uniformKernel ((u i).2 / h) *
polyBasis p ((u i).2 / h) j * winsorize B (u i).1
Quadratic-form empirical Gram guard at (2L)⁻¹.
Definition (Lean source)
def empiricalGramGuard {p : ℕ} (L : ℝ)
(A : Matrix (Fin (p + 1)) (Fin (p + 1)) ℝ) : Prop :=
∀ v : Fin (p + 1) → ℝ,
(2 * L)⁻¹ * ∑ i, (v i) ^ 2 ≤ matrixQuadratic A v
def guardedCoefficient
The guarded coefficient: inverse score on the stable branch and zero otherwise.
Definition (Lean source)
noncomputable def guardedCoefficient (n p : ℕ) (L : ℝ) (t : Bool)
(h B : ℝ) (u : SignedDistanceSample n) : Fin (p + 1) → ℝ := by
classical
exact if empiricalGramGuard L (empiricalGram n p t h u) then
mulVec (empiricalGram n p t h u)⁻¹ (empiricalScore n p t h B u)
else 0
def clip
Projection onto [-C,C].
def winsorLevel
The theorem's winsorization level B_n = a_n^(-1/3).
Definition (Lean source)
def populationScore
Population score in the original, unwinsorized normal equations.
Definition (Lean source)
noncomputable def populationScore (P : A1A2Law) (p : ℕ) (t : Bool)
(x : Score) (h : ℝ) : Fin (p + 1) → ℝ := by
classical
exact fun j => ∫ w,
h⁻¹ ^ 2 *
(if signedArm t (signedDistance (knownGeometry P) x (causalScore w))
then 1 else 0) *
uniformKernel (signedDistance (knownGeometry P) x (causalScore w) / h) *
polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) j *
observedOutcome P w ∂P.law
def populationCoefficient
The original population local-polynomial coefficient.
Definition (Lean source)
noncomputable def populationCoefficient (P : A1A2Law) (p : ℕ) (t : Bool)
(x : Score) (h : ℝ) : Fin (p + 1) → ℝ :=
mulVec (populationGram P p t x h)⁻¹ (populationScore P p t x h)
The winsorized, clipped, Gram-stabilized signed-distance local-polynomial rule at bandwidth h, using B(h)=h^(-1/3).
Definition (Lean source)
noncomputable def stabilizedLocalPolynomial (n p : ℕ) (L h : ℝ) :
A1A2RuleFun n :=
fun w G x =>
let u := geometrySignedDistanceData n G w x
let B := rpow h (-(1 : ℝ) / 3)
clip (2 * L)
(guardedCoefficient n p L true h B u 0 -
guardedCoefficient n p L false h B u 0)
theorem uniformKernel_measurable
The fixed uniform kernel is Borel measurable.
Formal statement
conclusion
Proof (Lean source)
-- @node: uniformKernel_measurable
lemma uniformKernel_measurable : Measurable uniformKernel := by
unfold uniformKernel
exact measurable_const.indicator measurableSet_Icc
Each coordinate of the finite monomial basis is Borel measurable.
Formal statement
Proof (Lean source)
-- @node: polyBasis_apply_measurable
lemma polyBasis_apply_measurable (p : ℕ) (j : Fin (p + 1)) :
Measurable (fun d : ℝ => polyBasis p d j) := by
unfold polyBasis
fun_prop
Winsorization at a fixed level is Borel measurable.
Formal statement
Proof (Lean source)
-- @node: winsorize_measurable
lemma winsorize_measurable (B : ℝ) : Measurable (winsorize B) := by
unfold winsorize
apply Measurable.ite measurableSet_Iio
· fun_prop
· apply Measurable.ite (by
simpa using measurableSet_singleton (0 : ℝ))
· fun_prop
· fun_prop
A finite real matrix-valued map is measurable exactly when all of its entries are measurable.
Formal statement
hypotheses
conclusion
Measurable f ↔ ∀ i j, Measurable (fun x => f x i j)
Proof (Lean source)
-- @node: estimatorMeasurable_matrix_iff
lemma estimatorMeasurable_matrix_iff
{α : Type*} [MeasurableSpace α] {q : ℕ}
(f : α → Matrix (Fin q) (Fin q) ℝ) :
Measurable f ↔ ∀ i j, Measurable (fun x => f x i j) := by
constructor
· intro hf i j
exact measurable_pi_iff.mp (measurable_pi_iff.mp hf i) j
· intro h
exact measurable_pi_iff.mpr fun i => measurable_pi_iff.mpr fun j => h i j
Mathlib's total inverse on finite real matrices is Borel measurable.
Formal statement
Proof (Lean source)
-- @node: estimatorMatrix_inv_measurable
lemma estimatorMatrix_inv_measurable (q : ℕ) :
Measurable (fun G : Matrix (Fin q) (Fin q) ℝ => G⁻¹) := by
rw [estimatorMeasurable_matrix_iff]
intro i j
simp only [Matrix.inv_def, Matrix.smul_apply, Ring.inverse_eq_inv]
fun_prop
theorem estimatorInv_mulVec_apply_measurable Lemma estimatorInv_mulVec_apply_measurable in the paper ↗
Every coordinate of an inverse-matrix--vector product is measurable when the matrix and vector inputs are measurable.
Formal statement
hypotheses
conclusion
Measurable (fun x => (G x)⁻¹.mulVec (v x) i)
Proof (Lean source)
-- @node: estimatorInv_mulVec_apply_measurable
lemma estimatorInv_mulVec_apply_measurable
{α : Type*} [MeasurableSpace α] {q : ℕ}
(G : α → Matrix (Fin q) (Fin q) ℝ) (v : α → Fin q → ℝ)
(hG : Measurable G) (hv : Measurable v) (i : Fin q) :
Measurable (fun x => (G x)⁻¹.mulVec (v x) i) := by
simp only [mulVec, dotProduct]
apply measurable_sum
intro j _
exact ((estimatorMeasurable_matrix_iff _).mp
((estimatorMatrix_inv_measurable q).comp hG) i j).mul
(measurable_pi_iff.mp hv j)
The empirical local-polynomial Gram matrix is measurable in the compressed sample.
Formal statement
Proof (Lean source)
-- @node: empiricalGram_measurable
lemma empiricalGram_measurable (n p : ℕ) (t : Bool) (h : ℝ) :
Measurable (empiricalGram n p t h) := by
classical
rw [estimatorMeasurable_matrix_iff]
intro j k
unfold empiricalGram
apply Measurable.const_mul
apply Finset.measurable_sum
intro i _
have hpair : Measurable (fun u : SignedDistanceSample n => u i) :=
measurable_pi_apply i
have hd : Measurable (fun u : SignedDistanceSample n => (u i).2) :=
measurable_snd.comp hpair
have harm : Measurable (fun u : SignedDistanceSample n =>
if signedArm t (u i).2 then (1 : ℝ) else 0) := by
cases t
· simp only [signedArm, Bool.false_eq_true, if_false]
exact Measurable.ite (measurableSet_lt hd measurable_const)
measurable_const measurable_const
· simp only [signedArm, if_true]
exact Measurable.ite (measurableSet_le measurable_const hd)
measurable_const measurable_const
exact ((harm.mul
(uniformKernel_measurable.comp (hd.div_const h))).mul
((polyBasis_apply_measurable p j).comp (hd.div_const h))).mul
((polyBasis_apply_measurable p k).comp (hd.div_const h))
The winsorized empirical score is measurable in the compressed sample.
Formal statement
Proof (Lean source)
-- @node: empiricalScore_measurable
lemma empiricalScore_measurable (n p : ℕ) (t : Bool) (h B : ℝ) :
Measurable (empiricalScore n p t h B) := by
classical
rw [measurable_pi_iff]
intro j
unfold empiricalScore
apply Measurable.const_mul
apply Finset.measurable_sum
intro i _
have hpair : Measurable (fun u : SignedDistanceSample n => u i) :=
measurable_pi_apply i
have hy : Measurable (fun u : SignedDistanceSample n => (u i).1) :=
measurable_fst.comp hpair
have hd : Measurable (fun u : SignedDistanceSample n => (u i).2) :=
measurable_snd.comp hpair
have harm : Measurable (fun u : SignedDistanceSample n =>
if signedArm t (u i).2 then (1 : ℝ) else 0) := by
cases t
· simp only [signedArm, Bool.false_eq_true, if_false]
exact Measurable.ite (measurableSet_lt hd measurable_const)
measurable_const measurable_const
· simp only [signedArm, if_true]
exact Measurable.ite (measurableSet_le measurable_const hd)
measurable_const measurable_const
exact ((harm.mul
(uniformKernel_measurable.comp (hd.div_const h))).mul
((polyBasis_apply_measurable p j).comp (hd.div_const h))).mul
((winsorize_measurable B).comp hy)
theorem empiricalGramGuard_measurableSet
The quadratic-form Gram guard is a Borel set of finite matrices.
Formal statement
hypotheses
p :
ℕ
L :
ℝ
conclusion
Proof (Lean source)
-- @node: empiricalGramGuard_measurableSet
lemma empiricalGramGuard_measurableSet {p : ℕ} (L : ℝ) :
MeasurableSet {A : Matrix (Fin (p + 1)) (Fin (p + 1)) ℝ |
empiricalGramGuard L A} := by
apply IsClosed.measurableSet
unfold empiricalGramGuard matrixQuadratic
simp only [Set.setOf_forall]
apply isClosed_iInter
intro v
apply isClosed_le <;> fun_prop
The guarded inverse coefficient vector is measurable in the compressed sample.
Formal statement
Proof (Lean source)
-- @node: guardedCoefficient_measurable
lemma guardedCoefficient_measurable (n p : ℕ) (L h B : ℝ) (t : Bool) :
Measurable (guardedCoefficient n p L t h B) := by
unfold guardedCoefficient
apply Measurable.ite
· exact (empiricalGramGuard_measurableSet L).preimage
(empiricalGram_measurable n p t h)
· rw [measurable_pi_iff]
intro i
apply estimatorInv_mulVec_apply_measurable
· exact empiricalGram_measurable n p t h
· exact empiricalScore_measurable n p t h B
· fun_prop
theorem stabilizedLocalPolynomial_mem
The explicit estimator is a member of the sectionwise-Borel decision class at every positive bandwidth.
Formal statement
hypotheses
n p :
ℕ
ν L h :
ℝ
_hh :
0 < h
conclusion
stabilizedLocalPolynomial n p L h ∈ A1A2PointIndexedDecisionClass n p ν L
Proof (Lean source)
-- @node: stabilizedLocalPolynomial_mem
lemma stabilizedLocalPolynomial_mem (n p : ℕ) (ν L h : ℝ) (_hh : 0 < h) :
stabilizedLocalPolynomial n p L h ∈
A1A2PointIndexedDecisionClass n p ν L := by
let B := rpow h (-(1 : ℝ) / 3)
let T : A1A2PIRule n := {
map := fun _G _x u => clip (2 * L)
(guardedCoefficient n p L true h B u 0 -
guardedCoefficient n p L false h B u 0)
section_measurable := by
intro G x
unfold clip
exact measurable_const.max (measurable_const.min
((measurable_pi_iff.mp
(guardedCoefficient_measurable n p L h B true) 0).sub
(measurable_pi_iff.mp
(guardedCoefficient_measurable n p L h B false) 0))) }
refine ⟨T, ?_⟩
intro P hP w x hx
have hu : geometrySignedDistanceData n (knownGeometry P) w x =
signedDistanceData n P w x := by
funext i
apply Prod.ext
· simp only [geometrySignedDistanceData, signedDistanceData,
observedOutcome, treatment, knownGeometry]
by_cases hi : causalScore (w i) ∈ P.A1 <;>
simp [indicator, hi]
· rfl
simp only [stabilizedLocalPolynomial, T, B]
rw [hu]
Winsorization cannot remove more than the magnitude of its input.
Formal statement
Proof (Lean source)
lemma abs_sub_winsorize_le_abs {B y : ℝ} (hB : 0 ≤ B) :
|y - winsorize B y| ≤ |y| := by
by_cases hy : y < 0
· rw [winsorize, if_pos hy]
rcases le_total |y| B with hay | hBa
· rw [min_eq_left hay]
have hw : -|y| = y := by rw [abs_of_neg hy]; ring
rw [hw, sub_self, abs_zero]
exact abs_nonneg y
· rw [min_eq_right hBa]
rw [abs_of_nonpos (by rw [abs_of_neg hy] at hBa; linarith)]
rw [abs_of_neg hy]
linarith
· rw [winsorize, if_neg hy]
by_cases hy0 : y = 0
· simp [hy0]
· rw [if_neg hy0]
have hypos : 0 < y := lt_of_le_of_ne (le_of_not_gt hy) (Ne.symm hy0)
rcases le_total |y| B with hay | hBa
· rw [min_eq_left hay]
rw [abs_of_pos hypos, sub_self, abs_zero]
exact hypos.le
· rw [min_eq_right hBa]
rw [abs_of_nonneg (by rw [abs_of_pos hypos] at hBa; linarith)]
rw [abs_of_pos hypos]
linarith
Above a threshold at least one, the winsorization remainder is dominated by the (2+ν) moment times B⁻³ whenever ν ≥ 2.
Formal statement
hypotheses
ν B y :
ℝ
hν :
2 ≤ ν
hB :
1 ≤ B
conclusion
|y - winsorize B y| ≤ |y| ^ (2 + ν) * B ^ (-3 : ℤ)
Proof (Lean source)
lemma winsorize_tail_le_moment {ν B y : ℝ} (hν : 2 ≤ ν) (hB : 1 ≤ B) :
|y - winsorize B y| ≤ |y| ^ (2 + ν) * B ^ (-3 : ℤ) := by
by_cases hay : |y| ≤ B
· have hw : winsorize B y = y := by
by_cases hy : y < 0
· rw [winsorize, if_pos hy, min_eq_left hay, abs_of_neg hy]
ring
· by_cases hy0 : y = 0
· simp [winsorize, hy0]
· have hypos : 0 < y := lt_of_le_of_ne (le_of_not_gt hy) (Ne.symm hy0)
rw [winsorize, if_neg hy, if_neg hy0, min_eq_left hay, abs_of_pos hypos]
rw [hw, sub_self, abs_zero]
positivity
· have hBa : B < |y| := lt_of_not_ge hay
have ha1 : 1 ≤ |y| := hB.trans hBa.le
have hpow : |y| ^ (4 : ℕ) ≤ |y| ^ (2 + ν) := by
rw [← Real.rpow_natCast]
exact Real.rpow_le_rpow_of_exponent_le ha1 (by norm_num; linarith)
have hBpos : 0 < B := lt_of_lt_of_le zero_lt_one hB
have hB3pos : 0 < B ^ (3 : ℕ) := pow_pos hBpos _
have hratio : |y| ≤ |y| ^ (4 : ℕ) * B ^ (-3 : ℤ) := by
change |y| ≤ |y| ^ (4 : ℕ) * (B ^ (3 : ℕ))⁻¹
apply (le_mul_inv_iff₀ hB3pos).2
calc
|y| * B ^ (3 : ℕ) ≤ |y| * |y| ^ (3 : ℕ) :=
mul_le_mul_of_nonneg_left
(pow_le_pow_left₀ (le_trans zero_le_one hB) hBa.le 3) (abs_nonneg y)
_ = |y| ^ (4 : ℕ) := by ring
exact (abs_sub_winsorize_le_abs (le_trans zero_le_one hB)).trans
(hratio.trans (mul_le_mul_of_nonneg_right hpow (by positivity)))
theorem cty_winsorization_bias
A pointwise selected-kernel (2+ν) moment envelope gives the deterministic B⁻³ winsorization bias bound.
Formal statement
Proof (Lean source)
lemma cty_winsorization_bias (p : ℕ) (ν L B : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) (hB : 1 ≤ B) (t : Bool)
(x : Score) (hx : x ∈ P.support) :
|(∫ y, y ∂selectedA1A2CondKer P ν L t x) -
(∫ y, winsorize B y ∂selectedA1A2CondKer P ν L t x)| ≤
L * B ^ (-3 : ℤ) := by
rcases hP with ⟨hν, hL, hSupport, hDensCont, hDens, hMu, hVar,
hMean, hVariance, hMoment, hGeom, hVC, hGram, hMass, hSlice⟩
have hK : Nonempty (A1A2KernelWitness P ν L) := hMean.1
letI : IsProbabilityMeasure (selectedA1A2CondKer P ν L t x) :=
(selectedA1A2CondKer_markov hK t).isProbabilityMeasure x
have hmoment := hMoment t x hx
have hpow_int : Integrable (fun y : ℝ => |y| ^ (2 + ν))
(selectedA1A2CondKer P ν L t x) := by
refine ⟨((Real.continuous_rpow_const (by linarith)).comp
continuous_abs).measurable.aestronglyMeasurable, ?_⟩
rw [hasFiniteIntegral_iff_norm]
have hlt : selectedA1A2CondAbsMoment P ν L t x < ∞ :=
lt_of_le_of_lt hmoment ENNReal.ofReal_lt_top
simpa [selectedA1A2CondAbsMoment, Real.norm_eq_abs,
abs_of_nonneg (Real.rpow_nonneg (abs_nonneg _) _)] using hlt
have hy_abs : Integrable (fun y : ℝ => |y|)
(selectedA1A2CondKer P ν L t x) := by
have hint := integrable_norm_rpow_of_le
(μ := selectedA1A2CondKer P ν L t x)
(f := fun y : ℝ => y) measurable_id.aestronglyMeasurable
(p := 1) (q := 2 + ν) (by norm_num) (by linarith) (by linarith) hpow_int
simpa [Real.norm_eq_abs, Real.rpow_one] using hint
have hy : Integrable (fun y : ℝ => y) (selectedA1A2CondKer P ν L t x) :=
hy_abs.mono measurable_id.aestronglyMeasurable (by simp [Real.norm_eq_abs])
have hwin : Integrable (fun y : ℝ => winsorize B y)
(selectedA1A2CondKer P ν L t x) := by
have hwin_meas : Measurable (fun y : ℝ => winsorize B y) := by
unfold winsorize
apply Measurable.ite measurableSet_Iio
· fun_prop
· have hz : MeasurableSet {y : ℝ | y = 0} := by
simpa only [Set.setOf_eq_eq_singleton] using measurableSet_singleton (0 : ℝ)
apply Measurable.ite hz
· fun_prop
· fun_prop
refine (integrable_const B).mono hwin_meas.aestronglyMeasurable ?_
filter_upwards [] with y
dsimp [winsorize]
split_ifs
· rw [abs_neg, abs_of_nonneg (le_min (abs_nonneg y)
(le_trans zero_le_one hB)), abs_of_nonneg (le_trans zero_le_one hB)]
exact min_le_right _ _
· simpa using abs_nonneg B
· rw [abs_of_nonneg (le_min (abs_nonneg y)
(le_trans zero_le_one hB)), abs_of_nonneg (le_trans zero_le_one hB)]
exact min_le_right _ _
rw [← integral_sub hy hwin]
calc
|∫ y, y - winsorize B y ∂selectedA1A2CondKer P ν L t x| ≤
∫ y, |y| ^ (2 + ν) * B ^ (-3 : ℤ)
∂selectedA1A2CondKer P ν L t x := by
change ‖∫ y, y - winsorize B y ∂selectedA1A2CondKer P ν L t x‖ ≤ _
apply norm_integral_le_of_norm_le (hpow_int.mul_const _)
filter_upwards [] with y
simpa [Real.norm_eq_abs] using winsorize_tail_le_moment hν hB (y := y)
_ = B ^ (-3 : ℤ) * ∫ y, |y| ^ (2 + ν)
∂selectedA1A2CondKer P ν L t x := by
rw [← integral_const_mul]
congr 1
funext y
ring
_ ≤ L * B ^ (-3 : ℤ) := by
have hLint : ∫ y, |y| ^ (2 + ν)
∂selectedA1A2CondKer P ν L t x ≤ L := by
rw [← ENNReal.ofReal_le_ofReal_iff (le_trans (by norm_num) hL)]
rw [ofReal_integral_eq_lintegral_ofReal hpow_int
(Filter.Eventually.of_forall fun y => Real.rpow_nonneg (abs_nonneg y) _)]
simpa [selectedA1A2CondAbsMoment] using hmoment
nlinarith [show 0 ≤ B ^ (-3 : ℤ) by positivity]
Causal.EuclideanBallsVC 3 declarations The statement is phrased directly as non-shattering of finite point sets of cardinality at least four, which is the paper's “VC index at most four”.
VC index of planar Euclidean balls
The statement is phrased directly as non-shattering of finite point sets of cardinality at least four, which is the paper's “VC index at most four”.
A finite planar set is shattered by closed Euclidean balls.
Closed planar Euclidean balls have VC index at most four.
Definition (Lean source)
The collection of all closed Euclidean balls in ℝ² has VC index at most four. Consequently the fixed Euclidean metric and uniform kernel meet CTY's actual VC alternative.
Formal statement
conclusion
Proof (Lean source)
lemma euclidean_balls_vc : EuclideanBallsVCProperty := by
classical
intro S hcard hshatter
obtain ⟨U, hUS, hUcard⟩ := Finset.exists_subset_card_eq hcard
let e : Fin 4 ≃ U := (U.equivFinOfCardEq hUcard).symm
let z : Fin 4 → Score := fun i ↦ (e i : Score)
have hzS (i : Fin 4) : z i ∈ S := hUS (e i).property
let Φ : Score → (Fin 4 → ℝ) := fun x ↦ ![1, x 0, x 1, ‖x‖ ^ 2]
have hweighted (l : Fin 4 → ℝ) (w : Fin 4 → ℝ)
(hsum : ∑ i, l i • Φ (z i) = w) (c : Score) (r : ℝ) :
∑ i, l i * (dist (z i) c ^ 2 - r ^ 2) =
w 3 - 2 * c 0 * w 1 - 2 * c 1 * w 2 + (‖c‖ ^ 2 - r ^ 2) * w 0 := by
have hc (j : Fin 4) : ∑ i, l i * Φ (z i) j = w j := by
simpa only [Finset.sum_apply, Pi.smul_apply, smul_eq_mul] using congrFun hsum j
have hc0 := hc 0
have hc1 := hc 1
have hc2 := hc 2
have hc3 := hc 3
simp [Φ] at hc0 hc1 hc2 hc3
simp only [EuclideanSpace.norm_sq_eq, Fin.sum_univ_two,
Real.norm_eq_abs, sq_abs] at hc3
simp only [EuclideanSpace.dist_sq_eq, EuclideanSpace.norm_sq_eq,
Fin.sum_univ_two, Real.norm_eq_abs, Real.dist_eq, sq_abs]
simp only [Fin.sum_univ_four] at hc0 hc1 hc2 hc3 ⊢
ring_nf at hc0 hc1 hc2 hc3 ⊢
linear_combination hc3 - 2 * c 0 * hc1 - 2 * c 1 * hc2 +
(c 0 ^ 2 + c 1 ^ 2 - r ^ 2) * hc0
have hsign_contra (l : Fin 4 → ℝ) (w : Fin 4 → ℝ)
(hsum : ∑ i, l i • Φ (z i) = w) (hw0 : w 0 = 0)
(hwEval : ∀ c : Score, ∀ r : ℝ, 0 ≤ r →
¬ (∑ i, l i * (dist (z i) c ^ 2 - r ^ 2) < 0))
(hnz : ∃ i, l i ≠ 0) : False := by
have hlsum : ∑ i, l i = 0 := by
have h := congrFun hsum 0
simpa only [Finset.sum_apply, Pi.smul_apply, smul_eq_mul, Φ,
Matrix.cons_val_zero, mul_one] using h.trans hw0
obtain ⟨ineg, hineg⟩ : ∃ i, l i < 0 := by
by_contra hn
push_neg at hn
obtain ⟨i, hi⟩ := hnz
have hi' : 0 < l i := lt_of_le_of_ne (hn i) (Ne.symm hi)
have hpos : 0 < ∑ i, l i := Finset.sum_pos' (fun j _ ↦ hn j)
⟨i, Finset.mem_univ i, hi'⟩
linarith
let T : Finset Score := S.filter fun x ↦ ∃ i, z i = x ∧ 0 < l i
have hTS : T ⊆ S := filter_subset _ _
obtain ⟨c, r, hr, hball⟩ := hshatter T hTS
have hterm (i : Fin 4) : l i * (dist (z i) c ^ 2 - r ^ 2) ≤ 0 := by
by_cases hi : 0 < l i
· have hmem : z i ∈ T := Finset.mem_filter.mpr ⟨hzS i, ⟨i, rfl, hi⟩⟩
have hd := (hball (z i) (hzS i)).mp hmem
have hdist : 0 ≤ dist (z i) c := dist_nonneg
have hsq : dist (z i) c ^ 2 ≤ r ^ 2 := by nlinarith
exact mul_nonpos_of_nonneg_of_nonpos hi.le (sub_nonpos.mpr hsq)
· have hmem : z i ∉ T := by
simp only [T, mem_filter, hzS i, true_and, not_exists, not_and]
intro j hj
have : j = i := by
apply e.injective
exact Subtype.ext hj
simpa [this] using hi
have hd : r < dist (z i) c := lt_of_not_ge ((hball (z i) (hzS i)).not.mp hmem)
have hdist : 0 ≤ dist (z i) c := dist_nonneg
have hsq : 0 < dist (z i) c ^ 2 - r ^ 2 := by nlinarith
exact mul_nonpos_of_nonpos_of_nonneg (le_of_not_gt hi) hsq.le
have hstrict : l ineg * (dist (z ineg) c ^ 2 - r ^ 2) < 0 := by
have hmem : z ineg ∉ T := by
simp only [T, mem_filter, hzS ineg, true_and, not_exists, not_and]
intro j hj
have : j = ineg := by
apply e.injective
exact Subtype.ext hj
simpa [this] using hineg.not_gt
have hd : r < dist (z ineg) c := lt_of_not_ge ((hball (z ineg) (hzS ineg)).not.mp hmem)
have hdist : 0 ≤ dist (z ineg) c := dist_nonneg
have hsq : 0 < dist (z ineg) c ^ 2 - r ^ 2 := by nlinarith
exact mul_neg_of_neg_of_pos hineg hsq
have htotal : ∑ i, l i * (dist (z i) c ^ 2 - r ^ 2) < 0 := by
have hlt := Finset.sum_lt_sum (s := univ)
(fun i _ ↦ hterm i) ⟨ineg, Finset.mem_univ ineg, hstrict⟩
simpa using hlt
exact hwEval c r hr htotal
by_cases hlin : LinearIndependent ℝ (fun i ↦ Φ (z i))
· let b : Module.Basis (Fin 4) ℝ (Fin 4 → ℝ) :=
basisOfLinearIndependentOfCardEqFinrank hlin (by simp)
let w : Fin 4 → ℝ := single 3 1
let l : Fin 4 → ℝ := fun i ↦ b.repr w i
have hsum : ∑ i, l i • Φ (z i) = w := by
simpa only [l, b, coe_basisOfLinearIndependentOfCardEqFinrank] using b.sum_repr w
apply hsign_contra l w hsum (by simp [w])
· intro c r hr hneg
have heq := hweighted l w hsum c r
have hw3 : w 3 = 1 := by simp [w]
have hw1 : w 1 = 0 := by simp [w]
have hw2 : w 2 = 0 := by simp [w]
have hw0' : w 0 = 0 := by simp [w]
rw [hw3, hw1, hw2, hw0'] at heq
norm_num at heq
linarith
· have hwne : w ≠ 0 := by
intro hw
have := congrFun hw 3
simp [w] at this
by_contra hn
push_neg at hn
have : l = 0 := funext hn
rw [this] at hsum
simp at hsum
exact hwne hsum.symm
· obtain ⟨l, hsum, hnz⟩ := Fintype.not_linearIndependent_iff.mp hlin
exact hsign_contra l 0 hsum rfl (by
intro c r hr hneg
have heq := hweighted l 0 hsum c r
simp at heq
linarith) hnz
Causal.FiniteMaxAssembly 19 declarations This module builds the finite measurable partition used to split the causal hard-family marked-Poisson experiment into its local cells and common complement.
Causal finite-maximum assembly
This module builds the finite measurable partition used to split the causal hard-family marked-Poisson experiment into its local cells and common complement.
def causalPackingIndexMeasurableSpace
Equip the causal packing index set with the discrete measurable structure.
Definition (Lean source)
The disjoint hard cells and their common complement as a classifier.
Definition (Lean source)
-- @node: causalPackingPartitionSet
def causalPackingPartitionSet {M : ℕ} (centers : Fin M → Score) (w : ℝ) :
Unit ⊕ Fin M → Set CausalObservation
| .inr j => {z | causalScore z ∈ causalHardCell (centers j) w}
| .inl _ => {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}
theorem causalPackingPartitionSet_measurable
Every causal packing cell, including the complement, is measurable.
Formal statement
hypotheses
conclusion
MeasurableSet (causalPackingPartitionSet centers w j)
Proof (Lean source)
-- @node: causalPackingPartitionSet_measurable
lemma causalPackingPartitionSet_measurable {M : ℕ}
(centers : Fin M → Score) (w : ℝ) (j : Unit ⊕ Fin M) :
MeasurableSet (causalPackingPartitionSet centers w j) := by
have hscore : Measurable (causalScore : CausalObservation → Score) := by
unfold causalScore
fun_prop
have hcell (k : Fin M) :
MeasurableSet {z : CausalObservation |
causalScore z ∈ causalHardCell (centers k) w} := by
exact Metric.isClosed_closedBall.measurableSet.preimage hscore
cases j with
| inl u =>
rw [show causalPackingPartitionSet centers w (.inl u) =
(⋃ k : Fin M, {z : CausalObservation |
causalScore z ∈ causalHardCell (centers k) w})ᶜ by
ext z
simp [causalPackingPartitionSet]]
exact (MeasurableSet.iUnion hcell).compl
| inr j => simpa [causalPackingPartitionSet] using hcell j
theorem causalPackingPartitionSet_pairwiseDisjoint
Distinct indices select disjoint causal partition cells.
Formal statement
hypotheses
M :
ℕ
w :
ℝ
hdis :
∀ i j
if
i ≠ j
then
conclusion
Pairwise (fun i j : Unit ⊕ Fin M => Disjoint (causalPackingPartitionSet centers w i) (causalPackingPartitionSet centers w j))
Proof (Lean source)
-- @node: causalPackingPartitionSet_pairwiseDisjoint
lemma causalPackingPartitionSet_pairwiseDisjoint {M : ℕ}
(centers : Fin M → Score) (w : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w)) :
Pairwise (fun i j : Unit ⊕ Fin M =>
Disjoint (causalPackingPartitionSet centers w i)
(causalPackingPartitionSet centers w j)) := by
intro i j hij
cases i with
| inl u =>
cases j with
| inl v => exact (hij (by cases u; cases v; rfl)).elim
| inr j =>
apply Set.disjoint_left.2
intro z hz hj
exact hz (Set.mem_iUnion.2 ⟨j, hj⟩)
| inr i =>
cases j with
| inl u =>
apply Set.disjoint_left.2
intro z hi hz
exact hz (Set.mem_iUnion.2 ⟨i, hi⟩)
| inr j =>
apply Set.disjoint_left.2
intro z hi hj
exact Set.disjoint_left.1
(hdis i j (fun h => hij (congrArg inr h))) hi hj
theorem causalPackingPartitionSet_iUnion
The causal packing partition covers the observation space.
Formal statement
Proof (Lean source)
-- @node: causalPackingPartitionSet_iUnion
lemma causalPackingPartitionSet_iUnion {M : ℕ}
(centers : Fin M → Score) (w : ℝ) :
⋃ j : Unit ⊕ Fin M, causalPackingPartitionSet centers w j = univ := by
ext z
simp only [Set.mem_iUnion, Set.mem_univ, iff_true]
by_cases h : causalScore z ∈ ⋃ j, causalHardCell (centers j) w
· obtain ⟨j, hj⟩ := Set.mem_iUnion.1 h
exact ⟨.inr j, hj⟩
· exact ⟨.inl (), h⟩
The finite measurable partition formed by the causal hard cells.
Definition (Lean source)
-- @node: causalPackingFinitePartition
noncomputable def causalPackingFinitePartition {M : ℕ}
(centers : Fin M → Score) (w : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w)) :
FiniteMeasurablePartition CausalObservation (Unit ⊕ Fin M) :=
FiniteMeasurablePartition.ofSets (causalPackingPartitionSet centers w)
(causalPackingPartitionSet_measurable centers w)
(causalPackingPartitionSet_pairwiseDisjoint centers w hdis)
(causalPackingPartitionSet_iUnion centers w)
theorem causalPackingFinitePartition_cellSet
The abstract partition has the intended causal hard cells.
Formal statement
hypotheses
M :
ℕ
w :
ℝ
hdis :
∀ i j
if
i ≠ j
then
conclusion
(causalPackingFinitePartition centers w hdis).cellSet j
= causalPackingPartitionSet centers w j
Proof (Lean source)
-- @node: causalPackingFinitePartition_cellSet
lemma causalPackingFinitePartition_cellSet {M : ℕ}
(centers : Fin M → Score) (w : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w))
(j : Unit ⊕ Fin M) :
(causalPackingFinitePartition centers w hdis).cellSet j =
causalPackingPartitionSet centers w j := by
exact FiniteMeasurablePartition.ofSets_cellSet _ _ _ _ j
theorem causalPackingFinitePartition_cell_measure_eq
A local partition-cell mass is exactly the score-cell probability.
Formal statement
hypotheses
conclusion
P.law ((causalPackingFinitePartition centers w hdis).cellSet (.inr j))
= P.law {z | causalScore z ∈ causalHardCell (centers j) w}
Proof (Lean source)
-- @node: causalPackingFinitePartition_cell_measure_eq
lemma causalPackingFinitePartition_cell_measure_eq {M : ℕ}
(centers : Fin M → Score) (w : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w))
(P : A1A2Law) (j : Fin M) :
P.law ((causalPackingFinitePartition centers w hdis).cellSet (.inr j)) =
P.law {z | causalScore z ∈ causalHardCell (centers j) w} := by
rw [causalPackingFinitePartition_cellSet, causalPackingPartitionSet]
theorem causalPackingCellObservationLaw_eq_of_bit_eq
Equal positive cell mass and raw restriction locality identify the normalized observation laws in a causal packing cell.
Formal statement
hypotheses
M :
ℕ
w rho :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hrho :
0 < rho
hmass :
∀ omega j,
hlocal :
∀ omega omega' j
if
omega j = omega' j
then
(laws omega).law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}
= (laws omega').law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}
j :
Fin M
hbit :
omega j = omega' j
conclusion
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability (causalPackingFinitePartition centers w hdis).cellObservationLaw (laws omega).law (.inr j) = (causalPackingFinitePartition centers w hdis).cellObservationLaw (laws omega').law (.inr j))
Proof (Lean source)
-- @node: causalPackingCellObservationLaw_eq_of_bit_eq
lemma causalPackingCellObservationLaw_eq_of_bit_eq {M : ℕ}
(centers : Fin M → Score) (w rho : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w))
(laws : (Fin M → Bool) → A1A2Law) (hrho : 0 < rho)
(hmass : ∀ omega j,
(laws omega).law {z | causalScore z ∈ causalHardCell (centers j) w} =
ofReal rho)
(hlocal : ∀ omega omega' j, omega j = omega' j →
(laws omega).law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w} =
(laws omega').law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w})
(omega omega' : Fin M → Bool) (j : Fin M)
(hbit : omega j = omega' j) :
(letI : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law :=
(laws omega').law_isProbability
(causalPackingFinitePartition centers w hdis).cellObservationLaw
(laws omega).law (.inr j) =
(causalPackingFinitePartition centers w hdis).cellObservationLaw
(laws omega').law (.inr j)) := by
letI : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law :=
(laws omega').law_isProbability
let p := causalPackingFinitePartition centers w hdis
apply cellObservationLaw_eq_of_restrict_eq p (laws omega).law
(laws omega').law (.inr j)
· rw [show (laws omega).law (p.cellSet (.inr j)) = ofReal rho by
rw [show p = causalPackingFinitePartition centers w hdis by rfl,
causalPackingFinitePartition_cell_measure_eq, hmass omega j]]
exact (ENNReal.ofReal_pos.mpr hrho).ne'
· rw [show (laws omega).law (p.cellSet (.inr j)) = ofReal rho by
rw [show p = causalPackingFinitePartition centers w hdis by rfl,
causalPackingFinitePartition_cell_measure_eq, hmass omega j],
show (laws omega').law (p.cellSet (.inr j)) = ofReal rho by
rw [show p = causalPackingFinitePartition centers w hdis by rfl,
causalPackingFinitePartition_cell_measure_eq, hmass omega' j]]
· simpa [p, causalPackingFinitePartition_cellSet,
causalPackingPartitionSet] using hlocal omega omega' j hbit
A canonical vertex carrying the selected causal cell bit.
Definition (Lean source)
-- @node: causalPackingSingleBit
def causalPackingSingleBit {M : ℕ} (j : Fin M) (b : Bool) : Fin M → Bool :=
fun k => if k = j then b else false
The canonical marked-Poisson law in causal coordinate j.
Definition (Lean source)
-- @node: causalPackingCellExperiment
noncomputable def causalPackingCellExperiment {M : ℕ}
(p : FiniteMeasurablePartition CausalObservation (Unit ⊕ Fin M))
(laws : (Fin M → Bool) → A1A2Law) (lam : ℝ≥0)
(j : Fin M) (b : Bool) :
Measure (FiniteSample (CausalObservation × ℝ)) := by
letI : IsProbabilityMeasure (laws (causalPackingSingleBit j b)).law :=
(laws (causalPackingSingleBit j b)).law_isProbability
exact canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws (causalPackingSingleBit j b)).law (.inr j))
packingMarkLaw
(lam * p.cellMass (laws (causalPackingSingleBit j b)).law (.inr j))
instance causalPackingCellExperiment_isProbabilityMeasure
The stated experiment law has total mass one and therefore defines a probability distribution.
Definition (Lean source)
instance causalPackingCellExperiment_isProbabilityMeasure {M : ℕ}
(p : FiniteMeasurablePartition CausalObservation (Unit ⊕ Fin M))
(laws : (Fin M → Bool) → A1A2Law) (lam : ℝ≥0)
(j : Fin M) (b : Bool) :
IsProbabilityMeasure (causalPackingCellExperiment p laws lam j b) := by
unfold causalPackingCellExperiment
infer_instance
The causal complement experiment, represented at the all-false vertex.
Definition (Lean source)
-- @node: causalPackingCommonExperiment
noncomputable def causalPackingCommonExperiment {M : ℕ}
(p : FiniteMeasurablePartition CausalObservation (Unit ⊕ Fin M))
(laws : (Fin M → Bool) → A1A2Law) (lam : ℝ≥0) :
Measure (Unit → FiniteSample (CausalObservation × ℝ)) := by
let omega0 : Fin M → Bool := fun _ => false
letI : IsProbabilityMeasure (laws omega0).law :=
(laws omega0).law_isProbability
exact Measure.pi (fun _ : Unit => canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega0).law (.inl ())) packingMarkLaw
(lam * p.cellMass (laws omega0).law (.inl ())))
instance causalPackingCommonExperiment_isProbabilityMeasure
The stated experiment law has total mass one and therefore defines a probability distribution.
Definition (Lean source)
instance causalPackingCommonExperiment_isProbabilityMeasure {M : ℕ}
(p : FiniteMeasurablePartition CausalObservation (Unit ⊕ Fin M))
(laws : (Fin M → Bool) → A1A2Law) (lam : ℝ≥0) :
IsProbabilityMeasure (causalPackingCommonExperiment p laws lam) := by
unfold causalPackingCommonExperiment
infer_instance
theorem causalPackingCanonicalCellLaw_eq_of_bit_eq
A canonical causal cell experiment depends only on its own Boolean bit.
Formal statement
hypotheses
M :
ℕ
w rho :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hrho :
0 < rho
hmass :
∀ omega j,
hlocal :
∀ omega omega' j
if
omega j = omega' j
then
(laws omega).law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}
= (laws omega').law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}
R :
lam :
ℝ≥0
j :
Fin M
hbit :
omega j = omega' j
conclusion
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability let p := causalPackingFinitePartition centers w hdis canonicalMarkedPoissonSampleLaw (p.cellObservationLaw (laws omega).law (.inr j)) R (lam * p.cellMass (laws omega).law (.inr j)) = canonicalMarkedPoissonSampleLaw (p.cellObservationLaw (laws omega').law (.inr j)) R (lam * p.cellMass (laws omega').law (.inr j)))
Proof (Lean source)
-- @node: causalPackingCanonicalCellLaw_eq_of_bit_eq
lemma causalPackingCanonicalCellLaw_eq_of_bit_eq {M : ℕ}
(centers : Fin M → Score) (w rho : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w))
(laws : (Fin M → Bool) → A1A2Law) (hrho : 0 < rho)
(hmass : ∀ omega j,
(laws omega).law {z | causalScore z ∈ causalHardCell (centers j) w} =
ofReal rho)
(hlocal : ∀ omega omega' j, omega j = omega' j →
(laws omega).law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w} =
(laws omega').law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w})
(R : Measure ℝ) [IsProbabilityMeasure R] (lam : ℝ≥0)
(omega omega' : Fin M → Bool) (j : Fin M)
(hbit : omega j = omega' j) :
(letI : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law :=
(laws omega').law_isProbability
let p := causalPackingFinitePartition centers w hdis
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega).law (.inr j)) R
(lam * p.cellMass (laws omega).law (.inr j)) =
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega').law (.inr j)) R
(lam * p.cellMass (laws omega').law (.inr j))) := by
letI : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law :=
(laws omega').law_isProbability
let p := causalPackingFinitePartition centers w hdis
have hobs := causalPackingCellObservationLaw_eq_of_bit_eq centers w rho hdis
laws hrho hmass hlocal omega omega' j hbit
have hobs' : p.cellObservationLaw (laws omega).law (.inr j) =
p.cellObservationLaw (laws omega').law (.inr j) := by
simpa [p] using hobs
have hmassEq : p.cellMass (laws omega).law (.inr j) =
p.cellMass (laws omega').law (.inr j) := by
unfold FiniteMeasurablePartition.cellMass
rw [show (laws omega).law (p.cellSet (.inr j)) = ofReal rho by
rw [show p = causalPackingFinitePartition centers w hdis by rfl,
causalPackingFinitePartition_cell_measure_eq, hmass omega j],
show (laws omega').law (p.cellSet (.inr j)) = ofReal rho by
rw [show p = causalPackingFinitePartition centers w hdis by rfl,
causalPackingFinitePartition_cell_measure_eq, hmass omega' j]]
change canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega).law (.inr j)) R
(lam * p.cellMass (laws omega).law (.inr j)) =
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega').law (.inr j)) R
(lam * p.cellMass (laws omega').law (.inr j))
unfold canonicalMarkedPoissonSampleLaw
simp only [hobs', hmassEq]
theorem causalPackingCanonicalComplementLaw_eq
The canonical complement experiment is common to every causal vertex.
Formal statement
hypotheses
M :
ℕ
w :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hoff :
∀ omega omega',
(laws omega).law.restrict {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}
= (laws omega').law.restrict {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}
R :
lam :
ℝ≥0
conclusion
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability let p := causalPackingFinitePartition centers w hdis canonicalMarkedPoissonSampleLaw (p.cellObservationLaw (laws omega).law (.inl ())) R (lam * p.cellMass (laws omega).law (.inl ())) = canonicalMarkedPoissonSampleLaw (p.cellObservationLaw (laws omega').law (.inl ())) R (lam * p.cellMass (laws omega').law (.inl ())))
Proof (Lean source)
-- @node: causalPackingCanonicalComplementLaw_eq
lemma causalPackingCanonicalComplementLaw_eq {M : ℕ}
(centers : Fin M → Score) (w : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w))
(laws : (Fin M → Bool) → A1A2Law)
(hoff : ∀ omega omega', (laws omega).law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w} =
(laws omega').law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w})
(R : Measure ℝ) [IsProbabilityMeasure R] (lam : ℝ≥0)
(omega omega' : Fin M → Bool) :
(letI : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law :=
(laws omega').law_isProbability
let p := causalPackingFinitePartition centers w hdis
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega).law (.inl ())) R
(lam * p.cellMass (laws omega).law (.inl ())) =
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega').law (.inl ())) R
(lam * p.cellMass (laws omega').law (.inl ()))) := by
letI : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law :=
(laws omega').law_isProbability
let p := causalPackingFinitePartition centers w hdis
have hrest : (laws omega).law.restrict (p.cellSet (.inl ())) =
(laws omega').law.restrict (p.cellSet (.inl ())) := by
simpa [p, causalPackingFinitePartition_cellSet,
causalPackingPartitionSet] using hoff omega omega'
have hmass : (laws omega).law (p.cellSet (.inl ())) =
(laws omega').law (p.cellSet (.inl ())) := by
have h := congrArg (fun μ : Measure CausalObservation => μ univ) hrest
simpa [Measure.restrict_apply_univ] using h
have hcellMass : p.cellMass (laws omega).law (.inl ()) =
p.cellMass (laws omega').law (.inl ()) := by
unfold FiniteMeasurablePartition.cellMass
rw [hmass]
change canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega).law (.inl ())) R
(lam * p.cellMass (laws omega).law (.inl ())) =
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega').law (.inl ())) R
(lam * p.cellMass (laws omega').law (.inl ()))
by_cases hpos : (laws omega).law (p.cellSet (.inl ())) = 0
· have hpos' : (laws omega').law (p.cellSet (.inl ())) = 0 := by
rw [← hmass, hpos]
have hzero : p.cellMass (laws omega).law (.inl ()) = 0 := by
unfold FiniteMeasurablePartition.cellMass
rw [hpos]
simp
have hzero' : p.cellMass (laws omega').law (.inl ()) = 0 := by
unfold FiniteMeasurablePartition.cellMass
rw [hpos']
simp
rw [hzero, hzero']
simp only [mul_zero]
exact canonicalMarkedPoissonSampleLaw_zero
(p.cellObservationLaw (laws omega).law (.inl ()))
(p.cellObservationLaw (laws omega').law (.inl ())) R
· have hobs := cellObservationLaw_eq_of_restrict_eq p (laws omega).law
(laws omega').law (.inl ()) hpos hmass hrest
unfold canonicalMarkedPoissonSampleLaw
simp only [hobs, hcellMass]
def synthesizeCausalPackingConfiguration Definition synthesizeCausalPackingConfiguration in the paper ↗
Put the causal complement and cell blocks back into one marked sample.
Definition (Lean source)
-- @node: synthesizeCausalPackingConfiguration
noncomputable def synthesizeCausalPackingConfiguration {M : ℕ}
(z : (Unit → FiniteSample (CausalObservation × ℝ)) ×
(Fin M → FiniteSample (CausalObservation × ℝ))) :
FiniteSample (CausalObservation × ℝ) :=
superposeByMarks
((MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (CausalObservation × ℝ))).symm z)
theorem synthesizeCausalPackingConfiguration_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
Proof (Lean source)
lemma synthesizeCausalPackingConfiguration_measurable {M : ℕ} :
Measurable (synthesizeCausalPackingConfiguration (M := M)) := by
exact measurable_superposeByMarks.comp
(MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M =>
FiniteSample (CausalObservation × ℝ))).symm.measurable
theorem causalPackingExperiment_synthesis_law
Partition splitting identifies the independent causal blocks with the canonical marked-Poisson law at the selected vertex.
Formal statement
hypotheses
M :
ℕ
w rho :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hrho :
0 < rho
hmass :
∀ omega j,
hlocal :
∀ omega omega' j
if
omega j = omega' j
then
(laws omega).law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}
= (laws omega').law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}
hoff :
∀ omega omega',
(laws omega).law.restrict {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}
= (laws omega').law.restrict {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}
lam :
ℝ≥0
conclusion
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability Measure.map synthesizeCausalPackingConfiguration ((causalPackingCommonExperiment (causalPackingFinitePartition centers w hdis) laws lam).prod (Measure.pi fun j => causalPackingCellExperiment (causalPackingFinitePartition centers w hdis) laws lam j (omega j))) = canonicalMarkedPoissonSampleLaw (laws omega).law packingMarkLaw lam)
Proof (Lean source)
-- @node: causalPackingExperiment_synthesis_law
lemma causalPackingExperiment_synthesis_law {M : ℕ}
(centers : Fin M → Score) (w rho : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w))
(laws : (Fin M → Bool) → A1A2Law) (hrho : 0 < rho)
(hmass : ∀ omega j,
(laws omega).law {z | causalScore z ∈ causalHardCell (centers j) w} =
ofReal rho)
(hlocal : ∀ omega omega' j, omega j = omega' j →
(laws omega).law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w} =
(laws omega').law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w})
(hoff : ∀ omega omega', (laws omega).law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w} =
(laws omega').law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w})
(lam : ℝ≥0) (omega : Fin M → Bool) :
(letI : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
Measure.map synthesizeCausalPackingConfiguration
((causalPackingCommonExperiment
(causalPackingFinitePartition centers w hdis) laws lam).prod
(Measure.pi fun j => causalPackingCellExperiment
(causalPackingFinitePartition centers w hdis)
laws lam j (omega j))) =
canonicalMarkedPoissonSampleLaw (laws omega).law packingMarkLaw lam) := by
let p := causalPackingFinitePartition centers w hdis
let omega0 : Fin M → Bool := fun _ => false
letI : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega0).law :=
(laws omega0).law_isProbability
let cellLaw (k : Unit ⊕ Fin M) := canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega).law k) packingMarkLaw
(lam * p.cellMass (laws omega).law k)
have hcoord (j : Fin M) :
causalPackingCellExperiment p laws lam j (omega j) = cellLaw (.inr j) := by
symm
exact causalPackingCanonicalCellLaw_eq_of_bit_eq centers w rho hdis laws
hrho hmass hlocal packingMarkLaw lam omega
(causalPackingSingleBit j (omega j)) j (by simp [causalPackingSingleBit])
have hcommon : (fun _ : Unit => canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega0).law (.inl ())) packingMarkLaw
(lam * p.cellMass (laws omega0).law (.inl ()))) =
(fun _ : Unit => cellLaw (.inl ())) := by
funext u
cases u
exact causalPackingCanonicalComplementLaw_eq centers w hdis laws hoff
packingMarkLaw lam omega0 omega
have hprod : (causalPackingCommonExperiment p laws lam).prod
(Measure.pi fun j => causalPackingCellExperiment p laws lam j (omega j)) =
(Measure.pi fun u : Unit => cellLaw (.inl u)).prod
(Measure.pi fun j : Fin M => cellLaw (.inr j)) := by
change (Measure.pi (fun _ : Unit => canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega0).law (.inl ())) packingMarkLaw
(lam * p.cellMass (laws omega0).law (.inl ())))).prod
(Measure.pi fun j => causalPackingCellExperiment p laws lam j (omega j)) = _
rw [hcommon]
rw [show (fun j => causalPackingCellExperiment p laws lam j (omega j)) =
(fun j : Fin M => cellLaw (.inr j)) by funext j; exact hcoord j]
rw [show causalPackingFinitePartition centers w hdis = p by rfl, hprod]
calc
Measure.map synthesizeCausalPackingConfiguration
((Measure.pi fun u : Unit => cellLaw (.inl u)).prod
(Measure.pi fun j : Fin M => cellLaw (.inr j))) =
Measure.map superposeByMarks (Measure.pi cellLaw) := by
rw [show synthesizeCausalPackingConfiguration = superposeByMarks ∘
(MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M =>
FiniteSample (CausalObservation × ℝ))).symm by rfl,
← Measure.map_map measurable_superposeByMarks
(MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M =>
FiniteSample (CausalObservation × ℝ))).symm.measurable]
rw [(measurePreserving_sumPiEquivProdPi_symm cellLaw).map_eq]
_ = canonicalMarkedPoissonSampleLaw (laws omega).law packingMarkLaw lam := by
simpa [cellLaw] using
(map_superposeByMarks_canonicalCellLaws p (laws omega).law
packingMarkLaw lam)
Causal.FiniteMaxDecision 19 declarations This module reconstructs each fixed-geometry signed-distance section from the local compressed Poisson block and the remaining raw partition blocks.
Causal finite-maximum decoders
This module reconstructs each fixed-geometry signed-distance section from the local compressed Poisson block and the remaining raw partition blocks.
def causalDecisionIndexMeasurableSpace
Equip the causal decision index set with the discrete measurable structure.
Definition (Lean source)
theorem causalDecisionIndexMeasurableSingletonClass
Every singleton causal decision index is measurable.
Formal statement
Proof (Lean source)
local instance causalDecisionIndexMeasurableSingletonClass (M : ℕ) :
MeasurableSingletonClass (Unit ⊕ Fin M) := ⟨fun _ => trivial⟩
theorem signedObservationAt_eq_of_hard_geometry_eq
Equal assignment geometry makes the observed signed statistic identical.
Formal statement
hypotheses
P P' :
h :
P.support = P'.support ∧ P.A1 = P'.A1 ∧ P.A0 = P'.A0 ∧ P.boundary = P'.boundary
x :
conclusion
signedObservationAt P x = signedObservationAt P' x
Proof (Lean source)
-- @node: signedObservationAt_eq_of_hard_geometry_eq
lemma signedObservationAt_eq_of_hard_geometry_eq (P P' : A1A2Law)
(h : P.support = P'.support ∧ P.A1 = P'.A1 ∧ P.A0 = P'.A0 ∧
P.boundary = P'.boundary) (x : Score) :
signedObservationAt P x = signedObservationAt P' x := by
funext z
simp only [signedObservationAt, observedOutcome, treatment, signedDistance,
knownGeometry]
simp [h.2.1, h.2.2.1]
theorem knownGeometry_eq_of_components_eq
The two stated constructions agree under the theorem's assumptions.
Formal statement
hypotheses
P P' :
h :
P.support = P'.support ∧ P.A1 = P'.A1 ∧ P.A0 = P'.A0 ∧ P.boundary = P'.boundary
conclusion
knownGeometry P = knownGeometry P'
Proof (Lean source)
lemma knownGeometry_eq_of_components_eq (P P' : A1A2Law)
(h : P.support = P'.support ∧ P.A1 = P'.A1 ∧ P.A0 = P'.A0 ∧
P.boundary = P'.boundary) : knownGeometry P = knownGeometry P' := by
unfold knownGeometry
rw [GeometryData.mk.injEq]
exact ⟨h.1, h.2.2.1, h.2.1, h.2.2.2, rfl, rfl⟩
theorem signedDistanceData_measurable
The fixed-law signed-distance sample map is measurable.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: signedDistanceData_measurable
lemma signedDistanceData_measurable (n : ℕ) (P : A1A2Law) (x : Score) :
Measurable (fun w : CausalSample n => signedDistanceData n P w x) := by
apply measurable_pi_lambda
intro i
exact (signedObservationAt_measurable P x).comp
(measurable_pi_apply i : Measurable (fun w : CausalSample n => w i))
Mark a causal observation after replacing it by its observed outcome and signed distance at one fixed-geometry center.
Definition (Lean source)
-- @node: causalPackingMarkedStatistic
noncomputable def causalPackingMarkedStatistic (P : A1A2Law) (x : Score) :
CausalObservation × ℝ → (ℝ × ℝ) × ℝ :=
fun z => (signedObservationAt P x z.1, z.2)
theorem causalPackingMarkedStatistic_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
Proof (Lean source)
lemma causalPackingMarkedStatistic_measurable (P : A1A2Law) (x : Score) :
Measurable (causalPackingMarkedStatistic P x) := by
exact (signedObservationAt_measurable P x).comp measurable_fst |>.prodMk
measurable_snd
Compress one raw causal partition block to its signed observation.
Definition (Lean source)
-- @node: compressCausalPackingCell
noncomputable def compressCausalPackingCell {M : ℕ} (P0 : A1A2Law)
(centers : Fin M → Score) (j : Fin M)
(s : FiniteSample (CausalObservation × ℝ)) :
FiniteSample ((ℝ × ℝ) × ℝ) :=
finiteSampleMap (causalPackingMarkedStatistic P0 (centers j)) s
theorem compressCausalPackingCell_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (compressCausalPackingCell P0 centers j)
Proof (Lean source)
lemma compressCausalPackingCell_measurable {M : ℕ} (P0 : A1A2Law)
(centers : Fin M → Score) (j : Fin M) :
Measurable (compressCausalPackingCell P0 centers j) :=
measurable_finiteSampleMap _
(causalPackingMarkedStatistic_measurable P0 (centers j))
Reassemble the signed marked sample for decoder j.
Definition (Lean source)
-- @node: assembleCausalPackingBlocks
noncomputable def assembleCausalPackingBlocks {M : ℕ} (P0 : A1A2Law)
(centers : Fin M → Score) (j : Fin M)
(own : FiniteSample ((ℝ × ℝ) × ℝ))
(cells : Fin M → FiniteSample (CausalObservation × ℝ))
(common : Unit → FiniteSample (CausalObservation × ℝ)) :
FiniteSample ((ℝ × ℝ) × ℝ) :=
superposeByMarks (fun k : Unit ⊕ Fin M => match k with
| .inl u => finiteSampleMap
(causalPackingMarkedStatistic P0 (centers j)) (common u)
| .inr k => if k = j then own else finiteSampleMap
(causalPackingMarkedStatistic P0 (centers j)) (cells k))
theorem assembleCausalPackingBlocks_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (fun z : FiniteSample ((ℝ × ℝ) × ℝ) × (Fin M → FiniteSample (CausalObservation × ℝ)) × (Unit → FiniteSample (CausalObservation × ℝ)) => assembleCausalPackingBlocks P0 centers j z.1 z.2.1 z.2.2)
Proof (Lean source)
lemma assembleCausalPackingBlocks_measurable {M : ℕ} (P0 : A1A2Law)
(centers : Fin M → Score) (j : Fin M) : Measurable
(fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (CausalObservation × ℝ)) ×
(Unit → FiniteSample (CausalObservation × ℝ)) =>
assembleCausalPackingBlocks P0 centers j z.1 z.2.1 z.2.2) := by
apply measurable_superposeByMarks.comp
apply measurable_pi_lambda
intro k
cases k with
| inl u =>
exact (measurable_finiteSampleMap _
(causalPackingMarkedStatistic_measurable P0 _)).comp
((measurable_pi_apply u).comp measurable_snd.snd)
| inr k =>
by_cases h : k = j
· simp only [assembleCausalPackingBlocks, h, if_pos]
exact measurable_fst
· simp only [assembleCausalPackingBlocks, h, if_neg]
exact (measurable_finiteSampleMap _
(causalPackingMarkedStatistic_measurable P0 _)).comp
((measurable_pi_apply k).comp measurable_snd.fst)
The point estimate reconstructed from the independent causal blocks.
Definition (Lean source)
-- @node: causalPackingPoissonValue
noncomputable def causalPackingPoissonValue {n M : ℕ} (T : A1A2PIRule n)
(P0 : A1A2Law) (centers : Fin M → Score) (j : Fin M)
(own : FiniteSample ((ℝ × ℝ) × ℝ))
(cells : Fin M → FiniteSample (CausalObservation × ℝ))
(common : Unit → FiniteSample (CausalObservation × ℝ)) : ℝ :=
let s := assembleCausalPackingBlocks P0 centers j own cells common
if n ≤ s.count then T.map (knownGeometry P0) (centers j)
(canonicalPrefixObservations (0, 0) n s) else 0
theorem causalPackingPoissonValue_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (fun z : FiniteSample ((ℝ × ℝ) × ℝ) × (Fin M → FiniteSample (CausalObservation × ℝ)) × (Unit → FiniteSample (CausalObservation × ℝ)) => causalPackingPoissonValue T P0 centers j z.1 z.2.1 z.2.2)
Proof (Lean source)
lemma causalPackingPoissonValue_measurable {n M : ℕ} (T : A1A2PIRule n)
(P0 : A1A2Law) (centers : Fin M → Score) (j : Fin M) : Measurable
(fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (CausalObservation × ℝ)) ×
(Unit → FiniteSample (CausalObservation × ℝ)) =>
causalPackingPoissonValue T P0 centers j z.1 z.2.1 z.2.2) := by
let f := fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (CausalObservation × ℝ)) ×
(Unit → FiniteSample (CausalObservation × ℝ)) =>
assembleCausalPackingBlocks P0 centers j z.1 z.2.1 z.2.2
have hf : Measurable f := assembleCausalPackingBlocks_measurable P0 centers j
apply Measurable.ite
· exact (measurable_finiteSample_count measurableSet_Ici).preimage hf
· exact (T.section_measurable (knownGeometry P0) (centers j)).comp
((measurable_canonicalPrefixObservations (0, 0) n).comp hf)
· exact measurable_const
The midpoint decoder attached to the fixed measurable section.
Definition (Lean source)
-- @node: causalPackingPoissonDecoder
noncomputable def causalPackingPoissonDecoder {n M : ℕ} (T : A1A2PIRule n)
(P0 : A1A2Law) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (j : Fin M)
(own : FiniteSample ((ℝ × ℝ) × ℝ))
(cells : Fin M → FiniteSample (CausalObservation × ℝ))
(common : Unit → FiniteSample (CausalObservation × ℝ)) : Bool :=
let t := causalPackingPoissonValue T P0 centers j own cells common
decide (|t - values j true| ≤ |t - values j false|)
theorem causalPackingPoissonDecoder_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (fun z : FiniteSample ((ℝ × ℝ) × ℝ) × (Fin M → FiniteSample (CausalObservation × ℝ)) × (Unit → FiniteSample (CausalObservation × ℝ)) => causalPackingPoissonDecoder T P0 centers values j z.1 z.2.1 z.2.2)
Proof (Lean source)
lemma causalPackingPoissonDecoder_measurable {n M : ℕ} (T : A1A2PIRule n)
(P0 : A1A2Law) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (j : Fin M) : Measurable
(fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (CausalObservation × ℝ)) ×
(Unit → FiniteSample (CausalObservation × ℝ)) =>
causalPackingPoissonDecoder T P0 centers values j z.1 z.2.1 z.2.2) := by
let t := fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (CausalObservation × ℝ)) ×
(Unit → FiniteSample (CausalObservation × ℝ)) =>
causalPackingPoissonValue T P0 centers j z.1 z.2.1 z.2.2
have ht : Measurable t := causalPackingPoissonValue_measurable T P0 centers j
apply measurable_to_bool
change MeasurableSet {z | decide
(|t z - values j true| ≤ |t z - values j false|) = true}
have hm := measurableSet_le
(ht.sub (measurable_const : Measurable (fun _ => values j true))).abs
(ht.sub (measurable_const : Measurable (fun _ => values j false))).abs
convert hm using 1 <;> ext z <;> simp
theorem causalPackingPoissonDecoder_local
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
n M :
ℕ
T :
P0 :
j :
Fin M
own :
FiniteSample ((ℝ × ℝ) × ℝ)
cells cells' :
common :
h :
∀ k
if
k ≠ j
then
cells k = cells' k
conclusion
causalPackingPoissonDecoder T P0 centers values j own cells common
= causalPackingPoissonDecoder T P0 centers values j own cells' common
Proof (Lean source)
lemma causalPackingPoissonDecoder_local {n M : ℕ} (T : A1A2PIRule n)
(P0 : A1A2Law) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (j : Fin M)
(own : FiniteSample ((ℝ × ℝ) × ℝ))
(cells cells' : Fin M → FiniteSample (CausalObservation × ℝ))
(common : Unit → FiniteSample (CausalObservation × ℝ))
(h : ∀ k, k ≠ j → cells k = cells' k) :
causalPackingPoissonDecoder T P0 centers values j own cells common =
causalPackingPoissonDecoder T P0 centers values j own cells' common := by
have hblocks : (fun k : Unit ⊕ Fin M => match k with
| .inl u => finiteSampleMap
(causalPackingMarkedStatistic P0 (centers j)) (common u)
| .inr k => if k = j then own else finiteSampleMap
(causalPackingMarkedStatistic P0 (centers j)) (cells k)) =
(fun k : Unit ⊕ Fin M => match k with
| .inl u => finiteSampleMap
(causalPackingMarkedStatistic P0 (centers j)) (common u)
| .inr k => if k = j then own else finiteSampleMap
(causalPackingMarkedStatistic P0 (centers j)) (cells' k)) := by
funext k
cases k with
| inl u => rfl
| inr k => by_cases hkj : k = j <;> simp [hkj, h k]
unfold causalPackingPoissonDecoder causalPackingPoissonValue
assembleCausalPackingBlocks
rw [hblocks]
The measurable finite maximum at the selected causal packing centers.
Definition (Lean source)
-- @node: causalFinitePackingLoss
noncomputable def causalFinitePackingLoss {n M : ℕ} (rho : A1A2RuleFun n)
(P : A1A2Law) (centers : Fin M → Score) (w : CausalSample n) : ℝ≥0∞ :=
⨆ j, ofReal
|rho w (knownGeometry P) (centers j) - P.tau (centers j)|
theorem causalFinitePackingLoss_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
n M p :
ℕ
ν L :
ℝ
rho :
hrho :
rho ∈ A1A2PointIndexedDecisionClass n p ν L
P :
hP :
A1A2Class p ν L P
hcenters :
∀ j, centers j ∈ P.boundary
conclusion
Measurable (causalFinitePackingLoss rho P centers)
Proof (Lean source)
lemma causalFinitePackingLoss_measurable {n M p : ℕ} {ν L : ℝ}
(rho : A1A2RuleFun n) (hrho : rho ∈ A1A2PointIndexedDecisionClass n p ν L)
(P : A1A2Law) (hP : A1A2Class p ν L P)
(centers : Fin M → Score) (hcenters : ∀ j, centers j ∈ P.boundary) :
Measurable (causalFinitePackingLoss rho P centers) := by
obtain ⟨T, hT⟩ := hrho
unfold causalFinitePackingLoss
apply Measurable.iSup
intro j
apply Measurable.ennreal_ofReal
apply Measurable.abs
apply Measurable.sub_const
rw [show (fun w : CausalSample n =>
rho w (knownGeometry P) (centers j)) = fun w =>
T.map (knownGeometry P) (centers j) (signedDistanceData n P w (centers j)) by
funext w
exact hT P hP w (centers j) (hcenters j)]
exact (T.section_measurable (knownGeometry P) (centers j)).comp
(signedDistanceData_measurable n P (centers j))
theorem compressedCausalPackingCellExperiment_eq
Compressing a canonical causal cell block gives the marked-Poisson experiment generated by the normalized signed-observation cell law.
Formal statement
hypotheses
M :
ℕ
w rho :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hprob :
∀ j b, IsProbabilityMeasure (Q j b)
hrho :
0 < rho
hmass :
∀ omega j,
hmap :
∀ omega j,
Measure.map (signedObservationAt (laws omega) (centers j)) ((laws omega).law.restrict {z | causalScore z ∈ causalHardCell (centers j) w})
= ofReal rho • Q j (omega j)
lam :
ℝ≥0
j :
Fin M
b :
conclusion
compressedCoordinateLaw (compressCausalPackingCell (laws (causalPackingSingleBit j b)) centers j) (causalPackingCellExperiment (causalPackingFinitePartition centers w hdis) laws lam j b)
Proof (Lean source)
-- @node: compressedCausalPackingCellExperiment_eq
lemma compressedCausalPackingCellExperiment_eq {M : ℕ}
(centers : Fin M → Score) (w rho : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w))
(laws : (Fin M → Bool) → A1A2Law)
(Q : Fin M → Bool → Measure (ℝ × ℝ))
(hprob : ∀ j b, IsProbabilityMeasure (Q j b))
(hrho : 0 < rho)
(hmass : ∀ omega j,
(laws omega).law {z | causalScore z ∈ causalHardCell (centers j) w} =
ofReal rho)
(hmap : ∀ omega j, Measure.map (signedObservationAt (laws omega) (centers j))
((laws omega).law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w}) =
ofReal rho • Q j (omega j))
(lam : ℝ≥0) (j : Fin M) (b : Bool) :
compressedCoordinateLaw (compressCausalPackingCell
(laws (causalPackingSingleBit j b)) centers j)
(causalPackingCellExperiment
(causalPackingFinitePartition centers w hdis) laws lam j b) =
canonicalMarkedPoissonSampleLaw (Q j b) packingMarkLaw
(lam * toNNReal (ofReal rho)) := by
let omega := causalPackingSingleBit j b
let P := laws omega
let p := causalPackingFinitePartition centers w hdis
let f := signedObservationAt P (centers j)
letI : IsProbabilityMeasure P.law := P.law_isProbability
letI : IsProbabilityMeasure (Q j b) := hprob j b
have hcell : P.law (p.cellSet (.inr j)) = ofReal rho := by
rw [show p = causalPackingFinitePartition centers w hdis by rfl,
causalPackingFinitePartition_cell_measure_eq]
exact hmass omega j
have hpos : P.law (p.cellSet (.inr j)) ≠ 0 := by
rw [hcell]
exact (ENNReal.ofReal_pos.mpr hrho).ne'
have hm := hmap omega j
have hm' : Measure.map f (P.law.restrict (p.cellSet (.inr j))) =
ofReal rho • Q j b := by
simpa [f, P, omega, p, causalPackingFinitePartition_cellSet,
causalPackingPartitionSet, causalPackingSingleBit] using hm
have hnorm : Measure.map f (p.cellObservationLaw P.law (.inr j)) = Q j b := by
unfold FiniteMeasurablePartition.cellObservationLaw
rw [dif_neg hpos, Measure.map_smul, hm', hcell]
rw [← smul_assoc]
change ((ofReal rho)⁻¹ * ofReal rho) • Q j b = Q j b
rw [ENNReal.inv_mul_cancel (ENNReal.ofReal_pos.mpr hrho).ne'
ENNReal.ofReal_ne_top, one_smul]
unfold compressedCoordinateLaw compressCausalPackingCell
causalPackingCellExperiment canonicalMarkedPoissonSampleLaw
rw [Measure.map_map
(measurable_finiteSampleMap _
(causalPackingMarkedStatistic_measurable P (centers j)))
measurable_orderByMarks]
have hcomm : finiteSampleMap (causalPackingMarkedStatistic P (centers j)) ∘
orderByMarks = orderByMarks ∘ finiteSampleMap
(fun z : CausalObservation × ℝ => (f z.1, z.2)) := by
funext s
exact finiteSampleMap_orderByMarks f s
have hg : Measurable (fun z : CausalObservation × ℝ => (f z.1, z.2)) :=
((signedObservationAt_measurable P (centers j)).comp measurable_fst).prodMk
measurable_snd
rw [hcomm]
conv_lhs =>
rw [← Measure.map_map measurable_orderByMarks
(measurable_finiteSampleMap _ hg)]
rw [map_finiteMarkedPoissonSampleLaw_finiteSampleMap
(p.cellObservationLaw P.law (.inr j)) packingMarkLaw f
(signedObservationAt_measurable P (centers j))
(lam * p.cellMass P.law (.inr j))]
unfold FiniteMeasurablePartition.cellMass
rw [hcell]
congr 3
Causal.FiniteMaxLowerBound 16 declarations This module converts the causal hard-family cell experiment into a coordinatewise testing problem and transfers its loss back to a fixed-size sample.
Causal finite-packing lower bound
This module converts the causal hard-family cell experiment into a coordinatewise testing problem and transfers its loss back to a fixed-size sample.
def causalRiskIndexMeasurableSpace
Equip the causal risk index set with the discrete measurable structure.
Definition (Lean source)
theorem causalRiskIndexMeasurableSingletonClass
Every singleton causal risk index is measurable.
Formal statement
Proof (Lean source)
local instance causalRiskIndexMeasurableSingletonClass (M : ℕ) :
MeasurableSingletonClass (Unit ⊕ Fin M) := ⟨fun _ => trivial⟩
theorem causalScaledFrontier_eventually_klBudget
A polynomial-size packing eventually has enough logarithmic cardinality to absorb a sufficiently small fourth-power frontier budget.
Formal statement
hypotheses
q :
ℕ
hq :
1 ≤ q
c gamma K :
ℝ
hc :
0 < c
hgamma :
0 < gamma
hK :
0 ≤ K
hsmall :
128 * (q : ℝ) * K * gamma ^ 4 ≤ 1
conclusion
∀ᶠ n : ℕ in atTop,
∀ M : ℕ,
c * rpow (gamma * frontierRate n) (-(1 : ℝ) / q)
≤ M → K * (n : ℝ) * (gamma * frontierRate n) ^ 4 ≤ (1 / 4 : ℝ) * log M
Proof (Lean source)
-- @node: causalScaledFrontier_eventually_klBudget
lemma causalScaledFrontier_eventually_klBudget
(q : ℕ) (hq : 1 ≤ q) (c gamma K : ℝ)
(hc : 0 < c) (hgamma : 0 < gamma) (hK : 0 ≤ K)
(hsmall : 128 * (q : ℝ) * K * gamma ^ 4 ≤ 1) :
∀ᶠ n : ℕ in atTop, ∀ M : ℕ,
c * rpow (gamma * frontierRate n) (-(1 : ℝ) / q) ≤ M →
K * (n : ℝ) * (gamma * frontierRate n) ^ 4 ≤
(1 / 4 : ℝ) * log M := by
have hlog_atTop : Tendsto (fun n : ℕ => log (n : ℝ)) atTop atTop :=
Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop
have hlog_pos : ∀ᶠ n : ℕ in atTop, 0 < log (n : ℝ) :=
hlog_atTop.eventually_gt_atTop 0
have hloglog_bound : ∀ᶠ n : ℕ in atTop,
log (log (n : ℝ)) ≤ (1 / 2 : ℝ) * log (n : ℝ) := by
filter_upwards [hlog_atTop.eventually_ge_atTop 16, hlog_pos] with n hnlog hnlogpos
have hnlog0 : 0 ≤ log (n : ℝ) := le_trans (by norm_num) hnlog
have hbase := Real.log_le_rpow_div hnlog0 (show (0 : ℝ) < 1 / 2 by norm_num)
have hsqrt : log (log (n : ℝ)) ≤
2 * sqrt (log (n : ℝ)) := by
simpa [Real.sqrt_eq_rpow, div_eq_mul_inv, mul_comm] using hbase
have hfour : 4 ≤ sqrt (log (n : ℝ)) := by
rw [← Real.sqrt_sq (by norm_num : (0 : ℝ) ≤ 4)]
apply Real.sqrt_le_sqrt
norm_num
exact hnlog
nlinarith [Real.sq_sqrt hnlog0]
let D : ℝ := -(log c + (-(1 : ℝ) / q) * log gamma)
have hconst : ∀ᶠ n : ℕ in atTop,
D ≤ (1 / (32 * (q : ℝ))) * log (n : ℝ) := by
have hcoef : 0 < (1 / (32 * (q : ℝ)) : ℝ) := by positivity
exact (hlog_atTop.const_mul_atTop hcoef).eventually_ge_atTop D
filter_upwards [eventually_ge_atTop (2 : ℕ), hloglog_bound, hconst]
with n hn hloglog hconstn
intro M hM
have hnreal : (0 : ℝ) < n := by positivity
have hrate : 0 < frontierRate n := frontierRate_pos hn
have hqreal : (0 : ℝ) < q := by positivity
have hdelta : 0 < gamma * frontierRate n := mul_pos hgamma hrate
have hlowpos : 0 < c * rpow (gamma * frontierRate n)
(-(1 : ℝ) / q) := mul_pos hc (rpow_pos_of_pos hdelta _)
have hlogM := Real.log_le_log hlowpos hM
rw [show log (c * rpow (gamma * frontierRate n)
(-(1 : ℝ) / q)) = log c +
log (rpow (gamma * frontierRate n) (-(1 : ℝ) / q)) by
exact Real.log_mul hc.ne' (ne_of_gt (rpow_pos_of_pos hdelta _)),
show log (rpow (gamma * frontierRate n) (-(1 : ℝ) / q)) =
(-(1 : ℝ) / q) * log (gamma * frontierRate n) by
exact Real.log_rpow hdelta _,
Real.log_mul hgamma.ne' hrate.ne'] at hlogM
have hlograte : log (frontierRate n) =
(1 / 4 : ℝ) * (log (log n) - log n) := by
unfold frontierRate
have hn1r : (1 : ℝ) < n := by exact_mod_cast (show 1 < n by omega)
have hlogn : 0 < log (n : ℝ) := Real.log_pos hn1r
rw [show log (rpow (log n / n) (1 / 4 : ℝ)) =
(1 / 4 : ℝ) * log (log n / n) by
exact Real.log_rpow (div_pos hlogn hnreal) _,
Real.log_div hlogn.ne' hnreal.ne']
rw [hlograte] at hlogM
have hlogMlower : (1 / (32 * (q : ℝ))) * log n ≤ log M := by
dsimp [D] at hconstn
have hterm : (1 / (8 * (q : ℝ))) * log n ≤
(-(1 : ℝ) / q) *
((1 / 4 : ℝ) * (log (log n) - log n)) := by
rw [show (1 / (8 * (q : ℝ))) * log n =
((1 / 8 : ℝ) * log n) / q by ring,
show (-(1 : ℝ) / q) * ((1 / 4 : ℝ) *
(log (log n) - log n)) =
(-(1 / 4 : ℝ) * (log (log n) - log n)) / q by ring]
exact (div_le_div_iff_of_pos_right hqreal).2 (by linarith)
have hconst' : -(1 / (32 * (q : ℝ))) * log n ≤
log c + (-(1 : ℝ) / q) * log gamma := by linarith
have hlog0 : 0 ≤ log (n : ℝ) := Real.log_natCast_nonneg n
have hcoeff : (1 / (32 * (q : ℝ))) * log n ≤
-(1 / (32 * (q : ℝ))) * log n +
(1 / (8 * (q : ℝ))) * log n := by
field_simp [ne_of_gt hqreal]
linarith
calc
(1 / (32 * (q : ℝ))) * log n ≤
-(1 / (32 * (q : ℝ))) * log n +
(1 / (8 * (q : ℝ))) * log n := hcoeff
_ ≤ log c + (-(1 : ℝ) / q) * log gamma +
(-(1 : ℝ) / q) * ((1 / 4 : ℝ) *
(log (log n) - log n)) := add_le_add hconst' hterm
_ ≤ log M := by simpa [mul_add, add_assoc] using hlogM
have hcoef : K * gamma ^ 4 ≤ 1 / (128 * (q : ℝ)) := by
apply (le_div_iff₀ (by positivity : (0 : ℝ) < 128 * (q : ℝ))).2
nlinarith
have hlog0 : 0 ≤ log (n : ℝ) := Real.log_natCast_nonneg n
rw [mul_pow]
calc
K * (n : ℝ) * (gamma ^ 4 * frontierRate n ^ 4) =
(K * gamma ^ 4) * log n := by
rw [← frontierRate_fourth_power n hn]
ring
_ ≤ (1 / (128 * (q : ℝ))) * log n :=
mul_le_mul_of_nonneg_right hcoef hlog0
_ = (1 / 4 : ℝ) * ((1 / (32 * (q : ℝ))) * log n) := by ring
_ ≤ (1 / 4 : ℝ) * log M :=
mul_le_mul_of_nonneg_left hlogMlower (by norm_num)
Value of a causal rule on the retained prefix of a global marked sample.
Definition (Lean source)
-- @node: globalCausalPackingPoissonValue
noncomputable def globalCausalPackingPoissonValue {n : ℕ}
(T : A1A2PIRule n) (P0 : A1A2Law) (x : Score)
(s : FiniteSample (CausalObservation × ℝ)) : ℝ :=
if n ≤ s.count then T.map (knownGeometry P0) x
(canonicalPrefixObservations (0, 0) n
(finiteSampleMap (causalPackingMarkedStatistic P0 x) s)) else 0
theorem globalCausalPackingPoissonValue_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Proof (Lean source)
lemma globalCausalPackingPoissonValue_measurable {n : ℕ}
(T : A1A2PIRule n) (P0 : A1A2Law) (x : Score) :
Measurable (globalCausalPackingPoissonValue T P0 x) := by
apply Measurable.ite
· exact measurable_finiteSample_count measurableSet_Ici
· exact (T.section_measurable (knownGeometry P0) x).comp
((measurable_canonicalPrefixObservations (0, 0) n).comp
(measurable_finiteSampleMap _
(causalPackingMarkedStatistic_measurable P0 x)))
· exact measurable_const
Maximum target error on a global causal marked configuration.
Definition (Lean source)
-- @node: globalCausalPackingPoissonLoss
noncomputable def globalCausalPackingPoissonLoss {M n : ℕ}
(T : A1A2PIRule n) (P0 : A1A2Law) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool)
(s : FiniteSample (CausalObservation × ℝ)) : ℝ≥0∞ :=
⨆ j, ofReal
|globalCausalPackingPoissonValue T P0 (centers j) s - values j (omega j)|
theorem globalCausalPackingPoissonLoss_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
M n :
ℕ
T :
P0 :
conclusion
Measurable (globalCausalPackingPoissonLoss T P0 centers values omega)
Proof (Lean source)
lemma globalCausalPackingPoissonLoss_measurable {M n : ℕ}
(T : A1A2PIRule n) (P0 : A1A2Law) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool) :
Measurable (globalCausalPackingPoissonLoss T P0 centers values omega) := by
unfold globalCausalPackingPoissonLoss
apply Measurable.iSup
intro j
exact Measurable.ennreal_ofReal
(((globalCausalPackingPoissonValue_measurable T P0 (centers j)).sub_const _).abs)
The blockwise loss used by the direct-product experiment.
Definition (Lean source)
-- @node: blockCausalPackingPoissonLoss
noncomputable def blockCausalPackingPoissonLoss {M n : ℕ}
(T : A1A2PIRule n) (P0 : A1A2Law) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool)
(data : (Unit → FiniteSample (CausalObservation × ℝ)) ×
(Fin M → FiniteSample (CausalObservation × ℝ))) : ℝ≥0∞ :=
⨆ j, ofReal
|causalPackingPoissonValue T P0 centers j
(compressCausalPackingCell P0 centers j (data.2 j)) data.2 data.1 -
values j (omega j)|
theorem blockCausalPackingPoissonLoss_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
M n :
ℕ
T :
P0 :
conclusion
Measurable (blockCausalPackingPoissonLoss T P0 centers values omega)
Proof (Lean source)
lemma blockCausalPackingPoissonLoss_measurable {M n : ℕ}
(T : A1A2PIRule n) (P0 : A1A2Law) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool) :
Measurable (blockCausalPackingPoissonLoss T P0 centers values omega) := by
unfold blockCausalPackingPoissonLoss
apply Measurable.iSup
intro j
apply Measurable.ennreal_ofReal
apply Measurable.abs
apply Measurable.sub_const
have hm := (causalPackingPoissonValue_measurable T P0 centers j).comp
(((compressCausalPackingCell_measurable P0 centers j).comp
((measurable_pi_apply j).comp measurable_snd)).prodMk
(measurable_snd.prodMk measurable_fst))
exact hm
theorem assembleCausalPackingBlocks_eq_globalMap
Reassembling the local signed block and the other raw blocks equals mapping the synthesized global configuration.
Formal statement
hypotheses
conclusion
assembleCausalPackingBlocks P0 centers j (compressCausalPackingCell P0 centers j (cells j)) cells common
= finiteSampleMap (causalPackingMarkedStatistic P0 (centers j)) (synthesizeCausalPackingConfiguration (common, cells))
Proof (Lean source)
-- @node: assembleCausalPackingBlocks_eq_globalMap
lemma assembleCausalPackingBlocks_eq_globalMap {M : ℕ}
(P0 : A1A2Law) (centers : Fin M → Score) (j : Fin M)
(cells : Fin M → FiniteSample (CausalObservation × ℝ))
(common : Unit → FiniteSample (CausalObservation × ℝ)) :
assembleCausalPackingBlocks P0 centers j
(compressCausalPackingCell P0 centers j (cells j)) cells common =
finiteSampleMap (causalPackingMarkedStatistic P0 (centers j))
(synthesizeCausalPackingConfiguration (common, cells)) := by
unfold assembleCausalPackingBlocks compressCausalPackingCell
synthesizeCausalPackingConfiguration superposeByMarks
rw [show finiteSampleMap (causalPackingMarkedStatistic P0 (centers j))
(orderByMarks (superpose ((MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (CausalObservation × ℝ))).symm
(common, cells)))) =
orderByMarks (finiteSampleMap (causalPackingMarkedStatistic P0 (centers j))
(superpose ((MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (CausalObservation × ℝ))).symm
(common, cells)))) by rfl]
congr 1
change superpose _ = finiteSampleMap _ (superpose _)
rw [show finiteSampleMap (causalPackingMarkedStatistic P0 (centers j))
(superpose ((MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (CausalObservation × ℝ))).symm
(common, cells))) = superpose (fun k => finiteSampleMap
(causalPackingMarkedStatistic P0 (centers j))
(((MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (CausalObservation × ℝ))).symm
(common, cells)) k)) by rfl]
congr 1
funext k
cases k with
| inl u => rfl
| inr k =>
change (if k = j then finiteSampleMap _ (cells j)
else finiteSampleMap _ (cells k)) = finiteSampleMap _ (cells k)
by_cases h : k = j <;> simp [h]
theorem blockCausalPackingPoissonLoss_eq_global
The two stated constructions agree under the theorem's assumptions.
Formal statement
hypotheses
M n :
ℕ
T :
P0 :
data :
conclusion
blockCausalPackingPoissonLoss T P0 centers values omega data
= globalCausalPackingPoissonLoss T P0 centers values omega (synthesizeCausalPackingConfiguration data)
Proof (Lean source)
lemma blockCausalPackingPoissonLoss_eq_global {M n : ℕ}
(T : A1A2PIRule n) (P0 : A1A2Law) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool)
(data : (Unit → FiniteSample (CausalObservation × ℝ)) ×
(Fin M → FiniteSample (CausalObservation × ℝ))) :
blockCausalPackingPoissonLoss T P0 centers values omega data =
globalCausalPackingPoissonLoss T P0 centers values omega
(synthesizeCausalPackingConfiguration data) := by
rcases data with ⟨common, cells⟩
unfold blockCausalPackingPoissonLoss globalCausalPackingPoissonLoss
congr 1
funext j
congr 2
unfold causalPackingPoissonValue globalCausalPackingPoissonValue
rw [assembleCausalPackingBlocks_eq_globalMap]
rfl
theorem causalPackingCoordinatewiseError_lower_bound
The causal cell experiment inherits the finite direct-product testing lower bound from its compressed one-cell KL budgets.
Formal statement
hypotheses
M n :
ℕ
hM :
1 ≤ M
T :
P0 :
w rho kappa :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hprob :
∀ j b, IsProbabilityMeasure (Q0 j b)
hrho :
0 < rho
hmass :
∀ omega j,
hmap :
∀ omega j,
Measure.map (signedObservationAt (laws omega) (centers j)) ((laws omega).law.restrict {z | causalScore z ∈ causalHardCell (centers j) w})
= ofReal rho • Q0 j (omega j)
hgeom :
∀ omega,
(laws omega).support = P0.support ∧
(laws omega).A1 = P0.A1 ∧
(laws omega).A0 = P0.A0 ∧
(laws omega).boundary = P0.boundary
hkappa :
kappa < 1
conclusion
≤ coordinatewiseErrorProbability (fun j b => causalPackingCellExperiment (causalPackingFinitePartition centers w hdis) laws (2 * n) j b) (causalPackingCommonExperiment (causalPackingFinitePartition centers w hdis) laws (2 * n)) (fun j => compressCausalPackingCell P0 centers j) (causalPackingPoissonDecoder T P0 centers values)
Proof (Lean source)
-- @node: causalPackingCoordinatewiseError_lower_bound
lemma causalPackingCoordinatewiseError_lower_bound {M n : ℕ}
(hM : 1 ≤ M) (T : A1A2PIRule n) (P0 : A1A2Law)
(centers : Fin M → Score) (values : Fin M → Bool → ℝ)
(w rho kappa : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w))
(laws : (Fin M → Bool) → A1A2Law)
(Q0 : Fin M → Bool → Measure (ℝ × ℝ))
(hprob : ∀ j b, IsProbabilityMeasure (Q0 j b))
(hrho : 0 < rho)
(hmass : ∀ omega j,
(laws omega).law {z | causalScore z ∈ causalHardCell (centers j) w} =
ofReal rho)
(hmap : ∀ omega j, Measure.map (signedObservationAt (laws omega) (centers j))
((laws omega).law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w}) =
ofReal rho • Q0 j (omega j))
(hgeom : ∀ omega, (laws omega).support = P0.support ∧
(laws omega).A1 = P0.A1 ∧ (laws omega).A0 = P0.A0 ∧
(laws omega).boundary = P0.boundary)
(hkappa : kappa < 1)
(hkl : ∀ j, klDiv (Q0 j false) (Q0 j true) *
ofReal (2 * n * rho) ≤ ofReal (kappa * log M)) :
ofReal ((1 / 2 : ℝ) *
(1 - exp (-((M : ℝ) ^ (1 - kappa)) / 2))) ≤
coordinatewiseErrorProbability
(fun j b => causalPackingCellExperiment
(causalPackingFinitePartition centers w hdis) laws (2 * n) j b)
(causalPackingCommonExperiment
(causalPackingFinitePartition centers w hdis) laws (2 * n))
(fun j => compressCausalPackingCell P0 centers j)
(causalPackingPoissonDecoder T P0 centers values) := by
letI : StandardBorelSpace (FiniteSample (CausalObservation × ℝ)) :=
finiteSample_standardBorelSpace
letI : StandardBorelSpace (FiniteSample ((ℝ × ℝ) × ℝ)) :=
finiteSample_standardBorelSpace
let p := causalPackingFinitePartition centers w hdis
let Q : ∀ j : Fin M, Bool → Measure (FiniteSample (CausalObservation × ℝ)) :=
fun j b => causalPackingCellExperiment p laws (2 * n) j b
let R : Measure (Unit → FiniteSample (CausalObservation × ℝ)) :=
causalPackingCommonExperiment p laws (2 * n)
let compress : ∀ j : Fin M,
FiniteSample (CausalObservation × ℝ) → FiniteSample ((ℝ × ℝ) × ℝ) :=
fun j => compressCausalPackingCell P0 centers j
let decoder := causalPackingPoissonDecoder T P0 centers values
have hcompress : ∀ j, Measurable (compress j) :=
fun j => compressCausalPackingCell_measurable P0 centers j
have hdecoder : ∀ j, Measurable
(fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (CausalObservation × ℝ)) ×
(Unit → FiniteSample (CausalObservation × ℝ)) =>
decoder j z.1 z.2.1 z.2.2) :=
fun j => causalPackingPoissonDecoder_measurable T P0 centers values j
have hlocal : ∀ j s z z' a,
(∀ k, k ≠ j → z k = z' k) →
decoder j s z a = decoder j s z' a := by
intro j s z z' a hz
exact causalPackingPoissonDecoder_local T P0 centers values j s z z' a hz
have hdp := (coordinatewise_overlap_direct_product hM Q R compress
hcompress decoder hdecoder hlocal).2 kappa hkappa
have hcoord : ∀ j, klDiv
(compressedCoordinateLaw (compress j) (Q j false))
(compressedCoordinateLaw (compress j) (Q j true)) ≤
ofReal (kappa * log M) := by
intro j
let t : ℝ≥0 := (2 * n) * toNNReal (ofReal rho)
letI : IsProbabilityMeasure (Q0 j false) := hprob j false
letI : IsProbabilityMeasure (Q0 j true) := hprob j true
have hcomp (b : Bool) : compress j = compressCausalPackingCell
(laws (causalPackingSingleBit j b)) centers j := by
unfold compress compressCausalPackingCell causalPackingMarkedStatistic
funext s
cases s with
| mk count points =>
change (⟨count, fun i =>
(signedObservationAt P0 (centers j) (points i).1, (points i).2)⟩ :
Σ k, Fin k → (ℝ × ℝ) × ℝ) =
⟨count, fun i =>
(signedObservationAt (laws (causalPackingSingleBit j b))
(centers j) (points i).1, (points i).2)⟩
congr
funext i
exact congrArg (fun y => (y, (points i).2))
(congrFun (signedObservationAt_eq_of_hard_geometry_eq P0
(laws (causalPackingSingleBit j b))
⟨(hgeom _).1.symm, (hgeom _).2.1.symm,
(hgeom _).2.2.1.symm, (hgeom _).2.2.2.symm⟩ (centers j))
(points i).1)
rw [show compressedCoordinateLaw (compress j) (Q j false) =
canonicalMarkedPoissonSampleLaw (Q0 j false) packingMarkLaw t by
rw [hcomp false]
exact compressedCausalPackingCellExperiment_eq centers w rho hdis laws
Q0 hprob hrho hmass hmap (2 * n) j false,
show compressedCoordinateLaw (compress j) (Q j true) =
canonicalMarkedPoissonSampleLaw (Q0 j true) packingMarkLaw t by
rw [hcomp true]
exact compressedCausalPackingCellExperiment_eq centers w rho hdis laws
Q0 hprob hrho hmass hmap (2 * n) j true]
unfold canonicalMarkedPoissonSampleLaw
calc
klDiv
(Measure.map orderByMarks
(finiteMarkedPoissonSampleLaw (Q0 j false) packingMarkLaw t))
(Measure.map orderByMarks
(finiteMarkedPoissonSampleLaw (Q0 j true) packingMarkLaw t)) ≤
klDiv
(finiteMarkedPoissonSampleLaw (Q0 j false) packingMarkLaw t)
(finiteMarkedPoissonSampleLaw (Q0 j true) packingMarkLaw t) :=
compressedCoordinateLaw_klDiv_le orderByMarks measurable_orderByMarks _ _
_ = (t : ℝ≥0∞) * klDiv (Q0 j false) (Q0 j true) := by
rw [← finiteMeasureMarkedPoissonLaw_probability_eq (Q0 j false)
(Q0 j false) packingMarkLaw t,
← finiteMeasureMarkedPoissonLaw_probability_eq (Q0 j true)
(Q0 j false) packingMarkLaw t,
klDiv_finiteMeasureMarkedPoissonLaw (Q0 j false) (Q0 j true)
(Q0 j false) packingMarkLaw t (by simp)]
_ = klDiv (Q0 j false) (Q0 j true) *
ofReal (2 * n * rho) := by
rw [mul_comm]
congr 1
simp [t]
_ ≤ _ := hkl j
rw [coordinatewiseErrorProbability_eq_one_sub_success Q R compress hcompress
decoder hdecoder]
simpa [Q, R, compress, decoder, p] using hdp hcoord
theorem exists_vertex_causalPoissonLoss_ge_coordinatewiseError Lemma exists_vertex_causalPoissonLoss_ge_coordinatewiseError in the paper ↗
Averaging the direct-product error selects a causal vertex whose global Poissonized maximum loss is large.
Formal statement
hypotheses
M n :
ℕ
T :
P0 :
w rho delta :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hrho :
0 < rho
hmass :
∀ omega j,
hlocal :
∀ omega omega' j
if
omega j = omega' j
then
(laws omega).law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}
= (laws omega').law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}
hoff :
∀ omega omega',
(laws omega).law.restrict {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}
= (laws omega').law.restrict {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}
hvalues :
∀ omega j, (laws omega).tau (centers j) = values j (omega j)
conclusion
Proof (Lean source)
-- @node: exists_vertex_causalPoissonLoss_ge_coordinatewiseError
lemma exists_vertex_causalPoissonLoss_ge_coordinatewiseError {M n : ℕ}
(T : A1A2PIRule n) (P0 : A1A2Law) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (w rho delta : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (causalHardCell (centers i) w) (causalHardCell (centers j) w))
(laws : (Fin M → Bool) → A1A2Law) (hrho : 0 < rho)
(hmass : ∀ omega j,
(laws omega).law {z | causalScore z ∈ causalHardCell (centers j) w} =
ofReal rho)
(hlocal : ∀ omega omega' j, omega j = omega' j →
(laws omega).law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w} =
(laws omega').law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w})
(hoff : ∀ omega omega', (laws omega).law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w} =
(laws omega').law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w})
(hvalues : ∀ omega j, (laws omega).tau (centers j) = values j (omega j))
(hsep : ∀ j, delta ≤ |values j true - values j false|) :
∃ omega : Fin M → Bool,
letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability
ofReal (delta / 2) *
coordinatewiseErrorProbability
(fun j b => causalPackingCellExperiment
(causalPackingFinitePartition centers w hdis) laws (2 * n) j b)
(causalPackingCommonExperiment
(causalPackingFinitePartition centers w hdis) laws (2 * n))
(fun j => compressCausalPackingCell P0 centers j)
(causalPackingPoissonDecoder T P0 centers values) ≤
∫⁻ s, globalCausalPackingPoissonLoss T P0 centers values omega s
∂canonicalMarkedPoissonSampleLaw (laws omega).law packingMarkLaw (2 * n) := by
classical
letI lawProb (omega : Fin M → Bool) : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
let p := causalPackingFinitePartition centers w hdis
let Q : ∀ j : Fin M, Bool → Measure (FiniteSample (CausalObservation × ℝ)) :=
fun j b => causalPackingCellExperiment p laws (2 * n) j b
let R : Measure (Unit → FiniteSample (CausalObservation × ℝ)) :=
causalPackingCommonExperiment p laws (2 * n)
let μ (omega : Fin M → Bool) := R.prod (Measure.pi fun j => Q j (omega j))
let bad (omega : Fin M → Bool) :=
{data : (Unit → FiniteSample (CausalObservation × ℝ)) ×
(Fin M → FiniteSample (CausalObservation × ℝ)) |
∃ j, causalPackingPoissonDecoder T P0 centers values j
(compressCausalPackingCell P0 centers j (data.2 j)) data.2 data.1 ≠ omega j}
let risk (omega : Fin M → Bool) :=
∫⁻ data, blockCausalPackingPoissonLoss T P0 centers values omega data ∂μ omega
have hrisk (omega : Fin M → Bool) :
ofReal (delta / 2) * μ omega (bad omega) ≤ risk omega := by
rw [← setLIntegral_const]
calc
(∫⁻ _ in bad omega, ofReal (delta / 2) ∂μ omega) ≤
∫⁻ data in bad omega,
blockCausalPackingPoissonLoss T P0 centers values omega data ∂μ omega := by
apply setLIntegral_mono
(blockCausalPackingPoissonLoss_measurable T P0 centers values omega)
intro data hdata
obtain ⟨j, hj⟩ := hdata
unfold blockCausalPackingPoissonLoss
refine le_trans (ENNReal.ofReal_le_ofReal
(midpointDecoder_wrong_bit_error (values j)
(causalPackingPoissonValue T P0 centers j
(compressCausalPackingCell P0 centers j (data.2 j)) data.2 data.1)
delta (hsep j) (omega j) hj)) ?_
exact le_iSup (fun k : Fin M => ofReal
|causalPackingPoissonValue T P0 centers k
(compressCausalPackingCell P0 centers k (data.2 k)) data.2 data.1 -
values k (omega k)|) j
_ ≤ risk omega := setLIntegral_le_lintegral _ _
obtain ⟨omegaMax, -, hmax⟩ := Finset.exists_max_image
(Finset.univ : Finset (Fin M → Bool)) risk Finset.univ_nonempty
refine ⟨omegaMax, ?_⟩
have hsum : ofReal (delta / 2) *
(∑ omega : Fin M → Bool, μ omega (bad omega)) ≤
((2 : ℝ≥0∞) ^ M) * risk omegaMax := by
calc
ofReal (delta / 2) *
(∑ omega : Fin M → Bool, μ omega (bad omega)) =
∑ omega : Fin M → Bool,
ofReal (delta / 2) * μ omega (bad omega) := by
rw [Finset.mul_sum]
_ ≤ ∑ omega : Fin M → Bool, risk omega :=
Finset.sum_le_sum fun omega _ => hrisk omega
_ ≤ ∑ _omega : Fin M → Bool, risk omegaMax :=
Finset.sum_le_sum fun omega homega => hmax omega homega
_ = ((2 : ℝ≥0∞) ^ M) * risk omegaMax := by simp [Fintype.card_fun]
have hpow : (2 : ℝ≥0∞) ^ M ≠ 0 := pow_ne_zero _ (by norm_num)
have hpowtop : (2 : ℝ≥0∞) ^ M ≠ ⊤ :=
ENNReal.pow_ne_top ENNReal.ofNat_ne_top
have havg : ofReal (delta / 2) *
((∑ omega : Fin M → Bool, μ omega (bad omega)) /
((2 : ℝ≥0∞) ^ M)) ≤ risk omegaMax := by
rw [← mul_div_assoc]
apply (ENNReal.div_le_iff_le_mul (inl hpow) (inl hpowtop)).2
simpa [mul_comm] using hsum
have hsynth := causalPackingExperiment_synthesis_law centers w rho hdis laws
hrho hmass hlocal hoff (2 * n) omegaMax
have hriskEq : risk omegaMax =
∫⁻ s, globalCausalPackingPoissonLoss T P0 centers values omegaMax s
∂canonicalMarkedPoissonSampleLaw (laws omegaMax).law packingMarkLaw
(2 * n) := by
unfold risk μ R Q p
rw [← hsynth]
rw [lintegral_map'
(globalCausalPackingPoissonLoss_measurable T P0 centers values omegaMax).aemeasurable
synthesizeCausalPackingConfiguration_measurable.aemeasurable]
apply lintegral_congr
intro data
exact blockCausalPackingPoissonLoss_eq_global T P0 centers values omegaMax data
rw [← hriskEq]
simpa [coordinatewiseErrorProbability, Q, R, μ, bad, p] using havg
theorem globalCausalPackingPoissonLoss_eq_finitePackingLoss
On the successful count event the causal global Poisson loss is the finite packing loss of the retained sample.
Formal statement
hypotheses
M n :
ℕ
T :
rhoRule :
P0 P :
hgeometry :
knownGeometry P0 = knownGeometry P
hsection :
∀ w j,
rhoRule w (knownGeometry P) (centers j)
= T.map (knownGeometry P) (centers j) (signedDistanceData n P w (centers j))
hvalues :
∀ j, P.tau (centers j) = values j (omega j)
s :
hs :
n ≤ s.count
conclusion
globalCausalPackingPoissonLoss T P0 centers values omega s
= causalFinitePackingLoss rhoRule P centers (canonicalPrefixObservations (0, 0) n s)
Proof (Lean source)
-- @node: globalCausalPackingPoissonLoss_eq_finitePackingLoss
lemma globalCausalPackingPoissonLoss_eq_finitePackingLoss {M n : ℕ}
(T : A1A2PIRule n) (rhoRule : A1A2RuleFun n) (P0 P : A1A2Law)
(centers : Fin M → Score) (values : Fin M → Bool → ℝ)
(omega : Fin M → Bool)
(hgeometry : knownGeometry P0 = knownGeometry P)
(hsection : ∀ w j, rhoRule w (knownGeometry P) (centers j) =
T.map (knownGeometry P) (centers j) (signedDistanceData n P w (centers j)))
(hvalues : ∀ j, P.tau (centers j) = values j (omega j))
(s : FiniteSample (CausalObservation × ℝ)) (hs : n ≤ s.count) :
globalCausalPackingPoissonLoss T P0 centers values omega s =
causalFinitePackingLoss rhoRule P centers
(canonicalPrefixObservations (0, 0) n s) := by
unfold globalCausalPackingPoissonLoss causalFinitePackingLoss
congr 1
funext j
congr 2
rw [hvalues j, hsection]
unfold globalCausalPackingPoissonValue
rw [if_pos hs]
have hstat : causalPackingMarkedStatistic P0 (centers j) =
causalPackingMarkedStatistic P (centers j) := by
funext z
unfold causalPackingMarkedStatistic signedObservationAt observedOutcome treatment
have hA1 := congrArg GeometryData.A1 hgeometry
change P0.A1 = P.A1 at hA1
rw [hA1, hgeometry]
rw [hstat]
rw [hgeometry]
unfold signedDistanceData
unfold canonicalPrefixObservations
have hmap : n ≤ (finiteSampleMap
(causalPackingMarkedStatistic P (centers j)) s).count := by simpa
rw [dif_pos hmap, dif_pos hs]
rfl
theorem globalCausalPackingPoissonLoss_le_on_count_lt
Failed-count zero defaults are bounded by the target envelope.
Formal statement
hypotheses
M n :
ℕ
T :
P0 :
B :
ℝ
hB :
∀ j, |values j (omega j)| ≤ B
s :
hs :
s.count < n
conclusion
globalCausalPackingPoissonLoss T P0 centers values omega s ≤ ofReal B
Proof (Lean source)
-- @node: globalCausalPackingPoissonLoss_le_on_count_lt
lemma globalCausalPackingPoissonLoss_le_on_count_lt {M n : ℕ}
(T : A1A2PIRule n) (P0 : A1A2Law) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool)
(B : ℝ) (hB : ∀ j, |values j (omega j)| ≤ B)
(s : FiniteSample (CausalObservation × ℝ)) (hs : s.count < n) :
globalCausalPackingPoissonLoss T P0 centers values omega s ≤
ofReal B := by
unfold globalCausalPackingPoissonLoss
apply iSup_le
intro j
apply ENNReal.ofReal_le_ofReal
unfold globalCausalPackingPoissonValue
rw [if_neg (Nat.not_le_of_lt hs)]
simpa only [zero_sub, abs_neg] using hB j
theorem globalCausalPackingPoissonRisk_le_fixedRisk_add_tail
De-Poissonization for the causal finite packing maximum.
Formal statement
hypotheses
M n :
ℕ
T :
rhoRule :
P0 P :
hgeometry :
knownGeometry P0 = knownGeometry P
hsection :
∀ w j,
rhoRule w (knownGeometry P) (centers j)
= T.map (knownGeometry P) (centers j) (signedDistanceData n P w (centers j))
hvalues :
∀ j, P.tau (centers j) = values j (omega j)
hfiniteMeas :
Measurable (causalFinitePackingLoss rhoRule P centers)
B :
ℝ
hB :
∀ j, |values j (omega j)| ≤ B
conclusion
(letI : IsProbabilityMeasure P.law := P.law_isProbability ∫⁻ s, globalCausalPackingPoissonLoss T P0 centers values omega s ∂canonicalMarkedPoissonSampleLaw P.law packingMarkLaw (2 * n))
≤ (∫⁻ w, causalFinitePackingLoss rhoRule P centers w ∂causalSampleLaw P n)
Proof (Lean source)
-- @node: globalCausalPackingPoissonRisk_le_fixedRisk_add_tail
lemma globalCausalPackingPoissonRisk_le_fixedRisk_add_tail {M n : ℕ}
(T : A1A2PIRule n) (rhoRule : A1A2RuleFun n) (P0 P : A1A2Law)
(centers : Fin M → Score) (values : Fin M → Bool → ℝ)
(omega : Fin M → Bool)
(hgeometry : knownGeometry P0 = knownGeometry P)
(hsection : ∀ w j, rhoRule w (knownGeometry P) (centers j) =
T.map (knownGeometry P) (centers j) (signedDistanceData n P w (centers j)))
(hvalues : ∀ j, P.tau (centers j) = values j (omega j))
(hfiniteMeas : Measurable (causalFinitePackingLoss rhoRule P centers))
(B : ℝ) (hB : ∀ j, |values j (omega j)| ≤ B) :
(letI : IsProbabilityMeasure P.law := P.law_isProbability
∫⁻ s, globalCausalPackingPoissonLoss T P0 centers values omega s
∂canonicalMarkedPoissonSampleLaw P.law packingMarkLaw (2 * n)) ≤
(∫⁻ w, causalFinitePackingLoss rhoRule P centers w ∂causalSampleLaw P n) +
ofReal B *
ofReal (exp (-(n : ℝ) * (1 - log 2))) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
let μ := canonicalMarkedPoissonSampleLaw P.law packingMarkLaw (2 * n)
let success : Set (FiniteSample (CausalObservation × ℝ)) :=
FiniteSample.count ⁻¹' Ici n
have hsuccess : MeasurableSet success :=
measurable_finiteSample_count measurableSet_Ici
have hsplit := lintegral_add_compl
(globalCausalPackingPoissonLoss T P0 centers values omega) (μ := μ) hsuccess
rw [← hsplit]
apply add_le_add
· have hmap := map_canonicalPrefixObservations_restrict_count_ge
P.law packingMarkLaw (2 * n) (0, 0) n
have heq : ∫⁻ s in success,
globalCausalPackingPoissonLoss T P0 centers values omega s ∂μ =
∫⁻ s in success, causalFinitePackingLoss rhoRule P centers
(canonicalPrefixObservations (0, 0) n s) ∂μ := by
apply lintegral_congr_ae
filter_upwards [ae_restrict_mem hsuccess] with s hs
exact globalCausalPackingPoissonLoss_eq_finitePackingLoss T rhoRule P0 P
centers values omega hgeometry hsection hvalues s hs
rw [heq]
change (∫⁻ s, causalFinitePackingLoss rhoRule P centers
(canonicalPrefixObservations (0, 0) n s) ∂μ.restrict success) ≤ _
rw [← lintegral_map' hfiniteMeas.aemeasurable
(measurable_canonicalPrefixObservations (0, 0) n).aemeasurable]
rw [hmap, lintegral_smul_measure]
change (poissonMeasure (2 * n)) (Ici n) *
(∫⁻ w, causalFinitePackingLoss rhoRule P centers w ∂causalSampleLaw P n) ≤ _
exact mul_le_of_le_one_left (by positivity) prob_le_one
· calc
(∫⁻ s in successᶜ,
globalCausalPackingPoissonLoss T P0 centers values omega s ∂μ) ≤
∫⁻ _s in successᶜ, ofReal B ∂μ := by
apply setLIntegral_mono measurable_const
intro s hs
apply globalCausalPackingPoissonLoss_le_on_count_lt
T P0 centers values omega B hB s
simpa [success] using hs
_ = ofReal B * μ successᶜ := setLIntegral_const _ _
_ ≤ ofReal B *
ofReal (exp (-(n : ℝ) * (1 - log 2))) := by
gcongr
have hcount := canonicalMarkedPoissonSampleLaw_map_count
P.law packingMarkLaw (2 * n)
have hfail : μ successᶜ = (poissonMeasure (2 * n)) {k | k < n} := by
rw [← hcount]
rw [Measure.map_apply measurable_finiteSample_count (by measurability)]
congr 1
ext s
simp [success]
rw [hfail]
exact poisson_two_n_lower_tail n
Causal.Hypercube.BernoulliKernel 5 declarations This module supplies the bounded selected conditional kernels used by the potential-outcome angular construction.
Pointwise Bernoulli kernels for the causal hard family
This module supplies the bounded selected conditional kernels used by the potential-outcome angular construction. Unlike the Gaussian-noise kernels in the support-boundary family, these kernels obey every finite conditional moment envelope uniformly in the exponent.
The real-valued Bernoulli kernel with measurable success-probability profile p.
Definition (Lean source)
-- @node: causalSelectedBernoulliKernel
noncomputable def causalSelectedBernoulliKernel
(p : Score → ℝ) (hp : Measurable p) : Kernel Score ℝ where
toFun x := bernoulliLaw (p x)
measurable' := by
unfold bernoulliLaw
fun_prop
theorem causalSelectedBernoulliKernel_isMarkovKernel
A unit-range success-probability profile makes the selected Bernoulli kernel Markov.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: causalSelectedBernoulliKernel_isMarkovKernel
lemma causalSelectedBernoulliKernel_isMarkovKernel
(p : Score → ℝ) (hp : Measurable p)
(hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1) :
IsMarkovKernel (causalSelectedBernoulliKernel p hp) := by
constructor
intro x
exact bernoulliLaw_isProbabilityMeasure
(hp0 x) (hp1 x)
theorem causalSelectedBernoulliKernel_integral_id
The selected Bernoulli kernel has pointwise mean equal to its supplied success-probability profile.
Formal statement
hypotheses
conclusion
∫ y, y ∂causalSelectedBernoulliKernel p hp x = p x
Proof (Lean source)
-- @node: causalSelectedBernoulliKernel_integral_id
lemma causalSelectedBernoulliKernel_integral_id
(p : Score → ℝ) (hp : Measurable p)
(hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1) (x : Score) :
∫ y, y ∂causalSelectedBernoulliKernel p hp x = p x := by
change ∫ y, y ∂Causalean.Mathlib.Probability.bernoulliLaw (p x) = p x
rw [bernoulliLaw_integral
(hp0 x) (hp1 x)]
ring
theorem causalSelectedBernoulliKernel_variance_id
The selected Bernoulli kernel has pointwise variance p(x)(1-p(x)).
Formal statement
hypotheses
conclusion
variance id (causalSelectedBernoulliKernel p hp x) = p x * (1 - p x)
Proof (Lean source)
-- @node: causalSelectedBernoulliKernel_variance_id
lemma causalSelectedBernoulliKernel_variance_id
(p : Score → ℝ) (hp : Measurable p)
(hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1) (x : Score) :
variance id (causalSelectedBernoulliKernel p hp x) = p x * (1 - p x) := by
change variance id (bernoulliLaw (p x)) = _
letI : IsProbabilityMeasure (causalSelectedBernoulliKernel p hp x) :=
bernoulliLaw_isProbabilityMeasure
(hp0 x) (hp1 x)
have hmean :
∫ y, id y ∂Causalean.Mathlib.Probability.bernoulliLaw (p x) = p x := by
rw [bernoulliLaw_integral
(hp0 x) (hp1 x)]
simp only [id_eq]
ring
rw [variance_eq_integral measurable_id.aemeasurable]
rw [hmean]
rw [bernoulliLaw_integral
(hp0 x) (hp1 x)]
simp only [id_eq]
ring
theorem causalSelectedBernoulliKernel_condAbsMoment_le_one
Every pointwise absolute moment of order at least four equals the success probability and is therefore at most one.
Formal statement
hypotheses
conclusion
(∫⁻ y, ofReal (|y| ^ (2 + ν)) ∂causalSelectedBernoulliKernel p hp x) ≤ 1
Proof (Lean source)
-- @node: causalSelectedBernoulliKernel_condAbsMoment_le_one
lemma causalSelectedBernoulliKernel_condAbsMoment_le_one
(p : Score → ℝ) (hp : Measurable p)
(hp1 : ∀ x, p x ≤ 1)
{ν : ℝ} (hν : 2 ≤ ν) (x : Score) :
(∫⁻ y, ofReal (|y| ^ (2 + ν))
∂causalSelectedBernoulliKernel p hp x) ≤ 1 := by
change (∫⁻ y, ofReal (|y| ^ (2 + ν))
∂Causalean.Mathlib.Probability.bernoulliLaw (p x)) ≤ 1
rw [bernoulliLaw_lintegral_ofReal]
have hexp : 2 + ν ≠ 0 := by linarith
simp [hexp, hp1 x]
Causal.Hypercube.Density 1 declarations Density and angular cancellation certificates for the hard family
Density and angular cancellation certificates for the hard family
theorem a1a2Hypercube_density_and_mass
The hypercube certificate includes uniform density and cell-mass control for every vertex.
Formal statement
hypotheses
Proof (Lean source)
lemma a1a2Hypercube_density_and_mass
(p : ℕ) (ν L Δ c A C C0 : ℝ)
(h : A1A2HypercubeAt p ν L Δ c A C C0) :
∃ P : A1A2Law, A1A2Class p ν L P := by
rcases h with
⟨M, w, ρ, x, P, Q, hc, hA, hC, hC0, hp0, hρ, hM, hw, hρeq,
hx, hcell, hsep, hdisjoint, hclass, _⟩
exact ⟨P (fun _ => false), hclass _⟩
Causal.Hypercube.Design 8 declarations The predicate in this file records the whole certified least-favourable family: common geometry, class membership, disjoint local cells, locality, target separation, radial agreement, and the two directed KL bounds.
Fixed-geometry angular hypercube
The predicate in this file records the whole certified least-favourable family: common geometry, class membership, disjoint local cells, locality, target separation, radial agreement, and the two directed KL bounds.
def A1A2HypercubeAt
All quantitative certificates supplied by the rectangle-angular hypercube at separation Δ.
Definition (Lean source)
def A1A2HypercubeAt (p : ℕ) (ν L Δ c A C C0 : ℝ) : Prop :=
∃ (M : ℕ) (w ρ : ℝ)
(x : Fin M → Score) (P : (Fin M → Bool) → A1A2Law)
(Q : Fin M → Bool → Measure (ℝ × ℝ)),
0 < c ∧ 0 < A ∧ 0 < C ∧ 0 < C0 ∧ (p = 0 → 2 * C < A) ∧ 0 < ρ ∧
(M : ℝ) ≥ c * rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
w = A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) ∧
ρ = pi * w ^ 2 / 36 ∧
(∀ j, x j ∈ causalHardBottomEdge) ∧
(∀ j, causalHardCell (x j) w ⊆ causalHardSquare) ∧
(∀ j k, j ≠ k → dist (x j) (x k) ≥ 2 * w) ∧
(∀ j k, j ≠ k → Disjoint (causalHardCell (x j) w)
(causalHardCell (x k) w)) ∧
(∀ ω, A1A2Class p ν L (P ω)) ∧
(∀ ω, (P ω).support = causalHardSquare ∧
(P ω).A1 = causalHardArmOne ∧
(P ω).A0 = causalHardSquare \ causalHardArmOne ∧
(P ω).boundary = frontier causalHardArmOne) ∧
(∀ ω j, (P ω).law {z | causalScore z ∈ causalHardCell (x j) w} =
ofReal ρ) ∧
(∀ ω ω' j, ω j = ω' j →
(P ω).law.restrict {z | causalScore z ∈ causalHardCell (x j) w} =
(P ω').law.restrict {z | causalScore z ∈ causalHardCell (x j) w}) ∧
(∀ ω ω', (P ω).law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (x j) w} =
(P ω').law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (x j) w}) ∧
(∀ j b, IsProbabilityMeasure (Q j b)) ∧
(∀ ω j, Measure.map (signedObservationAt (P ω) (x j))
((P ω).law.restrict {z | causalScore z ∈ causalHardCell (x j) w}) =
ofReal ρ • Q j (ω j)) ∧
(∀ ω ω' j, ω j = ω' j → (P ω).tau (x j) = (P ω').tau (x j)) ∧
(∀ ω j, |(P ω).tau (x j) -
(P (update ω j (!ω j))).tau (x j)| = Δ) ∧
(∀ j, Measure.map snd (Q j false) = Measure.map snd (Q j true)) ∧
(∀ j, (Q j false).restrict
{yd | ¬ (0 < yd.2 ∧ yd.2 < 2 * C * Δ)} =
(Q j true).restrict {yd | ¬ (0 < yd.2 ∧ yd.2 < 2 * C * Δ)}) ∧
(∀ j, klDiv (Q j false) (Q j true) ≤
ofReal (C0 * Δ ^ 4 / w ^ 2)) ∧
(∀ j, klDiv (Q j true) (Q j false) ≤
ofReal (C0 * Δ ^ 4 / w ^ 2))
theorem causalHardConstructionBandwidthConstant
A single order-dependent bandwidth constant dominates every normalized bump derivative needed through order p + 1 and is strictly larger than the twice-cutoff threshold used in the order-zero construction.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ A : ℝ
if
256 < A ∧ 1 ≤ A ∧ ∀ j, j ≤ p + 1
then
Proof (Lean source)
-- @node: causalHardConstructionBandwidthConstant
lemma causalHardConstructionBandwidthConstant (p : ℕ) :
∃ A : ℝ, 256 < A ∧ 1 ≤ A ∧
∀ j, j ≤ p + 1 → packingBumpDerivativeBound j ≤ A := by
refine ⟨257 + packingBumpDerivativeScale (p + 1), ?_, ?_, ?_⟩
· have hscale := packingBumpDerivativeScale_pos (p + 1)
linarith
· have hscale := packingBumpDerivativeScale_pos (p + 1)
linarith
· intro j hj
exact (packingBumpDerivativeBound_le_scale hj).trans (by linarith)
theorem causalHardPowerBandwidthEventuallySmall Lemma causalHardPowerBandwidthEventuallySmall in the paper ↗
For a fixed positive bandwidth constant, the power-law bandwidth is at most 1/24 throughout a sufficiently small positive separation interval.
Formal statement
hypotheses
p :
ℕ
A :
ℝ
hA :
0 < A
conclusion
∃ δ0 : ℝ
if
0 < δ0 ∧ ∀ Δ : ℝ, 0 < Δ
and
Δ ≤ δ0
then
Δ ≤ 1 / 16 ∧ Δ * A ≤ 1 ∧ A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) ≤ 1 / 24
Proof (Lean source)
-- @node: causalHardPowerBandwidthEventuallySmall
lemma causalHardPowerBandwidthEventuallySmall (p : ℕ) {A : ℝ}
(hA : 0 < A) :
∃ δ0 : ℝ, 0 < δ0 ∧ ∀ Δ : ℝ, 0 < Δ → Δ ≤ δ0 →
Δ ≤ 1 / 16 ∧ Δ * A ≤ 1 ∧
A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) ≤ 1 / 24 := by
have he : 0 < (1 : ℝ) / (p + 1 : ℝ) := by positivity
have hcont : ContinuousAt
(fun Δ : ℝ => A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))) 0 := by
have hp : ContinuousAt
(fun Δ : ℝ => (Δ, (1 : ℝ) / (p + 1 : ℝ))) 0 :=
continuousAt_id.prodMk continuousAt_const
have hr := (Real.continuousAt_rpow_of_pos
(0, (1 : ℝ) / (p + 1 : ℝ)) he).comp_of_eq hp rfl
exact continuousAt_const.mul hr
rw [Metric.continuousAt_iff] at hcont
obtain ⟨δ, hδ, hδmap⟩ := hcont (1 / 24) (by norm_num)
refine ⟨min (min (δ / 2) (1 / 16)) A⁻¹,
lt_min (lt_min (half_pos hδ) (by norm_num)) (inv_pos.mpr hA), ?_⟩
intro Δ hΔ hΔ0
have hsmall : Δ ≤ 1 / 16 := hΔ0.trans (min_le_left _ _ |>.trans (min_le_right _ _))
have hscale : Δ * A ≤ 1 := by
have hΔA : Δ ≤ A⁻¹ := hΔ0.trans (min_le_right _ _)
calc
Δ * A ≤ A⁻¹ * A := mul_le_mul_of_nonneg_right hΔA hA.le
_ = 1 := inv_mul_cancel₀ hA.ne'
have hdist : dist Δ 0 < δ := by
rw [Real.dist_eq, sub_zero, abs_of_pos hΔ]
exact hΔ0.trans_lt
(min_le_left _ _ |>.trans (min_le_left _ _) |>.trans_lt (half_lt_self hδ))
have hm := hδmap hdist
have hz : rpow 0 ((1 : ℝ) / (p + 1 : ℝ)) = 0 :=
(Real.rpow_eq_zero le_rfl (ne_of_gt he)).2 rfl
rw [hz, mul_zero, dist_zero_right, Real.norm_eq_abs] at hm
have hnonneg : 0 ≤ A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) :=
mul_nonneg hA.le (Real.rpow_nonneg hΔ.le _)
rw [abs_of_nonneg hnonneg] at hm
exact ⟨hsmall, hscale, hm.le⟩
theorem causalHardSmoothGridPackage
The order-dependent constant and a small-separation interval jointly provide the scaled grid and the treatment-profile smooth-extension certificate. These are the geometric and smoothness leaves of the final hypercube constructor.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ A δ0 : ℝ
if
256 < A ∧ 0 < δ0 ∧ ∀ Δ : ℝ, 0 < Δ
and
Δ ≤ δ0
and
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) let M := angularGridSize w 0 < w ∧
(M : ℝ) ≥ (1 / (24 * A)) * rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ i j : Fin M, i ≠ j → Disjoint (causalHardCell (causalHardGridCenter M i) w) (causalHardCell (causalHardGridCenter M j) w)) ∧
∀ omega : Fin M
then
Bool, EuclideanCExtEnvelope (causalHardTreatmentProfile Δ w (causalHardGridCenter M) omega) p 48 causalHardSquare
Proof (Lean source)
-- @node: causalHardSmoothGridPackage
lemma causalHardSmoothGridPackage (p : ℕ) :
∃ A δ0 : ℝ, 256 < A ∧ 0 < δ0 ∧
∀ Δ : ℝ, 0 < Δ → Δ ≤ δ0 →
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
0 < w ∧
(M : ℝ) ≥ (1 / (24 * A)) *
rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ j : Fin M, causalHardGridCenter M j ∈ causalHardBottomEdge) ∧
(∀ j : Fin M,
causalHardCell (causalHardGridCenter M j) w ⊆ causalHardSquare) ∧
(∀ i j : Fin M, i ≠ j →
3 * w ≤ dist (causalHardGridCenter M i)
(causalHardGridCenter M j)) ∧
(∀ i j : Fin M, i ≠ j →
Disjoint (causalHardCell (causalHardGridCenter M i) w)
(causalHardCell (causalHardGridCenter M j) w)) ∧
∀ omega : Fin M → Bool,
EuclideanCExtEnvelope
(causalHardTreatmentProfile Δ w
(causalHardGridCenter M) omega)
p 48 causalHardSquare := by
obtain ⟨A, hA16, hA1, hderiv⟩ :=
causalHardConstructionBandwidthConstant p
obtain ⟨δ0, hδ0, hsmall⟩ :=
causalHardPowerBandwidthEventuallySmall p (lt_trans (by norm_num) hA16)
refine ⟨A, δ0, hA16, hδ0, ?_⟩
intro Δ hΔ hΔ0
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
obtain ⟨hΔsmall, hΔscale, hwsmall⟩ := hsmall Δ hΔ hΔ0
have hgeom := causalHardGrid_scaled_family_geometry p
(lt_trans (by norm_num) hA16) hΔ hwsmall
refine ⟨hgeom.1, hgeom.2.1, hgeom.2.2.2.1,
hgeom.2.2.2.2.1, hgeom.2.2.2.2.2.1,
hgeom.2.2.2.2.2.2, ?_⟩
intro omega
apply causalHardTreatmentProfile_euclideanCExtEnvelope_powerBandwidth
p (by norm_num) hA1 hΔ hΔsmall hgeom.2.2.2.2.2.1 omega hderiv
calc
Δ * packingBumpDerivativeBound 0 ≤ Δ * A :=
mul_le_mul_of_nonneg_left (hderiv 0 (by omega)) hΔ.le
_ ≤ 1 := hΔscale
theorem causalHardHypercubeConstructorPrefix
The geometric/smooth package supplies constructor-ready positive packing and cutoff constants. In particular, the cutoff is strictly below half the bandwidth constant, as required in the order-zero branch.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ c A C δ0 : ℝ
if
0 < c ∧ 0 < A ∧ 0 < C ∧ (p = 0 → 2 * C < A) ∧ 0 < δ0 ∧ ∀ Δ : ℝ, 0 < Δ
and
Δ ≤ δ0
and
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) let M := angularGridSize w 0 < w ∧
(M : ℝ) ≥ c * rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ i j : Fin M, i ≠ j → Disjoint (causalHardCell (causalHardGridCenter M i) w) (causalHardCell (causalHardGridCenter M j) w)) ∧
∀ omega : Fin M
then
Bool, EuclideanCExtEnvelope (causalHardTreatmentProfile Δ w (causalHardGridCenter M) omega) p 48 causalHardSquare
Proof (Lean source)
-- @node: causalHardHypercubeConstructorPrefix
lemma causalHardHypercubeConstructorPrefix (p : ℕ) :
∃ c A C δ0 : ℝ,
0 < c ∧ 0 < A ∧ 0 < C ∧ (p = 0 → 2 * C < A) ∧ 0 < δ0 ∧
∀ Δ : ℝ, 0 < Δ → Δ ≤ δ0 →
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
0 < w ∧
(M : ℝ) ≥ c *
rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ j : Fin M, causalHardGridCenter M j ∈ causalHardBottomEdge) ∧
(∀ j : Fin M,
causalHardCell (causalHardGridCenter M j) w ⊆ causalHardSquare) ∧
(∀ i j : Fin M, i ≠ j →
3 * w ≤ dist (causalHardGridCenter M i)
(causalHardGridCenter M j)) ∧
(∀ i j : Fin M, i ≠ j →
Disjoint (causalHardCell (causalHardGridCenter M i) w)
(causalHardCell (causalHardGridCenter M j) w)) ∧
∀ omega : Fin M → Bool,
EuclideanCExtEnvelope
(causalHardTreatmentProfile Δ w
(causalHardGridCenter M) omega)
p 48 causalHardSquare := by
obtain ⟨A, δ0, hA, hδ0, hpackage⟩ := causalHardSmoothGridPackage p
refine ⟨1 / (24 * A), A, 128, δ0, ?_, by linarith, by norm_num, ?_, hδ0, ?_⟩
· positivity
· intro _
linarith
· intro Δ hΔ hΔ0
simpa using hpackage Δ hΔ hΔ0
theorem causalHardHypercubeConstructorData
The constructor prefix with the quantitative small-separation facts kept explicit. These bounds are the common input to the Bernoulli variance, complete-cell, and localized signed-radius certificates in the final hypercube assembly.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ c A C δ0 : ℝ
if
0 < c ∧ 256 < A ∧ 0 < C ∧ (p = 0 → 2 * C < A) ∧ 0 < δ0 ∧ ∀ Δ : ℝ, 0 < Δ
and
Δ ≤ δ0
and
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) let M := angularGridSize w Δ ≤ 1 / 16 ∧
Δ * A ≤ 1 ∧
w ≤ 1 / 24 ∧
0 < w ∧
(M : ℝ) ≥ c * rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ i j : Fin M, i ≠ j → Disjoint (causalHardCell (causalHardGridCenter M i) w) (causalHardCell (causalHardGridCenter M j) w)) ∧
∀ omega : Fin M
then
Bool, EuclideanCExtEnvelope (causalHardTreatmentProfile Δ w (causalHardGridCenter M) omega) p 48 causalHardSquare
Proof (Lean source)
-- @node: causalHardHypercubeConstructorData
lemma causalHardHypercubeConstructorData (p : ℕ) :
∃ c A C δ0 : ℝ,
0 < c ∧ 256 < A ∧ 0 < C ∧ (p = 0 → 2 * C < A) ∧ 0 < δ0 ∧
∀ Δ : ℝ, 0 < Δ → Δ ≤ δ0 →
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
Δ ≤ 1 / 16 ∧ Δ * A ≤ 1 ∧ w ≤ 1 / 24 ∧ 0 < w ∧
(M : ℝ) ≥ c *
rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ j : Fin M, causalHardGridCenter M j ∈ causalHardBottomEdge) ∧
(∀ j : Fin M,
causalHardCell (causalHardGridCenter M j) w ⊆ causalHardSquare) ∧
(∀ i j : Fin M, i ≠ j →
3 * w ≤ dist (causalHardGridCenter M i)
(causalHardGridCenter M j)) ∧
(∀ i j : Fin M, i ≠ j →
Disjoint (causalHardCell (causalHardGridCenter M i) w)
(causalHardCell (causalHardGridCenter M j) w)) ∧
∀ omega : Fin M → Bool,
EuclideanCExtEnvelope
(causalHardTreatmentProfile Δ w
(causalHardGridCenter M) omega)
p 48 causalHardSquare := by
obtain ⟨A, hA16, hA1, hderiv⟩ :=
causalHardConstructionBandwidthConstant p
have hA0 : 0 < A := lt_trans (by norm_num) hA16
obtain ⟨δ0, hδ0, hsmall⟩ :=
causalHardPowerBandwidthEventuallySmall p hA0
refine ⟨1 / (24 * A), A, 128, δ0, ?_, hA16, by norm_num, ?_, hδ0, ?_⟩
· positivity
· intro _
linarith
· intro Δ hΔ hΔ0
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
obtain ⟨hΔsmall, hΔscale, hwsmall⟩ := hsmall Δ hΔ hΔ0
have hgeom := causalHardGrid_scaled_family_geometry p hA0 hΔ hwsmall
refine ⟨hΔsmall, hΔscale, hwsmall, hgeom.1, hgeom.2.1,
hgeom.2.2.2.1, hgeom.2.2.2.2.1, hgeom.2.2.2.2.2.1,
hgeom.2.2.2.2.2.2, ?_⟩
intro omega
apply causalHardTreatmentProfile_euclideanCExtEnvelope_powerBandwidth
p (by norm_num) hA1 hΔ hΔsmall hgeom.2.2.2.2.2.1 omega hderiv
calc
Δ * packingBumpDerivativeBound 0 ≤ Δ * A :=
mul_le_mul_of_nonneg_left (hderiv 0 (by omega)) hΔ.le
_ ≤ 1 := hΔscale
theorem causalHardHypercubeAt_of_constructorData
The constructor data, analytic certificates, and normalized signed-cell comparison assemble into the complete hypercube predicate.
Formal statement
hypotheses
p :
ℕ
L0 L ν c A δ0 Δ :
ℝ
hL0 :
48 ≤ L0
hGram :
∀ L : ℝ
if
L0 ≤ L
then
∀ {M : ℕ} (b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool) (hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w) (hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k)) (hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare),
PopulationGramFloor (causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell) p L
hν :
2 ≤ ν
hL :
L0 ≤ L
hc :
0 < c
hA :
0 < A
hA256 :
256 < A
hδ0 :
0 < δ0
hΔ :
0 < Δ
hΔ0 :
Δ ≤ δ0
hdata :
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) let M := angularGridSize w Δ ≤ 1 / 16 ∧
Δ * A ≤ 1 ∧
w ≤ 1 / 24 ∧
0 < w ∧
(M : ℝ) ≥ c * rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ i j : Fin M, i ≠ j → Disjoint (causalHardCell (causalHardGridCenter M i) w) (causalHardCell (causalHardGridCenter M j) w)) ∧
EuclideanCExtEnvelope (causalHardTreatmentProfile Δ w (causalHardGridCenter M) omega) p 48 causalHardSquare
conclusion
A1A2HypercubeAt p ν L Δ c A 128 262144
Proof (Lean source)
-- @node: causalHardHypercubeAt_of_constructorData
lemma causalHardHypercubeAt_of_constructorData (p : ℕ) {L0 L ν c A δ0 Δ : ℝ}
(hL0 : 48 ≤ L0)
(hGram : ∀ L : ℝ, L0 ≤ L →
∀ {M : ℕ} (b cA delta w : ℝ) (centers : Fin M → Score)
(omega : Fin M → Bool) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare),
PopulationGramFloor
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell) p L)
(hν : 2 ≤ ν) (hL : L0 ≤ L) (hc : 0 < c) (hA : 0 < A)
(hA256 : 256 < A) (hδ0 : 0 < δ0) (hΔ : 0 < Δ) (hΔ0 : Δ ≤ δ0)
(hdata :
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
Δ ≤ 1 / 16 ∧ Δ * A ≤ 1 ∧ w ≤ 1 / 24 ∧ 0 < w ∧
(M : ℝ) ≥ c * rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ j : Fin M, causalHardGridCenter M j ∈ causalHardBottomEdge) ∧
(∀ j : Fin M, causalHardCell (causalHardGridCenter M j) w ⊆
causalHardSquare) ∧
(∀ i j : Fin M, i ≠ j →
3 * w ≤ dist (causalHardGridCenter M i) (causalHardGridCenter M j)) ∧
(∀ i j : Fin M, i ≠ j →
Disjoint (causalHardCell (causalHardGridCenter M i) w)
(causalHardCell (causalHardGridCenter M j) w)) ∧
∀ omega : Fin M → Bool,
EuclideanCExtEnvelope
(causalHardTreatmentProfile Δ w (causalHardGridCenter M) omega)
p 48 causalHardSquare) :
A1A2HypercubeAt p ν L Δ c A 128 262144 := by
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
let centers : Fin M → Score := causalHardGridCenter M
obtain ⟨hΔsmall, hΔscale, hwsmall, hw, hM, hcenter, hcell, hsep,
hdisjoint, hsmooth⟩ := hdata
have hL48 : 48 ≤ L := hL0.trans hL
have hb : (0 : ℝ) < 1 / 16 := by norm_num
have hscale : (0 : ℝ) < 8 * Δ := by positivity
let P := fun omega => causalHardA1A2Law (1 / 16) 8 Δ w centers omega
hb hscale (by norm_num) hΔ hw hsep hcell
let Q := fun j bit => causalHardCellBitObservationLaw (1 / 16) 8 Δ w centers
hb hscale (by norm_num) hΔ hw hsep hcell j bit
have hvertex := causalHardA1A2Law_vertex_core (1 / 16) 8 Δ w centers hb
hscale (by norm_num) hΔ hΔsmall hw hsep
(fun j => hcell j (Metric.mem_closedBall_self hw.le)) hcell
dsimp only at hvertex
refine ⟨M, w, pi * w ^ 2 / 36, centers, P, Q,
hc, hA, by norm_num, by norm_num, ?_, ?_, hM, rfl, rfl,
hcenter, hcell, ?_, hdisjoint, ?_, hvertex.1, hvertex.2.1,
hvertex.2.2.1, hvertex.2.2.2.1, ?_, ?_, ?_, hvertex.2.2.2.2,
?_, ?_, ?_, ?_⟩
· intro hp0
linarith
· positivity
· intro j k hjk
exact (by linarith [hsep j k hjk])
· intro omega
apply causalHardA1A2Law_mem_class_of_analytic_certificates p ν L
(1 / 16) 8 Δ w centers omega hb hscale (by norm_num) hΔ hΔsmall hw
hsep hcell hν hL48
· obtain ⟨U, hUopen, hsub, g, hgdiff, hgeq, hbdd, hbddLip, henv⟩ :=
hsmooth omega
refine ⟨U, hUopen, hsub, g, hgdiff, ?_, hbdd, hbddLip,
henv.trans hL48⟩
exact hgeq
· exact hGram L hL (1 / 16) 8 Δ w centers omega hb hscale
(by norm_num) hΔ hw hsep hcell
· exact causalHardA1A2Law_localMass_certificate (1 / 16) 8 Δ w centers
omega hb hscale (by norm_num) hΔ hw hsep hcell hL48
· exact causalHardA1A2Law_slice_certificate (1 / 16) 8 Δ w centers omega
hb hscale (by norm_num) hΔ hw hsep hcell hL48
· intro j bit
dsimp [Q]
infer_instance
· intro omega j
exact causalHardCellSignedObservationMeasure_eq_bitLaw j (1 / 16) 8 Δ w
centers omega hb hscale (by norm_num) hΔ hw hsep hcell
· intro omega omega' j hbit
exact causalHardA1A2Law_tau_center_eq_of_bit_eq j (1 / 16) 8 Δ w
centers omega omega' hb hscale (by norm_num) hΔ hΔsmall hw hsep
(fun k => hcell k (Metric.mem_closedBall_self hw.le)) hcell hbit
· intro j
exact causalHardCellBitObservationLaw_common_signedMarginal j (1 / 16) 8 Δ w
centers hb hscale (by norm_num) hΔ hw (hwsmall.trans (by norm_num))
hsep (hcenter j) hcell
· intro j
have hout := causalHardCellBitObservationLaw_restrict_compl_eq j centers
(b := 1 / 16) (cA := 8) (delta := Δ) (w := w) rfl hb hscale
(by norm_num) hΔ hΔsmall hw (hwsmall.trans (by norm_num)) hsep
(hcenter j) hcell
have hcut : 2 * (8 * Δ) / (1 / 16 : ℝ) = 2 * 128 * Δ := by ring
simpa only [hcut] using hout
· intro j
exact (causalHardCellBitObservationLaw_klDiv_le j centers hΔ hΔsmall hw
(hwsmall.trans (by norm_num)) hsep (hcenter j) hcell).1
· intro j
exact (causalHardCellBitObservationLaw_klDiv_le j centers hΔ hΔsmall hw
(hwsmall.trans (by norm_num)) hsep (hcenter j) hcell).2
For every local-polynomial order, all sufficiently small separations allow the fixed-square, fixed-assignment rectangle-angular hypercube.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ L0 : ℝ,
48 ≤ L0 ∧
∀ ν : ℝ,
2
≤ ν → ∀ L : ℝ, L0 ≤ L → ∃ c A C C0 : ℝ, 0 < c ∧ 0 < A ∧ 0 < C ∧ 0 < C0 ∧ (p = 0 → 2 * C < A) ∧ ∃ δ0 : ℝ, 0 < δ0 ∧ ∀ Δ : ℝ, 0 < Δ → Δ ≤ δ0 → A1A2HypercubeAt p ν L Δ c A C C0
Proof (Lean source)
lemma cty_a1_a2_rectangle_angular_hypercube (p : ℕ) :
∃ L0 : ℝ, 48 ≤ L0 ∧ ∀ ν : ℝ, 2 ≤ ν → ∀ L : ℝ, L0 ≤ L →
∃ c A C C0 : ℝ,
0 < c ∧ 0 < A ∧ 0 < C ∧ 0 < C0 ∧ (p = 0 → 2 * C < A) ∧
∃ δ0 : ℝ, 0 < δ0 ∧ ∀ Δ : ℝ, 0 < Δ → Δ ≤ δ0 →
A1A2HypercubeAt p ν L Δ c A C C0 := by
obtain ⟨LGram, hLGram48, hGram⟩ :=
causalHardA1A2Law_populationGram_certificate p
obtain ⟨c, A, C, δ0, hc, hA, hC, hp0, hδ0, hdata⟩ :=
causalHardHypercubeConstructorData p
have hApos : 0 < A := lt_trans (by norm_num) hA
refine ⟨LGram, hLGram48, ?_⟩
intro ν hν L hL
refine ⟨c, A, 128, 262144, hc, hApos, by norm_num, by norm_num, ?_,
δ0, hδ0, ?_⟩
· intro hp
have := hp0 hp
norm_num at this ⊢
linarith
· intro Δ hΔ hΔ0
apply causalHardHypercubeAt_of_constructorData p hLGram48 hGram hν hL
hc hApos hA
· exact hδ0
· exact hΔ
· exact hΔ0
· exact hdata Δ hΔ hΔ0
Causal.Hypercube.Divergence 1 declarations Adjacent signed-radius locality and divergence certificates
Adjacent signed-radius locality and divergence certificates
theorem a1a2Hypercube_has_adjacent_KL
The hard-family predicate exposes a two-sided adjacent KL certificate at the Δ⁴/w² scale, together with common signed-radius marginals.
Formal statement
Proof (Lean source)
lemma a1a2Hypercube_has_adjacent_KL
(p : ℕ) (ν L Δ c A C C0 : ℝ)
(h : A1A2HypercubeAt p ν L Δ c A C C0) :
∃ Q0 Q1 : Measure (ℝ × ℝ),
Measure.map snd Q0 = Measure.map snd Q1 ∧
klDiv Q0 Q1 ≠ ⊤ ∧
klDiv Q1 Q0 ≠ ⊤ := by
rcases h with
⟨M, w, ρ, x, P, Q, hc, hA, hC, hC0, hp0, hρ, hM, hw, hρeq,
hx, hcell, hsep, hdisjoint, hclass, hgeom, hmass, hlocal, hoff,
hprob, hmap, _htargetLocal, htau, hradius, htail, hkl01, hkl10⟩
by_cases hM0 : M = 0
· subst M
let R : Measure (ℝ × ℝ) := Measure.dirac (0, 0)
refine ⟨R, R, rfl, ?_, ?_⟩
· simp [R]
· simp [R]
· let j : Fin M := ⟨0, Nat.pos_of_ne_zero hM0⟩
refine ⟨Q j false, Q j true, hradius j, ?_, ?_⟩
· exact ne_top_of_le_ne_top (by simp) (hkl01 j)
· exact ne_top_of_le_ne_top (by simp) (hkl10 j)
Causal.Hypercube.Family 17 declarations This module packages the normalized angular score measure and the two Bernoulli profiles into the selected-kernel potential-outcome law used at each hypercube vertex.
Decorated laws in the causal hard family
This module packages the normalized angular score measure and the two Bernoulli profiles into the selected-kernel potential-outcome law used at each hypercube vertex.
The causal hard law at one Boolean vertex. Its score marginal is the angular design on the fixed square and its selected arm kernels are exactly the Bernoulli kernels used to construct the joint potential-outcome law.
Definition (Lean source)
-- @node: causalHardA1A2Law
noncomputable def causalHardA1A2Law {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare) : A1A2Law := by
let nu := causalHardScoreMeasure b cA delta w centers omega
let p0 := causalHardControlProfile
let p1 := causalHardTreatmentProfile delta w centers omega
have hp := causalHardProfiles_measurable delta w centers omega
letI : IsProbabilityMeasure nu :=
causalHardScoreMeasure_isProbabilityMeasure centers omega hb hscale hcA
hdelta hw hsep hcell
exact causalBernoulliA1A2Law nu causalHardSquare
(causalHardSquare \ causalHardArmOne) causalHardArmOne
(frontier causalHardArmOne)
(causalHardScoreDensity b cA delta w centers omega) p0 p1
hp.1 hp.2
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).1.1)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).1.2)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).2.1)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).2.2)
causalHardArmZero_measurableSet causalHardArmOne_measurableSet
causalHardAssignment_partition causalHardAssignment_frontier.symm
causalHardFrontier_compact_and_interior.2 rfl
(causalHardScoreMeasure_support centers omega hb hscale hcA hdelta hw hsep).symm
theorem causalHardA1A2Law_geometry
Every vertex law has the prescribed common support and assignment geometry.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
conclusion
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell P.support
= causalHardSquare ∧
P.A1 = causalHardArmOne ∧
P.A0 = causalHardSquare \ causalHardArmOne ∧
P.boundary = frontier causalHardArmOne
Proof (Lean source)
-- @node: causalHardA1A2Law_geometry
lemma causalHardA1A2Law_geometry {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare) :
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
P.support = causalHardSquare ∧
P.A1 = causalHardArmOne ∧
P.A0 = causalHardSquare \ causalHardArmOne ∧
P.boundary = frontier causalHardArmOne := by
simp [causalHardA1A2Law, causalBernoulliA1A2Law]
theorem causalHardA1A2Law_muPO
At every score, the hard law's selected conditional means are the two profiles supplied to its Bernoulli kernels.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
t :
x :
conclusion
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell).muPO t x
= if t then causalHardTreatmentProfile delta w centers omega x else causalHardControlProfile x
Proof (Lean source)
-- @node: causalHardA1A2Law_muPO
lemma causalHardA1A2Law_muPO {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare)
(t : Bool) (x : Score) :
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell).muPO t x =
if t then causalHardTreatmentProfile delta w centers omega x
else causalHardControlProfile x := by
cases t <;> rfl
theorem causalHardControlProfile_coordinatePartial
Every indexed coordinate partial of the constant control profile is 1/2 at order zero and vanishes at positive order.
Formal statement
hypotheses
conclusion
= if coordinateMultiOrder alpha = 0 then 1 / 2 else 0
Proof (Lean source)
-- @node: causalHardControlProfile_coordinatePartial
lemma causalHardControlProfile_coordinatePartial (alpha : Fin 2 → ℕ)
(x : Score) :
coordinatePartial causalHardControlProfile alpha x =
if coordinateMultiOrder alpha = 0 then 1 / 2 else 0 := by
unfold coordinatePartial causalHardControlProfile
by_cases hk : coordinateMultiOrder alpha = 0
· have ha : alpha = fun _ => 0 := by
change alpha 0 + alpha 1 = 0 at hk
funext i
fin_cases i
· simpa using Nat.eq_zero_of_add_eq_zero_right hk
· simpa using Nat.eq_zero_of_add_eq_zero_left hk
subst alpha
change (iteratedFDeriv ℝ 0 (fun _ : Score => (1 / 2 : ℝ)) x) _ = 1 / 2
exact rfl
· rw [iteratedFDeriv_const_of_ne hk]
simp [hk]
theorem causalHardControlProfile_euclideanCExtEnvelope
The common control profile has the paper's Euclidean smooth-extension envelope for every bound at least 1/2.
Formal statement
hypotheses
p :
ℕ
L :
ℝ
hL :
1 / 2 ≤ L
conclusion
Proof (Lean source)
-- @node: causalHardControlProfile_euclideanCExtEnvelope
lemma causalHardControlProfile_euclideanCExtEnvelope (p : ℕ) {L : ℝ}
(hL : 1 / 2 ≤ L) :
EuclideanCExtEnvelope causalHardControlProfile p L causalHardSquare := by
refine ⟨Set.univ, isOpen_univ, subset_univ _, causalHardControlProfile,
contDiffOn_const, (fun _ _ => rfl), ?_, ?_, ?_⟩
· refine ⟨1 / 2, ?_⟩
rintro r ⟨alpha, halpha, x, hx, rfl⟩
rw [causalHardControlProfile_coordinatePartial]
split <;> norm_num
· refine ⟨0, ?_⟩
rintro r ⟨alpha, halpha, x, hx, z, hz, hxz, rfl⟩
simp [causalHardControlProfile_coordinatePartial]
· have hnonempty : (coordinatePartialValues causalHardControlProfile p
causalHardSquare).Nonempty := by
refine ⟨1 / 2, fun _ => 0, by simp [coordinateMultiOrder],
scorePoint 0 0, ?_, ?_⟩
· intro i
fin_cases i <;> norm_num [scorePoint]
· norm_num [causalHardControlProfile_coordinatePartial,
coordinateMultiOrder]
have hpartial : sSup (coordinatePartialValues causalHardControlProfile p
causalHardSquare) ≤ 1 / 2 := csSup_le hnonempty (by
rintro r ⟨alpha, halpha, x, hx, rfl⟩
rw [causalHardControlProfile_coordinatePartial]
split <;> norm_num)
have hlip : sSup (coordinatePartialLipschitzValues
causalHardControlProfile p causalHardSquare) ≤ 0 := csSup_le (by
refine ⟨0, fun _ => 0, by simp [coordinateMultiOrder],
scorePoint 0 0, ?_, scorePoint 1 0, ?_, ?_, ?_⟩
· intro i
fin_cases i <;> norm_num [scorePoint]
· intro i
fin_cases i <;> norm_num [scorePoint]
· intro h
have hcoord := congrArg (fun y : Score => y 0) h
norm_num [scorePoint] at hcoord
· simp [causalHardControlProfile_coordinatePartial]) (by
rintro r ⟨alpha, halpha, x, hx, z, hz, hxz, rfl⟩
simp [causalHardControlProfile_coordinatePartial])
linarith
theorem causalHardA1A2Law_control_euclideanCExtEnvelope
Every hard-family vertex satisfies the smooth-extension clause for its control-arm regression.
Formal statement
hypotheses
M :
ℕ
p :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
L :
ℝ
hL :
1 / 2 ≤ L
conclusion
EuclideanCExtEnvelope ((causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell).muPO false) p L causalHardSquare
Proof (Lean source)
-- @node: causalHardA1A2Law_control_euclideanCExtEnvelope
lemma causalHardA1A2Law_control_euclideanCExtEnvelope {M : ℕ}
(p : ℕ) (b cA delta w : ℝ) (centers : Fin M → Score)
(omega : Fin M → Bool) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare)
{L : ℝ} (hL : 1 / 2 ≤ L) :
EuclideanCExtEnvelope
((causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell).muPO false) p L causalHardSquare := by
exact causalHardControlProfile_euclideanCExtEnvelope p hL
theorem causalHardA1A2Law_cell_mass
Every complete hard cell has the advertised bit-independent probability under the full potential-outcome law.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
conclusion
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell).law {z | causalScore z ∈ causalHardCell (centers j) w}
Proof (Lean source)
-- @node: causalHardA1A2Law_cell_mass
lemma causalHardA1A2Law_cell_mass {M : ℕ} (j : Fin M)
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare) :
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell).law {z | causalScore z ∈ causalHardCell (centers j) w} =
ofReal (pi * w ^ 2 / 36) := by
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell
have hC : MeasurableSet (causalHardCell (centers j) w) :=
Metric.isClosed_closedBall.measurableSet
rw [show {z | causalScore z ∈ causalHardCell (centers j) w} =
causalScore ⁻¹' causalHardCell (centers j) w by rfl]
rw [← Measure.map_apply (by unfold causalScore; fun_prop) hC]
rw [P.marginal_eq]
change causalHardScoreMeasure b cA delta w centers omega
(causalHardCell (centers j) w) = _
exact causalHardScoreMeasure_cell_mass j centers omega hb hscale hcA hdelta hw
hsep (hcell j)
theorem causalHardA1A2Law_restrict_cell_eq
The full potential-outcome law restricted to one hard cell depends on a vertex only through the bit indexing that cell.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
j :
Fin M
hbit :
omega j = omega' j
conclusion
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell).law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}
= (causalHardA1A2Law b cA delta w centers omega' hb hscale hcA hdelta hw hsep hcell).law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}
Proof (Lean source)
-- @node: causalHardA1A2Law_restrict_cell_eq
lemma causalHardA1A2Law_restrict_cell_eq {M : ℕ} {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare)
{omega omega' : Fin M → Bool} {j : Fin M}
(hbit : omega j = omega' j) :
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell).law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w} =
(causalHardA1A2Law b cA delta w centers omega' hb hscale hcA hdelta hw
hsep hcell).law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w} := by
let nu := causalHardScoreMeasure b cA delta w centers omega
let nu' := causalHardScoreMeasure b cA delta w centers omega'
let p0 := causalHardControlProfile
let p1 := causalHardTreatmentProfile delta w centers omega
let p1' := causalHardTreatmentProfile delta w centers omega'
have hp := causalHardProfiles_measurable delta w centers omega
have hp' := causalHardProfiles_measurable delta w centers omega'
letI : IsProbabilityMeasure nu :=
causalHardScoreMeasure_isProbabilityMeasure centers omega hb hscale hcA
hdelta hw hsep hcell
letI : IsProbabilityMeasure nu' :=
causalHardScoreMeasure_isProbabilityMeasure centers omega' hb hscale hcA
hdelta hw hsep hcell
have hparam : ∀ x ∈ causalHardCell (centers j) w, p1 x = p1' x := by
intro x hx
unfold p1 p1' causalHardTreatmentProfile clippedPackingRegression
rw [packingRegression_eq_on_cell hw hsep hbit hx]
exact causalBernoulliPotentialOutcomeMeasure_restrict_score_eq
nu nu' p0 p1 p0 p1' hp.1 hp.2 hp'.1 hp'.2
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).1.1)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).1.2)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).2.1)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).2.2)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega' x).1.1)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega' x).1.2)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega' x).2.1)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega' x).2.2)
Metric.isClosed_closedBall.measurableSet
(causalHardScoreMeasure_restrict_cell_eq hw hsep hbit)
(fun _ _ ↦ rfl) hparam
theorem causalHardA1A2Law_restrict_off_cells_eq
Away from every hard cell, the full potential-outcome law is independent of the Boolean vertex.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
conclusion
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell).law.restrict {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}
= (causalHardA1A2Law b cA delta w centers omega' hb hscale hcA hdelta hw hsep hcell).law.restrict {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}
Proof (Lean source)
-- @node: causalHardA1A2Law_restrict_off_cells_eq
lemma causalHardA1A2Law_restrict_off_cells_eq {M : ℕ} {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare)
(omega omega' : Fin M → Bool) :
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell).law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w} =
(causalHardA1A2Law b cA delta w centers omega' hb hscale hcA hdelta hw
hsep hcell).law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w} := by
let nu := causalHardScoreMeasure b cA delta w centers omega
let nu' := causalHardScoreMeasure b cA delta w centers omega'
let p0 := causalHardControlProfile
let p1 := causalHardTreatmentProfile delta w centers omega
let p1' := causalHardTreatmentProfile delta w centers omega'
have hp := causalHardProfiles_measurable delta w centers omega
have hp' := causalHardProfiles_measurable delta w centers omega'
letI : IsProbabilityMeasure nu :=
causalHardScoreMeasure_isProbabilityMeasure centers omega hb hscale hcA
hdelta hw hsep hcell
letI : IsProbabilityMeasure nu' :=
causalHardScoreMeasure_isProbabilityMeasure centers omega' hb hscale hcA
hdelta hw hsep hcell
have hparam : ∀ x ∈ (⋃ j, causalHardCell (centers j) w)ᶜ,
p1 x = p1' x := by
intro x hx
have hxBalls : ∀ j, x ∉ causalHardCell (centers j) w := by
intro j hxj
exact hx (Set.mem_iUnion.2 ⟨j, hxj⟩)
unfold p1 p1' causalHardTreatmentProfile clippedPackingRegression
rw [packingRegression_eq_off_cells hw omega hxBalls,
packingRegression_eq_off_cells hw omega' hxBalls]
exact causalBernoulliPotentialOutcomeMeasure_restrict_score_eq
nu nu' p0 p1 p0 p1' hp.1 hp.2 hp'.1 hp'.2
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).1.1)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).1.2)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).2.1)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega x).2.2)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega' x).1.1)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega' x).1.2)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega' x).2.1)
(fun x ↦ (causalHardProfiles_mem_unitInterval delta w centers omega' x).2.2)
(MeasurableSet.iUnion fun _ ↦
Metric.isClosed_closedBall.measurableSet).compl
(causalHardScoreMeasure_restrict_compl_cells_eq hw omega omega')
(fun _ _ ↦ rfl) hparam
theorem causalHardA1A2Law_tau_center_eq_of_bit_eq
Flipping one vertex bit changes the treatment effect at the corresponding cell center by exactly the bump amplitude.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
∀ k, centers k ∈ causalHardSquare
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
hbit :
omega j = omega' j
conclusion
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell).tau (centers j)
= (causalHardA1A2Law b cA delta w centers omega' hb hscale hcA hdelta hw hsep hcell).tau (centers j)
Proof (Lean source)
-- @node: causalHardA1A2Law_tau_center_eq_of_bit_eq
lemma causalHardA1A2Law_tau_center_eq_of_bit_eq {M : ℕ} (j : Fin M)
(b cA delta w : ℝ) (centers : Fin M → Score)
(omega omega' : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : ∀ k, centers k ∈ causalHardSquare)
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare)
(hbit : omega j = omega' j) :
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell).tau (centers j) =
(causalHardA1A2Law b cA delta w centers omega' hb hscale hcA hdelta hw
hsep hcell).tau (centers j) := by
have hleft := causalHardTreatmentProfile_eq_packingRegression_on_square
hdelta.le hdeltaSmall hw hsep omega (hcenter j)
have hright := causalHardTreatmentProfile_eq_packingRegression_on_square
hdelta.le hdeltaSmall hw hsep omega' (hcenter j)
have hreg := packingRegression_eq_on_cell (b := (1 / 16 : ℝ))
(delta := delta) hw hsep hbit (Metric.mem_closedBall_self hw.le)
change causalHardTreatmentProfile delta w centers omega (centers j) -
causalHardControlProfile (centers j) =
causalHardTreatmentProfile delta w centers omega' (centers j) -
causalHardControlProfile (centers j)
rw [hleft, hright, hreg]
theorem causalHardA1A2Law_tau_center_flip
Flipping one vertex bit changes the treatment effect at the corresponding cell center by exactly the bump amplitude.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
∀ k, centers k ∈ causalHardSquare
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
conclusion
|(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell).tau (centers j)
- (causalHardA1A2Law b cA delta w centers (update omega j (!omega j)) hb hscale hcA hdelta hw hsep hcell).tau (centers j)|
= delta
Proof (Lean source)
-- @node: causalHardA1A2Law_tau_center_flip
lemma causalHardA1A2Law_tau_center_flip {M : ℕ} (j : Fin M)
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : ∀ k, centers k ∈ causalHardSquare)
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare) :
|(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell).tau (centers j) -
(causalHardA1A2Law b cA delta w centers
(update omega j (!omega j)) hb hscale hcA hdelta hw
hsep hcell).tau (centers j)| = delta := by
have hprofile := causalHardTreatmentProfile_center_flip hdelta.le hdeltaSmall
hw hsep hcenter omega j
simpa [A1A2Law.tau, causalHardA1A2Law_muPO] using hprofile
theorem causalHardA1A2Law_vertex_core
The already-constructed hard law simultaneously supplies the common geometry, exact cell masses, bit locality, off-cell agreement, and target separation needed by the final hypercube assembly.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
∀ k, centers k ∈ causalHardSquare
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
conclusion
let P := fun omega
=> causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell (∀ omega, (P omega).support = causalHardSquare ∧ (P omega).A1 = causalHardArmOne ∧ (P omega).A0 = causalHardSquare \ causalHardArmOne ∧ (P omega).boundary = frontier causalHardArmOne) ∧
(∀ omega j, (P omega).law {z | causalScore z ∈ causalHardCell (centers j) w} = ofReal (pi * w ^ 2 / 36)) ∧
(∀ omega omega' j, omega j = omega' j → (P omega).law.restrict {z | causalScore z ∈ causalHardCell (centers j) w} = (P omega').law.restrict {z | causalScore z ∈ causalHardCell (centers j) w}) ∧
(∀ omega omega', (P omega).law.restrict {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w} = (P omega').law.restrict {z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}) ∧
∀ omega j,
|(P omega).tau (centers j) - (P (update omega j (!omega j))).tau (centers j)|
= delta
Proof (Lean source)
-- @node: causalHardA1A2Law_vertex_core
lemma causalHardA1A2Law_vertex_core {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : ∀ k, centers k ∈ causalHardSquare)
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare) :
let P := fun omega => causalHardA1A2Law b cA delta w centers omega
hb hscale hcA hdelta hw hsep hcell
(∀ omega, (P omega).support = causalHardSquare ∧
(P omega).A1 = causalHardArmOne ∧
(P omega).A0 = causalHardSquare \ causalHardArmOne ∧
(P omega).boundary = frontier causalHardArmOne) ∧
(∀ omega j, (P omega).law
{z | causalScore z ∈ causalHardCell (centers j) w} =
ofReal (pi * w ^ 2 / 36)) ∧
(∀ omega omega' j, omega j = omega' j →
(P omega).law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w} =
(P omega').law.restrict
{z | causalScore z ∈ causalHardCell (centers j) w}) ∧
(∀ omega omega', (P omega).law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w} =
(P omega').law.restrict
{z | causalScore z ∉ ⋃ j, causalHardCell (centers j) w}) ∧
∀ omega j, |(P omega).tau (centers j) -
(P (update omega j (!omega j))).tau (centers j)| = delta := by
dsimp only
refine ⟨?_, ?_, ?_, ?_, ?_⟩
· intro omega
exact causalHardA1A2Law_geometry b cA delta w centers omega hb hscale
hcA hdelta hw hsep hcell
· intro omega j
exact causalHardA1A2Law_cell_mass j b cA delta w centers omega hb hscale
hcA hdelta hw hsep hcell
· intro omega omega' j hbit
exact causalHardA1A2Law_restrict_cell_eq hb hscale hcA hdelta hw hsep
hcell hbit
· intro omega omega'
exact causalHardA1A2Law_restrict_off_cells_eq hb hscale hcA hdelta hw
hsep hcell omega omega'
· intro omega j
exact causalHardA1A2Law_tau_center_flip j b cA delta w centers omega hb
hscale hcA hdelta hdeltaSmall hw hsep hcenter hcell
theorem causalHardA1A2Law_condAbsMoment_le
Every selected conditional outcome kernel in the hard family obeys the all-orders moment envelope, uniformly over scores and vertices.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
ν L :
ℝ
hν :
2 ≤ ν
hL :
1 ≤ L
t :
x :
conclusion
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell).condAbsMoment ν t x
≤ ofReal L
Proof (Lean source)
-- @node: causalHardA1A2Law_condAbsMoment_le
lemma causalHardA1A2Law_condAbsMoment_le {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare)
{ν L : ℝ} (hν : 2 ≤ ν) (hL : 1 ≤ L) (t : Bool) (x : Score) :
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell).condAbsMoment ν t x ≤ ofReal L := by
have hp := causalHardProfiles_measurable delta w centers omega
have hp1 (z : Score) : causalHardControlProfile z ≤ 1 :=
(causalHardProfiles_mem_unitInterval delta w centers omega z).1.2
have hp2 (z : Score) :
causalHardTreatmentProfile delta w centers omega z ≤ 1 :=
(causalHardProfiles_mem_unitInterval delta w centers omega z).2.2
have hone : (1 : ℝ≥0∞) ≤ ofReal L := by
simpa only [ENNReal.ofReal_one] using ENNReal.ofReal_le_ofReal hL
cases t with
| false =>
exact (causalSelectedBernoulliKernel_condAbsMoment_le_one
causalHardControlProfile hp.1 hp1 hν x).trans hone
| true =>
exact (causalSelectedBernoulliKernel_condAbsMoment_le_one
(causalHardTreatmentProfile delta w centers omega) hp.2 hp2 hν x).trans hone
theorem causalHardA1A2Law_density_certificates
The hard law's density is continuous on its support and obeys every class envelope L ≥ 48.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
L :
ℝ
hL :
48 ≤ L
conclusion
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell ContinuousOn P.density P.support ∧
∀ x ∈ P.support, L⁻¹ ≤ P.density x ∧ P.density x ≤ L
Proof (Lean source)
-- @node: causalHardA1A2Law_density_certificates
lemma causalHardA1A2Law_density_certificates {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare)
{L : ℝ} (hL : 48 ≤ L) :
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
ContinuousOn P.density P.support ∧
∀ x ∈ P.support, L⁻¹ ≤ P.density x ∧ P.density x ≤ L := by
dsimp only
have hLpos : 0 < L := (by norm_num : (0 : ℝ) < 48).trans_le hL
have hinv : L⁻¹ ≤ (48 : ℝ)⁻¹ :=
(inv_le_inv₀ hLpos (by norm_num : (0 : ℝ) < 48)).mpr hL
constructor
· exact (causalHardScoreDensity_continuous centers omega hb hscale).continuousOn
· intro x hx
have hd := causalHardScoreDensity_mem_Icc (b := b) hcA hdelta hw hsep omega x
exact ⟨hinv.trans (by norm_num at hd ⊢; exact hd.1),
hd.2.trans (by linarith)⟩
theorem causalHardA1A2Law_kernel_certificates
On the hard square, the selected Bernoulli kernels have exactly the decorated pointwise means and variances, and their variances obey every class envelope L ≥ 48.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
L :
ℝ
hL :
48 ≤ L
conclusion
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell (∀ t x, x ∈ P.support → P.muPO t x = ∫ y, y ∂P.condKer t x) ∧
(∀ t x, x ∈ P.support → P.sigmaSqPO t x = variance id (P.condKer t x)) ∧
(∀ t, ContinuousOn (P.sigmaSqPO t) P.support ∧ ∀ x ∈ P.support, L⁻¹ ≤ P.sigmaSqPO t x ∧ P.sigmaSqPO t x ≤ L)
Proof (Lean source)
-- @node: causalHardA1A2Law_kernel_certificates
lemma causalHardA1A2Law_kernel_certificates {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare)
{L : ℝ} (hL : 48 ≤ L) :
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
(∀ t x, x ∈ P.support → P.muPO t x = ∫ y, y ∂P.condKer t x) ∧
(∀ t x, x ∈ P.support →
P.sigmaSqPO t x = variance id (P.condKer t x)) ∧
(∀ t, ContinuousOn (P.sigmaSqPO t) P.support ∧
∀ x ∈ P.support, L⁻¹ ≤ P.sigmaSqPO t x ∧ P.sigmaSqPO t x ≤ L) := by
dsimp only
have hp := causalHardProfiles_measurable delta w centers omega
have hLpos : 0 < L := (by norm_num : (0 : ℝ) < 48).trans_le hL
have hinv : L⁻¹ ≤ (48 : ℝ)⁻¹ :=
(inv_le_inv₀ hLpos (by norm_num : (0 : ℝ) < 48)).mpr hL
refine ⟨?_, ?_, ?_⟩
· intro t x hx
cases t with
| false =>
exact (causalSelectedBernoulliKernel_integral_id
causalHardControlProfile hp.1
(fun z => (causalHardProfiles_mem_unitInterval delta w centers omega z).1.1)
(fun z => (causalHardProfiles_mem_unitInterval delta w centers omega z).1.2)
x).symm
| true =>
exact (causalSelectedBernoulliKernel_integral_id
(causalHardTreatmentProfile delta w centers omega) hp.2
(fun z => (causalHardProfiles_mem_unitInterval delta w centers omega z).2.1)
(fun z => (causalHardProfiles_mem_unitInterval delta w centers omega z).2.2)
x).symm
· intro t x hx
cases t with
| false =>
exact (causalSelectedBernoulliKernel_variance_id
causalHardControlProfile hp.1
(fun z => (causalHardProfiles_mem_unitInterval delta w centers omega z).1.1)
(fun z => (causalHardProfiles_mem_unitInterval delta w centers omega z).1.2)
x).symm
| true =>
exact (causalSelectedBernoulliKernel_variance_id
(causalHardTreatmentProfile delta w centers omega) hp.2
(fun z => (causalHardProfiles_mem_unitInterval delta w centers omega z).2.1)
(fun z => (causalHardProfiles_mem_unitInterval delta w centers omega z).2.2)
x).symm
· intro t
cases t with
| false =>
constructor
· change ContinuousOn (fun _ : Score => (1 / 2 : ℝ) * (1 - 1 / 2))
causalHardSquare
exact continuous_const.continuousOn
· intro x hx
change L⁻¹ ≤ (1 / 2 : ℝ) * (1 - 1 / 2) ∧
(1 / 2 : ℝ) * (1 - 1 / 2) ≤ L
constructor <;> norm_num <;> linarith
| true =>
let f := causalHardTreatmentProfile delta w centers omega
have hf : Continuous f :=
clippedPackingRegression_continuous (1 / 16) delta w centers omega
constructor
· exact (hf.mul (continuous_const.sub hf)).continuousOn
· intro x hx
have hprob : f x ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ) :=
causalHardTreatmentProfile_mem_middleHalf hdelta.le
hdeltaSmall hw hsep omega hx
change L⁻¹ ≤ f x * (1 - f x) ∧ f x * (1 - f x) ≤ L
constructor
· apply hinv.trans
nlinarith [hprob.1, hprob.2]
· nlinarith [hprob.1, hprob.2]
theorem causalHardA1A2Law_class_geometry
Every hard-family vertex has the complete fixed-rectangle geometry block required by A1A2Class, including rectifiability and Hausdorff bounds.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
L :
ℝ
hL :
48 ≤ L
conclusion
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell MeasurableSet P.A0 ∧
MeasurableSet P.A1 ∧
P.A0 ∪ P.A1 = P.support ∧
Disjoint P.A0 P.A1 ∧
IsCompact P.boundary ∧
P.boundary ⊆ interior P.support ∧
RectifiableCurve P.boundary ∧
ofReal L⁻¹ ≤ Measure.hausdorffMeasure 1 P.boundary ∧
Measure.hausdorffMeasure 1 P.boundary ≤ ofReal L
Proof (Lean source)
-- @node: causalHardA1A2Law_class_geometry
lemma causalHardA1A2Law_class_geometry {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare)
{L : ℝ} (hL : 48 ≤ L) :
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
MeasurableSet P.A0 ∧ MeasurableSet P.A1 ∧
P.A0 ∪ P.A1 = P.support ∧ Disjoint P.A0 P.A1 ∧
P.boundary = frontier P.A0 ∩ frontier P.A1 ∧
IsCompact P.boundary ∧ P.boundary ⊆ interior P.support ∧
RectifiableCurve P.boundary ∧
ofReal L⁻¹ ≤ Measure.hausdorffMeasure 1 P.boundary ∧
Measure.hausdorffMeasure 1 P.boundary ≤ ofReal L := by
dsimp only
refine ⟨causalHardArmZero_measurableSet, causalHardArmOne_measurableSet,
causalHardAssignment_partition.1, causalHardAssignment_partition.2,
?_, causalHardFrontier_compact_and_interior.1,
causalHardFrontier_compact_and_interior.2,
causalHardFrontier_rectifiableCurve,
(causalHardFrontier_hausdorff_bounds hL).1,
(causalHardFrontier_hausdorff_bounds hL).2⟩
exact causalHardAssignment_frontier.symm
theorem causalHardA1A2Law_mem_class_of_analytic_certificates
Once the four genuinely analytic hard-square leaves are available, all remaining clauses of A1A2Class follow from the explicit score law, Bernoulli kernels, profiles, and fixed rectangle geometry.
Formal statement
hypotheses
M :
ℕ
p :
ℕ
ν L b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
hν :
2 ≤ ν
hL :
48 ≤ L
conclusion
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell EuclideanCExtEnvelope (P.muPO true) p L P.support → PopulationGramFloor P p L → (∀ t x h, x ∈ P.boundary → 0 < h → h ≤ L⁻¹ → ofReal L⁻¹ ≤ armLocalMass P t x h) → (∀ t x s, x ∈ P.boundary → 0 < s → s ≤ L⁻¹ → 0 < armSliceDensityMass P t x s ∧ armSliceDensityMass P t x s < ∞) → A1A2Class p ν L P
Proof (Lean source)
-- @node: causalHardA1A2Law_mem_class_of_analytic_certificates
lemma causalHardA1A2Law_mem_class_of_analytic_certificates {M : ℕ}
(p : ℕ) (ν L b cA delta w : ℝ) (centers : Fin M → Score)
(omega : Fin M → Bool) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta)
(hdeltaSmall : delta ≤ 1 / 16) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare)
(hν : 2 ≤ ν) (hL : 48 ≤ L) :
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
EuclideanCExtEnvelope (P.muPO true) p L P.support →
PopulationGramFloor P p L →
(∀ t x h, x ∈ P.boundary → 0 < h → h ≤ L⁻¹ →
ofReal L⁻¹ ≤ armLocalMass P t x h) →
(∀ t x s, x ∈ P.boundary → 0 < s → s ≤ L⁻¹ →
0 < armSliceDensityMass P t x s ∧ armSliceDensityMass P t x s < ∞) →
A1A2Class p ν L P := by
dsimp only
intro hTreatment hGram hLocalMass hSlice
have hDensity := causalHardA1A2Law_density_certificates b cA delta w centers
omega hb hscale hcA hdelta hw hsep hcell hL
have hKernel := causalHardA1A2Law_kernel_certificates b cA delta w centers
omega hb hscale hcA hdelta hdeltaSmall hw hsep hcell hL
have hGeometry := causalHardA1A2Law_class_geometry b cA delta w centers omega
hb hscale hcA hdelta hw hsep hcell hL
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
have hMoment : ∀ t x, x ∈ P.support →
P.condAbsMoment ν t x ≤ ofReal L := by
intro t x hx
exact causalHardA1A2Law_condAbsMoment_le b cA delta w centers omega hb
hscale hcA hdelta hw hsep hcell hν (by linarith) t x
let K : A1A2KernelWitness P ν L :=
{ condKer := P.condKer
condKer_markov := P.condKer_markov
condKer_disint := P.condKer_disint
mean_eq := hKernel.1
variance_eq := hKernel.2.1
moment_le := hMoment }
have hK : Nonempty (A1A2KernelWitness P ν L) := ⟨K⟩
refine ⟨hν, by linarith, causalHardSquare_rectangularScoreSupport (by linarith),
hDensity.1, hDensity.2, ?_, hKernel.2.2,
⟨hK, selectedA1A2CondKer_mean_eq hK⟩,
selectedA1A2CondKer_variance_eq hK,
selectedA1A2CondAbsMoment_le hK,
hGeometry, euclidean_balls_vc, hGram, hLocalMass, hSlice⟩
· intro t
cases t with
| false =>
exact causalHardA1A2Law_control_euclideanCExtEnvelope p b cA delta w
centers omega hb hscale hcA hdelta hw hsep hcell (by linarith)
| true => exact hTreatment
Causal.Hypercube.HardSquareAnalytic 16 declarations This module starts the remaining local-mass, slice, and Gram block by reducing the uniform kernel to its closed-ball support.
Analytic reductions for the fixed hard square
This module starts the remaining local-mass, slice, and Gram block by reducing the uniform kernel to its closed-ball support.
The quadratic form of a scaled rank-one matrix is the scaled square of the corresponding dot product. This is the algebraic step that rewrites the population Gram form as an integral of a squared local polynomial.
Formal statement
hypotheses
conclusion
matrixQuadratic (fun i j => a * f i * f j) v = a * (∑ i, v i * f i) ^ 2
Proof (Lean source)
-- @node: matrixQuadratic_rankOne
lemma matrixQuadratic_rankOne {d : ℕ} (a : ℝ) (f v : Fin d → ℝ) :
matrixQuadratic (fun i j => a * f i * f j) v =
a * (∑ i, v i * f i) ^ 2 := by
classical
unfold matrixQuadratic
calc
∑ i, ∑ j, v i * (a * f i * f j) * v j =
∑ i, (a * (v i * f i)) * (∑ j, v j * f j) := by
apply Finset.sum_congr rfl
intro i _
rw [Finset.mul_sum]
apply Finset.sum_congr rfl
intro j _
ring
_ = a * (∑ i, v i * f i) * (∑ j, v j * f j) := by
rw [← Finset.sum_mul]
congr 1
rw [Finset.mul_sum]
_ = a * (∑ i, v i * f i) ^ 2 := by ring
Specializing the rank-one identity to the local-polynomial basis gives the squared polynomial integrand appearing in the population Gram floor.
Formal statement
hypotheses
conclusion
= a * (∑ i, v i * u ^ (i : ℕ)) ^ 2
Proof (Lean source)
-- @node: matrixQuadratic_polyBasis_rankOne
lemma matrixQuadratic_polyBasis_rankOne (p : ℕ) (a u : ℝ)
(v : Fin (p + 1) → ℝ) :
matrixQuadratic
(fun i j => a * polyBasis p u i * polyBasis p u j) v =
a * (∑ i, v i * u ^ (i : ℕ)) ^ 2 := by
rw [matrixQuadratic_rankOne]
rfl
theorem matrixQuadratic_polyBasis_rankOne_nonneg Lemma matrixQuadratic_polyBasis_rankOne_nonneg in the paper ↗
A nonnegative local weight makes every rank-one polynomial Gram contribution positive semidefinite.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: matrixQuadratic_polyBasis_rankOne_nonneg
lemma matrixQuadratic_polyBasis_rankOne_nonneg (p : ℕ) {a u : ℝ}
(ha : 0 ≤ a) (v : Fin (p + 1) → ℝ) :
0 ≤ matrixQuadratic
(fun i j => a * polyBasis p u i * polyBasis p u j) v := by
rw [matrixQuadratic_polyBasis_rankOne]
positivity
A closed axis-aligned box in the two-dimensional score space.
Definition (Lean source)
-- @node: causalHardScoreBox
def causalHardScoreBox (a0 b0 a1 b1 : ℝ) : Set Score :=
{z | a0 ≤ z 0 ∧ z 0 ≤ b0 ∧ a1 ≤ z 1 ∧ z 1 ≤ b1}
theorem causalHardScoreBox_volume
The volume of a nonempty score box is the product of its side lengths.
Formal statement
hypotheses
a0 b0 a1 b1 :
ℝ
h0 :
a0 ≤ b0
_h1 :
a1 ≤ b1
conclusion
Proof (Lean source)
-- @node: causalHardScoreBox_volume
lemma causalHardScoreBox_volume {a0 b0 a1 b1 : ℝ}
(h0 : a0 ≤ b0) (_h1 : a1 ≤ b1) :
volume (causalHardScoreBox a0 b0 a1 b1) =
ofReal ((b0 - a0) * (b1 - a1)) := by
let a : Fin 2 → ℝ := ![a0, a1]
let b : Fin 2 → ℝ := ![b0, b1]
have hset : causalHardScoreBox a0 b0 a1 b1 =
((MeasurableEquiv.toLp 2 (Fin 2 → ℝ)).symm) ⁻¹' Icc a b := by
ext z
simp only [causalHardScoreBox, mem_setOf_eq, mem_preimage, mem_Icc, Pi.le_def]
constructor
· intro hz
constructor <;> intro i <;> fin_cases i
· exact hz.1
· exact hz.2.2.1
· exact hz.2.1
· exact hz.2.2.2
· rintro ⟨hlo, hhi⟩
exact ⟨hlo 0, hhi 0, hlo 1, hhi 1⟩
rw [hset, (EuclideanSpace.volume_preserving_symm_measurableEquiv_toLp
(Fin 2)).measure_preimage]
· rw [Real.volume_Icc_pi]
simp only [Fin.prod_univ_two, a, b, Matrix.cons_val_zero,
Matrix.cons_val_one]
rw [ENNReal.ofReal_mul (sub_nonneg.mpr h0)]
· exact (measurableSet_Icc : MeasurableSet (Icc a b)).nullMeasurableSet
theorem mem_closedBall_of_coordinate_diff_le_half Lemma mem_closedBall_of_coordinate_diff_le_half in the paper ↗
Coordinatewise displacement by at most half the radius stays inside the Euclidean closed ball in dimension two.
Formal statement
hypotheses
conclusion
z ∈ closedBall x h
Proof (Lean source)
-- @node: mem_closedBall_of_coordinate_diff_le_half
lemma mem_closedBall_of_coordinate_diff_le_half {x z : Score} {h : ℝ}
(hh : 0 ≤ h) (h0 : |z 0 - x 0| ≤ h / 2)
(h1 : |z 1 - x 1| ≤ h / 2) :
z ∈ closedBall x h := by
rw [Metric.mem_closedBall, dist_eq_norm, EuclideanSpace.norm_eq]
simp only [Fin.sum_univ_two, Real.norm_eq_abs]
rw [Real.sqrt_le_iff]
constructor
· exact hh
· change |z 0 - x 0| ^ 2 + |z 1 - x 1| ^ 2 ≤ h ^ 2
have hh2 : 0 ≤ h / 2 := by positivity
have hs0 := (sq_le_sq₀ (abs_nonneg (z 0 - x 0)) hh2).2 h0
have hs1 := (sq_le_sq₀ (abs_nonneg (z 1 - x 1)) hh2).2 h1
nlinarith
Coordinate characterization of the fixed assignment rectangle's frontier.
Formal statement
hypotheses
x :
conclusion
x ∈ frontier causalHardArmOne ↔ -1 ≤ x 0 ∧
x 0 ≤ 1 ∧
0 ≤ x 1 ∧
x 1 ≤ 2 ∧
(x 0 = -1 ∨ x 0 = 1 ∨ x 1 = 0 ∨ x 1 = 2)
Proof (Lean source)
-- @node: mem_frontier_causalHardArmOne_iff
lemma mem_frontier_causalHardArmOne_iff (x : Score) :
x ∈ frontier causalHardArmOne ↔
-1 ≤ x 0 ∧ x 0 ≤ 1 ∧ 0 ≤ x 1 ∧ x 1 ≤ 2 ∧
(x 0 = -1 ∨ x 0 = 1 ∨ x 1 = 0 ∨ x 1 = 2) := by
rw [← causalHardRectangleAffineHomeomorph_image,
← causalHardRectangleAffineHomeomorph.image_frontier]
constructor
· rintro ⟨y, hy, rfl⟩
rcases (mem_frontier_scoreCube_half_iff y).mp hy with ⟨hy0, hy1, hedge⟩
rw [abs_le] at hy0 hy1
simp only [causalHardRectangleAffineHomeomorph, Homeomorph.trans_apply,
Homeomorph.smulOfNeZero_apply, Homeomorph.coe_addLeft,
PiLp.add_apply, PiLp.smul_apply, scorePoint_apply_zero,
scorePoint_apply_one, smul_eq_mul, zero_add]
refine ⟨by linarith, by linarith, by linarith, by linarith, ?_⟩
rcases hedge with hedge | hedge
· rcases (abs_eq (by norm_num : 0 ≤ (1 / 2 : ℝ))).mp hedge with h | h
· exact inr (inl (by linarith))
· exact inl (by linarith)
· rcases (abs_eq (by norm_num : 0 ≤ (1 / 2 : ℝ))).mp hedge with h | h
· exact inr (inr (inr (by linarith)))
· exact inr (inr (inl (by linarith)))
· rintro ⟨hx0l, hx0u, hx1l, hx1u, hedge⟩
let y : Score := scorePoint (x 0 / 2) ((x 1 - 1) / 2)
refine ⟨y, ?_, ?_⟩
· rw [mem_frontier_scoreCube_half_iff]
have hy0 : |y 0| ≤ 1 / 2 := by
rw [show y 0 = x 0 / 2 by simp [y, scorePoint_apply_zero], abs_le]
constructor <;> linarith
have hy1 : |y 1| ≤ 1 / 2 := by
rw [show y 1 = (x 1 - 1) / 2 by simp [y, scorePoint_apply_one], abs_le]
constructor <;> linarith
refine ⟨hy0, hy1, ?_⟩
rcases hedge with h | h | h | h
· left; rw [show y 0 = x 0 / 2 by simp [y, scorePoint_apply_zero], h]; norm_num
· left; rw [show y 0 = x 0 / 2 by simp [y, scorePoint_apply_zero], h]; norm_num
· right; rw [show y 1 = (x 1 - 1) / 2 by simp [y, scorePoint_apply_one], h]; norm_num
· right; rw [show y 1 = (x 1 - 1) / 2 by simp [y, scorePoint_apply_one], h]; norm_num
· ext i
fin_cases i
· simp [causalHardRectangleAffineHomeomorph, y, scorePoint_apply_zero]
ring
· simp [causalHardRectangleAffineHomeomorph, y, scorePoint_apply_one]
ring
theorem causalHardArmOne_inter_closedBall_volume_lower Lemma causalHardArmOne_inter_closedBall_volume_lower in the paper ↗
Every positive radius at most one cuts at least a quarter-box from the fixed treatment rectangle at each frontier point.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: causalHardArmOne_inter_closedBall_volume_lower
lemma causalHardArmOne_inter_closedBall_volume_lower
{x : Score} {h : ℝ} (hx : x ∈ frontier causalHardArmOne)
(hh : 0 < h) (hh1 : h ≤ 1) :
ofReal (h ^ 2 / 4) ≤
volume (causalHardArmOne ∩ closedBall x h) := by
have hx' := (mem_frontier_causalHardArmOne_iff x).mp hx
by_cases hx0 : x 0 ≤ 0
· by_cases hx1 : x 1 ≤ 1
· let R := causalHardScoreBox (x 0) (x 0 + h / 2) (x 1) (x 1 + h / 2)
have hRvol : volume R = ofReal (h ^ 2 / 4) := by
rw [causalHardScoreBox_volume (by linarith) (by linarith)]
congr 1
ring
rw [← hRvol]
apply measure_mono
intro z hz
refine ⟨⟨by linarith [hz.1], by linarith [hz.2.1],
by linarith [hz.2.2.1], by linarith [hz.2.2.2]⟩, ?_⟩
apply mem_closedBall_of_coordinate_diff_le_half hh.le
· rw [abs_of_nonneg (by linarith [hz.1])]; linarith [hz.2.1]
· rw [abs_of_nonneg (by linarith [hz.2.2.1])]; linarith [hz.2.2.2]
· let R := causalHardScoreBox (x 0) (x 0 + h / 2) (x 1 - h / 2) (x 1)
have hRvol : volume R = ofReal (h ^ 2 / 4) := by
rw [causalHardScoreBox_volume (by linarith) (by linarith)]
congr 1
ring
rw [← hRvol]
apply measure_mono
intro z hz
refine ⟨⟨by linarith [hz.1], by linarith [hz.2.1],
by linarith [hz.2.2.1], by linarith [hz.2.2.2]⟩, ?_⟩
apply mem_closedBall_of_coordinate_diff_le_half hh.le
· rw [abs_of_nonneg (by linarith [hz.1])]; linarith [hz.2.1]
· rw [abs_of_nonpos (by linarith [hz.2.2.2])]; linarith [hz.2.2.1]
· have hx0' : 0 ≤ x 0 := le_of_not_ge hx0
by_cases hx1 : x 1 ≤ 1
· let R := causalHardScoreBox (x 0 - h / 2) (x 0) (x 1) (x 1 + h / 2)
have hRvol : volume R = ofReal (h ^ 2 / 4) := by
rw [causalHardScoreBox_volume (by linarith) (by linarith)]
congr 1
ring
rw [← hRvol]
apply measure_mono
intro z hz
refine ⟨⟨by linarith [hz.1], by linarith [hz.2.1],
by linarith [hz.2.2.1], by linarith [hz.2.2.2]⟩, ?_⟩
apply mem_closedBall_of_coordinate_diff_le_half hh.le
· rw [abs_of_nonpos (by linarith [hz.2.1])]; linarith [hz.1]
· rw [abs_of_nonneg (by linarith [hz.2.2.1])]; linarith [hz.2.2.2]
· let R := causalHardScoreBox (x 0 - h / 2) (x 0) (x 1 - h / 2) (x 1)
have hRvol : volume R = ofReal (h ^ 2 / 4) := by
rw [causalHardScoreBox_volume (by linarith) (by linarith)]
congr 1
ring
rw [← hRvol]
apply measure_mono
intro z hz
refine ⟨⟨by linarith [hz.1], by linarith [hz.2.1],
by linarith [hz.2.2.1], by linarith [hz.2.2.2]⟩, ?_⟩
apply mem_closedBall_of_coordinate_diff_le_half hh.le
· rw [abs_of_nonpos (by linarith [hz.2.1])]; linarith [hz.1]
· rw [abs_of_nonpos (by linarith [hz.2.2.2])]; linarith [hz.2.2.1]
theorem causalHardArmZero_inter_closedBall_volume_lower Lemma causalHardArmZero_inter_closedBall_volume_lower in the paper ↗
Every positive radius at most one cuts a fixed positive-area box from the support-side complement of the treatment rectangle.
Formal statement
hypotheses
conclusion
ofReal (h ^ 2 / 8)
Proof (Lean source)
-- @node: causalHardArmZero_inter_closedBall_volume_lower
lemma causalHardArmZero_inter_closedBall_volume_lower
{x : Score} {h : ℝ} (hx : x ∈ frontier causalHardArmOne)
(hh : 0 < h) (hh1 : h ≤ 1) :
ofReal (h ^ 2 / 8) ≤
volume ((causalHardSquare \ causalHardArmOne) ∩ closedBall x h) := by
have hx' := (mem_frontier_causalHardArmOne_iff x).mp hx
rcases hx'.2.2.2.2 with hedge | hedge | hedge | hedge
· let R := causalHardScoreBox (x 0 - h / 2) (x 0 - h / 4)
(x 1 - h / 4) (x 1 + h / 4)
have hRvol : volume R = ofReal (h ^ 2 / 8) := by
rw [causalHardScoreBox_volume (by linarith) (by linarith)]
congr 1
ring
rw [← hRvol]
apply measure_mono
intro z hz
refine ⟨⟨?_, ?_⟩, ?_⟩
· intro i
fin_cases i
· change -3 ≤ z 0 ∧ z 0 ≤ 3
exact ⟨by linarith [hz.1, hx'.1], by linarith [hz.2.1, hx'.2.1]⟩
· change -3 ≤ z 1 ∧ z 1 ≤ 3
exact ⟨by linarith [hz.2.2.1, hx'.2.2.1],
by linarith [hz.2.2.2, hx'.2.2.2.1]⟩
· intro hA; linarith [hA.1, hz.2.1]
· apply mem_closedBall_of_coordinate_diff_le_half hh.le
· rw [abs_of_nonpos (by linarith [hz.2.1])]; linarith [hz.1]
· rw [abs_le]; exact ⟨by linarith [hz.2.2.1], by linarith [hz.2.2.2]⟩
· let R := causalHardScoreBox (x 0 + h / 4) (x 0 + h / 2)
(x 1 - h / 4) (x 1 + h / 4)
have hRvol : volume R = ofReal (h ^ 2 / 8) := by
rw [causalHardScoreBox_volume (by linarith) (by linarith)]
congr 1
ring
rw [← hRvol]
apply measure_mono
intro z hz
refine ⟨⟨?_, ?_⟩, ?_⟩
· intro i
fin_cases i
· change -3 ≤ z 0 ∧ z 0 ≤ 3
exact ⟨by linarith [hz.1, hx'.1], by linarith [hz.2.1, hx'.2.1]⟩
· change -3 ≤ z 1 ∧ z 1 ≤ 3
exact ⟨by linarith [hz.2.2.1, hx'.2.2.1],
by linarith [hz.2.2.2, hx'.2.2.2.1]⟩
· intro hA; linarith [hA.2.1, hz.1]
· apply mem_closedBall_of_coordinate_diff_le_half hh.le
· rw [abs_of_nonneg (by linarith [hz.1])]; linarith [hz.2.1]
· rw [abs_le]; exact ⟨by linarith [hz.2.2.1], by linarith [hz.2.2.2]⟩
· let R := causalHardScoreBox (x 0 - h / 4) (x 0 + h / 4)
(x 1 - h / 2) (x 1 - h / 4)
have hRvol : volume R = ofReal (h ^ 2 / 8) := by
rw [causalHardScoreBox_volume (by linarith) (by linarith)]
congr 1
ring
rw [← hRvol]
apply measure_mono
intro z hz
refine ⟨⟨?_, ?_⟩, ?_⟩
· intro i
fin_cases i
· change -3 ≤ z 0 ∧ z 0 ≤ 3
exact ⟨by linarith [hz.1, hx'.1], by linarith [hz.2.1, hx'.2.1]⟩
· change -3 ≤ z 1 ∧ z 1 ≤ 3
exact ⟨by linarith [hz.2.2.1, hx'.2.2.1],
by linarith [hz.2.2.2, hx'.2.2.2.1]⟩
· intro hA; linarith [hA.2.2.1, hz.2.2.2]
· apply mem_closedBall_of_coordinate_diff_le_half hh.le
· rw [abs_le]; exact ⟨by linarith [hz.1], by linarith [hz.2.1]⟩
· rw [abs_of_nonpos (by linarith [hz.2.2.2])]; linarith [hz.2.2.1]
· let R := causalHardScoreBox (x 0 - h / 4) (x 0 + h / 4)
(x 1 + h / 4) (x 1 + h / 2)
have hRvol : volume R = ofReal (h ^ 2 / 8) := by
rw [causalHardScoreBox_volume (by linarith) (by linarith)]
congr 1
ring
rw [← hRvol]
apply measure_mono
intro z hz
refine ⟨⟨?_, ?_⟩, ?_⟩
· intro i
fin_cases i
· change -3 ≤ z 0 ∧ z 0 ≤ 3
exact ⟨by linarith [hz.1, hx'.1], by linarith [hz.2.1, hx'.2.1]⟩
· change -3 ≤ z 1 ∧ z 1 ≤ 3
exact ⟨by linarith [hz.2.2.1, hx'.2.2.1],
by linarith [hz.2.2.2, hx'.2.2.2.1]⟩
· intro hA; linarith [hA.2.2.2, hz.2.2.1]
· apply mem_closedBall_of_coordinate_diff_le_half hh.le
· rw [abs_le]; exact ⟨by linarith [hz.1], by linarith [hz.2.1]⟩
· rw [abs_of_nonneg (by linarith [hz.2.2.1])]; linarith [hz.2.2.2]
theorem causalHardArm_inter_closedBall_volume_lower Lemma causalHardArm_inter_closedBall_volume_lower in the paper ↗
The two fixed assignment arms have a common quadratic intersection-area lower bound at every interface point.
Formal statement
hypotheses
conclusion
ofReal (h ^ 2 / 8)
Proof (Lean source)
-- @node: causalHardArm_inter_closedBall_volume_lower
lemma causalHardArm_inter_closedBall_volume_lower (t : Bool)
{x : Score} {h : ℝ} (hx : x ∈ frontier causalHardArmOne)
(hh : 0 < h) (hh1 : h ≤ 1) :
ofReal (h ^ 2 / 8) ≤
volume ((if t then causalHardArmOne else
causalHardSquare \ causalHardArmOne) ∩ closedBall x h) := by
cases t with
| false => exact causalHardArmZero_inter_closedBall_volume_lower hx hh hh1
| true =>
exact (ENNReal.ofReal_le_ofReal (by nlinarith [sq_nonneg h])).trans
(causalHardArmOne_inter_closedBall_volume_lower hx hh hh1)
theorem uniformKernel_eq_one_iff_abs_le
The uniform kernel is one exactly on its defining unit interval.
Formal statement
Proof (Lean source)
-- @node: uniformKernel_eq_one_iff_abs_le
lemma uniformKernel_eq_one_iff_abs_le (u : ℝ) :
uniformKernel u = 1 ↔ |u| ≤ 1 := by
by_cases hu : u ∈ Icc (-1 : ℝ) 1
· rw [uniformKernel, Set.indicator_of_mem hu]
simp [abs_le.mpr hu]
· rw [uniformKernel, Set.indicator_of_notMem hu]
simp only [zero_ne_one, false_iff]
exact fun ha ↦ hu (abs_le.mp ha)
theorem uniformKernel_signedDist_eq_one_iff
At positive bandwidth, either signed radial argument has uniform-kernel weight one exactly on the closed metric ball of that bandwidth.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: uniformKernel_signedDist_eq_one_iff
lemma uniformKernel_signedDist_eq_one_iff (t : Bool) (x z : Score)
{h : ℝ} (hh : 0 < h) :
uniformKernel (((if t then 1 else -1 : ℝ) * dist z x) / h) = 1 ↔
z ∈ closedBall x h := by
rw [uniformKernel_eq_one_iff_abs_le, Metric.mem_closedBall]
have hsign : |(if t then 1 else -1 : ℝ)| = 1 := by
cases t <;> norm_num
rw [abs_div, abs_mul, hsign, one_mul, abs_of_pos hh]
rw [abs_of_nonneg dist_nonneg, div_le_one hh, dist_comm]
theorem armLocalMass_integrand_eq_indicator_closedBall
The nonnegative integrand defining arm local mass is the constant h⁻² on the arm's closed bandwidth ball and zero elsewhere.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: armLocalMass_integrand_eq_indicator_closedBall
lemma armLocalMass_integrand_eq_indicator_closedBall
(t : Bool) (x z : Score) {h : ℝ} (hh : 0 < h) :
ofReal (h⁻¹ ^ 2 *
uniformKernel (((if t then 1 else -1 : ℝ) * dist z x) / h)) =
(closedBall x h).indicator
(fun _ : Score ↦ ofReal (h⁻¹ ^ 2)) z := by
by_cases hz : z ∈ closedBall x h
· rw [Set.indicator_of_mem hz,
(uniformKernel_signedDist_eq_one_iff t x z hh).2 hz, mul_one]
· rw [Set.indicator_of_notMem hz]
have hk : uniformKernel (((if t then 1 else -1 : ℝ) * dist z x) / h) = 0 := by
unfold uniformKernel
rw [Set.indicator_of_notMem]
intro hu
exact hz ((uniformKernel_signedDist_eq_one_iff t x z hh).1
(by rw [uniformKernel, Set.indicator_of_mem hu]))
rw [hk, mul_zero, ENNReal.ofReal_zero]
theorem armLocalMass_eq_normalized_inter_closedBall Lemma armLocalMass_eq_normalized_inter_closedBall in the paper ↗
Arm local mass is the normalized Lebesgue area of the intersection of the chosen assignment arm with the closed bandwidth ball.
Formal statement
hypotheses
conclusion
armLocalMass P t x h
Proof (Lean source)
-- @node: armLocalMass_eq_normalized_inter_closedBall
lemma armLocalMass_eq_normalized_inter_closedBall
(P : A1A2Law) (t : Bool) (x : Score) {h : ℝ} (hh : 0 < h) :
armLocalMass P t x h =
ofReal (h⁻¹ ^ 2) *
volume ((if t then P.A1 else P.A0) ∩ closedBall x h) := by
unfold armLocalMass
simp_rw [armLocalMass_integrand_eq_indicator_closedBall t x _ hh]
rw [setLIntegral_indicator Metric.isClosed_closedBall.measurableSet]
rw [setLIntegral_const]
rw [inter_comm]
The fixed hard-square arms have normalized uniform-kernel local mass at least 1/8 at every interface point and every bandwidth at most one.
Formal statement
hypotheses
P :
t :
x :
h :
ℝ
hA1 :
P.A1 = causalHardArmOne
hA0 :
P.A0 = causalHardSquare \ causalHardArmOne
hx :
hh :
0 < h
hh1 :
h ≤ 1
conclusion
ofReal (1 / 8 : ℝ) ≤ armLocalMass P t x h
Proof (Lean source)
-- @node: causalHardArmLocalMass_lower
lemma causalHardArmLocalMass_lower (P : A1A2Law) (t : Bool)
{x : Score} {h : ℝ}
(hA1 : P.A1 = causalHardArmOne)
(hA0 : P.A0 = causalHardSquare \ causalHardArmOne)
(hx : x ∈ frontier causalHardArmOne) (hh : 0 < h) (hh1 : h ≤ 1) :
ofReal (1 / 8 : ℝ) ≤ armLocalMass P t x h := by
rw [armLocalMass_eq_normalized_inter_closedBall P t x hh, hA1, hA0]
have harea := causalHardArm_inter_closedBall_volume_lower t hx hh hh1
calc
ofReal (1 / 8 : ℝ) =
ofReal (h⁻¹ ^ 2) * ofReal (h ^ 2 / 8) := by
rw [← ENNReal.ofReal_mul (by positivity : 0 ≤ h⁻¹ ^ 2)]
congr 1
field_simp
_ ≤ _ := mul_le_mul_right harea _
theorem causalHardA1A2Law_localMass_certificate
Every explicit angular hard law satisfies the class's uniform local-mass clause once the envelope is at least 48.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
L :
ℝ
hL :
48 ≤ L
conclusion
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell ∀ t x h, x ∈ P.boundary → 0 < h → h
≤ L⁻¹ → ofReal L⁻¹ ≤ armLocalMass P t x h
Proof (Lean source)
-- @node: causalHardA1A2Law_localMass_certificate
lemma causalHardA1A2Law_localMass_certificate {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare)
{L : ℝ} (hL : 48 ≤ L) :
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
∀ t x h, x ∈ P.boundary → 0 < h → h ≤ L⁻¹ →
ofReal L⁻¹ ≤ armLocalMass P t x h := by
dsimp only
intro t x h hx hh hhL
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
have hgeom := causalHardA1A2Law_geometry b cA delta w centers omega hb
hscale hcA hdelta hw hsep hcell
have hLpos : 0 < L := lt_of_lt_of_le (by norm_num) hL
have hh1 : h ≤ 1 := hhL.trans ((inv_le_one₀ hLpos).2 (by linarith))
have hconst : ofReal L⁻¹ ≤ ofReal (1 / 8 : ℝ) := by
apply ENNReal.ofReal_le_ofReal
simpa only [one_div] using
(inv_le_inv₀ hLpos (by norm_num : (0 : ℝ) < 8)).mpr (by linarith)
exact hconst.trans (causalHardArmLocalMass_lower P t hgeom.2.1
hgeom.2.2.1 (hgeom.2.2.2 ▸ hx) hh hh1)
Causal.Hypercube.HardSquareClassGeometry 7 declarations This module transports the existing explicit square-frontier traversal to the fixed arm-one rectangle.
Class-level geometry of the fixed assignment rectangle
This module transports the existing explicit square-frontier traversal to the fixed arm-one rectangle. It supplies the rectifiability leaf needed by the hard-square class certificate.
def causalHardRectangleAffineHomeomorph Definition causalHardRectangleAffineHomeomorph in the paper ↗
Scale the unit square by two and translate it upward by one.
Definition (Lean source)
-- @node: causalHardRectangleAffineHomeomorph
noncomputable def causalHardRectangleAffineHomeomorph : Score ≃ₜ Score :=
(Homeomorph.smulOfNeZero (2 : ℝ) (by norm_num)).trans
(Homeomorph.addLeft (scorePoint 0 1))
theorem causalHardRectangleAffineHomeomorph_image
The affine image of the centered unit square is the fixed arm-one rectangle.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardRectangleAffineHomeomorph_image
lemma causalHardRectangleAffineHomeomorph_image :
causalHardRectangleAffineHomeomorph '' scoreCube (1 / 2 : ℝ) =
causalHardArmOne := by
ext x
constructor
· rintro ⟨y, hy, rfl⟩
have hy0 := hy (0 : Fin 2)
have hy1 := hy (1 : Fin 2)
rw [abs_le] at hy0 hy1
simp only [causalHardRectangleAffineHomeomorph, Homeomorph.trans_apply,
Homeomorph.smulOfNeZero_apply, Homeomorph.coe_addLeft,
causalHardArmOne, mem_setOf_eq, PiLp.add_apply, PiLp.smul_apply,
scorePoint_apply_zero, scorePoint_apply_one, smul_eq_mul, zero_add]
constructor
· linarith
constructor
· linarith
constructor <;> linarith
· intro hx
simp only [causalHardArmOne, mem_setOf_eq] at hx
let y : Score := scorePoint (x 0 / 2) ((x 1 - 1) / 2)
refine ⟨y, ?_, ?_⟩
· intro i
change |y i| ≤ 1 / 2
fin_cases i
· rw [show y ⟨0, by omega⟩ = x 0 / 2 by
simpa [y] using
scorePoint_apply_zero (x 0 / 2) ((x 1 - 1) / 2)]
rw [abs_le]
constructor <;> linarith [hx.1, hx.2.1]
· rw [show y ⟨1, by omega⟩ = (x 1 - 1) / 2 by
simpa [y] using
scorePoint_apply_one (x 0 / 2) ((x 1 - 1) / 2)]
rw [abs_le]
constructor <;> linarith [hx.2.2.1, hx.2.2.2]
· ext i
fin_cases i
· simp only [causalHardRectangleAffineHomeomorph,
Homeomorph.trans_apply, Homeomorph.smulOfNeZero_apply,
Homeomorph.coe_addLeft, PiLp.add_apply, PiLp.smul_apply, smul_eq_mul]
rw [show (scorePoint 0 1) ⟨0, by omega⟩ = 0 by
simpa using scorePoint_apply_zero 0 1,
show y ⟨0, by omega⟩ = x 0 / 2 by
simpa [y] using
scorePoint_apply_zero (x 0 / 2) ((x 1 - 1) / 2)]
norm_num [causalHardRectangleAffineHomeomorph,
Homeomorph.coe_addLeft]
ring
· simp only [causalHardRectangleAffineHomeomorph,
Homeomorph.trans_apply, Homeomorph.smulOfNeZero_apply,
Homeomorph.coe_addLeft, PiLp.add_apply, PiLp.smul_apply, smul_eq_mul]
rw [show (scorePoint 0 1) ⟨1, by omega⟩ = 1 by
simpa using scorePoint_apply_one 0 1,
show y ⟨1, by omega⟩ = (x 1 - 1) / 2 by
simpa [y] using
scorePoint_apply_one (x 0 / 2) ((x 1 - 1) / 2)]
norm_num [causalHardRectangleAffineHomeomorph,
Homeomorph.coe_addLeft]
ring
The square traversal transported to the fixed assignment rectangle.
Definition (Lean source)
-- @node: causalHardRectangleFrontierParam
noncomputable def causalHardRectangleFrontierParam (t : ℝ) : Score :=
causalHardRectangleAffineHomeomorph (squareFrontierParam t)
theorem causalHardFrontier_rectifiableCurve
The fixed assignment frontier is a rectifiable curve.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardFrontier_rectifiableCurve
lemma causalHardFrontier_rectifiableCurve :
RectifiableCurve (frontier causalHardArmOne) := by
refine ⟨16, causalHardRectangleFrontierParam, ?_, ?_⟩
· have hT : LipschitzWith 2
(causalHardRectangleAffineHomeomorph : Score → Score) := by
have hs : LipschitzWith 2 (fun x : Score => (2 : ℝ) • x) := by
simpa using (lipschitzWith_smul (2 : ℝ) :
LipschitzWith ‖(2 : ℝ)‖₊ (fun x : Score => (2 : ℝ) • x))
have ha := (isometry_add_left (scorePoint 0 1)).lipschitz.comp hs
rw [one_mul] at ha
exact ha
have hc := hT.comp squareFrontierParam_lipschitz
convert hc.lipschitzOnWith using 1 <;>
first
| rfl
| norm_num [causalHardRectangleFrontierParam, Function.comp_def]
· change (fun t => causalHardRectangleAffineHomeomorph
(squareFrontierParam t)) '' Icc (0 : ℝ) 1 = _
rw [← Set.image_image, squareFrontierParam_image,
causalHardRectangleAffineHomeomorph.image_frontier,
causalHardRectangleAffineHomeomorph_image]
theorem causalHardSquare_rectangularScoreSupport
The hard square has the class's rectangular-support form for every envelope at least three.
Formal statement
Proof (Lean source)
-- @node: causalHardSquare_rectangularScoreSupport
lemma causalHardSquare_rectangularScoreSupport {L : ℝ} (hL : 3 ≤ L) :
RectangularScoreSupport causalHardSquare L := by
refine ⟨-3, 3, by norm_num, rfl, ?_⟩
intro x hx i
apply abs_le.mpr
constructor
· linarith [(hx i).1]
· exact (hx i).2.trans hL
theorem causalHardFrontier_hausdorff_bounds_fixed Lemma causalHardFrontier_hausdorff_bounds_fixed in the paper ↗
The fixed rectangle frontier has one-dimensional Hausdorff mass between 1/48 and 48, the uniform bounds needed by every admissible hard law.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardFrontier_hausdorff_bounds_fixed
lemma causalHardFrontier_hausdorff_bounds_fixed :
ofReal (48 : ℝ)⁻¹ ≤
Measure.hausdorffMeasure 1 (frontier causalHardArmOne) ∧
Measure.hausdorffMeasure 1 (frontier causalHardArmOne) ≤
ofReal 48 := by
have hupper : Measure.hausdorffMeasure 1 (frontier causalHardArmOne) ≤ 16 := by
have himage : causalHardRectangleFrontierParam '' Icc (0 : ℝ) 1 =
frontier causalHardArmOne := by
change (fun t => causalHardRectangleAffineHomeomorph
(squareFrontierParam t)) '' Icc (0 : ℝ) 1 = _
rw [← Set.image_image, squareFrontierParam_image,
causalHardRectangleAffineHomeomorph.image_frontier,
causalHardRectangleAffineHomeomorph_image]
rw [← himage]
have hT : LipschitzWith 2
(causalHardRectangleAffineHomeomorph : Score → Score) := by
have hs : LipschitzWith 2 (fun x : Score => (2 : ℝ) • x) := by
simpa using (lipschitzWith_smul (2 : ℝ) :
LipschitzWith ‖(2 : ℝ)‖₊ (fun x : Score => (2 : ℝ) • x))
have ha := (isometry_add_left (scorePoint 0 1)).lipschitz.comp hs
rw [one_mul] at ha
exact ha
have hlip : LipschitzOnWith 16 causalHardRectangleFrontierParam
(Icc (0 : ℝ) 1) := by
have hc := hT.comp squareFrontierParam_lipschitz
convert hc.lipschitzOnWith using 1 <;>
first
| rfl
| norm_num [causalHardRectangleFrontierParam, Function.comp_def]
have h := hlip.hausdorffMeasure_image_le (by norm_num : (0 : ℝ) ≤ 1)
simpa [hausdorffMeasure_real] using h
have hsegment : segment ℝ (scorePoint (-1) 0) (scorePoint 1 0) ⊆
frontier causalHardArmOne := by
rw [segment_eq_image_lineMap]
rintro z ⟨t, ht, rfl⟩
let y : Score := scorePoint (t - 1 / 2) (-1 / 2)
have hy : y ∈ frontier (scoreCube (1 / 2 : ℝ)) := by
rw [mem_frontier_scoreCube_half_iff]
refine ⟨?_, ?_, inr ?_⟩
· rw [show y 0 = t - 1 / 2 by simp [y, scorePoint_apply_zero], abs_le]
constructor <;> linarith [ht.1, ht.2]
· rw [show y 1 = -1 / 2 by simp [y, scorePoint_apply_one]]
norm_num
· rw [show y 1 = -1 / 2 by simp [y, scorePoint_apply_one]]
norm_num
have him : causalHardRectangleAffineHomeomorph y ∈
frontier causalHardArmOne := by
rw [← causalHardRectangleAffineHomeomorph_image,
← causalHardRectangleAffineHomeomorph.image_frontier]
exact ⟨y, hy, rfl⟩
convert him using 1
ext i
fin_cases i
· simp [causalHardRectangleAffineHomeomorph, y, AffineMap.lineMap_apply,
scorePoint_apply_zero]
ring
· simp [causalHardRectangleAffineHomeomorph, y, AffineMap.lineMap_apply,
scorePoint_apply_one]
norm_num
have hlower : (2 : ℝ≥0∞) ≤
Measure.hausdorffMeasure 1 (frontier causalHardArmOne) := by
calc
(2 : ℝ≥0∞) = Measure.hausdorffMeasure 1
(segment ℝ (scorePoint (-1) 0) (scorePoint 1 0)) := by
rw [hausdorffMeasure_segment]
simp [edist_dist, dist_scorePoint_same_second]
norm_num
_ ≤ _ := measure_mono hsegment
constructor
· exact (by norm_num : ofReal (48 : ℝ)⁻¹ ≤ (2 : ℝ≥0∞)).trans hlower
· exact hupper.trans (by norm_num)
theorem causalHardFrontier_hausdorff_bounds Lemma causalHardFrontier_hausdorff_bounds in the paper ↗
The fixed frontier Hausdorff bounds remain valid for every class envelope L ≥ 48.
Formal statement
hypotheses
L :
ℝ
hL :
48 ≤ L
conclusion
Proof (Lean source)
-- @node: causalHardFrontier_hausdorff_bounds
lemma causalHardFrontier_hausdorff_bounds {L : ℝ} (hL : 48 ≤ L) :
ofReal L⁻¹ ≤
Measure.hausdorffMeasure 1 (frontier causalHardArmOne) ∧
Measure.hausdorffMeasure 1 (frontier causalHardArmOne) ≤
ofReal L := by
have hLpos : 0 < L := (by norm_num : (0 : ℝ) < 48).trans_le hL
have hinv : L⁻¹ ≤ (48 : ℝ)⁻¹ := by
exact (inv_le_inv₀ hLpos (by norm_num : (0 : ℝ) < 48)).mpr hL
exact ⟨(ENNReal.ofReal_le_ofReal hinv).trans
causalHardFrontier_hausdorff_bounds_fixed.1,
causalHardFrontier_hausdorff_bounds_fixed.2.trans
(ENNReal.ofReal_le_ofReal hL)⟩
Causal.Hypercube.HardSquareGeometry 28 declarations This file records the elementary square, rectangle, and disk facts used by the causal angular hypercube construction.
Geometry of the fixed causal hard square
This file records the elementary square, rectangle, and disk facts used by the causal angular hypercube construction.
def causalHardSquare
The common square support [-3,3]².
def causalHardArmOne
The common arm-one rectangle [-1,1] × [0,2].
def causalHardBottomEdge
The middle of the bottom edge on which the packing points lie.
The equispaced hard-family centers on the middle of the assignment rectangle's bottom edge.
Definition (Lean source)
-- @node: causalHardGridCenter
noncomputable def causalHardGridCenter (M : ℕ) (j : Fin M) : Score :=
scorePoint (-1 / 4 + ((j : ℕ) + 1 : ℝ) / (2 * (M + 1 : ℕ))) 0
theorem causalHardGridCenter_mem_bottomEdge
Every hard-family grid center lies on the prescribed middle bottom edge.
Formal statement
Proof (Lean source)
-- @node: causalHardGridCenter_mem_bottomEdge
lemma causalHardGridCenter_mem_bottomEdge (M : ℕ) (j : Fin M) :
causalHardGridCenter M j ∈ causalHardBottomEdge := by
have hj := angularGridCenter_first_abs_lt_quarter M j
have habs : |causalHardGridCenter M j 0| < (1 / 4 : ℝ) := by
simpa [causalHardGridCenter, angularGridCenter, scorePoint] using hj
rw [causalHardBottomEdge]
constructor
· have h := (abs_lt.mp habs).1
linarith
constructor
· have h := (abs_lt.mp habs).2
linarith
· simp [causalHardGridCenter, scorePoint_apply_one]
theorem causalHardGridCenter_dist
The translated hard-family grid has the same exact spacing as the lower-edge grid used by the support-boundary construction.
Formal statement
Proof (Lean source)
-- @node: causalHardGridCenter_dist
lemma causalHardGridCenter_dist (M : ℕ) (i j : Fin M) :
dist (causalHardGridCenter M i) (causalHardGridCenter M j) =
|((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)| / (2 * (M + 1 : ℕ)) := by
rw [causalHardGridCenter, causalHardGridCenter,
dist_scorePoint_same_second]
have hden : 0 ≤ (2 * (M + 1 : ℕ) : ℝ) := by positivity
have hinner :
-1 / 4 + (((i : ℕ) : ℝ) + 1) / (2 * (M + 1 : ℕ)) -
(-1 / 4 + (((j : ℕ) : ℝ) + 1) / (2 * (M + 1 : ℕ))) =
(((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)) / (2 * (M + 1 : ℕ)) := by
ring
rw [hinner, abs_div, abs_of_nonneg hden]
theorem causalHardGridCenter_separated
Distinct translated grid centers are separated by at least one grid spacing.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: causalHardGridCenter_separated
lemma causalHardGridCenter_separated (M : ℕ) (i j : Fin M) (hij : i ≠ j) :
1 / (2 * (M + 1 : ℕ) : ℝ) ≤
dist (causalHardGridCenter M i) (causalHardGridCenter M j) := by
rw [causalHardGridCenter_dist]
have hcast : ((i : ℕ) : ℝ) ≠ ((j : ℕ) : ℝ) := by
exact_mod_cast (Fin.val_ne_of_ne hij)
have habs : 1 ≤ |((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)| := by
rcases lt_or_gt_of_ne hcast with hlt | hgt
· rw [abs_of_nonpos (sub_nonpos.mpr hlt.le)]
have hnat : (i : ℕ) + 1 ≤ (j : ℕ) :=
Nat.succ_le_iff.mpr (by exact_mod_cast hlt)
have hnatR : (((i : ℕ) : ℝ) + 1) ≤ ((j : ℕ) : ℝ) := by
exact_mod_cast hnat
linarith
· rw [abs_of_nonneg (sub_nonneg.mpr hgt.le)]
have hnat : (j : ℕ) + 1 ≤ (i : ℕ) :=
Nat.succ_le_iff.mpr (by exact_mod_cast hgt)
have hnatR : (((j : ℕ) : ℝ) + 1) ≤ ((i : ℕ) : ℝ) := by
exact_mod_cast hnat
linarith
exact div_le_div_of_nonneg_right habs (by positivity)
def causalHardCell
The local disk associated with a packing point.
Definition (Lean source)
The coordinate description of the hard square agrees with the standard score-cube representation used by the angular helpers.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardSquare_eq_scoreCube
lemma causalHardSquare_eq_scoreCube : causalHardSquare = scoreCube 3 := by
ext x
simp only [causalHardSquare, scoreCube, mem_setOf_eq]
constructor
· intro hx i
exact abs_le.mpr (hx i)
· intro hx i
exact abs_le.mp (hx i)
The fixed hard square is Borel measurable.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardSquare_measurableSet
lemma causalHardSquare_measurableSet : MeasurableSet causalHardSquare := by
rw [causalHardSquare_eq_scoreCube]
exact scoreCube_measurableSet 3
The fixed hard square is compact.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardSquare_isCompact
lemma causalHardSquare_isCompact : IsCompact causalHardSquare := by
rw [causalHardSquare_eq_scoreCube, Metric.isCompact_iff_isClosed_bounded]
constructor
· unfold scoreCube
rw [show {x : Score | ∀ i, |x i| ≤ (3 : ℝ)} =
⋂ i : Fin 2, {x : Score | |x i| ≤ (3 : ℝ)} by ext; simp]
exact isClosed_iInter fun i => isClosed_le
((PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) i).abs)
continuous_const
· rw [Metric.isBounded_iff_subset_closedBall 0]
refine ⟨6, ?_⟩
intro x hx
rw [Metric.mem_closedBall, dist_zero_right, EuclideanSpace.norm_eq]
have h0 := hx (0 : Fin 2)
have h1 := hx (1 : Fin 2)
simp only [Fin.sum_univ_two, Real.norm_eq_abs]
rw [Real.sqrt_le_iff]
constructor
· norm_num
· have h0sq : |x 0| ^ 2 ≤ (3 : ℝ) ^ 2 :=
(sq_le_sq₀ (abs_nonneg _) (by norm_num)).2 h0
have h1sq : |x 1| ^ 2 ≤ (3 : ℝ) ^ 2 :=
(sq_le_sq₀ (abs_nonneg _) (by norm_num)).2 h1
nlinarith
The closure of the interior of the fixed hard square is the square itself.
Formal statement
conclusion
Proof (Lean source)
-- @node: closure_interior_causalHardSquare
lemma closure_interior_causalHardSquare :
closure (interior causalHardSquare) = causalHardSquare := by
rw [causalHardSquare_eq_scoreCube]
have hconvex : Convex ℝ (scoreCube 3) := by
intro x hx y hy a b ha hb hab i
unfold scoreCube at hx hy
simp only [PiLp.add_apply, PiLp.smul_apply, smul_eq_mul]
rw [abs_le]
constructor
· have := add_le_add
(mul_le_mul_of_nonneg_left (abs_le.mp (hx i)).1 ha)
(mul_le_mul_of_nonneg_left (abs_le.mp (hy i)).1 hb)
nlinarith
· have := add_le_add
(mul_le_mul_of_nonneg_left (abs_le.mp (hx i)).2 ha)
(mul_le_mul_of_nonneg_left (abs_le.mp (hy i)).2 hb)
nlinarith
have hzero : (0 : Score) ∈ interior (scoreCube 3) := by
rw [mem_interior_iff_mem_nhds]
apply Filter.mem_of_superset
(Metric.ball_mem_nhds (0 : Score) (show (0 : ℝ) < 3 by norm_num))
intro x hx
unfold scoreCube
intro i
rw [Metric.mem_ball, dist_zero_right] at hx
exact (PiLp.norm_apply_le x i).trans hx.le
have hclosed : IsClosed (scoreCube 3) := by
rw [← causalHardSquare_eq_scoreCube]
exact causalHardSquare_isCompact.isClosed
rw [hconvex.closure_interior_eq_closure_of_nonempty_interior ⟨0, hzero⟩,
hclosed.closure_eq]
theorem volume_restrict_causalHardSquare_support Lemma volume_restrict_causalHardSquare_support in the paper ↗
Restricting planar Lebesgue measure to the fixed hard square has exactly that square as its topological support.
Formal statement
conclusion
Proof (Lean source)
-- @node: volume_restrict_causalHardSquare_support
lemma volume_restrict_causalHardSquare_support :
(volume.restrict causalHardSquare).support = causalHardSquare := by
apply Set.Subset.antisymm
· intro x hx
have hmem := (Measure.support_restrict_subset hx).1
rwa [causalHardSquare_isCompact.isClosed.closure_eq] at hmem
· have hi : interior causalHardSquare ⊆
(volume.restrict causalHardSquare).support := by
intro x hx
exact Measure.interior_inter_support
⟨hx, by simp [Measure.support_eq_univ]⟩
have hc := closure_mono hi
rw [closure_interior_causalHardSquare,
Measure.isClosed_support.closure_eq] at hc
exact hc
The fixed hard square has planar Lebesgue mass 36.
Formal statement
conclusion
volume causalHardSquare = 36
Proof (Lean source)
-- @node: causalHardSquare_volume
lemma causalHardSquare_volume : volume causalHardSquare = 36 := by
have hset : causalHardSquare =
((MeasurableEquiv.toLp 2 (Fin 2 → ℝ)).symm) ⁻¹'
Icc (fun _ => (-3 : ℝ)) (fun _ => 3) := by
ext x
simp only [causalHardSquare, mem_setOf_eq, mem_preimage, mem_Icc, Pi.le_def]
constructor
· intro hx
exact ⟨fun i => (hx i).1, fun i => (hx i).2⟩
· rintro ⟨hlo, hhi⟩ i
exact ⟨hlo i, hhi i⟩
rw [hset, (EuclideanSpace.volume_preserving_symm_measurableEquiv_toLp
(Fin 2)).measure_preimage]
· rw [Real.volume_Icc_pi]
simp only [Fin.prod_const]
have hsix : (3 : ℝ) - -3 = ((6 : ℕ) : ℝ) := by norm_num
rw [hsix, ENNReal.ofReal_natCast]
norm_num
· exact (measurableSet_Icc : MeasurableSet
(Icc (fun _ : Fin 2 => (-3 : ℝ)) (fun _ => 3))).nullMeasurableSet
The arm-one rectangle is a Borel subset of the hard square.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardArmOne_measurableSet
lemma causalHardArmOne_measurableSet : MeasurableSet causalHardArmOne := by
apply IsClosed.measurableSet
unfold causalHardArmOne
let c0 := PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) 0
let c1 := PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) 1
exact (isClosed_le continuous_const c0).inter
((isClosed_le c0 continuous_const).inter
((isClosed_le continuous_const c1).inter
(isClosed_le c1 continuous_const)))
The fixed arm-one rectangle is closed.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardArmOne_isClosed
lemma causalHardArmOne_isClosed : IsClosed causalHardArmOne := by
unfold causalHardArmOne
let c0 := PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) 0
let c1 := PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) 1
exact (isClosed_le continuous_const c0).inter
((isClosed_le c0 continuous_const).inter
((isClosed_le continuous_const c1).inter
(isClosed_le c1 continuous_const)))
The fixed arm-one rectangle is compact.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardArmOne_isCompact
lemma causalHardArmOne_isCompact : IsCompact causalHardArmOne := by
rw [Metric.isCompact_iff_isClosed_bounded]
refine ⟨causalHardArmOne_isClosed, ?_⟩
rw [Metric.isBounded_iff_subset_closedBall 0]
refine ⟨3, ?_⟩
intro x hx
rw [Metric.mem_closedBall, dist_zero_right, EuclideanSpace.norm_eq]
have h0sq : |x 0| ^ 2 ≤ (1 : ℝ) := by
have h0 : |x 0| ≤ 1 := abs_le.mpr ⟨hx.1, hx.2.1⟩
nlinarith [abs_nonneg (x 0)]
have h1sq : |x 1| ^ 2 ≤ (4 : ℝ) := by
have h1 : |x 1| ≤ 2 := abs_le.mpr ⟨by linarith [hx.2.2.1], hx.2.2.2⟩
nlinarith [abs_nonneg (x 1)]
simp only [Fin.sum_univ_two, Real.norm_eq_abs]
rw [Real.sqrt_le_iff]
constructor
· norm_num
· nlinarith
theorem causalHardArmOne_subset_interior_square Lemma causalHardArmOne_subset_interior_square in the paper ↗
The assignment rectangle, including its frontier, lies strictly inside the common score support.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardArmOne_subset_interior_square
lemma causalHardArmOne_subset_interior_square :
causalHardArmOne ⊆ interior causalHardSquare := by
intro x hx
rw [mem_interior_iff_mem_nhds]
apply Filter.mem_of_superset
(Metric.ball_mem_nhds x (show (0 : ℝ) < 1 / 2 by norm_num))
intro z hz i
have hcoord : |z i - x i| < 1 / 2 := by
have hle : |z i - x i| ≤ dist z x := by
simpa [dist_eq_norm, Real.norm_eq_abs] using PiLp.norm_apply_le (z - x) i
exact hle.trans_lt (by simpa [Metric.mem_ball] using hz)
change -1 ≤ x 0 ∧ x 0 ≤ 1 ∧ 0 ≤ x 1 ∧ x 1 ≤ 2 at hx
fin_cases i
· change |z 0 - x 0| < 1 / 2 at hcoord
change -3 ≤ z 0 ∧ z 0 ≤ 3
have hc := abs_lt.mp hcoord
constructor <;> linarith [hx.1, hx.2.1]
· change |z 1 - x 1| < 1 / 2 at hcoord
change -3 ≤ z 1 ∧ z 1 ≤ 3
have hc := abs_lt.mp hcoord
constructor <;> linarith [hx.2.2.1, hx.2.2.2]
theorem causalHardFrontier_compact_and_interior Lemma causalHardFrontier_compact_and_interior in the paper ↗
The common assignment frontier is compact and lies in the interior of the fixed hard square.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardFrontier_compact_and_interior
lemma causalHardFrontier_compact_and_interior :
IsCompact (frontier causalHardArmOne) ∧
frontier causalHardArmOne ⊆ interior causalHardSquare := by
have hsub : frontier causalHardArmOne ⊆ causalHardArmOne :=
causalHardArmOne_isClosed.frontier_subset
exact ⟨causalHardArmOne_isCompact.of_isClosed_subset isClosed_frontier hsub,
hsub.trans causalHardArmOne_subset_interior_square⟩
The frontier shared by the two assignment arms is exactly the frontier of the arm-one rectangle.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardAssignment_frontier
lemma causalHardAssignment_frontier :
frontier (causalHardSquare \ causalHardArmOne) ∩
frontier causalHardArmOne = frontier causalHardArmOne := by
apply Set.Subset.antisymm inter_subset_right
intro x hx
have hxInt : x ∈ interior causalHardSquare :=
causalHardFrontier_compact_and_interior.2 hx
have hxFront := hx
rw [frontier_eq_closure_inter_closure] at hx
refine ⟨?_, hxFront⟩
rw [frontier_eq_closure_inter_closure]
change x ∈ closure (causalHardSquare \ causalHardArmOne) ∧
x ∈ closure (causalHardSquare \ causalHardArmOne)ᶜ
constructor
· rw [mem_closure_iff]
intro o ho hxo
have hmeet := (mem_closure_iff.mp hx.2) (o ∩ interior causalHardSquare)
(ho.inter isOpen_interior) ⟨hxo, hxInt⟩
rcases hmeet with ⟨y, ⟨hyo, hyS⟩, hyA⟩
exact ⟨y, hyo, ⟨interior_subset hyS, hyA⟩⟩
· exact closure_mono (fun y (hy : y ∈ causalHardArmOne) =>
show y ∈ (causalHardSquare \ causalHardArmOne)ᶜ from by
intro hdiff
exact hdiff.2 hy) hx.1
The fixed arm-zero region is Borel measurable.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardArmZero_measurableSet
lemma causalHardArmZero_measurableSet :
MeasurableSet (causalHardSquare \ causalHardArmOne) :=
causalHardSquare_measurableSet.diff causalHardArmOne_measurableSet
Every point of the fixed assignment rectangle lies in the support square.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardArmOne_subset_square
lemma causalHardArmOne_subset_square : causalHardArmOne ⊆ causalHardSquare := by
intro x hx i
fin_cases i
· change -3 ≤ x 0 ∧ x 0 ≤ 3
exact ⟨by linarith [hx.1], by linarith [hx.2.1]⟩
· change -3 ≤ x 1 ∧ x 1 ≤ 3
exact ⟨by linarith [hx.2.2.1], by linarith [hx.2.2.2]⟩
The square complement of arm one and arm one form the required disjoint partition of the fixed support.
Formal statement
conclusion
Proof (Lean source)
-- @node: causalHardAssignment_partition
lemma causalHardAssignment_partition :
(causalHardSquare \ causalHardArmOne) ∪ causalHardArmOne = causalHardSquare ∧
Disjoint (causalHardSquare \ causalHardArmOne) causalHardArmOne := by
constructor
· exact diff_union_of_subset causalHardArmOne_subset_square
· exact disjoint_sdiff_left
A radius-at-most-one disk centered on the selected middle bottom edge is strictly contained in the hard support square.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: causalHardCell_subset_square
lemma causalHardCell_subset_square {x : Score} {w : ℝ}
(hx : x ∈ causalHardBottomEdge) (hw : w ≤ 1) :
causalHardCell x w ⊆ causalHardSquare := by
intro z hz i
have hcoord : |z i - x i| ≤ dist z x := by
simpa [dist_eq_norm, Real.norm_eq_abs] using PiLp.norm_apply_le (z - x) i
have hdist : dist z x ≤ w := by
simpa [causalHardCell, Metric.mem_closedBall, dist_comm] using hz
have hxi : |x i| ≤ 1 / 2 := by
fin_cases i <;> norm_num [causalHardBottomEdge] at hx ⊢
· exact abs_le.mpr ⟨hx.1, hx.2.1⟩
· simp [hx.2.2]
have hzi : |z i| ≤ |x i| + |z i - x i| := by
calc
|z i| = |x i + (z i - x i)| := by congr 1 <;> ring
_ ≤ _ := abs_add_le _ _
constructor
· have : |z i| ≤ 3 := by linarith
exact (abs_le.mp this).1
· have : |z i| ≤ 3 := by linarith
exact (abs_le.mp this).2
A planar hard cell has the usual disk area.
Formal statement
Proof (Lean source)
-- @node: causalHardCell_volume
lemma causalHardCell_volume (x : Score) (w : ℝ) (hw : 0 ≤ w) :
volume (causalHardCell x w) = ofReal (pi * w ^ 2) := by
rw [causalHardCell, EuclideanSpace.volume_closedBall_fin_two]
rw [← ENNReal.ofReal_pow hw]
rw [← ENNReal.ofReal_mul (sq_nonneg w)]
congr 1
ring
theorem causalHardGrid_geometry
For every sufficiently small positive radius, the translated explicit grid supplies the cardinality, containment, three-radius separation, and full-disc disjointness required by the causal hard family.
Formal statement
hypotheses
w :
ℝ
hw0 :
0 < w
hw :
w ≤ 1 / 24
conclusion
let M := angularGridSize w 1 / (24 * w) ≤ (M : ℝ) ∧
(∀ i j : Fin M, i ≠ j → Disjoint (causalHardCell (causalHardGridCenter M i) w) (causalHardCell (causalHardGridCenter M j) w))
Proof (Lean source)
-- @node: causalHardGrid_geometry
lemma causalHardGrid_geometry (w : ℝ) (hw0 : 0 < w) (hw : w ≤ 1 / 24) :
let M := angularGridSize w
1 / (24 * w) ≤ (M : ℝ) ∧
(∀ j : Fin M, causalHardGridCenter M j ∈ causalHardBottomEdge) ∧
(∀ j : Fin M,
causalHardCell (causalHardGridCenter M j) w ⊆ causalHardSquare) ∧
(∀ i j : Fin M, i ≠ j →
3 * w ≤ dist (causalHardGridCenter M i) (causalHardGridCenter M j)) ∧
(∀ i j : Fin M, i ≠ j →
Disjoint (causalHardCell (causalHardGridCenter M i) w)
(causalHardCell (causalHardGridCenter M j) w)) := by
let M := angularGridSize w
have hspacing : 3 * w ≤ 1 / (2 * (M + 1 : ℕ) : ℝ) := by
simpa [M] using angularGridSize_spacing w hw0 hw
have hsep : ∀ i j : Fin M, i ≠ j →
3 * w ≤ dist (causalHardGridCenter M i) (causalHardGridCenter M j) := by
intro i j hij
exact hspacing.trans (causalHardGridCenter_separated M i j hij)
refine ⟨angularGridSize_lower w hw0 hw, ?_, ?_, hsep, ?_⟩
· exact fun j => causalHardGridCenter_mem_bottomEdge M j
· intro j
exact causalHardCell_subset_square (causalHardGridCenter_mem_bottomEdge M j)
(hw.trans (by norm_num))
· intro i j hij
change Disjoint
(closedBall (causalHardGridCenter M i) w)
(closedBall (causalHardGridCenter M j) w)
apply Metric.closedBall_disjoint_closedBall
have hs := hsep i j hij
linarith
theorem causalHardGrid_scaled_geometry
At the paper bandwidth w = A Δ^(1/(p+1)), the explicit grid realizes the exact inverse-bandwidth cardinality rate and every geometric cell clause of A1A2HypercubeAt.
Formal statement
hypotheses
conclusion
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) let M := angularGridSize w (M : ℝ)
≥ (1 / (24 * A)) * rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
w = A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ i j : Fin M, i ≠ j → Disjoint (causalHardCell (causalHardGridCenter M i) w) (causalHardCell (causalHardGridCenter M j) w))
Proof (Lean source)
-- @node: causalHardGrid_scaled_geometry
lemma causalHardGrid_scaled_geometry (p : ℕ) {A Δ : ℝ}
(hA : 0 < A) (hΔ : 0 < Δ)
(hsmall : A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) ≤ 1 / 24) :
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
(M : ℝ) ≥ (1 / (24 * A)) *
rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
w = A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ j : Fin M, causalHardGridCenter M j ∈ causalHardBottomEdge) ∧
(∀ j : Fin M,
causalHardCell (causalHardGridCenter M j) w ⊆ causalHardSquare) ∧
(∀ i j : Fin M, i ≠ j →
dist (causalHardGridCenter M i) (causalHardGridCenter M j) ≥ 2 * w) ∧
(∀ i j : Fin M, i ≠ j →
Disjoint (causalHardCell (causalHardGridCenter M i) w)
(causalHardCell (causalHardGridCenter M j) w)) := by
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
have hrpow : 0 < rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) :=
Real.rpow_pos_of_pos hΔ _
have hw0 : 0 < w := mul_pos hA hrpow
have hgeom := causalHardGrid_geometry w hw0 hsmall
have hrate :
(1 / (24 * A)) * rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) =
1 / (24 * w) := by
have hneg : rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) =
(rpow Δ ((1 : ℝ) / (p + 1 : ℝ)))⁻¹ := by
rw [show -(1 : ℝ) / (p + 1 : ℝ) =
-((1 : ℝ) / (p + 1 : ℝ)) by ring]
exact Real.rpow_neg hΔ.le _
rw [hneg]
dsimp [w]
field_simp
refine ⟨?_, rfl, hgeom.2.1, hgeom.2.2.1, ?_, hgeom.2.2.2.2⟩
· rw [hrate]
exact hgeom.1
· intro i j hij
have hs := hgeom.2.2.2.1 i j hij
linarith [hw0]
theorem causalHardGrid_scaled_family_geometry
The scaled grid certificates in the constructor-ready form used by the hard-law family, retaining the stronger three-radius separation proved by the underlying explicit grid.
Formal statement
hypotheses
conclusion
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) let M := angularGridSize w 0 < w ∧
(M : ℝ) ≥ (1 / (24 * A)) * rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
w = A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ i j : Fin M, i ≠ j → Disjoint (causalHardCell (causalHardGridCenter M i) w) (causalHardCell (causalHardGridCenter M j) w))
Proof (Lean source)
-- @node: causalHardGrid_scaled_family_geometry
lemma causalHardGrid_scaled_family_geometry (p : ℕ) {A Δ : ℝ}
(hA : 0 < A) (hΔ : 0 < Δ)
(hsmall : A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) ≤ 1 / 24) :
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
0 < w ∧
(M : ℝ) ≥ (1 / (24 * A)) *
rpow Δ (-(1 : ℝ) / (p + 1 : ℝ)) ∧
w = A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) ∧
(∀ j : Fin M, causalHardGridCenter M j ∈ causalHardBottomEdge) ∧
(∀ j : Fin M,
causalHardCell (causalHardGridCenter M j) w ⊆ causalHardSquare) ∧
(∀ i j : Fin M, i ≠ j →
3 * w ≤ dist (causalHardGridCenter M i) (causalHardGridCenter M j)) ∧
(∀ i j : Fin M, i ≠ j →
Disjoint (causalHardCell (causalHardGridCenter M i) w)
(causalHardCell (causalHardGridCenter M j) w)) := by
let w := A * rpow Δ ((1 : ℝ) / (p + 1 : ℝ))
let M := angularGridSize w
have hrpow : 0 < rpow Δ ((1 : ℝ) / (p + 1 : ℝ)) :=
Real.rpow_pos_of_pos hΔ _
have hw0 : 0 < w := mul_pos hA hrpow
have hscaled := causalHardGrid_scaled_geometry p hA hΔ hsmall
have hgrid := causalHardGrid_geometry w hw0 hsmall
exact ⟨hw0, hscaled.1, hscaled.2.1, hscaled.2.2.1,
hscaled.2.2.2.1, hgrid.2.2.2.1, hscaled.2.2.2.2.2⟩
Causal.Hypercube.HardSquareGram 3 declarations This module isolates the finite-dimensional compactness argument behind the population-Gram floor.
Polynomial coercivity for the hard-square Gram certificate
This module isolates the finite-dimensional compactness argument behind the
population-Gram floor. Its radial energy is the polar-coordinate integral
of the squared degree-p local polynomial on a fixed nondegenerate interval.
theorem firstQuadrant_radial_integral
A radial integrand over the open first-quadrant sector of a disk has the expected polar-coordinate representation. The omitted coordinate axes are Lebesgue-null, so this is the fixed π / 2 sector used at rectangle corners.
Formal statement
hypotheses
g :
ℝ → ℝ
r :
ℝ
conclusion
(∫ z : ℝ × ℝ in {z | 0 < z.1 ∧ 0 < z.2 ∧ planarRadius z ≤ r}, g (planarRadius z))
Proof (Lean source)
-- @node: firstQuadrant_radial_integral
lemma firstQuadrant_radial_integral (g : ℝ → ℝ) (r : ℝ) :
(∫ z : ℝ × ℝ in
{z | 0 < z.1 ∧ 0 < z.2 ∧ planarRadius z ≤ r}, g (planarRadius z)) =
∫ s : ℝ in Ioc 0 r, (pi / 2) * s * g s := by
let D : Set (ℝ × ℝ) :=
{z | 0 < z.1 ∧ 0 < z.2 ∧ planarRadius z ≤ r}
let E : Set (ℝ × ℝ) := Ioc 0 r ×ˢ Ioo 0 (pi / 2)
have hD : MeasurableSet D := by
change MeasurableSet {z : ℝ × ℝ |
0 < z.1 ∧ 0 < z.2 ∧ planarRadius z ≤ r}
exact (measurableSet_lt measurable_const measurable_fst).inter
((measurableSet_lt measurable_const measurable_snd).inter
(measurableSet_le planarRadius_measurable measurable_const))
have hE : MeasurableSet E := measurableSet_Ioc.prod measurableSet_Ioo
change (∫ z : ℝ × ℝ in D, g (planarRadius z)) = _
rw [← integral_indicator hD, ← integral_comp_polarCoord_symm]
rw [show (∫ q in polarCoord.target,
q.1 • D.indicator (fun z => g (planarRadius z)) (polarCoord.symm q)) =
∫ q in E, q.1 * g q.1 by
rw [← integral_indicator polarCoord.open_target.measurableSet,
← integral_indicator hE]
apply integral_congr_ae
filter_upwards with q
by_cases hq : q ∈ polarCoord.target
· have hqtarget := hq
simp only [polarCoord_target, mem_prod, mem_Ioi, mem_Ioo] at hq
have hinv := polarCoord.right_inv hq
have hrs : planarRadius (polarCoord.symm q) = q.1 :=
congrArg Prod.fst hinv
have hsin : 0 < sin q.2 ↔ 0 < q.2 := by
constructor
· intro hs
by_contra hn
exact (not_lt_of_ge (Real.sin_nonpos_of_nonpos_of_neg_pi_le
(le_of_not_gt hn) hq.2.1.le)) hs
· intro htheta
exact Real.sin_pos_of_pos_of_lt_pi htheta hq.2.2
have hcos (htheta0 : 0 < q.2) :
0 < cos q.2 ↔ q.2 < pi / 2 := by
constructor
· intro hc
by_contra hn
exact (not_lt_of_ge (Real.cos_nonpos_of_pi_div_two_le_of_le
(le_of_not_gt hn) (by linarith [Real.pi_pos]))) hc
· intro htheta
exact Real.cos_pos_of_mem_Ioo ⟨by linarith, htheta⟩
have hy : 0 < q.1 * sin q.2 ↔ 0 < q.2 :=
(mul_pos_iff_of_pos_left hq.1).trans hsin
have hmem : polarCoord.symm q ∈ D ↔ q ∈ E := by
change (0 < (polarCoord.symm q).1 ∧
0 < (polarCoord.symm q).2 ∧
planarRadius (polarCoord.symm q) ≤ r) ↔
(0 < q.1 ∧ q.1 ≤ r) ∧ 0 < q.2 ∧ q.2 < pi / 2
rw [hrs]
simp only [polarCoord_symm_apply]
constructor
· rintro ⟨hx, hy', hr⟩
have htheta0 := hy.mp hy'
exact ⟨⟨hq.1, hr⟩, htheta0,
(hcos htheta0).mp ((mul_pos_iff_of_pos_left hq.1).mp hx)⟩
· rintro ⟨⟨_, hr⟩, htheta0, htheta1⟩
exact ⟨(mul_pos_iff_of_pos_left hq.1).mpr
((hcos htheta0).mpr htheta1),
hy.mpr htheta0, hr⟩
by_cases hmemD : polarCoord.symm q ∈ D
· rw [indicator_of_mem hqtarget, indicator_of_mem hmemD,
indicator_of_mem (hmem.mp hmemD), hrs]
simp [smul_eq_mul]
· rw [indicator_of_mem hqtarget]
simp only [indicator]
rw [if_neg hmemD, if_neg (mt hmem.mpr hmemD)]
simp
· have hqE : q ∉ E := by
rintro ⟨⟨hq0, _⟩, htheta0, htheta1⟩
apply hq
simp only [polarCoord_target, mem_prod, mem_Ioi, mem_Ioo]
exact ⟨hq0, lt_trans (neg_lt_zero.mpr Real.pi_pos) htheta0,
htheta1.trans (by linarith [Real.pi_pos])⟩
simp only [indicator]
rw [if_neg hq, if_neg hqE]
]
rw [show (fun q : ℝ × ℝ => q.1 * g q.1) =
fun q => (q.1 * g q.1) * (1 : ℝ) by funext q; ring]
change (∫ q in Ioc 0 r ×ˢ Ioo 0 (pi / 2),
(q.1 * g q.1) * (1 : ℝ)) = _
rw [Measure.volume_eq_prod]
rw [setIntegral_prod_mul (μ := volume) (ν := volume)
(fun s : ℝ => s * g s) (fun _ : ℝ => (1 : ℝ))
(Ioc 0 r) (Ioo 0 (pi / 2))]
rw [setIntegral_one_eq_measureReal, Measure.real_def, Real.volume_Ioo]
simp only [sub_zero, ENNReal.toReal_ofReal (by positivity : 0 ≤ pi / 2)]
rw [mul_comm, ← integral_const_mul]
apply integral_congr_ae
filter_upwards with s
ring
theorem firstQuadrant_scaledPolynomial_integral
After bandwidth rescaling, the normalized squared-polynomial integral over the first-quadrant sector is exactly π / 2 times its radial energy.
Formal statement
hypotheses
conclusion
(∫ z : ℝ × ℝ in {z | 0 < z.1 ∧ 0 < z.2 ∧ planarRadius z ≤ h}, h⁻¹ ^ 2 * (∑ i, v i * (if t then planarRadius z / h else -(planarRadius z / h)) ^ (i : ℕ)) ^ 2)
= (pi / 2) * ∫ u in (0 : ℝ)..1, (∑ i, v i * (if t then u else -u) ^ (i : ℕ)) ^ 2 * u
Proof (Lean source)
-- @node: firstQuadrant_scaledPolynomial_integral
lemma firstQuadrant_scaledPolynomial_integral (p : ℕ) (t : Bool)
(v : Fin (p + 1) → ℝ) {h : ℝ} (hh : 0 < h) :
(∫ z : ℝ × ℝ in
{z | 0 < z.1 ∧ 0 < z.2 ∧ planarRadius z ≤ h},
h⁻¹ ^ 2 *
(∑ i, v i * (if t then planarRadius z / h else
-(planarRadius z / h)) ^ (i : ℕ)) ^ 2) =
(pi / 2) *
∫ u in (0 : ℝ)..1,
(∑ i, v i * (if t then u else -u) ^ (i : ℕ)) ^ 2 * u := by
let F : ℝ → ℝ := fun u =>
(∑ i, v i * (if t then u else -u) ^ (i : ℕ)) ^ 2 * u
change (∫ z : ℝ × ℝ in
{z | 0 < z.1 ∧ 0 < z.2 ∧ planarRadius z ≤ h},
(fun s => h⁻¹ ^ 2 *
(∑ i, v i * (if t then s / h else -(s / h)) ^ (i : ℕ)) ^ 2)
(planarRadius z)) = _
rw [firstQuadrant_radial_integral
(fun s => h⁻¹ ^ 2 *
(∑ i, v i * (if t then s / h else -(s / h)) ^ (i : ℕ)) ^ 2) h]
rw [← intervalIntegral.integral_of_le hh.le]
have hfun : (fun s : ℝ => (pi / 2) * s *
(h⁻¹ ^ 2 *
(∑ i, v i * (if t then s / h else -(s / h)) ^ (i : ℕ)) ^ 2)) =
fun s => (pi / 2 * h⁻¹) * F (s / h) := by
funext s
dsimp [F]
field_simp
<;> ring
rw [hfun, intervalIntegral.integral_const_mul]
rw [intervalIntegral.integral_comp_div F hh.ne']
simp only [zero_div, div_self hh.ne', smul_eq_mul]
change (pi / 2 * h⁻¹) *
(h * ∫ u in (0 : ℝ)..1, F u) = _
calc
_ = ((pi / 2 * h⁻¹) * h) *
∫ u in (0 : ℝ)..1, F u := by ring
_ = (pi / 2) * ∫ u in (0 : ℝ)..1, F u := by
rw [show (pi / 2 * h⁻¹) * h = pi / 2 by field_simp]
_ = _ := rfl
theorem populationGram_quadratic_eq_integral
The population Gram quadratic form is the integral of the squared local polynomial against the nonnegative arm and kernel weight.
Formal statement
hypotheses
conclusion
matrixQuadratic (populationGram P p t x h) v
= ∫ w, h⁻¹ ^ 2 * (if (if t then 0 ≤ signedDistance (knownGeometry P) x (causalScore w) else signedDistance (knownGeometry P) x (causalScore w) < 0) then 1 else 0) * uniformKernel (signedDistance (knownGeometry P) x (causalScore w) / h) * (∑ i, v i * (signedDistance (knownGeometry P) x (causalScore w) / h) ^ (i : ℕ)) ^ 2 ∂P.law
Proof (Lean source)
-- @node: populationGram_quadratic_eq_integral
lemma populationGram_quadratic_eq_integral (P : A1A2Law) (p : ℕ)
(t : Bool) (x : Score) {h : ℝ} (hh : h ≠ 0)
(v : Fin (p + 1) → ℝ) :
matrixQuadratic (populationGram P p t x h) v =
∫ w, h⁻¹ ^ 2 *
(if (if t then 0 ≤ signedDistance (knownGeometry P) x (causalScore w)
else signedDistance (knownGeometry P) x (causalScore w) < 0)
then 1 else 0) *
uniformKernel (signedDistance (knownGeometry P) x (causalScore w) / h) *
(∑ i, v i * (signedDistance (knownGeometry P) x (causalScore w) / h) ^
(i : ℕ)) ^ 2 ∂P.law := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
let d : CausalObservation → ℝ := fun w =>
signedDistance (knownGeometry P) x (causalScore w)
let a : CausalObservation → ℝ := fun w => h⁻¹ ^ 2 *
(if (if t then 0 ≤ d w else d w < 0) then 1 else 0) *
uniformKernel (d w / h)
have hscore : Measurable causalScore := measurable_snd.comp measurable_snd
have hA0 : MeasurableSet P.A0 := P.A0_measurable
have hA1 : MeasurableSet P.A1 := P.A1_measurable
have hd : Measurable d := by
dsimp [d, signedDistance, knownGeometry]
apply mul
· apply Measurable.sub
· exact (measurable_const.indicator hA1).comp hscore
· exact (measurable_const.indicator hA0).comp hscore
· exact continuous_dist.measurable.comp (hscore.prodMk measurable_const)
have harmMeas : MeasurableSet {w | if t then 0 ≤ d w else d w < 0} := by
cases t
· exact measurableSet_lt hd measurable_const
· exact measurableSet_le measurable_const hd
have hkMeas : Measurable (fun w => uniformKernel (d w / h)) := by
unfold uniformKernel
exact (measurable_const.indicator measurableSet_Icc).comp (hd.div_const h)
have ha : Measurable a := by
dsimp [a]
have hind : Measurable
(fun w => if (if t then 0 ≤ d w else d w < 0) then (1 : ℝ) else 0) := by
exact measurable_const.ite harmMeas measurable_const
exact (measurable_const.mul hind).mul hkMeas
have habs (w : CausalObservation) : |a w| ≤ |h⁻¹ ^ 2| := by
dsimp [a]
by_cases harm : if t then 0 ≤ d w else d w < 0
· simp only [harm, if_true]
by_cases hk : d w / h ∈ Icc (-1 : ℝ) 1
· rw [uniformKernel, indicator_of_mem hk]
simp
· rw [uniformKernel, indicator_of_notMem hk, mul_zero, abs_zero]
exact abs_nonneg _
· simp [harm, sq_nonneg]
have hentry (i j : Fin (p + 1)) : Integrable
(fun w => a w * polyBasis p (d w / h) i * polyBasis p (d w / h) j)
P.law := by
apply Integrable.of_bound
((ha.fun_mul ((hd.div_const h).pow_const _)).fun_mul
((hd.div_const h).pow_const _) |>.aestronglyMeasurable)
(h⁻¹ ^ 2)
filter_upwards with w
by_cases hk : d w / h ∈ Icc (-1 : ℝ) 1
· have hdu : |d w / h| ≤ 1 := abs_le.mpr hk
have hi : |(d w / h) ^ (i : ℕ)| ≤ 1 := by
rw [abs_pow]
exact pow_le_one₀ (abs_nonneg _) hdu
have hj : |(d w / h) ^ (j : ℕ)| ≤ 1 := by
rw [abs_pow]
exact pow_le_one₀ (abs_nonneg _) hdu
have haw : 0 ≤ a w := by
dsimp [a]
by_cases harm : if t then 0 ≤ d w else d w < 0
· rw [if_pos harm, uniformKernel, indicator_of_mem hk]
positivity
· simp [harm]
have haw' : a w ≤ h⁻¹ ^ 2 := by
rw [← abs_of_nonneg haw, ← abs_of_nonneg (sq_nonneg h⁻¹)]
exact habs w
dsimp [polyBasis]
rw [abs_mul, abs_mul]
calc
|a w| * |(d w / h) ^ (i : ℕ)| * |(d w / h) ^ (j : ℕ)|
≤ |h⁻¹ ^ 2| * 1 * 1 := by gcongr
_ = h⁻¹ ^ 2 := by rw [abs_of_nonneg (sq_nonneg _)]; ring
· have hzero : a w = 0 := by
dsimp [a]
rw [uniformKernel, indicator_of_notMem hk, mul_zero]
rw [hzero]
simp [sq_nonneg]
unfold matrixQuadratic populationGram
change (∑ i, ∑ j, v i * (∫ w, a w * polyBasis p (d w / h) i *
polyBasis p (d w / h) j ∂P.law) * v j) = _
calc
_ = ∑ i, ∑ j, ∫ w, v i *
(a w * polyBasis p (d w / h) i * polyBasis p (d w / h) j) * v j
∂P.law := by
apply Finset.sum_congr rfl
intro i hi
apply Finset.sum_congr rfl
intro j hj
rw [← integral_const_mul, ← integral_mul_const]
_ = ∫ w, ∑ i, ∑ j, v i *
(a w * polyBasis p (d w / h) i * polyBasis p (d w / h) j) * v j
∂P.law := by
symm
rw [integral_finset_sum univ (fun i _ =>
integrable_finset_sum _ fun j _ =>
((hentry i j).const_mul (v i)).mul_const (v j))]
apply Finset.sum_congr rfl
intro i hi
rw [integral_finset_sum univ (fun j _ =>
((hentry i j).const_mul (v i)).mul_const (v j))]
_ = _ := by
apply integral_congr_ae
filter_upwards with w
have hrank := matrixQuadratic_polyBasis_rankOne p (a w) (d w / h) v
change (∑ i, ∑ j, v i *
(a w * polyBasis p (d w / h) i * polyBasis p (d w / h) j) * v j) =
a w * (∑ i, v i * (d w / h) ^ (i : ℕ)) ^ 2
simpa only [matrixQuadratic, mul_assoc, mul_left_comm, mul_comm] using hrank
Causal.Hypercube.HardSquareGramCertificate 27 declarations This module transports the hard law to its score density, restricts the Gram quadratic form to a fixed radial sector in either assignment arm, and combines the resulting polar integral with finite-dimensional polynomial
Population-Gram certificate for the hard square
This module transports the hard law to its score density, restricts the Gram quadratic form to a fixed radial sector in either assignment arm, and combines the resulting polar integral with finite-dimensional polynomial coercivity.
A component of the fixed hard-square population-Gram certificate.
theorem scoreOfProd_apply
A component of the fixed hard-square population-Gram certificate.
Formal statement
Proof (Lean source)
-- @node: scoreOfProd_apply
lemma scoreOfProd_apply (q : ℝ × ℝ) :
scoreOfProd q = scorePoint q.1 q.2 := by
ext i
fin_cases i <;> rfl
theorem scoreOfProd_volumePreserving
A component of the fixed hard-square population-Gram certificate.
Formal statement
conclusion
Proof (Lean source)
-- @node: scoreOfProd_volumePreserving
lemma scoreOfProd_volumePreserving :
MeasurePreserving scoreOfProd (volume : Measure (ℝ × ℝ)) volume := by
have h1 : MeasurePreserving MeasurableEquiv.finTwoArrow.symm
(volume : Measure (ℝ × ℝ)) (volume : Measure (Fin 2 → ℝ)) :=
(volume_preserving_finTwoArrow ℝ).symm MeasurableEquiv.finTwoArrow
have h2 : MeasurePreserving (MeasurableEquiv.toLp 2 (Fin 2 → ℝ))
(volume : Measure (Fin 2 → ℝ)) (volume : Measure Score) :=
PiLp.volume_preserving_toLp (Fin 2)
exact h2.comp h1
A component of the fixed hard-square population-Gram certificate.
Definition (Lean source)
-- @node: signedProdEquiv
noncomputable def signedProdEquiv (sx sy : Bool) : (ℝ × ℝ) ≃ᵐ (ℝ × ℝ) :=
MeasurableEquiv.prodCongr
(if sx then MeasurableEquiv.refl ℝ else MeasurableEquiv.neg ℝ)
(if sy then MeasurableEquiv.refl ℝ else MeasurableEquiv.neg ℝ)
theorem signedProdEquiv_volumePreserving
A component of the fixed hard-square population-Gram certificate.
Formal statement
Proof (Lean source)
-- @node: signedProdEquiv_volumePreserving
lemma signedProdEquiv_volumePreserving (sx sy : Bool) :
MeasurePreserving (signedProdEquiv sx sy) volume volume := by
cases sx <;> cases sy
· exact
(Measure.measurePreserving_neg (volume : Measure ℝ)).prod
(Measure.measurePreserving_neg (volume : Measure ℝ))
· exact
(Measure.measurePreserving_neg (volume : Measure ℝ)).prod
(MeasurePreserving.id (volume : Measure ℝ))
· exact
(MeasurePreserving.id (volume : Measure ℝ)).prod
(Measure.measurePreserving_neg (volume : Measure ℝ))
· exact
(MeasurePreserving.id (volume : Measure ℝ)).prod
(MeasurePreserving.id (volume : Measure ℝ))
A component of the fixed hard-square population-Gram certificate.
Definition (Lean source)
-- @node: hardSquareSectorEquiv
noncomputable def hardSquareSectorEquiv (x : Score) (sx sy : Bool) :
(ℝ × ℝ) ≃ᵐ Score :=
(signedProdEquiv sx sy).trans scoreOfProd |>.trans (MeasurableEquiv.addLeft x)
theorem hardSquareSectorEquiv_volumePreserving
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: hardSquareSectorEquiv_volumePreserving
lemma hardSquareSectorEquiv_volumePreserving (x : Score) (sx sy : Bool) :
MeasurePreserving (hardSquareSectorEquiv x sx sy) volume volume := by
exact (measurePreserving_add_left volume x).comp
(scoreOfProd_volumePreserving.comp (signedProdEquiv_volumePreserving sx sy))
theorem hardSquareSectorEquiv_dist
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: hardSquareSectorEquiv_dist
lemma hardSquareSectorEquiv_dist (x : Score) (sx sy : Bool) (q : ℝ × ℝ) :
dist (hardSquareSectorEquiv x sx sy q) x = planarRadius q := by
cases sx <;> cases sy
all_goals
rw [hardSquareSectorEquiv, MeasurableEquiv.trans_apply, MeasurableEquiv.trans_apply,
MeasurableEquiv.coe_addLeft]
conv_lhs => rhs; rw [← add_zero x]
rw [dist_add_left]
rw [scoreOfProd_apply, dist_zero_right, EuclideanSpace.norm_eq]
all_goals simp [signedProdEquiv, MeasurableEquiv.prodCongr, Equiv.prodCongr,
Fin.sum_univ_two, scorePoint_apply_zero,
scorePoint_apply_one, Real.norm_eq_abs, sq_abs, planarRadius]
theorem hardSquareSectorEquiv_apply_zero
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
conclusion
hardSquareSectorEquiv x sx sy q 0 = x 0 + if sx then q.1 else -q.1
Proof (Lean source)
-- @node: hardSquareSectorEquiv_apply_zero
lemma hardSquareSectorEquiv_apply_zero (x : Score) (sx sy : Bool) (q : ℝ × ℝ) :
hardSquareSectorEquiv x sx sy q 0 = x 0 + if sx then q.1 else -q.1 := by
cases sx <;> cases sy <;>
simp [hardSquareSectorEquiv, signedProdEquiv, MeasurableEquiv.prodCongr,
Equiv.prodCongr, scoreOfProd_apply, scorePoint_apply_zero]
theorem hardSquareSectorEquiv_apply_one
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
conclusion
hardSquareSectorEquiv x sx sy q 1 = x 1 + if sy then q.2 else -q.2
Proof (Lean source)
-- @node: hardSquareSectorEquiv_apply_one
lemma hardSquareSectorEquiv_apply_one (x : Score) (sx sy : Bool) (q : ℝ × ℝ) :
hardSquareSectorEquiv x sx sy q 1 = x 1 + if sy then q.2 else -q.2 := by
cases sx <;> cases sy <;>
simp [hardSquareSectorEquiv, signedProdEquiv, MeasurableEquiv.prodCongr,
Equiv.prodCongr, scoreOfProd_apply, scorePoint_apply_one]
theorem fst_le_planarRadius
A component of the fixed hard-square population-Gram certificate.
Formal statement
Proof (Lean source)
-- @node: fst_le_planarRadius
lemma fst_le_planarRadius (q : ℝ × ℝ) :
q.1 ≤ planarRadius q := by
rw [planarRadius]
exact (le_abs_self q.1).trans
(Real.abs_le_sqrt (by nlinarith [sq_nonneg q.2]))
theorem snd_le_planarRadius
A component of the fixed hard-square population-Gram certificate.
Formal statement
Proof (Lean source)
-- @node: snd_le_planarRadius
lemma snd_le_planarRadius (q : ℝ × ℝ) :
q.2 ≤ planarRadius q := by
rw [planarRadius]
exact (le_abs_self q.2).trans
(Real.abs_le_sqrt (by nlinarith [sq_nonneg q.1]))
A component of the fixed hard-square population-Gram certificate.
Definition (Lean source)
-- @node: hardSquareSectorDomain
def hardSquareSectorDomain (h : ℝ) : Set (ℝ × ℝ) :=
{q | 0 < q.1 ∧ 0 < q.2 ∧ planarRadius q ≤ h}
theorem hardSquareArmOne_sector_subset
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
x :
h :
ℝ
hx :
hh1 :
h ≤ 1
sx sy :
conclusion
Proof (Lean source)
-- @node: hardSquareArmOne_sector_subset
lemma hardSquareArmOne_sector_subset {x : Score} {h : ℝ}
(hx : x ∈ frontier causalHardArmOne) (hh1 : h ≤ 1)
(sx sy : Bool)
(hsx : (sx = true ∧ x 0 ≤ 0) ∨ (sx = false ∧ 0 ≤ x 0))
(hsy : (sy = true ∧ x 1 ≤ 1) ∨ (sy = false ∧ 1 ≤ x 1)) :
hardSquareSectorEquiv x sx sy '' hardSquareSectorDomain h ⊆
causalHardArmOne ∩ closedBall x h := by
have hx' := (mem_frontier_causalHardArmOne_iff x).mp hx
cases sx <;> cases sy
all_goals simp at hsx hsy
all_goals
rintro z ⟨q, hq, rfl⟩
change 0 < q.1 ∧ 0 < q.2 ∧ planarRadius q ≤ h at hq
have hq0 := fst_le_planarRadius q
have hq1 := snd_le_planarRadius q
refine ⟨?_, ?_⟩
· simp only [causalHardArmOne, mem_setOf_eq, hardSquareSectorEquiv_apply_zero,
hardSquareSectorEquiv_apply_one, Bool.false_eq_true, Bool.true_eq,
if_true, if_false]
repeat' apply intro
all_goals linarith [hq.2.2]
· rw [Metric.mem_closedBall, hardSquareSectorEquiv_dist]
exact hq.2.2
theorem hardSquareArmOne_contains_sector
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
conclusion
∃ sx sy : Bool,
Proof (Lean source)
-- @node: hardSquareArmOne_contains_sector
lemma hardSquareArmOne_contains_sector {x : Score} {h : ℝ}
(hx : x ∈ frontier causalHardArmOne) (_hh : 0 < h) (hh1 : h ≤ 1) :
∃ sx sy : Bool,
hardSquareSectorEquiv x sx sy '' hardSquareSectorDomain h ⊆
causalHardArmOne ∩ closedBall x h := by
by_cases hx0 : x 0 ≤ 0 <;> by_cases hx1 : x 1 ≤ 1
· exact ⟨true, true, hardSquareArmOne_sector_subset hx hh1 true true
(inl ⟨rfl, hx0⟩) (inl ⟨rfl, hx1⟩)⟩
· exact ⟨true, false, hardSquareArmOne_sector_subset hx hh1 true false
(inl ⟨rfl, hx0⟩) (inr ⟨rfl, le_of_not_ge hx1⟩)⟩
· exact ⟨false, true, hardSquareArmOne_sector_subset hx hh1 false true
(inr ⟨rfl, le_of_not_ge hx0⟩) (inl ⟨rfl, hx1⟩)⟩
· exact ⟨false, false, hardSquareArmOne_sector_subset hx hh1 false false
(inr ⟨rfl, le_of_not_ge hx0⟩) (inr ⟨rfl, le_of_not_ge hx1⟩)⟩
theorem hardSquareArmZero_sector_subset
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
x :
h :
ℝ
hx :
hh1 :
h ≤ 1
sx sy :
conclusion
hardSquareSectorEquiv x sx sy '' hardSquareSectorDomain h ⊆ (causalHardSquare \ causalHardArmOne) ∩ closedBall x h
Proof (Lean source)
-- @node: hardSquareArmZero_sector_subset
lemma hardSquareArmZero_sector_subset {x : Score} {h : ℝ}
(hx : x ∈ frontier causalHardArmOne) (hh1 : h ≤ 1)
(sx sy : Bool)
(hedge : (sx = false ∧ x 0 = -1) ∨ (sx = true ∧ x 0 = 1) ∨
(sy = false ∧ x 1 = 0) ∨ (sy = true ∧ x 1 = 2)) :
hardSquareSectorEquiv x sx sy '' hardSquareSectorDomain h ⊆
(causalHardSquare \ causalHardArmOne) ∩ closedBall x h := by
have hx' := (mem_frontier_causalHardArmOne_iff x).mp hx
rintro z ⟨q, hq, rfl⟩
change 0 < q.1 ∧ 0 < q.2 ∧ planarRadius q ≤ h at hq
have hq0 := fst_le_planarRadius q
have hq1 := snd_le_planarRadius q
have hz0 := hardSquareSectorEquiv_apply_zero x sx sy q
have hz1 := hardSquareSectorEquiv_apply_one x sx sy q
have hq0h : q.1 ≤ h := hq0.trans hq.2.2
have hq1h : q.2 ≤ h := hq1.trans hq.2.2
have hdiff0 :
|hardSquareSectorEquiv x sx sy q 0 - x 0| ≤ h := by
rw [hz0]
cases sx <;> simp [abs_of_pos hq.1] <;> linarith
have hdiff1 :
|hardSquareSectorEquiv x sx sy q 1 - x 1| ≤ h := by
rw [hz1]
cases sy <;> simp [abs_of_pos hq.2.1] <;> linarith
refine ⟨⟨?_, ?_⟩, ?_⟩
· intro i
fin_cases i
· change -3 ≤ hardSquareSectorEquiv x sx sy q 0 ∧
hardSquareSectorEquiv x sx sy q 0 ≤ 3
rw [abs_le] at hdiff0
constructor <;> linarith
· change -3 ≤ hardSquareSectorEquiv x sx sy q 1 ∧
hardSquareSectorEquiv x sx sy q 1 ≤ 3
rw [abs_le] at hdiff1
constructor <;> linarith
· intro hA
simp only [causalHardArmOne, mem_setOf_eq] at hA
rcases hedge with ⟨rfl, hedge⟩ | ⟨rfl, hedge⟩ |
⟨rfl, hedge⟩ | ⟨rfl, hedge⟩
· simp at hz0
rw [hz0, hedge] at hA
linarith
· simp at hz0
rw [hz0, hedge] at hA
linarith
· simp at hz1
rw [hz1, hedge] at hA
linarith
· simp at hz1
rw [hz1, hedge] at hA
linarith
· rw [Metric.mem_closedBall, hardSquareSectorEquiv_dist]
exact hq.2.2
theorem hardSquareArmZero_contains_sector
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
conclusion
∃ sx sy : Bool,
hardSquareSectorEquiv x sx sy '' hardSquareSectorDomain h ⊆ (causalHardSquare \ causalHardArmOne) ∩ closedBall x h
Proof (Lean source)
-- @node: hardSquareArmZero_contains_sector
lemma hardSquareArmZero_contains_sector {x : Score} {h : ℝ}
(hx : x ∈ frontier causalHardArmOne) (_hh : 0 < h) (hh1 : h ≤ 1) :
∃ sx sy : Bool,
hardSquareSectorEquiv x sx sy '' hardSquareSectorDomain h ⊆
(causalHardSquare \ causalHardArmOne) ∩ closedBall x h := by
rcases (mem_frontier_causalHardArmOne_iff x).mp hx |>.2.2.2.2 with h | h | h | h
· exact ⟨false, true, hardSquareArmZero_sector_subset hx hh1 false true
(inl ⟨rfl, h⟩)⟩
· exact ⟨true, true, hardSquareArmZero_sector_subset hx hh1 true true
(inr (inl ⟨rfl, h⟩))⟩
· exact ⟨true, false, hardSquareArmZero_sector_subset hx hh1 true false
(inr (inr (inl ⟨rfl, h⟩)))⟩
· exact ⟨true, true, hardSquareArmZero_sector_subset hx hh1 true true
(inr (inr (inr ⟨rfl, h⟩)))⟩
A component of the fixed hard-square population-Gram certificate.
Definition (Lean source)
-- @node: hardSquareGramScoreIntegrand
noncomputable def hardSquareGramScoreIntegrand (P : A1A2Law) (p : ℕ)
(t : Bool) (x : Score) (h : ℝ) (v : Fin (p + 1) → ℝ)
(z : Score) : ℝ :=
h⁻¹ ^ 2 *
(if (if t then 0 ≤ signedDistance (knownGeometry P) x z
else signedDistance (knownGeometry P) x z < 0) then 1 else 0) *
uniformKernel (signedDistance (knownGeometry P) x z / h) *
(∑ i, v i * (signedDistance (knownGeometry P) x z / h) ^ (i : ℕ)) ^ 2
theorem hardSquareGramScoreIntegrand_measurable
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
conclusion
Measurable (hardSquareGramScoreIntegrand P p t x h v)
Proof (Lean source)
-- @node: hardSquareGramScoreIntegrand_measurable
lemma hardSquareGramScoreIntegrand_measurable (P : A1A2Law) (p : ℕ)
(t : Bool) (x : Score) (h : ℝ) (v : Fin (p + 1) → ℝ) :
Measurable (hardSquareGramScoreIntegrand P p t x h v) := by
have hd : Measurable (fun z => signedDistance (knownGeometry P) x z) := by
unfold signedDistance knownGeometry
exact ((measurable_const.indicator P.A1_measurable).sub
(measurable_const.indicator P.A0_measurable)).mul
(continuous_dist.measurable.comp (measurable_id.prodMk measurable_const))
have harm : MeasurableSet {z | if t then
0 ≤ signedDistance (knownGeometry P) x z
else signedDistance (knownGeometry P) x z < 0} := by
cases t
· exact measurableSet_lt hd measurable_const
· exact measurableSet_le measurable_const hd
have hind : Measurable (fun z =>
if (if t then 0 ≤ signedDistance (knownGeometry P) x z
else signedDistance (knownGeometry P) x z < 0) then (1 : ℝ) else 0) :=
measurable_const.ite harm measurable_const
have hk : Measurable (fun z =>
uniformKernel (signedDistance (knownGeometry P) x z / h)) := by
unfold uniformKernel
exact (measurable_const.indicator measurableSet_Icc).comp (hd.div_const h)
unfold hardSquareGramScoreIntegrand
fun_prop
theorem hardSquareGramScoreIntegrand_nonneg
A component of the fixed hard-square population-Gram certificate.
Formal statement
Proof (Lean source)
-- @node: hardSquareGramScoreIntegrand_nonneg
lemma hardSquareGramScoreIntegrand_nonneg (P : A1A2Law) (p : ℕ)
(t : Bool) (x : Score) (h : ℝ) (v : Fin (p + 1) → ℝ) (z : Score) :
0 ≤ hardSquareGramScoreIntegrand P p t x h v z := by
unfold hardSquareGramScoreIntegrand
by_cases ha : if t then 0 ≤ signedDistance (knownGeometry P) x z
else signedDistance (knownGeometry P) x z < 0
· rw [if_pos ha]
have hk : 0 ≤ uniformKernel (signedDistance (knownGeometry P) x z / h) := by
unfold uniformKernel
by_cases hu : signedDistance (knownGeometry P) x z / h ∈ Icc (-1 : ℝ) 1
· rw [indicator_of_mem hu]; positivity
· rw [indicator_of_notMem hu]
positivity
· simp [ha]
theorem hardSquareGramScoreIntegrand_integrable
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: hardSquareGramScoreIntegrand_integrable
lemma hardSquareGramScoreIntegrand_integrable (P : A1A2Law) (p : ℕ)
(t : Bool) (x : Score) {h : ℝ} (hh : h ≠ 0)
(v : Fin (p + 1) → ℝ) :
Integrable (hardSquareGramScoreIntegrand P p t x h v)
(P.law.map causalScore) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
letI : IsProbabilityMeasure (P.law.map causalScore) :=
Measure.isProbabilityMeasure_map (measurable_snd.comp measurable_snd).aemeasurable
let C : ℝ := |h⁻¹ ^ 2| * (∑ i, |v i|) ^ 2
apply Integrable.of_bound
((hardSquareGramScoreIntegrand_measurable P p t x h v).aestronglyMeasurable)
C
filter_upwards with z
let d := signedDistance (knownGeometry P) x z
by_cases hu : d / h ∈ Icc (-1 : ℝ) 1
· have habsu : |d / h| ≤ 1 := abs_le.mpr hu
have hsum : |∑ i, v i * (d / h) ^ (i : ℕ)| ≤ ∑ i, |v i| := by
calc
|∑ i, v i * (d / h) ^ (i : ℕ)| ≤
∑ i, |v i * (d / h) ^ (i : ℕ)| := Finset.abs_sum_le_sum_abs _ _
_ ≤ ∑ i, |v i| := by
apply Finset.sum_le_sum
intro i hi
rw [abs_mul, abs_pow]
exact mul_le_of_le_one_right (abs_nonneg (v i))
(pow_le_one₀ (abs_nonneg _) habsu)
unfold hardSquareGramScoreIntegrand
change |h⁻¹ ^ 2 *
(if (if t then 0 ≤ d else d < 0) then 1 else 0) *
uniformKernel (d / h) * (∑ i, v i * (d / h) ^ (i : ℕ)) ^ 2| ≤ C
rw [uniformKernel, indicator_of_mem hu]
by_cases ha : if t then 0 ≤ d else d < 0
· rw [if_pos ha]
dsimp [C]
simp only [mul_one, abs_mul, abs_pow]
gcongr
· rw [if_neg ha]
simp [C]
positivity
· have hk : uniformKernel (d / h) = 0 := by
rw [uniformKernel, indicator_of_notMem hu]
unfold hardSquareGramScoreIntegrand
change |h⁻¹ ^ 2 *
(if (if t then 0 ≤ d else d < 0) then 1 else 0) *
uniformKernel (d / h) * (∑ i, v i * (d / h) ^ (i : ℕ)) ^ 2| ≤ C
rw [hk]
simp [C]
positivity
theorem populationGram_quadratic_eq_scoreIntegral
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
conclusion
matrixQuadratic (populationGram P p t x h) v
= ∫ z, hardSquareGramScoreIntegrand P p t x h v z ∂(P.law.map causalScore)
Proof (Lean source)
-- @node: populationGram_quadratic_eq_scoreIntegral
lemma populationGram_quadratic_eq_scoreIntegral (P : A1A2Law) (p : ℕ)
(t : Bool) (x : Score) {h : ℝ} (hh : h ≠ 0)
(v : Fin (p + 1) → ℝ) :
matrixQuadratic (populationGram P p t x h) v =
∫ z, hardSquareGramScoreIntegrand P p t x h v z ∂(P.law.map causalScore) := by
rw [populationGram_quadratic_eq_integral P p t x hh v]
symm
apply integral_map (measurable_snd.comp measurable_snd).aemeasurable
exact (hardSquareGramScoreIntegrand_integrable P p t x hh v).aestronglyMeasurable
theorem hardSquareGramScoreIntegrand_on_arm
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
P :
p :
ℕ
t :
x :
h :
ℝ
hh :
0 < h
v :
Fin (p + 1) → ℝ
z :
hA1 :
P.A1 = causalHardArmOne
hA0 :
P.A0 = causalHardSquare \ causalHardArmOne
hz :
hzball :
z ∈ closedBall x h
hzd :
0 < dist z x
conclusion
hardSquareGramScoreIntegrand P p t x h v z
Proof (Lean source)
-- @node: hardSquareGramScoreIntegrand_on_arm
lemma hardSquareGramScoreIntegrand_on_arm (P : A1A2Law) (p : ℕ)
(t : Bool) (x : Score) {h : ℝ} (hh : 0 < h)
(v : Fin (p + 1) → ℝ) (z : Score)
(hA1 : P.A1 = causalHardArmOne)
(hA0 : P.A0 = causalHardSquare \ causalHardArmOne)
(hz : z ∈ (if t then causalHardArmOne else
causalHardSquare \ causalHardArmOne))
(hzball : z ∈ closedBall x h) (hzd : 0 < dist z x) :
hardSquareGramScoreIntegrand P p t x h v z =
h⁻¹ ^ 2 *
(∑ i, v i * (if t then dist z x / h else -(dist z x / h)) ^
(i : ℕ)) ^ 2 := by
cases t
· have hzA0 : z ∈ P.A0 := by simpa [hA0] using hz
have hzA1 : z ∉ P.A1 := by rw [hA1]; exact hz.2
have hd : signedDistance (knownGeometry P) x z = -dist z x := by
simp [signedDistance, knownGeometry, hzA0, hzA1]
rw [hardSquareGramScoreIntegrand, hd]
have hk := (uniformKernel_signedDist_eq_one_iff false x z hh).2 hzball
simp at hk
simp only [Bool.false_eq_true, if_false]
rw [if_pos (by linarith), hk]
simp only [mul_one]
congr 2
apply Finset.sum_congr rfl
intro i hi
ring
· have hzA1 : z ∈ P.A1 := by simpa [hA1] using hz
have hzA0 : z ∉ P.A0 := by rw [hA0]; exact fun hz0 => hz0.2 hz
have hd : signedDistance (knownGeometry P) x z = dist z x := by
simp [signedDistance, knownGeometry, hzA0, hzA1]
rw [hardSquareGramScoreIntegrand, hd]
have hk := (uniformKernel_signedDist_eq_one_iff true x z hh).2 hzball
simp at hk
simp only [if_true]
rw [if_pos hzd.le, hk]
ring
theorem hardSquare_sector_scaledPolynomial_integral
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
conclusion
(∫ z : Score in hardSquareSectorEquiv x sx sy '' hardSquareSectorDomain h, h⁻¹ ^ 2 * (∑ i, v i * (if t then dist z x / h else -(dist z x / h)) ^ (i : ℕ)) ^ 2)
= (pi / 2) * ∫ u in (0 : ℝ)..1, (∑ i, v i * (if t then u else -u) ^ (i : ℕ)) ^ 2 * u
Proof (Lean source)
-- @node: hardSquare_sector_scaledPolynomial_integral
lemma hardSquare_sector_scaledPolynomial_integral (p : ℕ) (t : Bool)
(v : Fin (p + 1) → ℝ) (x : Score) (sx sy : Bool)
{h : ℝ} (hh : 0 < h) :
(∫ z : Score in hardSquareSectorEquiv x sx sy '' hardSquareSectorDomain h,
h⁻¹ ^ 2 *
(∑ i, v i * (if t then dist z x / h else -(dist z x / h)) ^
(i : ℕ)) ^ 2) =
(pi / 2) *
∫ u in (0 : ℝ)..1,
(∑ i, v i * (if t then u else -u) ^ (i : ℕ)) ^ 2 * u := by
let D : Set (ℝ × ℝ) := hardSquareSectorDomain h
let e := hardSquareSectorEquiv x sx sy
let F : Score → ℝ := fun z => h⁻¹ ^ 2 *
(∑ i, v i * (if t then dist z x / h else -(dist z x / h)) ^
(i : ℕ)) ^ 2
have ht := (hardSquareSectorEquiv_volumePreserving x sx sy).setIntegral_preimage_emb
e.measurableEmbedding F (e '' D)
rw [e.injective.preimage_image D] at ht
change (∫ z in e '' D, F z) = _
rw [← ht]
calc
(∫ q in D, F (e q)) =
∫ q : ℝ × ℝ in D, h⁻¹ ^ 2 *
(∑ i, v i * (if t then planarRadius q / h else
-(planarRadius q / h)) ^ (i : ℕ)) ^ 2 := by
apply integral_congr_ae
filter_upwards with q
simp only [F, e, hardSquareSectorEquiv_dist]
_ = _ := firstQuadrant_scaledPolynomial_integral p t v hh
theorem hardSquare_populationGram_quadratic_lower Lemma hardSquare_populationGram_quadratic_lower in the paper ↗
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
P :
p :
ℕ
t :
x :
h :
ℝ
hh :
0 < h
hh1 :
h ≤ 1
v :
Fin (p + 1) → ℝ
hSupport :
P.support = causalHardSquare
hA1 :
P.A1 = causalHardArmOne
hA0 :
P.A0 = causalHardSquare \ causalHardArmOne
hBoundary :
P.boundary = frontier causalHardArmOne
hx :
x ∈ P.boundary
hdensMeas :
Measurable P.density
hdensLower :
∀ z ∈ P.support, (1 / 48 : ℝ) ≤ P.density z
conclusion
(1 / 48 : ℝ) * (pi / 2) * (∫ u in (0 : ℝ)..1, (∑ i, v i * (if t then u else -u) ^ (i : ℕ)) ^ 2 * u)
≤ matrixQuadratic (populationGram P p t x h) v
Proof (Lean source)
-- @node: hardSquare_populationGram_quadratic_lower
lemma hardSquare_populationGram_quadratic_lower (P : A1A2Law) (p : ℕ)
(t : Bool) (x : Score) {h : ℝ} (hh : 0 < h) (hh1 : h ≤ 1)
(v : Fin (p + 1) → ℝ)
(hSupport : P.support = causalHardSquare)
(hA1 : P.A1 = causalHardArmOne)
(hA0 : P.A0 = causalHardSquare \ causalHardArmOne)
(hBoundary : P.boundary = frontier causalHardArmOne)
(hx : x ∈ P.boundary) (hdensMeas : Measurable P.density)
(hdensLower : ∀ z ∈ P.support, (1 / 48 : ℝ) ≤ P.density z) :
(1 / 48 : ℝ) * (pi / 2) *
(∫ u in (0 : ℝ)..1,
(∑ i, v i * (if t then u else -u) ^ (i : ℕ)) ^ 2 * u) ≤
matrixQuadratic (populationGram P p t x h) v := by
let G : Score → ℝ := hardSquareGramScoreIntegrand P p t x h v
let W : Score → ℝ := fun z =>
(ofReal (P.support.indicator P.density z)).toReal
let F : Score → ℝ := fun z => h⁻¹ ^ 2 *
(∑ i, v i * (if t then dist z x / h else -(dist z x / h)) ^
(i : ℕ)) ^ 2
have hx' : x ∈ frontier causalHardArmOne := hBoundary ▸ hx
obtain ⟨sx, sy, hsector⟩ : ∃ sx sy : Bool,
hardSquareSectorEquiv x sx sy '' hardSquareSectorDomain h ⊆
(if t then causalHardArmOne else causalHardSquare \ causalHardArmOne) ∩
closedBall x h := by
cases t
· simpa using hardSquareArmZero_contains_sector hx' hh hh1
· simpa using hardSquareArmOne_contains_sector hx' hh hh1
let S : Set Score := hardSquareSectorEquiv x sx sy '' hardSquareSectorDomain h
have hsupportArm : (if t then causalHardArmOne else
causalHardSquare \ causalHardArmOne) ⊆ P.support := by
rw [hSupport]
cases t
· exact fun z hz => hz.1
· simpa using causalHardArmOne_subset_square
have hFonS : ∀ z ∈ S, G z = F z := by
intro z hzS
obtain ⟨q, hq, rfl⟩ := hzS
have hs := hsector ⟨q, hq, rfl⟩
have hdist := hardSquareSectorEquiv_dist x sx sy q
apply hardSquareGramScoreIntegrand_on_arm P p t x hh v _ hA1 hA0
hs.1 hs.2
rw [hdist]
change 0 < sqrt (q.1 ^ 2 + q.2 ^ 2)
apply Real.sqrt_pos.2
change 0 < q.1 ^ 2 + q.2 ^ 2
nlinarith [sq_pos_of_pos hq.1]
have hWlower : ∀ z ∈ S, (1 / 48 : ℝ) ≤ W z := by
intro z hzS
have hzArm := (hsector hzS).1
have hzSupport := hsupportArm hzArm
have hd := hdensLower z hzSupport
dsimp [W]
rw [indicator_of_mem hzSupport, ENNReal.toReal_ofReal (by linarith)]
exact hd
have hsuppMeas : MeasurableSet P.support := by
rw [hSupport]
exact causalHardSquare_measurableSet
have hweightMeas : Measurable (fun z =>
ofReal (P.support.indicator P.density z)) :=
(hdensMeas.indicator hsuppMeas).ennreal_ofReal
have hweightFinite : ∀ᵐ z ∂volume,
ofReal (P.support.indicator P.density z) < ∞ := by
filter_upwards with z
exact ENNReal.ofReal_lt_top
have hGintMap := hardSquareGramScoreIntegrand_integrable P p t x hh.ne' v
have hGintDensity : Integrable G
(volume.withDensity (fun z => ofReal
(P.support.indicator P.density z))) := by
rw [← P.marginal_eq]
exact hGintMap
have hWGint : Integrable (fun z => W z * G z) volume := by
have h := (integrable_withDensity_iff hweightMeas hweightFinite).1 hGintDensity
simpa [W, mul_comm] using h
have hWGnonneg (z : Score) : 0 ≤ W z * G z := by
exact mul_nonneg ENNReal.toReal_nonneg
(hardSquareGramScoreIntegrand_nonneg P p t x h v z)
have hglobal : (∫ z in S, W z * G z) ≤ ∫ z, W z * G z := by
exact integral_mono_measure Measure.restrict_le_self
(ae_of_all _ hWGnonneg) hWGint
have hFmeas : Measurable F := by
cases t <;> dsimp [F] <;> fun_prop
have hSmeas : MeasurableSet S := by
let e := hardSquareSectorEquiv x sx sy
have hD : MeasurableSet (hardSquareSectorDomain h) := by
exact ((measurableSet_lt measurable_const measurable_fst).inter
((measurableSet_lt measurable_const measurable_snd).inter
(measurableSet_le planarRadius_measurable measurable_const)))
exact e.measurableEmbedding.measurableSet_image' hD
have hscaledFint : Integrable (fun z => (1 / 48 : ℝ) * F z)
(volume.restrict S) := by
apply Integrable.mono' hWGint.restrict
((hFmeas.const_mul (1 / 48 : ℝ)).aestronglyMeasurable)
filter_upwards [ae_restrict_mem hSmeas] with z hzS
rw [← hFonS z hzS]
rw [Real.norm_eq_abs, abs_of_nonneg (mul_nonneg (by norm_num)
(hardSquareGramScoreIntegrand_nonneg P p t x h v z))]
exact mul_le_mul_of_nonneg_right (hWlower z hzS)
(hardSquareGramScoreIntegrand_nonneg P p t x h v z)
have hsectorCompare :
(∫ z in S, (1 / 48 : ℝ) * F z) ≤ ∫ z in S, W z * G z := by
apply integral_mono_ae hscaledFint hWGint.restrict
filter_upwards [ae_restrict_mem hSmeas] with z hzS
rw [← hFonS z hzS]
exact mul_le_mul_of_nonneg_right (hWlower z hzS)
(hardSquareGramScoreIntegrand_nonneg P p t x h v z)
rw [populationGram_quadratic_eq_scoreIntegral P p t x hh.ne' v,
P.marginal_eq,
integral_withDensity_eq_integral_toReal_smul hweightMeas hweightFinite]
change _ ≤ ∫ z, W z * G z
calc
(1 / 48 : ℝ) * (pi / 2) *
(∫ u in (0 : ℝ)..1,
(∑ i, v i * (if t then u else -u) ^ (i : ℕ)) ^ 2 * u) =
∫ z in S, (1 / 48 : ℝ) * F z := by
rw [integral_const_mul]
rw [hardSquare_sector_scaledPolynomial_integral p t v x sx sy hh]
ring
_ ≤ ∫ z in S, W z * G z := hsectorCompare
_ ≤ _ := hglobal
theorem hardSquare_populationGramFloor_eventually
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ L0 : ℝ
if
48 ≤ L0 ∧ ∀ (P : A1A2Law) (L : ℝ), L0 ≤ L
and
P.support = causalHardSquare
and
P.A1 = causalHardArmOne
and
P.A0 = causalHardSquare \ causalHardArmOne
and
P.boundary = frontier causalHardArmOne
and
Measurable P.density
and
(∀ z ∈ P.support, (1 / 48 : ℝ) ≤ P.density z)
then
PopulationGramFloor P p L
Proof (Lean source)
-- @node: hardSquare_populationGramFloor_eventually
lemma hardSquare_populationGramFloor_eventually (p : ℕ) :
∃ L0 : ℝ, 48 ≤ L0 ∧ ∀ (P : A1A2Law) (L : ℝ), L0 ≤ L →
P.support = causalHardSquare →
P.A1 = causalHardArmOne →
P.A0 = causalHardSquare \ causalHardArmOne →
P.boundary = frontier causalHardArmOne →
Measurable P.density →
(∀ z ∈ P.support, (1 / 48 : ℝ) ≤ P.density z) →
PopulationGramFloor P p L := by
obtain ⟨c, hc, hcoerce⟩ := signedRadialPolynomialEnergy_coercive p
let gamma : ℝ := (1 / 48 : ℝ) * (pi / 2) * c
have hgamma : 0 < gamma := by
dsimp [gamma]
positivity
refine ⟨max 48 gamma⁻¹, le_max_left _ _, ?_⟩
intro P L hL hSupport hA1 hA0 hBoundary hdensMeas hdensLower
have hL48 : 48 ≤ L := (le_max_left 48 gamma⁻¹).trans hL
have hLpos : 0 < L := (by norm_num : (0 : ℝ) < 48).trans_le hL48
have hgammaInv : gamma⁻¹ ≤ L := (le_max_right 48 gamma⁻¹).trans hL
have hInv : L⁻¹ ≤ gamma := by
apply (inv_le_iff_one_le_mul₀' hLpos).2
calc
1 = gamma * gamma⁻¹ := (mul_inv_cancel₀ hgamma.ne').symm
_ ≤ gamma * L := mul_le_mul_of_nonneg_left hgammaInv hgamma.le
_ = L * gamma := mul_comm _ _
intro t x h hx hh hhL v
have hh1 : h ≤ 1 := by
exact hhL.trans ((inv_le_one₀ hLpos).2 (by linarith))
have hlower := hardSquare_populationGram_quadratic_lower P p t x hh hh1 v
hSupport hA1 hA0 hBoundary hx hdensMeas hdensLower
have hfactor : 0 ≤ (1 / 48 : ℝ) * (pi / 2) := by positivity
calc
L⁻¹ * ∑ i, (v i) ^ 2 ≤ gamma * ∑ i, (v i) ^ 2 := by
exact mul_le_mul_of_nonneg_right hInv (sum_nonneg fun i _ => sq_nonneg _)
_ ≤ (1 / 48 : ℝ) * (pi / 2) *
(∫ u in (0 : ℝ)..1,
(∑ i, v i * (if t then u else -u) ^ (i : ℕ)) ^ 2 * u) := by
dsimp [gamma]
simpa only [mul_assoc] using
(mul_le_mul_of_nonneg_left (hcoerce t v) hfactor)
_ ≤ matrixQuadratic (populationGram P p t x h) v := hlower
theorem causalHardA1A2Law_populationGram_certificate
A component of the fixed hard-square population-Gram certificate.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ L0 : ℝ
if
48 ≤ L0 ∧ ∀ (L : ℝ), L0 ≤ L
then
∀ {M : ℕ} (b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool) (hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w) (hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k)) (hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare),
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell PopulationGramFloor P p L
Proof (Lean source)
-- @node: causalHardA1A2Law_populationGram_certificate
lemma causalHardA1A2Law_populationGram_certificate (p : ℕ) :
∃ L0 : ℝ, 48 ≤ L0 ∧ ∀ (L : ℝ), L0 ≤ L →
∀ {M : ℕ} (b cA delta w : ℝ) (centers : Fin M → Score)
(omega : Fin M → Bool) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare),
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
PopulationGramFloor P p L := by
obtain ⟨L0, hL0, hcert⟩ := hardSquare_populationGramFloor_eventually p
refine ⟨L0, hL0, ?_⟩
intro L hL M b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
have hgeom := causalHardA1A2Law_geometry b cA delta w centers omega hb hscale
hcA hdelta hw hsep hcell
apply hcert P L hL hgeom.1 hgeom.2.1 hgeom.2.2.1 hgeom.2.2.2
· exact (causalHardScoreDensity_continuous centers omega hb hscale).measurable
· intro z hz
change (1 / 48 : ℝ) ≤
causalHardScoreDensity b cA delta w centers omega z
exact (causalHardScoreDensity_mem_Icc (b := b) hcA hdelta hw hsep omega z).1
Causal.Hypercube.HardSquareSignedCancellation 8 declarations This module transports the quantitative polar cancellation estimate to an arbitrary score-space center.
Half-disc cancellation for signed hard-square observations
This module transports the quantitative polar cancellation estimate to an arbitrary score-space center. In particular it applies without another change of coordinates to the translated centers on the bottom edge of the hard assignment rectangle.
theorem scoreCenter_signedRadialSet_angularTerm_integral_eq_zero
Reflecting horizontally through the cell center preserves every measurable signed-radius slice and reverses the angular density correction. Consequently the correction has zero integral on each such slice.
Formal statement
hypotheses
conclusion
(∫ x in (closedBall c w ∩ {x | (if 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 then dist x c else -dist x c) ∈ A}), packingAngularTerm b cA delta w c x)
= 0
Proof (Lean source)
-- @node: scoreCenter_signedRadialSet_angularTerm_integral_eq_zero
lemma scoreCenter_signedRadialSet_angularTerm_integral_eq_zero
(c : Score) (b cA delta w : ℝ) {A : Set ℝ}
(_hA : MeasurableSet A) :
(∫ x in
(closedBall c w ∩ {x |
(if 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 then dist x c
else -dist x c) ∈ A}),
packingAngularTerm b cA delta w c x) = 0 := by
let e : Score ≃ᵐ Score :=
(hardSquareSectorEquiv c true true).symm.trans
(hardSquareSectorEquiv c false true)
let D : Set Score :=
closedBall c w ∩ {x |
(if 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 then dist x c
else -dist x c) ∈ A}
have hePres : MeasurePreserving e (volume : Measure Score) volume :=
(hardSquareSectorEquiv_volumePreserving c false true).comp
(hardSquareSectorEquiv_volumePreserving c true true).symm
have heDist (x : Score) : dist (e x) c = dist x c := by
let q : ℝ × ℝ := (hardSquareSectorEquiv c true true).symm x
have hx : hardSquareSectorEquiv c true true q = x := by
simp [q]
calc
dist (e x) c = planarRadius q := by
simpa [e, q] using hardSquareSectorEquiv_dist c false true q
_ = dist x c := by
rw [← hx]
exact (hardSquareSectorEquiv_dist c true true q).symm
have heVertical (x : Score) :
(scoreCoordinates (e x) - scoreCoordinates c).2 =
(scoreCoordinates x - scoreCoordinates c).2 := by
let q : ℝ × ℝ := (hardSquareSectorEquiv c true true).symm x
have hx : hardSquareSectorEquiv c true true q = x := by
simp [q]
have he1 := hardSquareSectorEquiv_apply_one c false true q
have hx1 := hardSquareSectorEquiv_apply_one c true true q
change e x 1 - c 1 = x 1 - c 1
rw [← hx]
simpa [e, q] using congrArg (fun z : ℝ => z - c 1) (he1.trans hx1.symm)
have heSigned (x : Score) :
(if 0 ≤ (scoreCoordinates (e x) - scoreCoordinates c).2 then
dist (e x) c else -dist (e x) c) =
if 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 then
dist x c else -dist x c := by
rw [heDist, heVertical]
have heImage : e '' D = D := by
ext x
constructor
· rintro ⟨y, hy, rfl⟩
refine ⟨?_, ?_⟩
· rw [Metric.mem_closedBall, heDist]
exact hy.1
· change (if 0 ≤ (scoreCoordinates (e y) - scoreCoordinates c).2 then
dist (e y) c else -dist (e y) c) ∈ A
rw [heSigned]
exact hy.2
· intro hx
refine ⟨e.symm x, ?_, by simp⟩
have hdistInv := heDist (e.symm x)
have hsignedInv := heSigned (e.symm x)
simp only [e.apply_symm_apply] at hdistInv hsignedInv
constructor
· rw [Metric.mem_closedBall, ← hdistInv]
exact hx.1
· change (if 0 ≤ (scoreCoordinates (e.symm x) - scoreCoordinates c).2
then dist (e.symm x) c else -dist (e.symm x) c) ∈ A
rw [← hsignedInv]
exact hx.2
have heOdd (x : Score) :
packingAngularTerm b cA delta w c (e x) =
-packingAngularTerm b cA delta w c x := by
let q : ℝ × ℝ := (hardSquareSectorEquiv c true true).symm x
have hx : hardSquareSectorEquiv c true true q = x := by
simp [q]
have he0 := hardSquareSectorEquiv_apply_zero c false true q
have hx0 := hardSquareSectorEquiv_apply_zero c true true q
unfold packingAngularTerm packingDirectionCos
rw [heDist]
by_cases hd : dist x c = 0
· simp [hd]
· simp only [hd, if_false]
have hcoord : e x 0 - c 0 = -(x 0 - c 0) := by
rw [← hx]
rw [show e (hardSquareSectorEquiv c true true q) =
hardSquareSectorEquiv c false true q by simp [e]]
simp at he0 hx0
rw [he0, hx0]
ring
rw [hcoord]
ring
change (∫ x in D, packingAngularTerm b cA delta w c x) = 0
have hchange := hePres.setIntegral_image_emb e.measurableEmbedding
(packingAngularTerm b cA delta w c) D
rw [heImage] at hchange
simp_rw [heOdd] at hchange
rw [integral_neg] at hchange
linarith
theorem causalHardSignedStatistic_eq_verticalSignedRadius_on_cell
On a sufficiently small cell centered on the middle bottom edge, the hard-family signed statistic is the Euclidean radius with the sign of the vertical displacement.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: causalHardSignedStatistic_eq_verticalSignedRadius_on_cell
lemma causalHardSignedStatistic_eq_verticalSignedRadius_on_cell
{c z : Score} {w : ℝ} (hc : c ∈ causalHardBottomEdge)
(hw : w ≤ 1 / 2) (hz : z ∈ causalHardCell c w) :
causalHardSignedStatistic c z =
if 0 ≤ (scoreCoordinates z - scoreCoordinates c).2 then dist z c
else -dist z c := by
have hdist : dist z c ≤ w := by
simpa [causalHardCell, Metric.mem_closedBall, dist_comm] using hz
have hcoord (i : Fin 2) : |z i - c i| ≤ dist z c := by
simpa [dist_eq_norm, Real.norm_eq_abs] using PiLp.norm_apply_le (z - c) i
have hzSquare : z ∈ causalHardSquare :=
causalHardCell_subset_square hc (hw.trans (by norm_num)) hz
have hc0lo : -1 / 2 ≤ c 0 := hc.1
have hc0hi : c 0 ≤ 1 / 2 := hc.2.1
have hc1 : c 1 = 0 := hc.2.2
have hz0lo : -1 ≤ z 0 := by
have := hcoord 0
rw [abs_le] at this
linarith
have hz0hi : z 0 ≤ 1 := by
have := hcoord 0
rw [abs_le] at this
linarith
have hz1lohi : |z 1| ≤ 1 / 2 := by
calc
|z 1| = |z 1 - c 1| := by rw [hc1, sub_zero]
_ ≤ dist z c := hcoord 1
_ ≤ w := hdist
_ ≤ 1 / 2 := hw
by_cases hup : 0 ≤ (scoreCoordinates z - scoreCoordinates c).2
· have hz1lo : 0 ≤ z 1 := by
change 0 ≤ z 1 - c 1 at hup
linarith
have hz1hi : z 1 ≤ 2 := by
exact (le_abs_self (z 1)).trans (hz1lohi.trans (by norm_num))
have hA1 : z ∈ causalHardArmOne := by
exact ⟨hz0lo, hz0hi, hz1lo, hz1hi⟩
have horder : (scoreCoordinates c).2 ≤ (scoreCoordinates z).2 := by
change c 1 ≤ z 1
linarith
simp [causalHardSignedStatistic, hA1, hzSquare, horder]
· have hA1 : z ∉ causalHardArmOne := by
intro hA1
apply hup
change 0 ≤ z 1 - c 1
linarith [hA1.2.2.1]
have hA0 : z ∈ causalHardSquare \ causalHardArmOne := ⟨hzSquare, hA1⟩
have horder : ¬(scoreCoordinates c).2 ≤ (scoreCoordinates z).2 := by
intro h
apply hup
change 0 ≤ z 1 - c 1
change c 1 ≤ z 1 at h
linarith
simp [causalHardSignedStatistic, hA1, hA0, horder]
theorem scoreCenter_causalHardSignedStatistic_angularTerm_integral_eq_zero
The angular correction has zero integral on every measurable slice of the actual signed-distance statistic used by the hard family.
Formal statement
hypotheses
conclusion
(∫ x in (causalHardCell c w ∩ {x | causalHardSignedStatistic c x ∈ A}), packingAngularTerm b cA delta w c x)
= 0
Proof (Lean source)
-- @node: scoreCenter_causalHardSignedStatistic_angularTerm_integral_eq_zero
lemma scoreCenter_causalHardSignedStatistic_angularTerm_integral_eq_zero
{c : Score} (hc : c ∈ causalHardBottomEdge) (b cA delta w : ℝ)
(hw : w ≤ 1 / 2) {A : Set ℝ} (hA : MeasurableSet A) :
(∫ x in
(causalHardCell c w ∩ {x | causalHardSignedStatistic c x ∈ A}),
packingAngularTerm b cA delta w c x) = 0 := by
have hset :
causalHardCell c w ∩ {x | causalHardSignedStatistic c x ∈ A} =
closedBall c w ∩ {x |
(if 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 then dist x c
else -dist x c) ∈ A} := by
ext x
constructor
· intro hx
refine ⟨hx.1, ?_⟩
change (if 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 then
dist x c else -dist x c) ∈ A
rw [← causalHardSignedStatistic_eq_verticalSignedRadius_on_cell hc hw hx.1]
exact hx.2
· intro hx
refine ⟨hx.1, ?_⟩
change causalHardSignedStatistic c x ∈ A
rw [causalHardSignedStatistic_eq_verticalSignedRadius_on_cell hc hw hx.1]
exact hx.2
rw [hset]
exact scoreCenter_signedRadialSet_angularTerm_integral_eq_zero
c b cA delta w hA
theorem scoreCenter_closedBall_radial_angularTerm_integral_eq_zero
On every measurable radial slice of a translated complete disk, the angular density correction has zero mass. Point reflection through the center preserves the slice and negates the direction cosine.
Formal statement
hypotheses
conclusion
= 0
Proof (Lean source)
-- @node: scoreCenter_closedBall_radial_angularTerm_integral_eq_zero
lemma scoreCenter_closedBall_radial_angularTerm_integral_eq_zero
(c : Score) (b cA delta w : ℝ) {A : Set ℝ}
(_hA : MeasurableSet A) :
(∫ x in
(closedBall c w ∩ {x | dist x c ∈ A}),
packingAngularTerm b cA delta w c x) = 0 := by
let T : Score → Score := fun x => (2 : ℝ) • c - x
let D : Set Score := closedBall c w ∩ {x | dist x c ∈ A}
have hT : MeasurePreserving T (volume : Measure Score) volume := by
exact (measurePreserving_add_left volume ((2 : ℝ) • c)).comp
(Measure.measurePreserving_neg volume)
have hTemb : MeasurableEmbedding T := by
let e : Score ≃ₜ Score := (Homeomorph.neg Score).trans
(Homeomorph.addLeft ((2 : ℝ) • c))
exact e.measurableEmbedding
have hdist (x : Score) : dist (T x) c = dist x c := by
rw [dist_eq_norm, dist_eq_norm, show T x - c = -(x - c) by
dsimp [T]
module]
exact norm_neg _
have himage : T '' D = D := by
ext x
constructor
· rintro ⟨y, hy, rfl⟩
exact ⟨by simpa [D, Metric.mem_closedBall, hdist] using hy.1,
by simpa [D, hdist] using hy.2⟩
· intro hx
refine ⟨T x, ?_, ?_⟩
· exact ⟨by simpa [D, Metric.mem_closedBall, hdist] using hx.1,
by simpa [D, hdist] using hx.2⟩
· simp [T]
have hodd : ∀ x, packingAngularTerm b cA delta w c (T x) =
-packingAngularTerm b cA delta w c x := by
intro x
unfold packingAngularTerm packingDirectionCos
rw [hdist]
by_cases hx : dist x c = 0
· simp [hx]
· simp only [hx, if_false]
simp [T]
ring
have hchange := hT.setIntegral_image_emb hTemb
(packingAngularTerm b cA delta w c) D
rw [himage] at hchange
simp_rw [hodd] at hchange
rw [integral_neg] at hchange
linarith [hchange]
theorem scoreCenter_closedUpperHalf_radial_angularTerm_integral_eq_zero
On every measurable radial slice of a translated closed upper half-disc, the angular density correction has zero mass. Unlike the older grid-specific version, this statement applies directly to the hard-square centers.
Formal statement
hypotheses
conclusion
(∫ x in ({x | 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A}), packingAngularTerm b cA delta w c x)
= 0
Proof (Lean source)
-- @node: scoreCenter_closedUpperHalf_radial_angularTerm_integral_eq_zero
lemma scoreCenter_closedUpperHalf_radial_angularTerm_integral_eq_zero
(c : Score) (b cA delta w : ℝ) {A : Set ℝ}
(hA : MeasurableSet A) :
(∫ x in
({x | 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}),
packingAngularTerm b cA delta w c x) = 0 := by
let D : Set Score :=
{x | 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let E : Set (ℝ × ℝ) :=
{z | 0 ≤ (z - scoreCoordinates c).2 ∧
planarRadius (z - scoreCoordinates c) ≤ w} ∩
{z | planarRadius (z - scoreCoordinates c) ∈ A}
have himage : scoreCoordinates '' D = E := by
ext z
constructor
· rintro ⟨x, hx, rfl⟩
simpa [D, E, planarRadius_scoreCoordinates_sub] using hx
· intro hz
let x : Score := scorePoint z.1 z.2
have hcoord : scoreCoordinates x = z := by
ext <;> simp [x, scoreCoordinates, scorePoint_apply_zero,
scorePoint_apply_one]
refine ⟨x, ?_, hcoord⟩
simpa [D, E, hcoord, ← planarRadius_scoreCoordinates_sub] using hz
have hfun : packingAngularTerm b cA delta w c = fun x =>
angularTilt b cA delta w
(planarRadius (scoreCoordinates x - scoreCoordinates c)) *
((scoreCoordinates x - scoreCoordinates c).1 /
planarRadius (scoreCoordinates x - scoreCoordinates c)) := by
funext x
rw [packingAngularTerm, packingDirectionCos_eq_planarFirst_div_radius,
planarRadius_scoreCoordinates_sub]
change (∫ x in D, packingAngularTerm b cA delta w c x) = 0
rw [hfun]
rw [← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ =>
angularTilt b cA delta w
(planarRadius (z - scoreCoordinates c)) *
((z - scoreCoordinates c).1 /
planarRadius (z - scoreCoordinates c))) D]
rw [himage]
exact translatedClosedHalfDisc_radialSet_weighted_first_div_radius_cancellation
(angularTilt b cA delta w) w (scoreCoordinates c) hA
theorem scoreCenter_closedLowerHalf_radial_angularTerm_integral_eq_zero
The matching cancellation holds on every translated closed lower half-disc radial slice. Reflection through the center carries the upper slice to the lower slice and reverses the angular correction.
Formal statement
hypotheses
conclusion
(∫ x in ({x | (scoreCoordinates x - scoreCoordinates c).2 ≤ 0 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A}), packingAngularTerm b cA delta w c x)
= 0
Proof (Lean source)
-- @node: scoreCenter_closedLowerHalf_radial_angularTerm_integral_eq_zero
lemma scoreCenter_closedLowerHalf_radial_angularTerm_integral_eq_zero
(c : Score) (b cA delta w : ℝ) {A : Set ℝ}
(hA : MeasurableSet A) :
(∫ x in
({x | (scoreCoordinates x - scoreCoordinates c).2 ≤ 0 ∧
dist x c ≤ w} ∩ {x | dist x c ∈ A}),
packingAngularTerm b cA delta w c x) = 0 := by
let T : Score → Score := fun x => (2 : ℝ) • c - x
let U : Set Score :=
{x | 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let D : Set Score :=
{x | (scoreCoordinates x - scoreCoordinates c).2 ≤ 0 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
have hT : MeasurePreserving T (volume : Measure Score) volume := by
exact (measurePreserving_add_left volume ((2 : ℝ) • c)).comp
(Measure.measurePreserving_neg volume)
have hTemb : MeasurableEmbedding T := by
let e : Score ≃ₜ Score := (Homeomorph.neg Score).trans
(Homeomorph.addLeft ((2 : ℝ) • c))
exact e.measurableEmbedding
have hdist (x : Score) : dist (T x) c = dist x c := by
rw [dist_eq_norm, dist_eq_norm, show T x - c = -(x - c) by
dsimp [T]
module]
exact norm_neg _
have hcoord (x : Score) :
(scoreCoordinates (T x) - scoreCoordinates c).2 =
-(scoreCoordinates x - scoreCoordinates c).2 := by
change (T x) 1 - c 1 = -(x 1 - c 1)
simp [T]
ring
have himage : T '' U = D := by
ext x
constructor
· rintro ⟨y, hy, rfl⟩
exact ⟨⟨by rw [hcoord]; linarith [hy.1.1], by simpa [hdist] using hy.1.2⟩,
by simpa [hdist] using hy.2⟩
· intro hx
refine ⟨T x, ?_, ?_⟩
· exact ⟨⟨by rw [hcoord]; linarith [hx.1.1],
by simpa [hdist] using hx.1.2⟩, by simpa [hdist] using hx.2⟩
· simp [T]
have hodd : ∀ x, packingAngularTerm b cA delta w c (T x) =
-packingAngularTerm b cA delta w c x := by
intro x
unfold packingAngularTerm packingDirectionCos
rw [hdist]
by_cases hx : dist x c = 0
· simp [hx]
· simp only [hx, if_false]
simp [T]
ring
have hchange := hT.setIntegral_image_emb hTemb
(packingAngularTerm b cA delta w c) U
rw [himage] at hchange
simp_rw [hodd] at hchange
rw [integral_neg] at hchange
have hupper := scoreCenter_closedUpperHalf_radial_angularTerm_integral_eq_zero
c b cA delta w hA
change (∫ x in D, packingAngularTerm b cA delta w c x) = 0
change (∫ x in U, packingAngularTerm b cA delta w c x) = 0 at hupper
linarith [hchange, hupper]
theorem scoreCenter_radialSet_angular_outcome_abs_le
The quantitative upper-half-disc cancellation estimate is invariant under translation to an arbitrary score-space center.
Formal statement
hypotheses
conclusion
let D : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A} let Dloc : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)} |(∫ x in D, delta * angularRadialProfile w (dist x c))
+ (∫ x in D, b * (scoreCoordinates x - scoreCoordinates c).1 * angularTilt b cA delta w (dist x c) * ((scoreCoordinates x - scoreCoordinates c).1 / dist x c))|
≤ delta * (volume Dloc).toReal
Proof (Lean source)
-- @node: scoreCenter_radialSet_angular_outcome_abs_le
lemma scoreCenter_radialSet_angular_outcome_abs_le
(c : Score) {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (hdelta : 0 ≤ delta)
{A : Set ℝ} (hA : MeasurableSet A) :
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let Dloc : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)}
|(∫ x in D, delta * angularRadialProfile w (dist x c)) +
(∫ x in D,
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c))| ≤
delta * (volume Dloc).toReal := by
dsimp only
let cp : ℝ × ℝ := scoreCoordinates c
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let Dloc : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)}
let E : Set (ℝ × ℝ) :=
{z | 0 < (z - cp).2 ∧ planarRadius (z - cp) ≤ w} ∩
{z | planarRadius (z - cp) ∈ A}
let Eloc : Set (ℝ × ℝ) :=
{z | 0 < (z - cp).2 ∧ planarRadius (z - cp) ≤ w} ∩
{z | planarRadius (z - cp) ∈ A ∩ Iio (2 * (cA * delta) / b)}
have himage : scoreCoordinates '' D = E := by
ext z
constructor
· rintro ⟨x, hx, rfl⟩
simpa [D, E, cp, planarRadius_scoreCoordinates_sub] using hx
· intro hz
let x : Score := scorePoint z.1 z.2
have hcoord : scoreCoordinates x = z := by
ext <;> simp [x, scoreCoordinates, scorePoint_apply_zero,
scorePoint_apply_one]
refine ⟨x, ?_, hcoord⟩
simpa [D, E, cp, hcoord, ← planarRadius_scoreCoordinates_sub] using hz
have himageLoc : scoreCoordinates '' Dloc = Eloc := by
ext z
constructor
· rintro ⟨x, hx, rfl⟩
simpa [Dloc, Eloc, cp, planarRadius_scoreCoordinates_sub] using hx
· intro hz
let x : Score := scorePoint z.1 z.2
have hcoord : scoreCoordinates x = z := by
ext <;> simp [x, scoreCoordinates, scorePoint_apply_zero,
scorePoint_apply_one]
refine ⟨x, ?_, hcoord⟩
simpa [Dloc, Eloc, cp, hcoord,
← planarRadius_scoreCoordinates_sub] using hz
change |(∫ x in D, delta * angularRadialProfile w (dist x c)) +
(∫ x in D, b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c))| ≤
delta * (volume Dloc).toReal
have hfirst : (fun x : Score => delta * angularRadialProfile w (dist x c)) =
fun x => delta * angularRadialProfile w
(planarRadius (scoreCoordinates x - scoreCoordinates c)) := by
funext x
rw [planarRadius_scoreCoordinates_sub]
have hsecond : (fun x : Score =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) =
fun x => b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w
(planarRadius (scoreCoordinates x - scoreCoordinates c)) *
((scoreCoordinates x - scoreCoordinates c).1 /
planarRadius (scoreCoordinates x - scoreCoordinates c)) := by
funext x
rw [planarRadius_scoreCoordinates_sub]
rw [hfirst, hsecond]
change |(∫ x in D, (fun z : ℝ × ℝ =>
delta * angularRadialProfile w (planarRadius (z - scoreCoordinates c)))
(scoreCoordinates x)) +
(∫ x in D, (fun z : ℝ × ℝ =>
b * (z - scoreCoordinates c).1 *
angularTilt b cA delta w (planarRadius (z - scoreCoordinates c)) *
((z - scoreCoordinates c).1 / planarRadius (z - scoreCoordinates c)))
(scoreCoordinates x))| ≤ delta * (volume Dloc).toReal
rw [← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ => delta * angularRadialProfile w
(planarRadius (z - scoreCoordinates c))) D,
← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ => b * (z - scoreCoordinates c).1 *
angularTilt b cA delta w (planarRadius (z - scoreCoordinates c)) *
((z - scoreCoordinates c).1 / planarRadius (z - scoreCoordinates c))) D]
have hvolScore : (volume Dloc).toReal =
(volume (scoreCoordinates '' Dloc)).toReal := by
have h := scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding (fun _ : ℝ × ℝ => (1 : ℝ)) Dloc
simpa [integral_const, Measure.real_def] using h.symm
rw [hvolScore, himage, himageLoc]
let T : (ℝ × ℝ) → (ℝ × ℝ) := fun u => cp + u
let E0 : Set (ℝ × ℝ) :=
{u | 0 < u.2 ∧ planarRadius u ≤ w} ∩ planarRadius ⁻¹' A
let E0loc : Set (ℝ × ℝ) :=
{u | 0 < u.2 ∧ planarRadius u ≤ w} ∩
planarRadius ⁻¹' (A ∩ Iio (2 * (cA * delta) / b))
have hT : MeasurableEmbedding T := (Homeomorph.addLeft cp).measurableEmbedding
have hmp : MeasurePreserving T (volume : Measure (ℝ × ℝ)) volume :=
measurePreserving_add_left volume cp
have hE : E = T '' E0 := by
ext z
constructor
· rintro ⟨hz, hAz⟩
refine ⟨z - cp, ⟨?_, ?_⟩, by simp [T]⟩
· simpa [E0] using hz
· simpa [E0] using hAz
· rintro ⟨u, ⟨hu, hAu⟩, rfl⟩
simpa [E, E0, T] using And.intro hu hAu
have hEloc : Eloc = T '' E0loc := by
ext z
constructor
· rintro ⟨hz, hAz⟩
refine ⟨z - cp, ⟨?_, ?_⟩, by simp [T]⟩
· simpa [E0loc] using hz
· simpa [E0loc] using hAz
· rintro ⟨u, ⟨hu, hAu⟩, rfl⟩
simpa [Eloc, E0loc, T] using And.intro hu hAu
rw [hE, hmp.setIntegral_image_emb hT, hmp.setIntegral_image_emb hT]
rw [hEloc]
have hvol : (volume (T '' E0loc)).toReal = (volume E0loc).toReal := by
have h := hmp.setIntegral_image_emb hT (fun _ : ℝ × ℝ => (1 : ℝ)) E0loc
simpa [integral_const, Measure.real_def] using h
rw [hvol]
simpa [T, cp, E0, E0loc] using
halfDisc_radialSet_angular_outcome_abs_le
(w := w) (R := w) hb hscale hdelta hA
theorem causalHardGridCenter_radialSet_angular_outcome_abs_le
The quantitative cancellation estimate at a hard-square packing center.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hdelta :
0 ≤ delta
A :
Set ℝ
hA :
conclusion
let c := causalHardGridCenter M j let D : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A} let Dloc : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)} |(∫ x in D, delta * angularRadialProfile w (dist x c))
+ (∫ x in D, b * (scoreCoordinates x - scoreCoordinates c).1 * angularTilt b cA delta w (dist x c) * ((scoreCoordinates x - scoreCoordinates c).1 / dist x c))|
≤ delta * (volume Dloc).toReal
Proof (Lean source)
-- @node: causalHardGridCenter_radialSet_angular_outcome_abs_le
lemma causalHardGridCenter_radialSet_angular_outcome_abs_le
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (hdelta : 0 ≤ delta)
{A : Set ℝ} (hA : MeasurableSet A) :
let c := causalHardGridCenter M j
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let Dloc : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)}
|(∫ x in D, delta * angularRadialProfile w (dist x c)) +
(∫ x in D,
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c))| ≤
delta * (volume Dloc).toReal := by
exact scoreCenter_radialSet_angular_outcome_abs_le
(causalHardGridCenter M j) hb hscale hdelta hA
Causal.Hypercube.HardSquareSignedCertificate 3 declarations This file specializes the common-statistic Bernoulli comparison to the normalized hard-cell laws.
Quantitative signed-observation certificate for the hard square
This file specializes the common-statistic Bernoulli comparison to the normalized hard-cell laws. The first step identifies the signed-radius marginal by angular cancellation on every measurable fibre.
theorem causalHardScoreMeasure_signedSlice_eq_uniform
Every measurable signed-radius slice of a complete hard cell has its uniform-background mass, independently of the active bit.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hwHalf :
w ≤ 1 / 2
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
centers j ∈ causalHardBottomEdge
hcell :
causalHardCell (centers j) w ⊆ causalHardSquare
A :
Set ℝ
hA :
conclusion
causalHardScoreMeasure b cA delta w centers omega (causalHardCell (centers j) w ∩ {x | causalHardSignedStatistic (centers j) x ∈ A})
= ofReal (1 / 36 : ℝ) * volume (causalHardCell (centers j) w ∩ {x | causalHardSignedStatistic (centers j) x ∈ A})
Proof (Lean source)
-- @node: causalHardScoreMeasure_signedSlice_eq_uniform
lemma causalHardScoreMeasure_signedSlice_eq_uniform
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w) (hwHalf : w ≤ 1 / 2)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : centers j ∈ causalHardBottomEdge)
(hcell : causalHardCell (centers j) w ⊆ causalHardSquare)
{A : Set ℝ} (hA : MeasurableSet A) :
causalHardScoreMeasure b cA delta w centers omega
(causalHardCell (centers j) w ∩
{x | causalHardSignedStatistic (centers j) x ∈ A}) =
ofReal (1 / 36 : ℝ) *
volume (causalHardCell (centers j) w ∩
{x | causalHardSignedStatistic (centers j) x ∈ A}) := by
let C : Set Score := causalHardCell (centers j) w ∩
{x | causalHardSignedStatistic (centers j) x ∈ A}
have hstat := causalHardSignedStatistic_measurable (centers j)
have hC : MeasurableSet C :=
Metric.isClosed_closedBall.measurableSet.inter (hA.preimage hstat)
have hcompact : IsCompact (causalHardCell (centers j) w) :=
isCompact_closedBall (centers j) w
have hpoint : ∀ x ∈ C,
packingAngularDensity b cA delta w centers omega x =
1 + if omega j then
packingAngularTerm b cA delta w (centers j) x else 0 := by
intro x hx
let omega' : Fin M → Bool := fun k => if k = j then omega j else false
rw [packingAngularDensity_eq_on_cell hw hsep
(omega' := omega') (j := j) (by simp [omega']) hx.1]
simp only [packingAngularDensity, omega']
rw [Finset.sum_eq_single j]
· simp
· intro k _ hkj
simp [hkj]
· simp
have hint : IntegrableOn
(packingAngularDensity b cA delta w centers omega) C volume :=
((packingAngularDensity_continuous hb hscale centers omega).continuousOn.integrableOn_compact
hcompact).mono_set inter_subset_left
have hterm : IntegrableOn
(fun x : Score => if omega j then
packingAngularTerm b cA delta w (centers j) x else 0) C := by
by_cases hj : omega j = true
· simpa [hj] using
(((packingAngularTerm_continuous hb hscale (centers j)).continuousOn.integrableOn_compact
hcompact).mono_set inter_subset_left)
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simpa [hjf] using (integrableOn_const : IntegrableOn (fun _ : Score => (0 : ℝ)) C)
have hdensityIntegral :
(∫ x in C, packingAngularDensity b cA delta w centers omega x) =
(volume C).toReal := by
rw [setIntegral_congr_fun hC hpoint]
have hone : IntegrableOn (fun _ : Score => (1 : ℝ)) C :=
(continuous_const.continuousOn.integrableOn_compact hcompact).mono_set
inter_subset_left
rw [integral_add hone hterm, integral_const]
simp only [Measure.real, Measure.restrict_apply_univ]
have hz : (∫ x in C, if omega j then
packingAngularTerm b cA delta w (centers j) x else 0) = 0 := by
by_cases hj : omega j = true
· simpa [C, hj] using
scoreCenter_causalHardSignedStatistic_angularTerm_integral_eq_zero
hcenter b cA delta w hwHalf hA
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simp [hjf]
rw [hz, add_zero]
simp
unfold causalHardScoreMeasure
rw [withDensity_apply _ hC]
have hsquare : ∀ x ∈ C, x ∈ causalHardSquare :=
fun x hx => hcell hx.1
have heq : (fun x => ofReal (causalHardSquare.indicator
(causalHardScoreDensity b cA delta w centers omega) x)) =ᵐ[volume.restrict C]
fun x => ofReal ((1 / 36 : ℝ) *
packingAngularDensity b cA delta w centers omega x) := by
filter_upwards [ae_restrict_mem hC] with x hx
rw [indicator_of_mem (hsquare x hx)]
rfl
rw [lintegral_congr_ae heq]
have hnonneg : 0 ≤ᵐ[volume.restrict C]
fun x => (1 / 36 : ℝ) *
packingAngularDensity b cA delta w centers omega x := by
filter_upwards with x
exact mul_nonneg (by norm_num)
((packingAngularDensity_mem_Icc hcA hdelta hw hsep omega x).1.trans'
(by norm_num))
have hint' : IntegrableOn (fun x => (1 / 36 : ℝ) *
packingAngularDensity b cA delta w centers omega x) C :=
hint.const_mul (1 / 36 : ℝ)
rw [← ofReal_integral_eq_lintegral_ofReal hint' hnonneg]
rw [integral_const_mul, hdensityIntegral, ENNReal.ofReal_mul (by norm_num)]
rw [ENNReal.ofReal_toReal (ne_of_lt
((measure_mono inter_subset_left).trans_lt hcompact.measure_lt_top))]
theorem causalHardScoreMeasure_restrict_map_signedStatistic_eq
The signed-radius marginal of the restricted score law is independent of the hard-cell bit.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hwHalf :
w ≤ 1 / 2
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
centers j ∈ causalHardBottomEdge
hcell :
causalHardCell (centers j) w ⊆ causalHardSquare
conclusion
Measure.map (causalHardSignedStatistic (centers j)) ((causalHardScoreMeasure b cA delta w centers omega).restrict (causalHardCell (centers j) w))
= Measure.map (causalHardSignedStatistic (centers j)) ((causalHardScoreMeasure b cA delta w centers omega').restrict (causalHardCell (centers j) w))
Proof (Lean source)
-- @node: causalHardScoreMeasure_restrict_map_signedStatistic_eq
lemma causalHardScoreMeasure_restrict_map_signedStatistic_eq
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(centers : Fin M → Score) (omega omega' : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w) (hwHalf : w ≤ 1 / 2)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : centers j ∈ causalHardBottomEdge)
(hcell : causalHardCell (centers j) w ⊆ causalHardSquare) :
Measure.map (causalHardSignedStatistic (centers j))
((causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w)) =
Measure.map (causalHardSignedStatistic (centers j))
((causalHardScoreMeasure b cA delta w centers omega').restrict
(causalHardCell (centers j) w)) := by
apply Measure.ext
intro A hA
rw [Measure.map_apply (causalHardSignedStatistic_measurable _) hA,
Measure.map_apply (causalHardSignedStatistic_measurable _) hA,
Measure.restrict_apply (hA.preimage (causalHardSignedStatistic_measurable _)),
Measure.restrict_apply (hA.preimage (causalHardSignedStatistic_measurable _))]
have hset : causalHardSignedStatistic (centers j) ⁻¹' A ∩
causalHardCell (centers j) w =
causalHardCell (centers j) w ∩
{x | causalHardSignedStatistic (centers j) x ∈ A} := by
ext x
simp [and_comm]
rw [hset,
causalHardScoreMeasure_signedSlice_eq_uniform j centers omega hb hscale
hcA hdelta hw hwHalf hsep hcenter hcell hA,
causalHardScoreMeasure_signedSlice_eq_uniform j centers omega' hb hscale
hcA hdelta hw hwHalf hsep hcenter hcell hA]
theorem causalHardScoreMeasure_signedStatistic_Ioo_le
The positive short signed-radius interval in a complete hard cell has at most its uniform-background disk mass.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w R :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hwHalf :
w ≤ 1 / 2
hR :
0 ≤ R
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
centers j ∈ causalHardBottomEdge
hcell :
causalHardCell (centers j) w ⊆ causalHardSquare
conclusion
Measure.map (causalHardSignedStatistic (centers j)) ((causalHardScoreMeasure b cA delta w centers omega).restrict (causalHardCell (centers j) w)) (Ioo 0 R)
Proof (Lean source)
-- @node: causalHardScoreMeasure_signedStatistic_Ioo_le
lemma causalHardScoreMeasure_signedStatistic_Ioo_le
{M : ℕ} (j : Fin M) {b cA delta w R : ℝ}
(centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w) (hwHalf : w ≤ 1 / 2)
(hR : 0 ≤ R)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : centers j ∈ causalHardBottomEdge)
(hcell : causalHardCell (centers j) w ⊆ causalHardSquare) :
Measure.map (causalHardSignedStatistic (centers j))
((causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w)) (Ioo 0 R) ≤
ofReal (pi * R ^ 2 / 36) := by
rw [Measure.map_apply (causalHardSignedStatistic_measurable _)
measurableSet_Ioo]
rw [Measure.restrict_apply
(measurableSet_Ioo.preimage (causalHardSignedStatistic_measurable _))]
have hset : causalHardSignedStatistic (centers j) ⁻¹' Ioo 0 R ∩
causalHardCell (centers j) w =
causalHardCell (centers j) w ∩
{x | causalHardSignedStatistic (centers j) x ∈ Ioo 0 R} := by
ext x
simp [and_comm]
rw [hset, causalHardScoreMeasure_signedSlice_eq_uniform j centers omega
hb hscale hcA hdelta hw hwHalf hsep hcenter hcell measurableSet_Ioo]
have hsubset : causalHardCell (centers j) w ∩
{x | causalHardSignedStatistic (centers j) x ∈ Ioo 0 R} ⊆
closedBall (centers j) R := by
intro x hx
have hsigned := causalHardSignedStatistic_eq_verticalSignedRadius_on_cell
hcenter hwHalf hx.1
rw [Metric.mem_closedBall]
have hmem := hx.2
change causalHardSignedStatistic (centers j) x ∈ Ioo 0 R at hmem
rw [hsigned] at hmem
split at hmem
· exact hmem.2.le
· linarith [show 0 ≤ dist x (centers j) from dist_nonneg, hmem.1]
calc
ofReal (1 / 36 : ℝ) *
volume (causalHardCell (centers j) w ∩
{x | causalHardSignedStatistic (centers j) x ∈ Ioo 0 R}) ≤
ofReal (1 / 36 : ℝ) *
volume (closedBall (centers j) R) :=
mul_le_mul_right (measure_mono hsubset) _
_ = ofReal (pi * R ^ 2 / 36) := by
rw [EuclideanSpace.volume_closedBall_fin_two, ← ENNReal.ofReal_pow hR,
← ENNReal.ofReal_mul (sq_nonneg R),
← ENNReal.ofReal_mul (by norm_num : 0 ≤ (1 / 36 : ℝ))]
congr 1
ring
Causal.Hypercube.HardSquareSignedKL 9 declarations This module identifies the observed outcome after signed-distance compression with an explicit Bernoulli mixture over the score law.
Signed-observation KL certificate for the hard square
This module identifies the observed outcome after signed-distance compression with an explicit Bernoulli mixture over the score law. It then combines the half-disc cancellation estimate with the common-statistic Bernoulli KL bound.
theorem packingRegression_mul_density_enable_cell_identity
Inside an arbitrary separated packing cell, switching its active bit from false to true changes the regression-density product by the radial bump plus the angular cross term. Unlike the older lower-support-edge identity, this version applies to the interior hard-square cells.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hj :
omega j = false
x :
hx :
x ∈ closedBall (centers j) w
conclusion
packingRegression b delta w centers (update omega j true) x * packingAngularDensity b cA delta w centers (update omega j true) x
- packingRegression b delta w centers omega x * packingAngularDensity b cA delta w centers omega x
= localizedPackingBump delta w (centers j) x
+ (packingAffineBaseline b x + localizedPackingBump delta w (centers j) x) * packingAngularTerm b cA delta w (centers j) x
Proof (Lean source)
-- @node: packingRegression_mul_density_enable_cell_identity
lemma packingRegression_mul_density_enable_cell_identity
{M : ℕ} (j : Fin M) {b cA delta w : ℝ} (centers : Fin M → Score)
(hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (hj : omega j = false) {x : Score}
(hx : x ∈ closedBall (centers j) w) :
packingRegression b delta w centers (update omega j true) x *
packingAngularDensity b cA delta w centers
(update omega j true) x -
packingRegression b delta w centers omega x *
packingAngularDensity b cA delta w centers omega x =
localizedPackingBump delta w (centers j) x +
(packingAffineBaseline b x +
localizedPackingBump delta w (centers j) x) *
packingAngularTerm b cA delta w (centers j) x := by
have hfar : ∀ i : Fin M, i ≠ j → w ≤ dist x (centers i) := by
intro i hij
have htri : dist (centers i) (centers j) ≤
dist (centers i) x + dist x (centers j) := dist_triangle _ _ _
have hs := hsep i j hij
rw [Metric.mem_closedBall] at hx
rw [dist_comm (centers i) x] at htri
linarith
have hregOn : packingRegression b delta w centers
(update omega j true) x =
packingAffineBaseline b x + localizedPackingBump delta w (centers j) x := by
unfold packingRegression
rw [Finset.sum_eq_single j]
· simp
· intro i _ hij
rw [localizedPackingBump_eq_zero_of_bandwidth_le_dist hw (hfar i hij)]
simp [update, hij]
· simp
have hregOff : packingRegression b delta w centers omega x =
packingAffineBaseline b x := by
unfold packingRegression
rw [Finset.sum_eq_zero]
· simp
· intro i _
by_cases hij : i = j
· subst i
simp [hj]
· rw [localizedPackingBump_eq_zero_of_bandwidth_le_dist hw (hfar i hij)]
simp
have hdensOn : packingAngularDensity b cA delta w centers
(update omega j true) x =
1 + packingAngularTerm b cA delta w (centers j) x := by
unfold packingAngularDensity
rw [Finset.sum_eq_single j]
· simp
· intro i _ hij
rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw (hfar i hij)]
simp [update, hij]
· simp
have hdensOff : packingAngularDensity b cA delta w centers omega x = 1 := by
unfold packingAngularDensity
rw [Finset.sum_eq_zero]
· simp
· intro i _
by_cases hij : i = j
· subst i
simp [hj]
· rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw (hfar i hij)]
simp
rw [hregOn, hregOff, hdensOn, hdensOff]
ring
theorem packingRegression_mul_density_enable_cell_radial_identity
The arbitrary-cell enable identity in the radial and direction-cosine coordinates used by the signed half-disc cancellation estimate.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hj :
omega j = false
x :
hx :
x ∈ closedBall (centers j) w
conclusion
packingRegression b delta w centers (update omega j true) x * packingAngularDensity b cA delta w centers (update omega j true) x
- packingRegression b delta w centers omega x * packingAngularDensity b cA delta w centers omega x
= delta * angularRadialProfile w (dist x (centers j))
+ (packingAffineBaseline b x + delta * angularRadialProfile w (dist x (centers j))) * angularTilt b cA delta w (dist x (centers j)) * ((scoreCoordinates x - scoreCoordinates (centers j)).1 / dist x (centers j))
Proof (Lean source)
-- @node: packingRegression_mul_density_enable_cell_radial_identity
lemma packingRegression_mul_density_enable_cell_radial_identity
{M : ℕ} (j : Fin M) {b cA delta w : ℝ} (centers : Fin M → Score)
(hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (hj : omega j = false) {x : Score}
(hx : x ∈ closedBall (centers j) w) :
packingRegression b delta w centers (update omega j true) x *
packingAngularDensity b cA delta w centers
(update omega j true) x -
packingRegression b delta w centers omega x *
packingAngularDensity b cA delta w centers omega x =
delta * angularRadialProfile w (dist x (centers j)) +
(packingAffineBaseline b x +
delta * angularRadialProfile w (dist x (centers j))) *
angularTilt b cA delta w (dist x (centers j)) *
((scoreCoordinates x - scoreCoordinates (centers j)).1 /
dist x (centers j)) := by
rw [packingRegression_mul_density_enable_cell_identity j centers hw hsep
omega hj hx, localizedPackingBump_eq_delta_mul_angularRadialProfile]
rw [packingAngularTerm, packingDirectionCos_eq_planarFirst_div_radius,
planarRadius_scoreCoordinates_sub]
ring
The success profile obtained by selecting the treatment profile on a measurable arm and the control profile off that arm.
Definition (Lean source)
-- @node: selectedArmSuccessProfile
noncomputable def selectedArmSuccessProfile
(A : Set Score) (p0 p1 : Score → ℝ) (x : Score) : ℝ := by
classical
exact if x ∈ A then p1 x else p0 x
theorem selectedArmSuccessProfile_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (selectedArmSuccessProfile A p0 p1)
Proof (Lean source)
lemma selectedArmSuccessProfile_measurable
{A : Set Score} (hA : MeasurableSet A) {p0 p1 : Score → ℝ}
(hp0 : Measurable p0) (hp1 : Measurable p1) :
Measurable (selectedArmSuccessProfile A p0 p1) := by
classical
unfold selectedArmSuccessProfile
exact Measurable.ite hA hp1 hp0
The potential outcome selected by membership of the score in an arm.
Definition (Lean source)
-- @node: selectedArmOutcome
noncomputable def selectedArmOutcome
(A : Set Score) (z : CausalObservation) : ℝ := by
classical
exact if causalScore z ∈ A then armCoord true z else armCoord false z
theorem causalBernoulliPotentialOutcomeMeasure_restrict_map_selected
Restricting an explicit two-Bernoulli potential-outcome law to a score set and selecting the outcome according to a measurable arm gives the corresponding piecewise Bernoulli composition product.
Formal statement
hypotheses
nu :
p0 p1 :
Score → ℝ
hp0 :
Measurable p0
hp1 :
Measurable p1
hp0lo :
∀ x, 0 ≤ p0 x
hp0hi :
∀ x, p0 x ≤ 1
hp1lo :
∀ x, 0 ≤ p1 x
hp1hi :
∀ x, p1 x ≤ 1
hA :
hC :
stat :
Score → ℝ
hstat :
Measurable stat
conclusion
let p : Score → ℝ := selectedArmSuccessProfile A p0 p1 let hp : Measurable p := selectedArmSuccessProfile_measurable hA hp0 hp1 Measure.map (fun z : CausalObservation => (selectedArmOutcome A z, stat (causalScore z))) ((causalBernoulliPotentialOutcomeMeasure nu p0 p1 hp0 hp1).restrict {z | causalScore z ∈ C})
= Measure.map (fun z : Score × ℝ => (z.2, stat z.1)) (Measure.compProd (nu.restrict C) (causalSelectedBernoulliKernel p hp))
Proof (Lean source)
-- @node: causalBernoulliPotentialOutcomeMeasure_restrict_map_selected
lemma causalBernoulliPotentialOutcomeMeasure_restrict_map_selected
(nu : Measure Score) [IsProbabilityMeasure nu]
(p0 p1 : Score → ℝ) (hp0 : Measurable p0) (hp1 : Measurable p1)
(hp0lo : ∀ x, 0 ≤ p0 x) (hp0hi : ∀ x, p0 x ≤ 1)
(hp1lo : ∀ x, 0 ≤ p1 x) (hp1hi : ∀ x, p1 x ≤ 1)
(A C : Set Score) (hA : MeasurableSet A) (hC : MeasurableSet C)
(stat : Score → ℝ) (hstat : Measurable stat) :
let p : Score → ℝ := selectedArmSuccessProfile A p0 p1
let hp : Measurable p := selectedArmSuccessProfile_measurable hA hp0 hp1
Measure.map
(fun z : CausalObservation => (selectedArmOutcome A z,
stat (causalScore z)))
((causalBernoulliPotentialOutcomeMeasure nu p0 p1 hp0 hp1).restrict
{z | causalScore z ∈ C}) =
Measure.map (fun z : Score × ℝ => (z.2, stat z.1))
(Measure.compProd (nu.restrict C) (causalSelectedBernoulliKernel p hp)) := by
classical
dsimp only
let k0 := causalSelectedBernoulliKernel p0 hp0
let k1 := causalSelectedBernoulliKernel p1 hp1
let p : Score → ℝ := selectedArmSuccessProfile A p0 p1
let hp : Measurable p := selectedArmSuccessProfile_measurable hA hp0 hp1
let k := causalSelectedBernoulliKernel p hp
letI : IsMarkovKernel k0 :=
causalSelectedBernoulliKernel_isMarkovKernel p0 hp0 hp0lo hp0hi
letI : IsMarkovKernel k1 :=
causalSelectedBernoulliKernel_isMarkovKernel p1 hp1 hp1lo hp1hi
letI : IsMarkovKernel k :=
causalSelectedBernoulliKernel_isMarkovKernel p hp
(fun x => by simp only [p, selectedArmSuccessProfile]; split_ifs <;> simp_all)
(fun x => by simp only [p, selectedArmSuccessProfile]; split_ifs <;> simp_all)
have hscore : Measurable (causalScore : CausalObservation → Score) := by
unfold causalScore
fun_prop
have harm1 : Measurable (armCoord true : CausalObservation → ℝ) := by
exact (measurable_fst.comp measurable_snd :
Measurable (fun w : CausalObservation => w.2.1))
have harm0 : Measurable (armCoord false : CausalObservation → ℝ) := by
exact (measurable_fst :
Measurable (fun w : CausalObservation => w.1))
have hselected : Measurable (selectedArmOutcome A) := by
unfold selectedArmOutcome
exact Measurable.ite (hA.preimage hscore) harm1 harm0
have hobs : Measurable (fun z : CausalObservation =>
(selectedArmOutcome A z, stat (causalScore z))) :=
hselected.prodMk (hstat.comp hscore)
ext S hS
rw [Measure.map_apply hobs hS]
rw [Measure.restrict_apply (hS.preimage hobs)]
unfold causalBernoulliPotentialOutcomeMeasure
have htarget : MeasurableSet
((fun z : CausalObservation =>
(selectedArmOutcome A z, stat (causalScore z))) ⁻¹' S ∩
{z | causalScore z ∈ C}) :=
(hS.preimage hobs).inter (hC.preimage hscore)
rw [Measure.map_apply (by fun_prop) htarget]
have hout : Measurable (fun z : Score × ℝ => (z.2, stat z.1)) := by
fun_prop
have hreorder : Measurable (fun z : Score × (ℝ × ℝ) =>
(z.2.1, z.2.2, z.1)) := by fun_prop
rw [Measure.map_apply hout hS]
rw [Measure.compProd_apply, Measure.compProd_apply]
rw [← lintegral_indicator hC]
· apply lintegral_congr
intro x
by_cases hxC : x ∈ C
· rw [indicator_of_mem hxC]
by_cases hxA : x ∈ A
· have hmap := Kernel.snd_prod k0 k1
have heval := congrArg (fun q : Kernel Score ℝ => q x) hmap
have hB : MeasurableSet ((fun y : ℝ => (y, stat x)) ⁻¹' S) :=
hS.preimage (measurable_id.prodMk measurable_const)
have hset := congrArg (fun m : Measure ℝ =>
m ((fun y : ℝ => (y, stat x)) ⁻¹' S)) heval
change (Kernel.snd (Kernel.prod k0 k1) x)
((fun y : ℝ => (y, stat x)) ⁻¹' S) =
k1 x ((fun y : ℝ => (y, stat x)) ⁻¹' S) at hset
rw [Kernel.snd_apply' _ x hB] at hset
have hpre :
Prod.mk x ⁻¹' ((fun z : Score × (ℝ × ℝ) => (z.2.1, z.2.2, z.1)) ⁻¹'
((fun z : CausalObservation =>
(selectedArmOutcome A z, stat (causalScore z))) ⁻¹' S ∩
{z | causalScore z ∈ C})) =
snd ⁻¹' ((fun y : ℝ => (y, stat x)) ⁻¹' S) := by
ext yy
simp [selectedArmOutcome, causalScore, armCoord, hxA, hxC]
rw [hpre]
change ((k0 ×ₖ k1) x) (snd ⁻¹' ((fun y : ℝ => (y, stat x)) ⁻¹' S)) =
(bernoulliLaw
(if x ∈ A then p1 x else p0 x))
(Prod.mk x ⁻¹' ((fun z : Score × ℝ => (z.2, stat z.1)) ⁻¹' S))
rw [if_pos hxA]
exact hset
· have hmap := Kernel.fst_prod k0 k1
have heval := congrArg (fun q : Kernel Score ℝ => q x) hmap
have hB : MeasurableSet ((fun y : ℝ => (y, stat x)) ⁻¹' S) :=
hS.preimage (measurable_id.prodMk measurable_const)
have hset := congrArg (fun m : Measure ℝ =>
m ((fun y : ℝ => (y, stat x)) ⁻¹' S)) heval
change (Kernel.fst (Kernel.prod k0 k1) x)
((fun y : ℝ => (y, stat x)) ⁻¹' S) =
k0 x ((fun y : ℝ => (y, stat x)) ⁻¹' S) at hset
rw [Kernel.fst_apply' _ x hB] at hset
have hpre :
Prod.mk x ⁻¹' ((fun z : Score × (ℝ × ℝ) => (z.2.1, z.2.2, z.1)) ⁻¹'
((fun z : CausalObservation =>
(selectedArmOutcome A z, stat (causalScore z))) ⁻¹' S ∩
{z | causalScore z ∈ C})) =
fst ⁻¹' ((fun y : ℝ => (y, stat x)) ⁻¹' S) := by
ext yy
simp [selectedArmOutcome, causalScore, armCoord, hxA, hxC]
rw [hpre]
change ((k0 ×ₖ k1) x) (fst ⁻¹' ((fun y : ℝ => (y, stat x)) ⁻¹' S)) =
(bernoulliLaw
(if x ∈ A then p1 x else p0 x))
(Prod.mk x ⁻¹' ((fun z : Score × ℝ => (z.2, stat z.1)) ⁻¹' S))
rw [if_neg hxA]
exact hset
· have : x ∉ C := hxC
have hpre : Prod.mk x ⁻¹' ((fun z : Score × (ℝ × ℝ) => (z.2.1, z.2.2, z.1)) ⁻¹' ((fun z : CausalObservation =>
(selectedArmOutcome A z, stat (causalScore z))) ⁻¹' S ∩
{z | causalScore z ∈ C})) = ∅ := by
ext yy
simp [causalScore, hxC]
rw [hpre, measure_empty]
rw [indicator_of_notMem hxC]
· exact hS.preimage hout
· exact htarget.preimage hreorder
theorem causalHardCellSignedObservationMeasure_eq_scoreBernoulli
On a hard cell, the raw signed observation measure is the explicit piecewise-Bernoulli composition product over the restricted score design.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
conclusion
let nu := causalHardScoreMeasure b cA delta w centers omega let p := causalHardObservedSuccessProfile delta w centers omega let hp := causalHardObservedSuccessProfile_measurable delta w centers omega let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell causalHardCellSignedObservationMeasure P (centers j) w
= Measure.map (fun z : Score × ℝ => (z.2, causalHardSignedStatistic (centers j) z.1)) (Measure.compProd (nu.restrict (causalHardCell (centers j) w)) (causalSelectedBernoulliKernel p hp))
Proof (Lean source)
-- @node: causalHardCellSignedObservationMeasure_eq_scoreBernoulli
lemma causalHardCellSignedObservationMeasure_eq_scoreBernoulli
{M : ℕ} (j : Fin M) (b cA delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare) :
let nu := causalHardScoreMeasure b cA delta w centers omega
let p := causalHardObservedSuccessProfile delta w centers omega
let hp := causalHardObservedSuccessProfile_measurable delta w centers omega
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
causalHardCellSignedObservationMeasure P (centers j) w =
Measure.map
(fun z : Score × ℝ => (z.2, causalHardSignedStatistic (centers j) z.1))
(Measure.compProd (nu.restrict (causalHardCell (centers j) w))
(causalSelectedBernoulliKernel p hp)) := by
dsimp only
let nu := causalHardScoreMeasure b cA delta w centers omega
let p0 := causalHardControlProfile
let p1 := causalHardTreatmentProfile delta w centers omega
have hpPair := causalHardProfiles_measurable delta w centers omega
letI : IsProbabilityMeasure nu :=
causalHardScoreMeasure_isProbabilityMeasure centers omega hb hscale hcA
hdelta hw hsep hcell
have hbase := causalBernoulliPotentialOutcomeMeasure_restrict_map_selected
nu p0 p1 hpPair.1 hpPair.2
(fun x => (causalHardProfiles_mem_unitInterval delta w centers omega x).1.1)
(fun x => (causalHardProfiles_mem_unitInterval delta w centers omega x).1.2)
(fun x => (causalHardProfiles_mem_unitInterval delta w centers omega x).2.1)
(fun x => (causalHardProfiles_mem_unitInterval delta w centers omega x).2.2)
causalHardArmOne (causalHardCell (centers j) w)
causalHardArmOne_measurableSet Metric.isClosed_closedBall.measurableSet
(causalHardSignedStatistic (centers j))
(causalHardSignedStatistic_measurable (centers j))
change _ = _ at hbase
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
have hleft : (fun z : CausalObservation =>
(selectedArmOutcome causalHardArmOne z,
causalHardSignedStatistic (centers j) (causalScore z))) =
signedObservationAt P (centers j) := by
funext z
rw [← signedDistance_causalHardA1A2Law_eq_causalHardSignedStatistic
b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell]
by_cases hz : causalScore z ∈ causalHardArmOne
· simp [P, selectedArmOutcome, signedObservationAt, observedOutcome,
treatment, causalHardA1A2Law, causalBernoulliA1A2Law, hz]
· simp [P, selectedArmOutcome, signedObservationAt, observedOutcome,
treatment, causalHardA1A2Law, causalBernoulliA1A2Law, hz]
have hparam : selectedArmSuccessProfile causalHardArmOne p0 p1 =
causalHardObservedSuccessProfile delta w centers omega := by
funext x
rfl
have hk : causalSelectedBernoulliKernel
(selectedArmSuccessProfile causalHardArmOne p0 p1)
(selectedArmSuccessProfile_measurable causalHardArmOne_measurableSet
hpPair.1 hpPair.2) =
causalSelectedBernoulliKernel
(causalHardObservedSuccessProfile delta w centers omega)
(causalHardObservedSuccessProfile_measurable delta w centers omega) := by
cases hparam
rfl
rw [hleft, hk] at hbase
simpa [causalHardCellSignedObservationMeasure, P, causalHardA1A2Law,
causalBernoulliA1A2Law] using hbase
theorem causalHardCellSignedObservationLaw_eq_of_bit_eq
The normalized signed-observation law on a hard cell depends on a vertex only through that cell's bit.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
hbit :
omega j = omega' j
conclusion
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell let P' := causalHardA1A2Law b cA delta w centers omega' hb hscale hcA hdelta hw hsep hcell causalHardCellSignedObservationLaw P (centers j) w
= causalHardCellSignedObservationLaw P' (centers j) w
Proof (Lean source)
-- @node: causalHardCellSignedObservationLaw_eq_of_bit_eq
lemma causalHardCellSignedObservationLaw_eq_of_bit_eq
{M : ℕ} (j : Fin M) (b cA delta w : ℝ)
(centers : Fin M → Score) (omega omega' : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare)
(hbit : omega j = omega' j) :
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
let P' := causalHardA1A2Law b cA delta w centers omega' hb hscale hcA
hdelta hw hsep hcell
causalHardCellSignedObservationLaw P (centers j) w =
causalHardCellSignedObservationLaw P' (centers j) w := by
dsimp only
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
let P' := causalHardA1A2Law b cA delta w centers omega' hb hscale hcA
hdelta hw hsep hcell
let rho : ℝ := pi * w ^ 2 / 36
have hrho : 0 < rho := by
dsimp [rho]
positivity
apply causalHardCellSignedObservationLaw_eq_of_restrict_eq
P P' (centers j) w rho hrho
· exact causalHardA1A2Law_cell_mass j b cA delta w centers omega hb hscale
hcA hdelta hw hsep hcell
· exact causalHardA1A2Law_cell_mass j b cA delta w centers omega' hb hscale
hcA hdelta hw hsep hcell
· exact causalHardA1A2Law_restrict_cell_eq hb hscale hcA hdelta hw hsep
hcell hbit
· funext z
have hsigned : signedDistance (knownGeometry P) (centers j) (causalScore z) =
signedDistance (knownGeometry P') (centers j) (causalScore z) := by
rw [signedDistance_causalHardA1A2Law_eq_causalHardSignedStatistic
b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell,
signedDistance_causalHardA1A2Law_eq_causalHardSignedStatistic
b cA delta w centers omega' hb hscale hcA hdelta hw hsep hcell]
have hA : P.A1 = P'.A1 := by
simp [P, P', causalHardA1A2Law, causalBernoulliA1A2Law]
simp only [signedObservationAt, Prod.mk.injEq]
exact ⟨by simp [observedOutcome, treatment, hA], hsigned⟩
theorem causalHardCellSignedObservationLaw_vertex_package
The hard family admits a bit-indexed choice of normalized cell laws, and every vertex's raw signed-observation measure is its common cell mass times the law selected by the corresponding bit.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
conclusion
(∀ j bit, IsProbabilityMeasure (Q j bit)) ∧
∀ omega j,
causalHardCellSignedObservationMeasure (causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell) (centers j) w
Proof (Lean source)
-- @node: causalHardCellSignedObservationLaw_vertex_package
lemma causalHardCellSignedObservationLaw_vertex_package
{M : ℕ} (b cA delta w : ℝ) (centers : Fin M → Score)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare) :
∃ Q : Fin M → Bool → Measure (ℝ × ℝ),
(∀ j bit, IsProbabilityMeasure (Q j bit)) ∧
∀ omega j,
causalHardCellSignedObservationMeasure
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell) (centers j) w =
ofReal (pi * w ^ 2 / 36) • Q j (omega j) := by
let representative (j : Fin M) (bit : Bool) : Fin M → Bool :=
fun k => if k = j then bit else false
let P (omega : Fin M → Bool) :=
causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell
let Q (j : Fin M) (bit : Bool) : Measure (ℝ × ℝ) :=
causalHardCellSignedObservationLaw (P (representative j bit))
(centers j) w
refine ⟨Q, ?_, ?_⟩
· intro j bit
dsimp [Q]
infer_instance
· intro omega j
have hbit : omega j = representative j (omega j) j := by
simp [representative]
have hlaw := causalHardCellSignedObservationLaw_eq_of_bit_eq
j b cA delta w centers omega (representative j (omega j)) hb hscale
hcA hdelta hw hsep hcell hbit
have hmass := causalHardA1A2Law_cell_mass j b cA delta w centers omega hb
hscale hcA hdelta hw hsep hcell
rw [causalHardCellSignedObservationMeasure_eq_mass_smul_law
(P omega) (centers j) w (pi * w ^ 2 / 36) (by positivity) hmass]
change _ = ofReal (pi * w ^ 2 / 36) • Q j (omega j)
rw [hlaw]
Causal.Hypercube.HardSquareSignedNormalized 8 declarations This module chooses canonical bit representatives and transfers the raw signed-observation localization results to normalized conditional cell laws.
Normalized signed hard-cell certificate
This module chooses canonical bit representatives and transfers the raw signed-observation localization results to normalized conditional cell laws.
The canonical hypercube vertex representing one cell bit.
Definition (Lean source)
-- @node: causalHardCellBitRepresentative
def causalHardCellBitRepresentative {M : ℕ} (j : Fin M) (bit : Bool) :
Fin M → Bool := fun k => if k = j then bit else false
The canonical normalized signed-observation law for a cell bit.
Definition (Lean source)
-- @node: causalHardCellBitObservationLaw
noncomputable def causalHardCellBitObservationLaw {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare)
(j : Fin M) (bit : Bool) : Measure (ℝ × ℝ) :=
causalHardCellSignedObservationLaw
(causalHardA1A2Law b cA delta w centers
(causalHardCellBitRepresentative j bit) hb hscale hcA hdelta hw hsep hcell)
(centers j) w
instance causalHardCellBitObservationLaw_isProbabilityMeasure
The stated experiment law has total mass one and therefore defines a probability distribution.
Definition (Lean source)
instance causalHardCellBitObservationLaw_isProbabilityMeasure {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare)
(j : Fin M) (bit : Bool) :
IsProbabilityMeasure (causalHardCellBitObservationLaw b cA delta w centers
hb hscale hcA hdelta hw hsep hcell j bit) := by
unfold causalHardCellBitObservationLaw
infer_instance
theorem causalHardCellSignedObservationMeasure_eq_bitLaw
Every raw cell observation measure is the common cell mass times the canonical normalized law selected by that vertex's cell bit.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
conclusion
causalHardCellSignedObservationMeasure (causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell) (centers j) w
= ofReal (pi * w ^ 2 / 36) • causalHardCellBitObservationLaw b cA delta w centers hb hscale hcA hdelta hw hsep hcell j (omega j)
Proof (Lean source)
-- @node: causalHardCellSignedObservationMeasure_eq_bitLaw
lemma causalHardCellSignedObservationMeasure_eq_bitLaw {M : ℕ}
(j : Fin M) (b cA delta w : ℝ) (centers : Fin M → Score)
(omega : Fin M → Bool) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare) :
causalHardCellSignedObservationMeasure
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell) (centers j) w =
ofReal (pi * w ^ 2 / 36) •
causalHardCellBitObservationLaw b cA delta w centers hb hscale hcA
hdelta hw hsep hcell j (omega j) := by
have hbit : omega j = causalHardCellBitRepresentative j (omega j) j := by
simp [causalHardCellBitRepresentative]
have hlaw := causalHardCellSignedObservationLaw_eq_of_bit_eq
j b cA delta w centers omega (causalHardCellBitRepresentative j (omega j))
hb hscale hcA hdelta hw hsep hcell hbit
have hmass := causalHardA1A2Law_cell_mass j b cA delta w centers omega hb
hscale hcA hdelta hw hsep hcell
rw [causalHardCellSignedObservationMeasure_eq_mass_smul_law _ _ _ _
(by positivity) hmass]
rw [hlaw]
rfl
theorem causalHardCellSignedObservationMeasure_map_snd
The second marginal of a raw signed observation is its restricted signed-statistic marginal.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
conclusion
Measure.map snd (causalHardCellSignedObservationMeasure (causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell) (centers j) w)
= Measure.map (causalHardSignedStatistic (centers j)) ((causalHardScoreMeasure b cA delta w centers omega).restrict (causalHardCell (centers j) w))
Proof (Lean source)
-- @node: causalHardCellSignedObservationMeasure_map_snd
lemma causalHardCellSignedObservationMeasure_map_snd {M : ℕ}
(j : Fin M) (b cA delta w : ℝ) (centers : Fin M → Score)
(omega : Fin M → Bool) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare) :
Measure.map snd
(causalHardCellSignedObservationMeasure
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell) (centers j) w) =
Measure.map (causalHardSignedStatistic (centers j))
((causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w)) := by
let nu := (causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w)
let p := causalHardObservedSuccessProfile delta w centers omega
letI : IsProbabilityMeasure
(causalHardScoreMeasure b cA delta w centers omega) :=
causalHardScoreMeasure_isProbabilityMeasure centers omega hb hscale hcA
hdelta hw hsep hcell
letI : IsFiniteMeasure nu := by dsimp [nu]; infer_instance
have hp := causalHardObservedSuccessProfile_measurable delta w centers omega
have hpunit : ∀ x, 0 ≤ p x ∧ p x ≤ 1 := by
intro x
have hprof := causalHardProfiles_mem_unitInterval delta w centers omega x
dsimp [p, causalHardObservedSuccessProfile]
split_ifs <;> simp_all
letI : IsMarkovKernel (causalSelectedBernoulliKernel p hp) :=
causalSelectedBernoulliKernel_isMarkovKernel p hp
(fun x => (hpunit x).1) (fun x => (hpunit x).2)
rw [causalHardCellSignedObservationMeasure_eq_scoreBernoulli j b cA delta w
centers omega hb hscale hcA hdelta hw hsep hcell]
have hpair : Measurable (fun z : Score × ℝ =>
(z.2, causalHardSignedStatistic (centers j) z.1)) :=
measurable_snd.prodMk
((causalHardSignedStatistic_measurable _).comp measurable_fst)
rw [Measure.map_map measurable_snd hpair]
change Measure.map (causalHardSignedStatistic (centers j) ∘ fst)
(Measure.compProd nu (causalSelectedBernoulliKernel p hp)) = _
rw [← Measure.map_map (causalHardSignedStatistic_measurable _) measurable_fst]
have hfst : Measure.map fst
(Measure.compProd nu (causalSelectedBernoulliKernel p hp)) = nu := by
simpa [Measure.fst] using
(Measure.fst_compProd nu (causalSelectedBernoulliKernel p hp))
rw [hfst]
theorem causalHardCellBitObservationLaw_common_signedMarginal
The canonical normalized bit laws have a common signed-radius marginal.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hwHalf :
w ≤ 1 / 2
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
centers j ∈ causalHardBottomEdge
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
conclusion
Measure.map snd (causalHardCellBitObservationLaw b cA delta w centers hb hscale hcA hdelta hw hsep hcell j false)
= Measure.map snd (causalHardCellBitObservationLaw b cA delta w centers hb hscale hcA hdelta hw hsep hcell j true)
Proof (Lean source)
-- @node: causalHardCellBitObservationLaw_common_signedMarginal
lemma causalHardCellBitObservationLaw_common_signedMarginal {M : ℕ}
(j : Fin M) (b cA delta w : ℝ) (centers : Fin M → Score)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w) (hwHalf : w ≤ 1 / 2)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : centers j ∈ causalHardBottomEdge)
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare) :
Measure.map snd (causalHardCellBitObservationLaw b cA delta w centers
hb hscale hcA hdelta hw hsep hcell j false) =
Measure.map snd (causalHardCellBitObservationLaw b cA delta w centers
hb hscale hcA hdelta hw hsep hcell j true) := by
let omega0 := causalHardCellBitRepresentative j false
let omega1 := causalHardCellBitRepresentative j true
let rho := pi * w ^ 2 / 36
have hrho : 0 < rho := by dsimp [rho]; positivity
have hraw0 := congrArg (Measure.map snd)
(causalHardCellSignedObservationMeasure_eq_bitLaw j b cA delta w centers
omega0 hb hscale hcA hdelta hw hsep hcell)
have hraw1 := congrArg (Measure.map snd)
(causalHardCellSignedObservationMeasure_eq_bitLaw j b cA delta w centers
omega1 hb hscale hcA hdelta hw hsep hcell)
rw [Measure.map_smul] at hraw0
rw [Measure.map_smul] at hraw1
have hbit0 : omega0 j = false := by
simp [omega0, causalHardCellBitRepresentative]
have hbit1 : omega1 j = true := by
simp [omega1, causalHardCellBitRepresentative]
rw [hbit0] at hraw0
rw [hbit1] at hraw1
apply measure_eq_of_pos_ofReal_smul_eq _ _ hrho
dsimp [rho] at hraw0 hraw1 ⊢
rw [← hraw0]
rw [causalHardCellSignedObservationMeasure_map_snd j b cA delta w centers
omega0 hb hscale hcA hdelta hw hsep hcell]
rw [← hraw1]
rw [causalHardCellSignedObservationMeasure_map_snd j b cA delta w centers
omega1 hb hscale hcA hdelta hw hsep hcell]
exact causalHardScoreMeasure_restrict_map_signedStatistic_eq j centers
omega0 omega1 hb hscale hcA hdelta hw hwHalf hsep hcenter (hcell j)
theorem causalHardCellBitObservationLaw_restrict_compl_eq
The canonical normalized bit laws agree away from the positive short-radius window.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hbEq :
b = 1 / 16
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hwHalf :
w ≤ 1 / 2
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
centers j ∈ causalHardBottomEdge
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
conclusion
(causalHardCellBitObservationLaw b cA delta w centers hb hscale hcA hdelta hw hsep hcell j false).restrict {yd | ¬ (0 < yd.2 ∧ yd.2 < 2 * (cA * delta) / b)}
= (causalHardCellBitObservationLaw b cA delta w centers hb hscale hcA hdelta hw hsep hcell j true).restrict {yd | ¬ (0 < yd.2 ∧ yd.2 < 2 * (cA * delta) / b)}
Proof (Lean source)
-- @node: causalHardCellBitObservationLaw_restrict_compl_eq
lemma causalHardCellBitObservationLaw_restrict_compl_eq {M : ℕ}
(j : Fin M) {b cA delta w : ℝ} (centers : Fin M → Score)
(hbEq : b = 1 / 16) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16)
(hw : 0 < w) (hwHalf : w ≤ 1 / 2)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : centers j ∈ causalHardBottomEdge)
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare) :
(causalHardCellBitObservationLaw b cA delta w centers hb hscale hcA
hdelta hw hsep hcell j false).restrict
{yd | ¬ (0 < yd.2 ∧ yd.2 < 2 * (cA * delta) / b)} =
(causalHardCellBitObservationLaw b cA delta w centers hb hscale hcA
hdelta hw hsep hcell j true).restrict
{yd | ¬ (0 < yd.2 ∧ yd.2 < 2 * (cA * delta) / b)} := by
let omega0 := causalHardCellBitRepresentative j false
let omega1 := causalHardCellBitRepresentative j true
let rho := pi * w ^ 2 / 36
have hrho : 0 < rho := by dsimp [rho]; positivity
have hupdate : update omega0 j true = omega1 := by
funext k
by_cases hkj : k = j
· subst k
simp [omega0, omega1, causalHardCellBitRepresentative]
· simp [omega0, omega1, causalHardCellBitRepresentative, hkj]
have hout := causalHardCellSignedObservationMeasure_restrict_compl_enable_eq
j centers omega0 hbEq hb hscale hcA hdelta hdeltaSmall hw hwHalf hsep
hcenter hcell (by simp [omega0, causalHardCellBitRepresentative])
rw [hupdate] at hout
dsimp only at hout
have hraw0 := causalHardCellSignedObservationMeasure_eq_bitLaw
j b cA delta w centers omega0 hb hscale hcA hdelta hw hsep hcell
have hraw1 := causalHardCellSignedObservationMeasure_eq_bitLaw
j b cA delta w centers omega1 hb hscale hcA hdelta hw hsep hcell
rw [show omega0 j = false by simp [omega0, causalHardCellBitRepresentative]] at hraw0
rw [show omega1 j = true by simp [omega1, causalHardCellBitRepresentative]] at hraw1
rw [hraw0, hraw1, Measure.restrict_smul, Measure.restrict_smul] at hout
apply measure_eq_of_pos_ofReal_smul_eq _ _ hrho
simpa [rho] using hout
theorem causalHardCellBitObservationLaw_klDiv_le
Both KL orientations between the canonical normalized bit laws have the paper's fourth-order localized bound.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
delta w :
ℝ
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hwHalf :
w ≤ 1 / 2
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
centers j ∈ causalHardBottomEdge
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
Proof (Lean source)
-- @node: causalHardCellBitObservationLaw_klDiv_le
lemma causalHardCellBitObservationLaw_klDiv_le {M : ℕ}
(j : Fin M) {delta w : ℝ} (centers : Fin M → Score)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16)
(hw : 0 < w) (hwHalf : w ≤ 1 / 2)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : centers j ∈ causalHardBottomEdge)
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare) :
let Q := causalHardCellBitObservationLaw (1 / 16) 8 delta w centers
(by norm_num) (by positivity) (by norm_num) hdelta hw hsep hcell j
klDiv (Q false) (Q true) ≤
ofReal (262144 * delta ^ 4 / w ^ 2) ∧
klDiv (Q true) (Q false) ≤
ofReal (262144 * delta ^ 4 / w ^ 2) := by
dsimp only
let omega0 := causalHardCellBitRepresentative j false
let omega1 := causalHardCellBitRepresentative j true
let rho : ℝ := pi * w ^ 2 / 36
let rhoNN : ℝ≥0 := ⟨rho, (by dsimp [rho]; positivity)⟩
have hrho : 0 < rho := by dsimp [rho]; positivity
have hrhoNNcoe : (rhoNN : ℝ≥0∞) = ofReal rho :=
(ENNReal.ofReal_coe_nnreal (p := rhoNN)).symm
have hupdate : update omega0 j true = omega1 := by
funext k
by_cases hkj : k = j
· subst k
simp [omega0, omega1, causalHardCellBitRepresentative]
· simp [omega0, omega1, causalHardCellBitRepresentative, hkj]
have hraw := causalHardCellSignedObservationMeasure_klDiv_enable_le
(b := 1 / 16) (cA := 8) (delta := delta) (w := w)
j centers omega0 (by norm_num) (by norm_num) (by positivity) (by norm_num)
hdelta hdeltaSmall hw hwHalf hsep hcenter hcell
(by simp [omega0, causalHardCellBitRepresentative])
rw [hupdate] at hraw
dsimp only at hraw
have hraw0 := causalHardCellSignedObservationMeasure_eq_bitLaw
j (1 / 16) 8 delta w centers omega0 (by norm_num) (by positivity)
(by norm_num) hdelta hw hsep hcell
have hraw1 := causalHardCellSignedObservationMeasure_eq_bitLaw
j (1 / 16) 8 delta w centers omega1 (by norm_num) (by positivity)
(by norm_num) hdelta hw hsep hcell
rw [show omega0 j = false by simp [omega0, causalHardCellBitRepresentative]] at hraw0
rw [show omega1 j = true by simp [omega1, causalHardCellBitRepresentative]] at hraw1
have hraw0NN : causalHardCellSignedObservationMeasure
(causalHardA1A2Law (1 / 16) 8 delta w centers omega0 (by norm_num)
(by positivity) (by norm_num) hdelta hw hsep hcell) (centers j) w =
rhoNN • causalHardCellBitObservationLaw
(1 / 16) 8 delta w centers (by norm_num) (by positivity) (by norm_num)
hdelta hw hsep hcell j false := by
rw [← Measure.coe_nnreal_smul, hrhoNNcoe]
exact hraw0
have hraw1NN : causalHardCellSignedObservationMeasure
(causalHardA1A2Law (1 / 16) 8 delta w centers omega1 (by norm_num)
(by positivity) (by norm_num) hdelta hw hsep hcell) (centers j) w =
rhoNN • causalHardCellBitObservationLaw
(1 / 16) 8 delta w centers (by norm_num) (by positivity) (by norm_num)
hdelta hw hsep hcell j true := by
rw [← Measure.coe_nnreal_smul, hrhoNNcoe]
exact hraw1
rw [hraw0NN, hraw1NN] at hraw
simp only [InformationTheory.klDiv_smul_same] at hraw
have hmass := causalHardScoreMeasure_signedStatistic_Ioo_le j centers omega0
(b := 1 / 16) (cA := 8) (delta := delta) (w := w)
(R := 2 * (8 * delta) / (1 / 16)) (by norm_num) (by positivity)
(by norm_num) hdelta hw hwHalf (by positivity) hsep hcenter (hcell j)
have hbound : ofReal (4 * delta ^ 2) *
Measure.map (causalHardSignedStatistic (centers j))
((causalHardScoreMeasure (1 / 16) 8 delta w centers omega0).restrict
(causalHardCell (centers j) w))
(Ioo 0 (2 * (8 * delta) / (1 / 16))) ≤
(rhoNN : ℝ≥0∞) * ofReal (262144 * delta ^ 4 / w ^ 2) := by
calc
_ ≤ ofReal (4 * delta ^ 2) *
ofReal (pi * (2 * (8 * delta) / (1 / 16)) ^ 2 / 36) :=
mul_le_mul_right hmass _
_ = (rhoNN : ℝ≥0∞) *
ofReal (262144 * delta ^ 4 / w ^ 2) := by
rw [← ENNReal.ofReal_mul (by positivity : 0 ≤ 4 * delta ^ 2)]
rw [hrhoNNcoe]
rw [← ENNReal.ofReal_mul (by positivity : 0 ≤ rho)]
congr 1
dsimp [rho]
field_simp
ring
constructor
· have hrhoNN0 : (rhoNN : ℝ≥0∞) ≠ 0 := by
apply ENNReal.coe_ne_zero.mpr
intro hz
have hzv : rho = 0 := congrArg (fun x : ℝ≥0 => (x : ℝ)) hz
linarith
apply (ENNReal.mul_le_mul_iff_right (a := (rhoNN : ℝ≥0∞)) hrhoNN0
ENNReal.coe_ne_top).mp
exact hraw.1.trans hbound
· have hrhoNN0 : (rhoNN : ℝ≥0∞) ≠ 0 := by
apply ENNReal.coe_ne_zero.mpr
intro hz
have hzv : rho = 0 := congrArg (fun x : ℝ≥0 => (x : ℝ)) hz
linarith
apply (ENNReal.mul_le_mul_iff_right (a := (rhoNN : ℝ≥0∞)) hrhoNN0
ENNReal.coe_ne_top).mp
exact hraw.2.trans hbound
Causal.Hypercube.HardSquareSignedObservation 19 declarations This module isolates the measure normalization used by the hard-square hypercube.
Normalized signed-observation laws on hard cells
This module isolates the measure normalization used by the hard-square hypercube. The quantitative KL comparison can therefore work directly with probability laws, while the final constructor recovers the original restricted law by multiplying by the exact cell mass.
The one-observation pair (Y,D^{±}) at a fixed interface point.
Definition (Lean source)
-- @node: signedObservationAt
noncomputable def signedObservationAt (P : A1A2Law) (x : Score)
(z : CausalObservation) : ℝ × ℝ :=
(observedOutcome P z, signedDistance (knownGeometry P) x (causalScore z))
theorem signedObservationAt_eq_armOne
On the treated arm, the observed coordinate of a signed observation is the treated potential outcome.
Formal statement
hypotheses
conclusion
signedObservationAt P x z
Proof (Lean source)
-- @node: signedObservationAt_eq_armOne
lemma signedObservationAt_eq_armOne (P : A1A2Law) (x : Score)
(z : CausalObservation) (hz : causalScore z ∈ P.A1) :
signedObservationAt P x z =
(armCoord true z,
signedDistance (knownGeometry P) x (causalScore z)) := by
simp [signedObservationAt, observedOutcome, treatment, hz]
theorem signedObservationAt_eq_armZero
Off the treated arm, the observed coordinate of a signed observation is the control potential outcome.
Formal statement
hypotheses
conclusion
signedObservationAt P x z
Proof (Lean source)
-- @node: signedObservationAt_eq_armZero
lemma signedObservationAt_eq_armZero (P : A1A2Law) (x : Score)
(z : CausalObservation) (hz : causalScore z ∉ P.A1) :
signedObservationAt P x z =
(armCoord false z,
signedDistance (knownGeometry P) x (causalScore z)) := by
simp [signedObservationAt, observedOutcome, treatment, hz]
theorem signedDistance_knownGeometry_eq_dist
On the arm-one part of a partition, signed distance is positive Euclidean distance.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: signedDistance_knownGeometry_eq_dist
lemma signedDistance_knownGeometry_eq_dist (P : A1A2Law) (x z : Score)
(hz1 : z ∈ P.A1) (hz0 : z ∉ P.A0) :
signedDistance (knownGeometry P) x z = dist z x := by
simp [signedDistance, knownGeometry, hz1, hz0]
theorem signedDistance_knownGeometry_eq_neg_dist
On the arm-zero part of a partition, signed distance is negative Euclidean distance.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: signedDistance_knownGeometry_eq_neg_dist
lemma signedDistance_knownGeometry_eq_neg_dist (P : A1A2Law) (x z : Score)
(hz0 : z ∈ P.A0) (hz1 : z ∉ P.A1) :
signedDistance (knownGeometry P) x z = -dist z x := by
simp [signedDistance, knownGeometry, hz1, hz0]
theorem signedObservationAt_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
Proof (Lean source)
lemma signedObservationAt_measurable (P : A1A2Law) (x : Score) :
Measurable (signedObservationAt P x) := by
have hs : Measurable (causalScore : CausalObservation → Score) := by
unfold causalScore
fun_prop
have ht : Measurable (treatment P) := by
unfold treatment
exact (measurable_const.indicator P.A1_measurable).comp hs
have ha1 : Measurable (armCoord true : CausalObservation → ℝ) := by
exact (measurable_fst.comp measurable_snd :
Measurable (fun w : CausalObservation => w.2.1))
have ha0 : Measurable (armCoord false : CausalObservation → ℝ) := by
exact (measurable_fst :
Measurable (fun w : CausalObservation => w.1))
have ho : Measurable (observedOutcome P) := by
unfold observedOutcome
exact (ht.mul ha1).add ((measurable_const.sub ht).mul ha0)
have hd0 : Measurable (fun z : Score =>
signedDistance (knownGeometry P) x z) := by
unfold signedDistance knownGeometry
exact ((measurable_const.indicator P.A1_measurable).sub
(measurable_const.indicator P.A0_measurable)).mul (by fun_prop)
exact ho.prodMk (hd0.comp hs)
The sign-dependent Bernoulli success profile of the observed outcome in the explicit hard family. The upper arm uses the perturbed treatment profile, while the lower arm uses the common control profile.
Definition (Lean source)
-- @node: causalHardObservedSuccessProfile
noncomputable def causalHardObservedSuccessProfile {M : ℕ} (delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) (z : Score) : ℝ := by
classical
exact if z ∈ causalHardArmOne then
causalHardTreatmentProfile delta w centers omega z
else causalHardControlProfile z
theorem causalHardObservedSuccessProfile_measurable
The observed hard-family Bernoulli parameter is Borel measurable.
Formal statement
hypotheses
conclusion
Measurable (causalHardObservedSuccessProfile delta w centers omega)
Proof (Lean source)
-- @node: causalHardObservedSuccessProfile_measurable
lemma causalHardObservedSuccessProfile_measurable {M : ℕ} (delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) :
Measurable (causalHardObservedSuccessProfile delta w centers omega) := by
unfold causalHardObservedSuccessProfile
exact Measurable.ite causalHardArmOne_measurableSet
(causalHardProfiles_measurable delta w centers omega).2
(causalHardProfiles_measurable delta w centers omega).1
theorem causalHardObservedSuccessProfile_mem_middleHalf
Throughout the hard square, the observed-outcome success probability is uniformly bounded in the middle half of the Bernoulli parameter interval.
Formal statement
hypotheses
M :
ℕ
delta w :
ℝ
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
z :
hz :
z ∈ causalHardSquare
conclusion
causalHardObservedSuccessProfile delta w centers omega z ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ)
Proof (Lean source)
-- @node: causalHardObservedSuccessProfile_mem_middleHalf
lemma causalHardObservedSuccessProfile_mem_middleHalf {M : ℕ}
{delta w : ℝ} (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 16)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {z : Score} (hz : z ∈ causalHardSquare) :
causalHardObservedSuccessProfile delta w centers omega z ∈
Icc (1 / 4 : ℝ) (3 / 4 : ℝ) := by
classical
unfold causalHardObservedSuccessProfile
split_ifs
· exact causalHardTreatmentProfile_mem_middleHalf hdelta0 hdelta hw hsep
omega hz
· change (1 / 2 : ℝ) ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ)
norm_num
Signed Euclidean distance for the fixed hard-square assignment geometry, written directly as a score statistic.
Definition (Lean source)
-- @node: causalHardSignedStatistic
noncomputable def causalHardSignedStatistic (c z : Score) : ℝ :=
(causalHardArmOne.indicator (fun _ => (1 : ℝ)) z -
(causalHardSquare \ causalHardArmOne).indicator (fun _ => (1 : ℝ)) z) *
dist z c
theorem causalHardSignedStatistic_measurable
The fixed-geometry signed-distance statistic is Borel measurable.
Formal statement
Proof (Lean source)
-- @node: causalHardSignedStatistic_measurable
lemma causalHardSignedStatistic_measurable (c : Score) :
Measurable (causalHardSignedStatistic c) := by
unfold causalHardSignedStatistic
exact ((measurable_const.indicator causalHardArmOne_measurableSet).sub
(measurable_const.indicator
(causalHardSquare_measurableSet.diff causalHardArmOne_measurableSet))).mul
(by fun_prop)
theorem signedDistance_causalHardA1A2Law_eq_causalHardSignedStatistic
The signed distance carried by every explicit hard-family law is the fixed score statistic above; in particular it is independent of the vertex.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
c z :
conclusion
signedDistance (knownGeometry (causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell)) c z
Proof (Lean source)
-- @node: signedDistance_causalHardA1A2Law_eq_causalHardSignedStatistic
lemma signedDistance_causalHardA1A2Law_eq_causalHardSignedStatistic {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare)
(c z : Score) :
signedDistance (knownGeometry
(causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw
hsep hcell)) c z = causalHardSignedStatistic c z := by
simp [signedDistance, knownGeometry, causalHardSignedStatistic,
causalHardA1A2Law_geometry b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell]
def causalHardCellSignedObservationMeasure Definition causalHardCellSignedObservationMeasure in the paper ↗
The finite signed-observation measure obtained by restricting a hard law to one packing cell and then applying the signed-distance compression.
Definition (Lean source)
-- @node: causalHardCellSignedObservationMeasure
noncomputable def causalHardCellSignedObservationMeasure
(P : A1A2Law) (x : Score) (w : ℝ) : Measure (ℝ × ℝ) :=
Measure.map (signedObservationAt P x)
(P.law.restrict {z | causalScore z ∈ causalHardCell x w})
instance causalHardCellSignedObservationMeasure_isFiniteMeasure
The stated signed-observation measure has finite total mass.
Definition (Lean source)
noncomputable instance causalHardCellSignedObservationMeasure_isFiniteMeasure
(P : A1A2Law) (x : Score) (w : ℝ) :
IsFiniteMeasure (causalHardCellSignedObservationMeasure P x w) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
constructor
rw [causalHardCellSignedObservationMeasure,
Measure.map_apply (signedObservationAt_measurable P x) MeasurableSet.univ,
preimage_univ]
exact lt_of_le_of_lt (Measure.restrict_apply_le _ _) (measure_lt_top P.law univ)
The normalized probability law of a signed observation conditional on the observation lying in the selected hard cell.
Definition (Lean source)
-- @node: causalHardCellSignedObservationLaw
noncomputable def causalHardCellSignedObservationLaw
(P : A1A2Law) (x : Score) (w : ℝ) : Measure (ℝ × ℝ) :=
letI : IsProbabilityMeasure P.law := P.law_isProbability
let μ : FiniteMeasure (ℝ × ℝ) :=
⟨causalHardCellSignedObservationMeasure P x w, inferInstance⟩
μ.normalize
instance causalHardCellSignedObservationLaw_isProbabilityMeasure
The stated experiment law has total mass one and therefore defines a probability distribution.
Definition (Lean source)
noncomputable instance causalHardCellSignedObservationLaw_isProbabilityMeasure
(P : A1A2Law) (x : Score) (w : ℝ) :
IsProbabilityMeasure (causalHardCellSignedObservationLaw P x w) := by
unfold causalHardCellSignedObservationLaw
infer_instance
theorem causalHardCellSignedObservationMeasure_eq_mass_smul_law
A positive exact cell mass lets normalization be undone without a zero-measure fallback branch.
Formal statement
hypotheses
P :
x :
w ρ :
ℝ
hρ :
0 < ρ
hmass :
conclusion
Proof (Lean source)
-- @node: causalHardCellSignedObservationMeasure_eq_mass_smul_law
lemma causalHardCellSignedObservationMeasure_eq_mass_smul_law
(P : A1A2Law) (x : Score) (w ρ : ℝ) (hρ : 0 < ρ)
(hmass : P.law {z | causalScore z ∈ causalHardCell x w} =
ofReal ρ) :
causalHardCellSignedObservationMeasure P x w =
ofReal ρ • causalHardCellSignedObservationLaw P x w := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
let μ : FiniteMeasure (ℝ × ℝ) :=
⟨causalHardCellSignedObservationMeasure P x w, inferInstance⟩
have hmeas : Measurable (signedObservationAt P x) := by
exact signedObservationAt_measurable P x
have hcell : MeasurableSet {z | causalScore z ∈ causalHardCell x w} := by
exact Metric.isClosed_closedBall.measurableSet.preimage (by
unfold causalScore
fun_prop)
have hμmass : (μ : Measure (ℝ × ℝ)) univ = ofReal ρ := by
rw [show (μ : Measure (ℝ × ℝ)) =
causalHardCellSignedObservationMeasure P x w by rfl]
rw [causalHardCellSignedObservationMeasure, Measure.map_apply hmeas
MeasurableSet.univ, preimage_univ]
simpa [Measure.restrict_apply, hcell] using hmass
have hμ0 : μ ≠ 0 := by
intro hz
have : (μ : Measure (ℝ × ℝ)) univ = 0 := by simp [hz]
rw [hμmass, ENNReal.ofReal_eq_zero] at this
linarith
have hmassNN : (μ.mass : ℝ≥0∞) = ofReal ρ := by
rw [FiniteMeasure.ennreal_mass, hμmass]
change (μ : Measure (ℝ × ℝ)) =
ofReal ρ • (μ.normalize : Measure (ℝ × ℝ))
rw [μ.toMeasure_normalize_eq_of_nonzero hμ0]
ext s hs
rw [Measure.smul_apply, Measure.smul_apply]
change (μ : Measure (ℝ × ℝ)) s =
ofReal ρ * ((↑(μ.mass⁻¹) : ℝ≥0∞) * (μ : Measure (ℝ × ℝ)) s)
have hmass0 : μ.mass ≠ 0 := by
intro hz
rw [hz, ENNReal.coe_zero] at hmassNN
have := ENNReal.ofReal_pos.mpr hρ
exact this.ne' hmassNN.symm
rw [← hmassNN, ENNReal.coe_inv hmass0, ← mul_assoc,
ENNReal.mul_inv_cancel (ENNReal.coe_ne_zero.mpr hmass0) ENNReal.coe_ne_top,
one_mul]
Equality after multiplication by a strictly positive finite cell mass can be cancelled. This is the normalization bridge used when a geometric calculation first identifies the signed-radius marginals of the restricted hard-cell measures.
Formal statement
Proof (Lean source)
-- @node: measure_eq_of_pos_ofReal_smul_eq
lemma measure_eq_of_pos_ofReal_smul_eq {A : Type*} [MeasurableSpace A]
(mu nu : Measure A) {rho : ℝ} (hrho : 0 < rho)
(h : ofReal rho • mu = ofReal rho • nu) :
mu = nu := by
ext s hs
have hs_eq := congrArg (fun m : Measure A => m s) h
simp only [Measure.smul_apply] at hs_eq
let a := ofReal rho
change a * mu s = a * nu s at hs_eq
have ha0 : a ≠ 0 := (ENNReal.ofReal_pos.mpr hrho).ne'
have hatop : a ≠ ⊤ := ENNReal.ofReal_ne_top
by_cases hmutop : mu s = ⊤
· have hprod : a * nu s = ⊤ := by
rw [← hs_eq]
simp [a, hmutop, ha0]
have hnutop : nu s = ⊤ := by
rcases ENNReal.mul_eq_top.mp hprod with hcase | hcase
· exact hcase.2
· exact (hatop hcase.1).elim
exact hmutop.trans hnutop.symm
· have hnutop : nu s ≠ ⊤ := by
intro hnu
have hleft : a * mu s ≠ ⊤ := ENNReal.mul_ne_top hatop hmutop
apply hleft
rw [hs_eq, hnu]
simp [a, ha0]
rw [← ENNReal.toReal_eq_toReal_iff' hmutop hnutop]
have hreal := congrArg toReal hs_eq
rw [ENNReal.toReal_mul, ENNReal.toReal_mul] at hreal
exact mul_left_cancel₀ (ENNReal.toReal_pos ha0 hatop).ne' hreal
theorem causalHardCellSignedObservationLaw_eq_of_restrict_eq
On a fixed hard cell, equality of the underlying restricted laws implies equality of the normalized signed-observation laws. This is the locality bridge that makes the final conditional law depend only on the cell bit.
Formal statement
hypotheses
P P' :
x :
w ρ :
ℝ
hρ :
0 < ρ
hmass :
hmass' :
hrestrict :
P.law.restrict {z | causalScore z ∈ causalHardCell x w}
= P'.law.restrict {z | causalScore z ∈ causalHardCell x w}
hobs :
signedObservationAt P x = signedObservationAt P' x
conclusion
Proof (Lean source)
-- @node: causalHardCellSignedObservationLaw_eq_of_restrict_eq
lemma causalHardCellSignedObservationLaw_eq_of_restrict_eq
(P P' : A1A2Law) (x : Score) (w ρ : ℝ) (hρ : 0 < ρ)
(hmass : P.law {z | causalScore z ∈ causalHardCell x w} =
ofReal ρ)
(hmass' : P'.law {z | causalScore z ∈ causalHardCell x w} =
ofReal ρ)
(hrestrict : P.law.restrict
{z | causalScore z ∈ causalHardCell x w} =
P'.law.restrict {z | causalScore z ∈ causalHardCell x w})
(hobs : signedObservationAt P x = signedObservationAt P' x) :
causalHardCellSignedObservationLaw P x w =
causalHardCellSignedObservationLaw P' x w := by
apply measure_eq_of_pos_ofReal_smul_eq _ _ hρ
rw [← causalHardCellSignedObservationMeasure_eq_mass_smul_law
P x w ρ hρ hmass,
← causalHardCellSignedObservationMeasure_eq_mass_smul_law
P' x w ρ hρ hmass']
unfold causalHardCellSignedObservationMeasure
rw [hrestrict, hobs]
Causal.Hypercube.HardSquareSignedOutside 1 declarations This module complements the signed hard-cell KL estimate with exact equality of the two raw observation measures away from the positive short-radius window.
Exact localization for signed hard-cell observations
This module complements the signed hard-cell KL estimate with exact equality of the two raw observation measures away from the positive short-radius window.
theorem causalHardCellSignedObservationMeasure_restrict_compl_enable_eq
Enabling one hard-cell bit changes its raw signed-observation measure only inside the positive short-radius window.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hbEq :
b = 1 / 16
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hwHalf :
w ≤ 1 / 2
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
centers j ∈ causalHardBottomEdge
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
hj :
omega j = false
conclusion
let omega' := update omega j true let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell let P' := causalHardA1A2Law b cA delta w centers omega' hb hscale hcA hdelta hw hsep hcell (causalHardCellSignedObservationMeasure P (centers j) w).restrict {yd | ¬ (0 < yd.2 ∧ yd.2 < 2 * (cA * delta) / b)}
= (causalHardCellSignedObservationMeasure P' (centers j) w).restrict {yd | ¬ (0 < yd.2 ∧ yd.2 < 2 * (cA * delta) / b)}
Proof (Lean source)
-- @node: causalHardCellSignedObservationMeasure_restrict_compl_enable_eq
lemma causalHardCellSignedObservationMeasure_restrict_compl_enable_eq
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(centers : Fin M → Score) (omega : Fin M → Bool)
(hbEq : b = 1 / 16) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16)
(hw : 0 < w) (hwHalf : w ≤ 1 / 2)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : centers j ∈ causalHardBottomEdge)
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare)
(hj : omega j = false) :
let omega' := update omega j true
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
let P' := causalHardA1A2Law b cA delta w centers omega' hb hscale hcA
hdelta hw hsep hcell
(causalHardCellSignedObservationMeasure P (centers j) w).restrict
{yd | ¬ (0 < yd.2 ∧ yd.2 < 2 * (cA * delta) / b)} =
(causalHardCellSignedObservationMeasure P' (centers j) w).restrict
{yd | ¬ (0 < yd.2 ∧ yd.2 < 2 * (cA * delta) / b)} := by
dsimp only
let omega' := update omega j true
let nu := (causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w)
let nu' := (causalHardScoreMeasure b cA delta w centers omega').restrict
(causalHardCell (centers j) w)
let p := causalHardObservedSuccessProfile delta w centers omega
let p' := causalHardObservedSuccessProfile delta w centers omega'
let q := fun x => max (1 / 4 : ℝ) (min (3 / 4 : ℝ) (p x))
let q' := fun x => max (1 / 4 : ℝ) (min (3 / 4 : ℝ) (p' x))
let stat := causalHardSignedStatistic (centers j)
let E := Ioo 0 (2 * (cA * delta) / b)
letI : IsProbabilityMeasure
(causalHardScoreMeasure b cA delta w centers omega) :=
causalHardScoreMeasure_isProbabilityMeasure centers omega hb hscale hcA
hdelta hw hsep hcell
letI : IsProbabilityMeasure
(causalHardScoreMeasure b cA delta w centers omega') :=
causalHardScoreMeasure_isProbabilityMeasure centers omega' hb hscale hcA
hdelta hw hsep hcell
have hp := causalHardObservedSuccessProfile_measurable delta w centers omega
have hp' := causalHardObservedSuccessProfile_measurable delta w centers omega'
have hq : Measurable q := measurable_const.max (measurable_const.min hp)
have hq' : Measurable q' := measurable_const.max (measurable_const.min hp')
have hq0 : ∀ x, (1 / 4 : ℝ) ≤ q x := fun x => le_max_left _ _
have hq1 : ∀ x, q x ≤ (3 / 4 : ℝ) := by
intro x
exact max_le (by norm_num) (min_le_left _ _)
have hq0' : ∀ x, (1 / 4 : ℝ) ≤ q' x := fun x => le_max_left _ _
have hq1' : ∀ x, q' x ≤ (3 / 4 : ℝ) := by
intro x
exact max_le (by norm_num) (min_le_left _ _)
have hqp : q =ᵐ[nu] p := by
filter_upwards [ae_restrict_mem Metric.isClosed_closedBall.measurableSet] with x hx
have hm := causalHardObservedSuccessProfile_mem_middleHalf hdelta.le hdeltaSmall
hw hsep omega (hcell j hx)
dsimp [q]
rw [min_eq_right hm.2, max_eq_right hm.1]
have hqp' : q' =ᵐ[nu'] p' := by
filter_upwards [ae_restrict_mem Metric.isClosed_closedBall.measurableSet] with x hx
have hm := causalHardObservedSuccessProfile_mem_middleHalf hdelta.le hdeltaSmall
hw hsep omega' (hcell j hx)
dsimp [q']
rw [min_eq_right hm.2, max_eq_right hm.1]
have hmap := causalHardScoreMeasure_restrict_map_signedStatistic_eq j centers
omega omega' hb hscale hcA hdelta hw hwHalf hsep hcenter (hcell j)
have hdiff : ∀ B : Set ℝ, MeasurableSet B →
|(∫ x in {x | stat x ∈ B}, q x ∂nu) -
∫ x in {x | stat x ∈ B}, q' x ∂nu'| ≤
delta * (Measure.map stat nu (B ∩ E)).toReal := by
intro B hB
have heq : (∫ x in {x | stat x ∈ B}, q x ∂nu) =
∫ x in {x | stat x ∈ B}, p x ∂nu := by
apply integral_congr_ae
exact ae_restrict_of_ae hqp
have heq' : (∫ x in {x | stat x ∈ B}, q' x ∂nu') =
∫ x in {x | stat x ∈ B}, p' x ∂nu' := by
apply integral_congr_ae
exact ae_restrict_of_ae hqp'
rw [heq, heq']
exact causalHardSignedSuccess_localized_setwise_bound j centers omega hbEq hb
hscale hcA hdelta hdeltaSmall hw hwHalf hsep hcenter (hcell j) hj hB
have hout := statisticBernoulliOutcome_restrict_compl_eq_of_localized_success_bound
nu nu' q q' stat hq hq' (causalHardSignedStatistic_measurable _)
hq0 hq1 hq0' hq1' hmap hdelta.le measurableSet_Ioo hdiff
have hk : commonStatisticBernoulliKernel q hq =ᵐ[nu]
causalSelectedBernoulliKernel p hp := by
filter_upwards [hqp] with x hx
simp [commonStatisticBernoulliKernel, causalSelectedBernoulliKernel, hx]
have hk' : commonStatisticBernoulliKernel q' hq' =ᵐ[nu']
causalSelectedBernoulliKernel p' hp' := by
filter_upwards [hqp'] with x hx
simp [commonStatisticBernoulliKernel, causalSelectedBernoulliKernel, hx]
letI : IsMarkovKernel (commonStatisticBernoulliKernel q hq) :=
commonStatisticBernoulliKernel_isMarkovKernel q hq
(fun x => by linarith [hq0 x]) (fun x => by linarith [hq1 x])
letI : IsMarkovKernel (commonStatisticBernoulliKernel q' hq') :=
commonStatisticBernoulliKernel_isMarkovKernel q' hq'
(fun x => by linarith [hq0' x]) (fun x => by linarith [hq1' x])
have hpunit : ∀ x, 0 ≤ p x ∧ p x ≤ 1 := by
intro x
have hprof := causalHardProfiles_mem_unitInterval delta w centers omega x
dsimp [p, causalHardObservedSuccessProfile]
split_ifs <;> simp_all
have hpunit' : ∀ x, 0 ≤ p' x ∧ p' x ≤ 1 := by
intro x
have hprof := causalHardProfiles_mem_unitInterval delta w centers omega' x
dsimp [p', causalHardObservedSuccessProfile]
split_ifs <;> simp_all
letI : IsMarkovKernel (causalSelectedBernoulliKernel p hp) :=
causalSelectedBernoulliKernel_isMarkovKernel p hp
(fun x => (hpunit x).1) (fun x => (hpunit x).2)
letI : IsMarkovKernel (causalSelectedBernoulliKernel p' hp') :=
causalSelectedBernoulliKernel_isMarkovKernel p' hp'
(fun x => (hpunit' x).1) (fun x => (hpunit' x).2)
rw [Measure.compProd_congr hk, Measure.compProd_congr hk'] at hout
rw [← causalHardCellSignedObservationMeasure_eq_scoreBernoulli j b cA delta w
centers omega hb hscale hcA hdelta hw hsep hcell,
← causalHardCellSignedObservationMeasure_eq_scoreBernoulli j b cA delta w
centers omega' hb hscale hcA hdelta hw hsep hcell] at hout
simpa [E] using hout
Causal.Hypercube.HardSquareSignedSuccess 5 declarations This module converts the half-disc angular cancellation into the setwise success-mass estimate needed by the common-statistic Bernoulli KL argument.
Signed hard-cell success-mass localization
This module converts the half-disc angular cancellation into the setwise success-mass estimate needed by the common-statistic Bernoulli KL argument.
theorem causalHardObservedSuccess_setIntegral_scoreMeasure
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hD :
conclusion
(∫ x in D, causalHardObservedSuccessProfile delta w centers omega x ∂(causalHardScoreMeasure b cA delta w centers omega))
= (1 / 36 : ℝ) * ∫ x in D ∩ causalHardSquare, causalHardObservedSuccessProfile delta w centers omega x * packingAngularDensity b cA delta w centers omega x
Proof (Lean source)
lemma causalHardObservedSuccess_setIntegral_scoreMeasure {M : ℕ} {b cA delta w : ℝ}
(centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
{D : Set Score} (hD : MeasurableSet D) :
(∫ x in D, causalHardObservedSuccessProfile delta w centers omega x
∂(causalHardScoreMeasure b cA delta w centers omega)) =
(1 / 36 : ℝ) * ∫ x in D ∩ causalHardSquare,
causalHardObservedSuccessProfile delta w centers omega x *
packingAngularDensity b cA delta w centers omega x := by
rw [causalHardScoreMeasure]
change (∫ x in D, causalHardObservedSuccessProfile delta w centers omega x
∂volume.withDensity (ofReal ∘ causalHardSquare.indicator
(causalHardScoreDensity b cA delta w centers omega))) = _
rw [setIntegral_withDensity_eq_setIntegral_toReal_smul₀
((ENNReal.measurable_ofReal.comp
((causalHardScoreDensity_continuous centers omega hb hscale).measurable.indicator
causalHardSquare_measurableSet)).aemeasurable)
(by simp) _ hD]
rw [← integral_const_mul]
rw [← integral_indicator hD,
← integral_indicator (hD.inter causalHardSquare_measurableSet)]
apply integral_congr_ae
filter_upwards with x
by_cases hxD : x ∈ D
· by_cases hxS : x ∈ causalHardSquare
· rw [Set.indicator_of_mem hxD, Set.indicator_of_mem
(show x ∈ D ∩ causalHardSquare from ⟨hxD, hxS⟩)]
have hdens0 : 0 ≤ causalHardScoreDensity b cA delta w centers omega x :=
mul_nonneg (by norm_num) ((packingAngularDensity_mem_Icc
(b := b) (cA := cA) (delta := delta) (w := w)
(centers := centers) (omega := omega) (x := x) hcA
hdelta hw hsep).1.trans' (by norm_num))
have hpack0 : 0 ≤ packingAngularDensity b cA delta w centers omega x :=
(packingAngularDensity_mem_Icc (b := b) hcA hdelta hw hsep omega x).1.trans'
(by norm_num)
simp [Function.comp_apply, hxS, ENNReal.toReal_ofReal hpack0,
causalHardScoreDensity]
ring
· rw [Set.indicator_of_mem hxD, Set.indicator_of_notMem (by simp [hxS])]
simp [Function.comp_apply, hxS]
· rw [Set.indicator_of_notMem hxD, Set.indicator_of_notMem (by simp [hxD])]
theorem packingAngularDensity_enable_cell_sub
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hj :
omega j = false
x :
hx :
x ∈ causalHardCell (centers j) w
conclusion
- packingAngularDensity b cA delta w centers omega x
= packingAngularTerm b cA delta w (centers j) x
Proof (Lean source)
lemma packingAngularDensity_enable_cell_sub {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (centers : Fin M → Score)
(hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (hj : omega j = false) {x : Score}
(hx : x ∈ causalHardCell (centers j) w) :
packingAngularDensity b cA delta w centers (update omega j true) x -
packingAngularDensity b cA delta w centers omega x =
packingAngularTerm b cA delta w (centers j) x := by
have hfar : ∀ i : Fin M, i ≠ j → w ≤ dist x (centers i) := by
intro i hij
have htri : dist (centers i) (centers j) ≤
dist (centers i) x + dist x (centers j) := dist_triangle _ _ _
have hs := hsep i j hij
change dist x (centers j) ≤ w at hx
rw [dist_comm (centers i) x] at htri
linarith
unfold packingAngularDensity
rw [Finset.sum_eq_single j, Finset.sum_eq_zero]
· simp
· intro i _
by_cases hij : i = j
· subst i
simp [hj]
· rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw (hfar i hij)]
simp
· intro i _ hij
rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw (hfar i hij)]
simp [update, hij]
· simp
theorem causalHardSignedSuccess_setIntegral_abs_le_cellArea
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hbEq :
b = 1 / 16
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hwHalf :
w ≤ 1 / 2
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
centers j ∈ causalHardBottomEdge
hcell :
causalHardCell (centers j) w ⊆ causalHardSquare
hj :
omega j = false
B :
Set ℝ
hB :
conclusion
let omega' := update omega j true let nu := (causalHardScoreMeasure b cA delta w centers omega).restrict (causalHardCell (centers j) w) let nu' := (causalHardScoreMeasure b cA delta w centers omega').restrict (causalHardCell (centers j) w) let p := causalHardObservedSuccessProfile delta w centers omega let p' := causalHardObservedSuccessProfile delta w centers omega' let stat := causalHardSignedStatistic (centers j) let Dloc := {x | 0 < (scoreCoordinates x - scoreCoordinates (centers j)).2 ∧ dist x (centers j) ≤ w} ∩ {x | dist x (centers j) ∈ B ∩ Iio (2 * (cA * delta) / b)} |∫ x in {x | stat x ∈ B}, p' x ∂nu'
- ∫ x in {x | stat x ∈ B}, p x ∂nu|
≤ (delta / 36) * (volume Dloc).toReal
Proof (Lean source)
lemma causalHardSignedSuccess_setIntegral_abs_le_cellArea
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(centers : Fin M → Score) (omega : Fin M → Bool)
(hbEq : b = 1 / 16)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16)
(hw : 0 < w) (hwHalf : w ≤ 1 / 2)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : centers j ∈ causalHardBottomEdge)
(hcell : causalHardCell (centers j) w ⊆ causalHardSquare)
(hj : omega j = false) {B : Set ℝ} (hB : MeasurableSet B) :
let omega' := update omega j true
let nu := (causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w)
let nu' := (causalHardScoreMeasure b cA delta w centers omega').restrict
(causalHardCell (centers j) w)
let p := causalHardObservedSuccessProfile delta w centers omega
let p' := causalHardObservedSuccessProfile delta w centers omega'
let stat := causalHardSignedStatistic (centers j)
let Dloc := {x | 0 < (scoreCoordinates x - scoreCoordinates (centers j)).2 ∧
dist x (centers j) ≤ w} ∩
{x | dist x (centers j) ∈ B ∩ Iio (2 * (cA * delta) / b)}
|∫ x in {x | stat x ∈ B}, p' x ∂nu' -
∫ x in {x | stat x ∈ B}, p x ∂nu| ≤
(delta / 36) * (volume Dloc).toReal := by
dsimp only
let c := centers j
let omega' := update omega j true
let stat := causalHardSignedStatistic c
let S : Set Score := {x | stat x ∈ B}
let C : Set Score := causalHardCell c w ∩ S
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ B}
let Dloc : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ B ∩ Iio (2 * (cA * delta) / b)}
let Lw : Set Score :=
{x | (scoreCoordinates x - scoreCoordinates c).2 ≤ 0 ∧ dist x c ≤ w} ∩
{x | -dist x c ∈ B}
let p := causalHardObservedSuccessProfile delta w centers omega
let p' := causalHardObservedSuccessProfile delta w centers omega'
let dens := packingAngularDensity b cA delta w centers omega
let dens' := packingAngularDensity b cA delta w centers omega'
let f := fun x : Score => p x * dens x
let f' := fun x : Score => p' x * dens' x
have hS : MeasurableSet S := hB.preimage (causalHardSignedStatistic_measurable c)
have hC : MeasurableSet C := Metric.isClosed_closedBall.measurableSet.inter hS
have hf : IntegrableOn f C := by
apply Measure.integrableOn_of_bounded (M := 2)
(ne_of_lt ((measure_mono inter_subset_left).trans_lt
(isCompact_closedBall c w).measure_lt_top))
((causalHardObservedSuccessProfile_measurable delta w centers omega).fun_mul
(packingAngularDensity_continuous hb hscale centers omega).measurable).aestronglyMeasurable
filter_upwards [ae_restrict_mem hC] with x hx
have hp01 := causalHardProfiles_mem_unitInterval delta w centers omega x
have hd := packingAngularDensity_mem_Icc (b := b) hcA hdelta hw hsep omega x
have hpabs : |p x| ≤ 1 := by
dsimp [p, causalHardObservedSuccessProfile]
split_ifs <;> rw [abs_of_nonneg] <;>
linarith [hp01.1.1, hp01.1.2, hp01.2.1, hp01.2.2]
have hdabs : |dens x| ≤ 2 := by
dsimp [dens]
rw [abs_of_nonneg] <;> linarith [hd.1, hd.2]
rw [Real.norm_eq_abs, abs_mul]
nlinarith [abs_nonneg (p x), abs_nonneg (dens x)]
have hf' : IntegrableOn f' C := by
apply Measure.integrableOn_of_bounded (M := 2)
(ne_of_lt ((measure_mono inter_subset_left).trans_lt
(isCompact_closedBall c w).measure_lt_top))
((causalHardObservedSuccessProfile_measurable delta w centers omega').fun_mul
(packingAngularDensity_continuous hb hscale centers omega').measurable).aestronglyMeasurable
filter_upwards [ae_restrict_mem hC] with x hx
have hp01 := causalHardProfiles_mem_unitInterval delta w centers omega' x
have hd := packingAngularDensity_mem_Icc (b := b) hcA hdelta hw hsep omega' x
have hpabs : |p' x| ≤ 1 := by
dsimp [p', causalHardObservedSuccessProfile]
split_ifs <;> rw [abs_of_nonneg] <;>
linarith [hp01.1.1, hp01.1.2, hp01.2.1, hp01.2.2]
have hdabs : |dens' x| ≤ 2 := by
dsimp [dens']
rw [abs_of_nonneg] <;> linarith [hd.1, hd.2]
rw [Real.norm_eq_abs, abs_mul]
nlinarith [abs_nonneg (p' x), abs_nonneg (dens' x)]
have hraw : |∫ x in C, f' x - f x| ≤ delta * (volume Dloc).toReal := by
have hboundary : (volume : Measure Score)
{x | (scoreCoordinates x - scoreCoordinates c).2 = 0} = 0 := by
have hpre : {x : Score | (scoreCoordinates x - scoreCoordinates c).2 = 0} =
scoreCoordinates ⁻¹' {z : ℝ × ℝ | z.2 = (scoreCoordinates c).2} := by
ext x
change (scoreCoordinates x).2 - (scoreCoordinates c).2 = 0 ↔
(scoreCoordinates x).2 = (scoreCoordinates c).2
constructor <;> intro h <;> linarith
rw [hpre, scoreCoordinates_measurePreserving.measure_preimage_emb
scoreCoordinates_measurableEmbedding]
have hset : {z : ℝ × ℝ | z.2 = (scoreCoordinates c).2} =
univ ×ˢ {(scoreCoordinates c).2} := by ext z; simp
rw [hset, Measure.volume_eq_prod,
Measure.prod_apply (MeasurableSet.univ.prod
(measurableSet_singleton (scoreCoordinates c).2))]
simp
have hD : MeasurableSet D := by
have hv : Measurable (fun x : Score =>
(scoreCoordinates x - scoreCoordinates c).2) := by fun_prop
have hr : Measurable (fun x : Score => dist x c) := by fun_prop
exact ((measurableSet_lt measurable_const hv).inter
(measurableSet_le hr measurable_const)).inter (hB.preimage hr)
have hLw : MeasurableSet Lw := by
have hv : Measurable (fun x : Score =>
(scoreCoordinates x - scoreCoordinates c).2) := by fun_prop
have hr : Measurable (fun x : Score => dist x c) := by fun_prop
exact ((measurableSet_le hv measurable_const).inter
(measurableSet_le hr measurable_const)).inter
(hB.preimage hr.neg)
let upper : Score → ℝ := fun x =>
delta * angularRadialProfile w (dist x c) +
(packingAffineBaseline b x + delta * angularRadialProfile w (dist x c)) *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)
let lower : Score → ℝ := fun x =>
(1 / 2 : ℝ) * packingAngularTerm b cA delta w c x
have hae : ∀ᵐ x ∂(volume : Measure Score),
C.indicator (fun x => f' x - f x) x =
D.indicator upper x + Lw.indicator lower x := by
filter_upwards [compl_mem_ae_iff.mpr hboundary] with x hx0
by_cases hxC : x ∈ C
· have hxcell := hxC.1
have hstat := causalHardSignedStatistic_eq_verticalSignedRadius_on_cell
hcenter hwHalf hxcell
change causalHardSignedStatistic c x =
(if 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 then dist x c
else -dist x c) at hstat
have hsq := hcell hxcell
by_cases hxup : 0 < (scoreCoordinates x - scoreCoordinates c).2
· have hxD : x ∈ D := by
refine ⟨⟨hxup, ?_⟩, ?_⟩
· exact hxcell
· have hm := hxC.2
change causalHardSignedStatistic c x ∈ B at hm
rw [hstat, if_pos hxup.le] at hm
exact hm
have hxnotL : x ∉ Lw := by
intro hxL
exact (not_le_of_gt hxup) hxL.1.1
rw [Set.indicator_of_mem hxC, Set.indicator_of_mem hxD,
Set.indicator_of_notMem hxnotL, add_zero]
have hA1 : x ∈ causalHardArmOne := by
have hv : 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 := hxup.le
have hs := causalHardSignedStatistic_eq_verticalSignedRadius_on_cell
hcenter hwHalf hxcell
-- The geometry proof of the signed-statistic identity already places
-- the positive half-cell in arm one.
have hc1 : c 1 = 0 := hcenter.2.2
have hcoord (i : Fin 2) : |x i - c i| ≤ dist x c := by
simpa [dist_eq_norm, Real.norm_eq_abs] using PiLp.norm_apply_le (x - c) i
have hdcell : dist x c ≤ w := hxcell
have hx0lo : -1 ≤ x 0 := by
have hh := hcoord 0
rw [abs_le] at hh
have hc0lo : -1 / 2 ≤ c 0 := by simpa [c] using hcenter.1
linarith [hc0lo, hdcell, hwHalf]
have hx0hi : x 0 ≤ 1 := by
have hh := hcoord 0
rw [abs_le] at hh
have hc0hi : c 0 ≤ 1 / 2 := by simpa [c] using hcenter.2.1
linarith [hc0hi, hdcell, hwHalf]
have hx1lo : 0 ≤ x 1 := by
change 0 ≤ x 1 - c 1 at hv
linarith
have hx1hi : x 1 ≤ 2 := by
have hd : dist x c ≤ w := hxcell
have hh := hcoord 1
rw [hc1, sub_zero, abs_le] at hh
linarith
exact ⟨hx0lo, hx0hi, hx1lo, hx1hi⟩
have hpOn : p' x = packingRegression b delta w centers omega' x := by
dsimp [p', causalHardObservedSuccessProfile]
rw [if_pos hA1]
simpa [hbEq] using
causalHardTreatmentProfile_eq_packingRegression_on_square
hdelta.le hdeltaSmall hw hsep omega' hsq
have hpOff : p x = packingRegression b delta w centers omega x := by
dsimp [p, causalHardObservedSuccessProfile]
rw [if_pos hA1]
simpa [hbEq] using
causalHardTreatmentProfile_eq_packingRegression_on_square
hdelta.le hdeltaSmall hw hsep omega hsq
dsimp [f', f, dens', dens, upper]
rw [hpOn, hpOff]
simpa [c, omega', hbEq] using
packingRegression_mul_density_enable_cell_radial_identity j centers
hw hsep omega hj hxcell
· have hxdown : (scoreCoordinates x - scoreCoordinates c).2 < 0 :=
have hxne : (scoreCoordinates x - scoreCoordinates c).2 ≠ 0 := by
simpa using hx0
lt_of_le_of_ne (le_of_not_gt hxup) hxne
have hxL : x ∈ Lw := by
refine ⟨⟨hxdown.le, hxcell⟩, ?_⟩
have hm := hxC.2
change causalHardSignedStatistic c x ∈ B at hm
rw [hstat, if_neg (not_le.mpr hxdown)] at hm
exact hm
have hxnotD : x ∉ D := by
intro hxD
exact (not_lt_of_ge hxdown.le) hxD.1.1
rw [Set.indicator_of_mem hxC, Set.indicator_of_notMem hxnotD,
Set.indicator_of_mem hxL, zero_add]
have hA1 : x ∉ causalHardArmOne := by
intro hA
have hc1 : c 1 = 0 := hcenter.2.2
have : 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 := by
change 0 ≤ x 1 - c 1
linarith [hA.2.2.1]
linarith
dsimp [f', f, p', p, dens', dens, lower,
causalHardObservedSuccessProfile]
rw [if_neg hA1, if_neg hA1]
dsimp [causalHardControlProfile]
have hdens := packingAngularDensity_enable_cell_sub (b := b) (cA := cA)
(delta := delta) j centers hw hsep omega hj hxcell
change packingAngularDensity b cA delta w centers omega' x -
packingAngularDensity b cA delta w centers omega x = _ at hdens
rw [← hdens]
ring
· rw [Set.indicator_of_notMem hxC]
have hxnotD : x ∉ D := by
intro hxD
apply hxC
refine ⟨hxD.1.2, ?_⟩
change stat x ∈ B
dsimp [stat]
rw [causalHardSignedStatistic_eq_verticalSignedRadius_on_cell
hcenter hwHalf hxD.1.2]
rw [if_pos hxD.1.1.le]
exact hxD.2
have hxnotL : x ∉ Lw := by
intro hxL
apply hxC
refine ⟨hxL.1.2, ?_⟩
change stat x ∈ B
dsimp [stat]
rw [causalHardSignedStatistic_eq_verticalSignedRadius_on_cell
hcenter hwHalf hxL.1.2]
have hxneg : (scoreCoordinates x - scoreCoordinates c).2 < 0 := by
have hxne : (scoreCoordinates x - scoreCoordinates c).2 ≠ 0 := by
simpa using hx0
exact lt_of_le_of_ne hxL.1.1 hxne
rw [if_neg (not_le.mpr hxneg)]
exact hxL.2
-- … truncated; follow the source link for the rest …
theorem causalHardSignedSuccess_localized_setwise_bound
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hbEq :
b = 1 / 16
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hwHalf :
w ≤ 1 / 2
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
centers j ∈ causalHardBottomEdge
hcell :
causalHardCell (centers j) w ⊆ causalHardSquare
hj :
omega j = false
B :
Set ℝ
hB :
conclusion
let omega' := update omega j true let nu := (causalHardScoreMeasure b cA delta w centers omega).restrict (causalHardCell (centers j) w) let nu' := (causalHardScoreMeasure b cA delta w centers omega').restrict (causalHardCell (centers j) w) let p := causalHardObservedSuccessProfile delta w centers omega let p' := causalHardObservedSuccessProfile delta w centers omega' let stat := causalHardSignedStatistic (centers j) let E := Ioo 0 (2 * (cA * delta) / b) |(∫ x in {x | stat x ∈ B}, p x ∂nu)
- ∫ x in {x | stat x ∈ B}, p' x ∂nu'|
≤ delta * (Measure.map stat nu (B ∩ E)).toReal
Proof (Lean source)
lemma causalHardSignedSuccess_localized_setwise_bound {M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(centers : Fin M → Score) (omega : Fin M → Bool)
(hbEq : b = 1 / 16) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16)
(hw : 0 < w) (hwHalf : w ≤ 1 / 2)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : centers j ∈ causalHardBottomEdge)
(hcell : causalHardCell (centers j) w ⊆ causalHardSquare)
(hj : omega j = false) {B : Set ℝ} (hB : MeasurableSet B) :
let omega' := update omega j true
let nu := (causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w)
let nu' := (causalHardScoreMeasure b cA delta w centers omega').restrict
(causalHardCell (centers j) w)
let p := causalHardObservedSuccessProfile delta w centers omega
let p' := causalHardObservedSuccessProfile delta w centers omega'
let stat := causalHardSignedStatistic (centers j)
let E := Ioo 0 (2 * (cA * delta) / b)
|(∫ x in {x | stat x ∈ B}, p x ∂nu) -
∫ x in {x | stat x ∈ B}, p' x ∂nu'| ≤
delta * (Measure.map stat nu (B ∩ E)).toReal := by
dsimp only
let omega' := update omega j true
let stat := causalHardSignedStatistic (centers j)
let E := Ioo 0 (2 * (cA * delta) / b)
have harea := causalHardSignedSuccess_setIntegral_abs_le_cellArea j centers omega
hbEq hb hscale hcA hdelta hdeltaSmall hw hwHalf hsep hcenter hcell hj hB
rw [abs_sub_comm]
apply harea.trans
rw [Measure.map_apply (causalHardSignedStatistic_measurable _) (hB.inter measurableSet_Ioo)]
rw [Measure.restrict_apply ((hB.inter measurableSet_Ioo).preimage
(causalHardSignedStatistic_measurable _))]
have hset : stat ⁻¹' (B ∩ E) ∩ causalHardCell (centers j) w =
causalHardCell (centers j) w ∩ {x | stat x ∈ B ∩ E} := by
ext x
simp [and_comm]
rw [hset, causalHardScoreMeasure_signedSlice_eq_uniform j centers omega hb hscale
hcA hdelta hw hwHalf hsep hcenter hcell (hB.inter measurableSet_Ioo)]
have hvoltop : volume (causalHardCell (centers j) w ∩
{x | stat x ∈ B ∩ E}) ≠ ∞ := ne_of_lt
((measure_mono inter_subset_left).trans_lt
(isCompact_closedBall (centers j) w).measure_lt_top)
rw [ENNReal.toReal_mul,
ENNReal.toReal_ofReal (by norm_num : (0 : ℝ) ≤ 1 / 36)]
have hsubset :
{x | 0 < (scoreCoordinates x - scoreCoordinates (centers j)).2 ∧
dist x (centers j) ≤ w} ∩
{x | dist x (centers j) ∈ B ∩ Iio (2 * (cA * delta) / b)} ⊆
causalHardCell (centers j) w ∩ {x | stat x ∈ B ∩ E} := by
intro x hx
have hxcell : x ∈ causalHardCell (centers j) w := hx.1.2
refine ⟨hxcell, ?_⟩
change causalHardSignedStatistic (centers j) x ∈
B ∩ Ioo 0 (2 * (cA * delta) / b)
rw [causalHardSignedStatistic_eq_verticalSignedRadius_on_cell
hcenter hwHalf hxcell, if_pos hx.1.1.le]
refine ⟨hx.2.1, ⟨dist_pos.mpr ?_, hx.2.2⟩⟩
intro heq
subst x
simp at hx
have hreal := ENNReal.toReal_mono hvoltop (measure_mono hsubset)
calc
delta / 36 *
(volume
({x | 0 < (scoreCoordinates x - scoreCoordinates (centers j)).2 ∧
dist x (centers j) ≤ w} ∩
{x | dist x (centers j) ∈ B ∩
Iio (2 * (cA * delta) / b)})).toReal ≤
delta / 36 *
(volume (causalHardCell (centers j) w ∩
{x | stat x ∈ B ∩ E})).toReal :=
mul_le_mul_of_nonneg_left hreal (by positivity)
_ = delta * (1 / 36 *
(volume (causalHardCell (centers j) w ∩
{x | stat x ∈ B ∩ E})).toReal) := by ring
theorem causalHardCellSignedObservationMeasure_klDiv_enable_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hbEq :
b = 1 / 16
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hwHalf :
w ≤ 1 / 2
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
centers j ∈ causalHardBottomEdge
hcell :
∀ k, causalHardCell (centers k) w ⊆ causalHardSquare
hj :
omega j = false
conclusion
let omega' := update omega j true let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell let P' := causalHardA1A2Law b cA delta w centers omega' hb hscale hcA hdelta hw hsep hcell (klDiv (causalHardCellSignedObservationMeasure P (centers j) w) (causalHardCellSignedObservationMeasure P' (centers j) w) ≤ ofReal (4 * delta ^ 2) * Measure.map (causalHardSignedStatistic (centers j)) ((causalHardScoreMeasure b cA delta w centers omega).restrict (causalHardCell (centers j) w)) (Ioo 0 (2 * (cA * delta) / b))) ∧
(klDiv (causalHardCellSignedObservationMeasure P' (centers j) w) (causalHardCellSignedObservationMeasure P (centers j) w) ≤ ofReal (4 * delta ^ 2) * Measure.map (causalHardSignedStatistic (centers j)) ((causalHardScoreMeasure b cA delta w centers omega).restrict (causalHardCell (centers j) w)) (Ioo 0 (2 * (cA * delta) / b)))
Proof (Lean source)
lemma causalHardCellSignedObservationMeasure_klDiv_enable_le {M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(centers : Fin M → Score) (omega : Fin M → Bool)
(hbEq : b = 1 / 16) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16)
(hw : 0 < w) (hwHalf : w ≤ 1 / 2)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : centers j ∈ causalHardBottomEdge)
(hcell : ∀ k, causalHardCell (centers k) w ⊆ causalHardSquare)
(hj : omega j = false) :
let omega' := update omega j true
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
let P' := causalHardA1A2Law b cA delta w centers omega' hb hscale hcA
hdelta hw hsep hcell
(klDiv
(causalHardCellSignedObservationMeasure P (centers j) w)
(causalHardCellSignedObservationMeasure P' (centers j) w) ≤
ofReal (4 * delta ^ 2) *
Measure.map (causalHardSignedStatistic (centers j))
((causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w))
(Ioo 0 (2 * (cA * delta) / b))) ∧
(klDiv
(causalHardCellSignedObservationMeasure P' (centers j) w)
(causalHardCellSignedObservationMeasure P (centers j) w) ≤
ofReal (4 * delta ^ 2) *
Measure.map (causalHardSignedStatistic (centers j))
((causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w))
(Ioo 0 (2 * (cA * delta) / b))) := by
dsimp only
let omega' := update omega j true
let nu := (causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w)
let nu' := (causalHardScoreMeasure b cA delta w centers omega').restrict
(causalHardCell (centers j) w)
let p := causalHardObservedSuccessProfile delta w centers omega
let p' := causalHardObservedSuccessProfile delta w centers omega'
let q := fun x => max (1 / 4 : ℝ) (min (3 / 4 : ℝ) (p x))
let q' := fun x => max (1 / 4 : ℝ) (min (3 / 4 : ℝ) (p' x))
let stat := causalHardSignedStatistic (centers j)
letI : IsProbabilityMeasure
(causalHardScoreMeasure b cA delta w centers omega) :=
causalHardScoreMeasure_isProbabilityMeasure centers omega hb hscale hcA
hdelta hw hsep hcell
letI : IsProbabilityMeasure
(causalHardScoreMeasure b cA delta w centers omega') :=
causalHardScoreMeasure_isProbabilityMeasure centers omega' hb hscale hcA
hdelta hw hsep hcell
have hp := causalHardObservedSuccessProfile_measurable delta w centers omega
have hp' := causalHardObservedSuccessProfile_measurable delta w centers omega'
have hq : Measurable q := measurable_const.max (measurable_const.min hp)
have hq' : Measurable q' := measurable_const.max (measurable_const.min hp')
have hq0 : ∀ x, (1 / 4 : ℝ) ≤ q x := fun x => le_max_left _ _
have hq1 : ∀ x, q x ≤ (3 / 4 : ℝ) := by
intro x
dsimp [q]
exact max_le (by norm_num) (min_le_left _ _)
have hq0' : ∀ x, (1 / 4 : ℝ) ≤ q' x := fun x => le_max_left _ _
have hq1' : ∀ x, q' x ≤ (3 / 4 : ℝ) := by
intro x
dsimp [q']
exact max_le (by norm_num) (min_le_left _ _)
have hqp : q =ᵐ[nu] p := by
filter_upwards [ae_restrict_mem Metric.isClosed_closedBall.measurableSet] with x hx
have hm := causalHardObservedSuccessProfile_mem_middleHalf hdelta.le hdeltaSmall
hw hsep omega (hcell j hx)
dsimp [q]
rw [min_eq_right hm.2, max_eq_right hm.1]
have hqp' : q' =ᵐ[nu'] p' := by
filter_upwards [ae_restrict_mem Metric.isClosed_closedBall.measurableSet] with x hx
have hm := causalHardObservedSuccessProfile_mem_middleHalf hdelta.le hdeltaSmall
hw hsep omega' (hcell j hx)
dsimp [q']
rw [min_eq_right hm.2, max_eq_right hm.1]
have hmap := causalHardScoreMeasure_restrict_map_signedStatistic_eq j centers
omega omega' hb hscale hcA hdelta hw hwHalf hsep hcenter (hcell j)
have hdiff : ∀ B : Set ℝ, MeasurableSet B →
|(∫ x in {x | stat x ∈ B}, q x ∂nu) -
∫ x in {x | stat x ∈ B}, q' x ∂nu'| ≤
delta * (Measure.map stat nu
(B ∩ Ioo 0 (2 * (cA * delta) / b))).toReal := by
intro B hB
have heq : (∫ x in {x | stat x ∈ B}, q x ∂nu) =
∫ x in {x | stat x ∈ B}, p x ∂nu := by
apply MeasureTheory.integral_congr_ae
exact ae_restrict_of_ae hqp
have heq' : (∫ x in {x | stat x ∈ B}, q' x ∂nu') =
∫ x in {x | stat x ∈ B}, p' x ∂nu' := by
apply MeasureTheory.integral_congr_ae
exact ae_restrict_of_ae hqp'
rw [heq, heq']
exact causalHardSignedSuccess_localized_setwise_bound j centers omega hbEq hb
hscale hcA hdelta hdeltaSmall hw hwHalf hsep hcenter (hcell j) hj hB
have hkl := statisticBernoulliOutcome_klDiv_le_of_localized_success_bound
nu nu' q q' stat hq hq' (causalHardSignedStatistic_measurable _)
hq0 hq1 hq0' hq1' hmap hdelta.le measurableSet_Ioo hdiff
have hdiff' : ∀ B : Set ℝ, MeasurableSet B →
|(∫ x in {x | stat x ∈ B}, q' x ∂nu') -
∫ x in {x | stat x ∈ B}, q x ∂nu| ≤
delta * (Measure.map stat nu' (B ∩ Ioo 0 (2 * (cA * delta) / b))).toReal := by
intro B hB
rw [← hmap]
simpa only [abs_sub_comm] using hdiff B hB
have hkl' := statisticBernoulliOutcome_klDiv_le_of_localized_success_bound
nu' nu q' q stat hq' hq (causalHardSignedStatistic_measurable _)
hq0' hq1' hq0 hq1 hmap.symm hdelta.le measurableSet_Ioo hdiff'
have hk : commonStatisticBernoulliKernel q hq =ᵐ[nu]
causalSelectedBernoulliKernel p hp := by
filter_upwards [hqp] with x hx
simp [commonStatisticBernoulliKernel, causalSelectedBernoulliKernel, hx]
have hk' : commonStatisticBernoulliKernel q' hq' =ᵐ[nu']
causalSelectedBernoulliKernel p' hp' := by
filter_upwards [hqp'] with x hx
simp [commonStatisticBernoulliKernel, causalSelectedBernoulliKernel, hx]
letI : IsMarkovKernel (commonStatisticBernoulliKernel q hq) :=
commonStatisticBernoulliKernel_isMarkovKernel q hq
(fun x => by linarith [hq0 x]) (fun x => by linarith [hq1 x])
letI : IsMarkovKernel (commonStatisticBernoulliKernel q' hq') :=
commonStatisticBernoulliKernel_isMarkovKernel q' hq'
(fun x => by linarith [hq0' x]) (fun x => by linarith [hq1' x])
have hpunit : ∀ x, 0 ≤ p x ∧ p x ≤ 1 := by
intro x
have hprof := causalHardProfiles_mem_unitInterval delta w centers omega x
dsimp [p, causalHardObservedSuccessProfile]
split_ifs <;> simp_all
have hpunit' : ∀ x, 0 ≤ p' x ∧ p' x ≤ 1 := by
intro x
have hprof := causalHardProfiles_mem_unitInterval delta w centers omega' x
dsimp [p', causalHardObservedSuccessProfile]
split_ifs <;> simp_all
letI : IsMarkovKernel (causalSelectedBernoulliKernel p hp) :=
causalSelectedBernoulliKernel_isMarkovKernel p hp
(fun x => (hpunit x).1) (fun x => (hpunit x).2)
letI : IsMarkovKernel (causalSelectedBernoulliKernel p' hp') :=
causalSelectedBernoulliKernel_isMarkovKernel p' hp'
(fun x => (hpunit' x).1) (fun x => (hpunit' x).2)
rw [MeasureTheory.Measure.compProd_congr hk,
MeasureTheory.Measure.compProd_congr hk'] at hkl
rw [MeasureTheory.Measure.compProd_congr hk',
MeasureTheory.Measure.compProd_congr hk] at hkl'
rw [← causalHardCellSignedObservationMeasure_eq_scoreBernoulli j b cA delta w
centers omega hb hscale hcA hdelta hw hsep hcell,
← causalHardCellSignedObservationMeasure_eq_scoreBernoulli j b cA delta w
centers omega' hb hscale hcA hdelta hw hsep hcell] at hkl
rw [← causalHardCellSignedObservationMeasure_eq_scoreBernoulli j b cA delta w
centers omega' hb hscale hcA hdelta hw hsep hcell,
← causalHardCellSignedObservationMeasure_eq_scoreBernoulli j b cA delta w
centers omega hb hscale hcA hdelta hw hsep hcell] at hkl'
rw [← hmap] at hkl'
exact ⟨hkl, hkl'⟩
Causal.Hypercube.HardSquareSlice 13 declarations This module proves finiteness by parametrizing the ambient radius circle and strict positivity by exhibiting short armwise arcs with nontrivial coordinate projections.
Arm-slice certificates for the fixed hard square
This module proves finiteness by parametrizing the ambient radius circle and strict positivity by exhibiting short armwise arcs with nontrivial coordinate projections.
The two-dimensional score space is isometric to the complex plane.
Definition (Lean source)
-- @node: causalHardScoreComplexEquiv
noncomputable def causalHardScoreComplexEquiv : Score ≃ᵢ ℂ where
toFun x := (x 0 : ℂ) + (x 1 : ℂ) * I
invFun z := scorePoint z.re z.im
left_inv x := by
ext i
fin_cases i
· simp [scorePoint_apply_zero]
· simp [scorePoint_apply_one]
right_inv z := by
apply Complex.ext <;> simp [scorePoint_apply_zero, scorePoint_apply_one]
isometry_toFun := by
intro x y
simp only [edist_dist]
rw [dist_eq_norm, dist_eq_norm, EuclideanSpace.norm_eq]
simp [Fin.sum_univ_two, Real.norm_eq_abs, Complex.norm_def,
Complex.normSq_apply, PiLp.sub_apply]
congr 2 <;> ring
theorem causalHardSphere_hausdorffMeasure_lt_top Lemma causalHardSphere_hausdorffMeasure_lt_top in the paper ↗
Every radius circle in the score plane has finite one-dimensional Hausdorff measure.
Proof (Lean source)
-- @node: causalHardSphere_hausdorffMeasure_lt_top
lemma causalHardSphere_hausdorffMeasure_lt_top (x : Score) (s : ℝ) :
μH[1] (sphere x s) < ∞ := by
by_cases hs : s < 0
· simp [Metric.sphere_eq_empty_of_neg hs]
have hsabs : |s| = s := abs_of_nonneg (le_of_not_gt hs)
let e := causalHardScoreComplexEquiv
have hcircle : μH[1] (sphere (e x) s) < ∞ := by
rw [← hsabs, ← image_circleMap_Ioc]
refine lt_of_le_of_lt
((lipschitzWith_circleMap (e x) s).hausdorffMeasure_image_le (by norm_num) _) ?_
rw [hausdorffMeasure_real, Real.volume_Ioc]
simpa only [ENNReal.rpow_one] using
ENNReal.mul_lt_top ENNReal.coe_lt_top ENNReal.ofReal_lt_top
rw [← e.image_sphere x s] at hcircle
simpa only [e, IsometryEquiv.hausdorffMeasure_image] using hcircle
theorem causalHardScoreCoordinate_lipschitz Lemma causalHardScoreCoordinate_lipschitz in the paper ↗
A score coordinate is one-Lipschitz.
Formal statement
Proof (Lean source)
-- @node: causalHardScoreCoordinate_lipschitz
lemma causalHardScoreCoordinate_lipschitz (i : Fin 2) :
LipschitzWith 1 (fun z : Score => z i) := by
rw [lipschitzWith_iff_dist_le_mul]
intro x y
simp only [NNReal.coe_one, one_mul, Real.dist_eq]
rw [dist_eq_norm, EuclideanSpace.norm_eq]
simp only [Fin.sum_univ_two, Real.norm_eq_abs, PiLp.sub_apply]
rw [Real.le_sqrt (abs_nonneg _) (by positivity)]
fin_cases i
· change |x 0 - y 0| ^ 2 ≤ |x 0 - y 0| ^ 2 + |x 1 - y 1| ^ 2
nlinarith [sq_nonneg |x 1 - y 1|]
· change |x 1 - y 1| ^ 2 ≤ |x 0 - y 0| ^ 2 + |x 1 - y 1| ^ 2
nlinarith [sq_nonneg |x 0 - y 0|]
theorem hausdorffMeasure_pos_of_scoreCoordinate_interval Lemma hausdorffMeasure_pos_of_scoreCoordinate_interval in the paper ↗
A score set whose coordinate projection contains a nondegenerate interval has positive one-dimensional Hausdorff measure.
Formal statement
Proof (Lean source)
-- @node: hausdorffMeasure_pos_of_scoreCoordinate_interval
lemma hausdorffMeasure_pos_of_scoreCoordinate_interval
{S : Set Score} {i : Fin 2} {a b : ℝ}
(hab : a < b) (hsub : Icc a b ⊆ (fun z : Score => z i) '' S) :
0 < μH[1] S := by
have hI : 0 < μH[1] (Icc a b) := by
rw [hausdorffMeasure_real, Real.volume_Icc]
exact ENNReal.ofReal_pos.mpr (sub_pos.mpr hab)
have himage : μH[1] ((fun z : Score => z i) '' S) ≤ μH[1] S := by
simpa using (causalHardScoreCoordinate_lipschitz i).hausdorffMeasure_image_le
(by norm_num : (0 : ℝ) ≤ 1) S
exact hI.trans_le ((measure_mono hsub).trans himage)
A radius-circle arc written as a graph over the second coordinate.
Definition (Lean source)
-- @node: causalHardArc0
noncomputable def causalHardArc0 (x : Score) (s dn dt r : ℝ) : Score :=
scorePoint (x 0 + dn * sqrt (s ^ 2 - r ^ 2)) (x 1 + dt * r)
A radius-circle arc written as a graph over the first coordinate.
Definition (Lean source)
-- @node: causalHardArc1
noncomputable def causalHardArc1 (x : Score) (s dn dt r : ℝ) : Score :=
scorePoint (x 0 + dt * r) (x 1 + dn * sqrt (s ^ 2 - r ^ 2))
theorem causalHardArc0_dist
Every admissible graph-over-second-coordinate arc point lies on its prescribed radius circle.
Formal statement
hypotheses
conclusion
dist (causalHardArc0 x s dn dt r) x = s
Proof (Lean source)
-- @node: causalHardArc0_dist
lemma causalHardArc0_dist {x : Score} {s r dn dt : ℝ} (hs : 0 < s)
(hr0 : 0 ≤ r) (hr : r ≤ s) (hdn : |dn| = 1) (hdt : |dt| = 1) :
dist (causalHardArc0 x s dn dt r) x = s := by
rw [dist_eq_norm, EuclideanSpace.norm_eq]
simp only [causalHardArc0, Fin.sum_univ_two, Real.norm_eq_abs,
PiLp.sub_apply, scorePoint_apply_zero, scorePoint_apply_one]
have hrad : 0 ≤ s ^ 2 - r ^ 2 := by nlinarith
simp only [add_sub_cancel_left]
rw [abs_mul, hdn, one_mul, abs_mul, hdt, one_mul,
abs_of_nonneg (Real.sqrt_nonneg _), abs_of_nonneg hr0,
Real.sq_sqrt hrad]
calc
sqrt (s ^ 2 - r ^ 2 + r ^ 2) = sqrt (s ^ 2) := by ring
_ = |s| := Real.sqrt_sq_eq_abs s
_ = s := abs_of_pos hs
theorem causalHardArc1_dist
Every admissible graph-over-first-coordinate arc point lies on its prescribed radius circle.
Formal statement
hypotheses
conclusion
dist (causalHardArc1 x s dn dt r) x = s
Proof (Lean source)
-- @node: causalHardArc1_dist
lemma causalHardArc1_dist {x : Score} {s r dn dt : ℝ} (hs : 0 < s)
(hr0 : 0 ≤ r) (hr : r ≤ s) (hdn : |dn| = 1) (hdt : |dt| = 1) :
dist (causalHardArc1 x s dn dt r) x = s := by
rw [dist_eq_norm, EuclideanSpace.norm_eq]
simp only [causalHardArc1, Fin.sum_univ_two, Real.norm_eq_abs,
PiLp.sub_apply, scorePoint_apply_zero, scorePoint_apply_one]
have hrad : 0 ≤ s ^ 2 - r ^ 2 := by nlinarith
simp only [add_sub_cancel_left]
rw [abs_mul, hdt, one_mul, abs_mul, hdn, one_mul,
abs_of_nonneg hr0, abs_of_nonneg (Real.sqrt_nonneg _),
Real.sq_sqrt hrad]
calc
sqrt (r ^ 2 + (s ^ 2 - r ^ 2)) = sqrt (s ^ 2) := by ring
_ = |s| := Real.sqrt_sq_eq_abs s
_ = s := abs_of_pos hs
The normal displacement of a short quarter arc is positive and at most the radius.
Formal statement
Proof (Lean source)
-- @node: causalHardArc_sqrt_bounds
lemma causalHardArc_sqrt_bounds {s r : ℝ} (hs : 0 < s) (hr0 : 0 ≤ r)
(hr : r ≤ s / 2) :
0 < sqrt (s ^ 2 - r ^ 2) ∧ sqrt (s ^ 2 - r ^ 2) ≤ s := by
have hrad : 0 < s ^ 2 - r ^ 2 := by nlinarith
constructor
· exact Real.sqrt_pos.2 hrad
· rw [Real.sqrt_le_iff]
exact ⟨hs.le, by nlinarith⟩
theorem causalHardArmOne_slice_hausdorffMeasure_pos Lemma causalHardArmOne_slice_hausdorffMeasure_pos in the paper ↗
Every positive radius at most one cuts a positive-length arc from the fixed treatment rectangle at every frontier point.
Formal statement
hypotheses
conclusion
0 < μH[1] {z | z ∈ causalHardArmOne ∧ dist z x = s}
Proof (Lean source)
-- @node: causalHardArmOne_slice_hausdorffMeasure_pos
lemma causalHardArmOne_slice_hausdorffMeasure_pos {x : Score} {s : ℝ}
(hx : x ∈ frontier causalHardArmOne) (hs : 0 < s) (hs1 : s ≤ 1) :
0 < μH[1] {z | z ∈ causalHardArmOne ∧ dist z x = s} := by
have hx' := (mem_frontier_causalHardArmOne_iff x).mp hx
rcases hx'.2.2.2.2 with hedge | hedge | hedge | hedge
· by_cases hm : x 1 ≤ 1
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 1)
(a := x 1 + s / 4) (b := x 1 + s / 2) (by linarith)
intro y hy
let r := y - x 1
let z := causalHardArc0 x s 1 1 r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.1]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.2]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨?_, causalHardArc0_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· simp only [causalHardArmOne, mem_setOf_eq, z, causalHardArc0,
scorePoint_apply_zero, scorePoint_apply_one]
rw [hedge]
exact ⟨by linarith, by linarith, by linarith [hx'.2.2.1],
by linarith [hx'.2.2.2.1]⟩
· simp [z, causalHardArc0, r, scorePoint_apply_one]
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 1)
(a := x 1 - s / 2) (b := x 1 - s / 4) (by linarith)
intro y hy
let r := x 1 - y
let z := causalHardArc0 x s 1 (-1) r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.2]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.1]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨?_, causalHardArc0_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· simp only [causalHardArmOne, mem_setOf_eq, z, causalHardArc0,
scorePoint_apply_zero, scorePoint_apply_one]
rw [hedge]
exact ⟨by linarith, by linarith, by linarith [hx'.2.2.1],
by linarith [hx'.2.2.2.1]⟩
· simp [z, causalHardArc0, r, scorePoint_apply_one]
· by_cases hm : x 1 ≤ 1
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 1)
(a := x 1 + s / 4) (b := x 1 + s / 2) (by linarith)
intro y hy
let r := y - x 1
let z := causalHardArc0 x s (-1) 1 r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.1]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.2]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨?_, causalHardArc0_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· simp only [causalHardArmOne, mem_setOf_eq, z, causalHardArc0,
scorePoint_apply_zero, scorePoint_apply_one]
rw [hedge]
exact ⟨by linarith, by linarith, by linarith [hx'.2.2.1],
by linarith [hx'.2.2.2.1]⟩
· simp [z, causalHardArc0, r, scorePoint_apply_one]
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 1)
(a := x 1 - s / 2) (b := x 1 - s / 4) (by linarith)
intro y hy
let r := x 1 - y
let z := causalHardArc0 x s (-1) (-1) r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.2]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.1]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨?_, causalHardArc0_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· simp only [causalHardArmOne, mem_setOf_eq, z, causalHardArc0,
scorePoint_apply_zero, scorePoint_apply_one]
rw [hedge]
exact ⟨by linarith, by linarith, by linarith [hx'.2.2.1],
by linarith [hx'.2.2.2.1]⟩
· simp [z, causalHardArc0, r, scorePoint_apply_one]
· by_cases hm : x 0 ≤ 0
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 0)
(a := x 0 + s / 4) (b := x 0 + s / 2) (by linarith)
intro y hy
let r := y - x 0
let z := causalHardArc1 x s 1 1 r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.1]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.2]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨?_, causalHardArc1_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· simp only [causalHardArmOne, mem_setOf_eq, z, causalHardArc1,
scorePoint_apply_zero, scorePoint_apply_one]
rw [hedge]
exact ⟨by linarith [hx'.1], by linarith [hx'.2.1],
by linarith, by linarith⟩
· simp [z, causalHardArc1, r, scorePoint_apply_zero]
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 0)
(a := x 0 - s / 2) (b := x 0 - s / 4) (by linarith)
intro y hy
let r := x 0 - y
let z := causalHardArc1 x s 1 (-1) r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.2]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.1]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨?_, causalHardArc1_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· simp only [causalHardArmOne, mem_setOf_eq, z, causalHardArc1,
scorePoint_apply_zero, scorePoint_apply_one]
rw [hedge]
exact ⟨by linarith [hx'.1], by linarith [hx'.2.1],
by linarith, by linarith⟩
· simp [z, causalHardArc1, r, scorePoint_apply_zero]
· by_cases hm : x 0 ≤ 0
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 0)
(a := x 0 + s / 4) (b := x 0 + s / 2) (by linarith)
intro y hy
let r := y - x 0
let z := causalHardArc1 x s (-1) 1 r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.1]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.2]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨?_, causalHardArc1_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· simp only [causalHardArmOne, mem_setOf_eq, z, causalHardArc1,
scorePoint_apply_zero, scorePoint_apply_one]
rw [hedge]
exact ⟨by linarith [hx'.1], by linarith [hx'.2.1],
by linarith, by linarith⟩
· simp [z, causalHardArc1, r, scorePoint_apply_zero]
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 0)
(a := x 0 - s / 2) (b := x 0 - s / 4) (by linarith)
intro y hy
let r := x 0 - y
let z := causalHardArc1 x s (-1) (-1) r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.2]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.1]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨?_, causalHardArc1_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· simp only [causalHardArmOne, mem_setOf_eq, z, causalHardArc1,
scorePoint_apply_zero, scorePoint_apply_one]
rw [hedge]
exact ⟨by linarith [hx'.1], by linarith [hx'.2.1],
by linarith, by linarith⟩
· simp [z, causalHardArc1, r, scorePoint_apply_zero]
theorem causalHardArmZero_slice_hausdorffMeasure_pos Lemma causalHardArmZero_slice_hausdorffMeasure_pos in the paper ↗
Every positive radius at most one cuts a positive-length arc from the support-side complement of the treatment rectangle.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: causalHardArmZero_slice_hausdorffMeasure_pos
lemma causalHardArmZero_slice_hausdorffMeasure_pos {x : Score} {s : ℝ}
(hx : x ∈ frontier causalHardArmOne) (hs : 0 < s) (hs1 : s ≤ 1) :
0 < μH[1] {z | z ∈ causalHardSquare \ causalHardArmOne ∧ dist z x = s} := by
have hx' := (mem_frontier_causalHardArmOne_iff x).mp hx
rcases hx'.2.2.2.2 with hedge | hedge | hedge | hedge
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 1)
(a := x 1 + s / 4) (b := x 1 + s / 2) (by linarith)
intro y hy
let r := y - x 1
let z := causalHardArc0 x s (-1) 1 r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.1]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.2]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨⟨?_, ?_⟩,
causalHardArc0_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· intro i
fin_cases i
· change -3 ≤ z 0 ∧ z 0 ≤ 3
simp only [z, causalHardArc0, scorePoint_apply_zero]
rw [hedge]
exact ⟨by linarith, by linarith⟩
· change -3 ≤ z 1 ∧ z 1 ≤ 3
simp only [z, causalHardArc0, scorePoint_apply_one]
exact ⟨by linarith [hx'.2.2.1], by linarith [hx'.2.2.2.1]⟩
· intro hA
simp only [causalHardArmOne, mem_setOf_eq] at hA
simp only [z, causalHardArc0, scorePoint_apply_zero] at hA
rw [hedge] at hA
linarith
· simp [z, causalHardArc0, r, scorePoint_apply_one]
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 1)
(a := x 1 + s / 4) (b := x 1 + s / 2) (by linarith)
intro y hy
let r := y - x 1
let z := causalHardArc0 x s 1 1 r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.1]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.2]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨⟨?_, ?_⟩,
causalHardArc0_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· intro i
fin_cases i
· change -3 ≤ z 0 ∧ z 0 ≤ 3
simp only [z, causalHardArc0, scorePoint_apply_zero]
rw [hedge]
exact ⟨by linarith, by linarith⟩
· change -3 ≤ z 1 ∧ z 1 ≤ 3
simp only [z, causalHardArc0, scorePoint_apply_one]
exact ⟨by linarith [hx'.2.2.1], by linarith [hx'.2.2.2.1]⟩
· intro hA
simp only [causalHardArmOne, mem_setOf_eq] at hA
simp only [z, causalHardArc0, scorePoint_apply_zero] at hA
rw [hedge] at hA
linarith
· simp [z, causalHardArc0, r, scorePoint_apply_one]
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 0)
(a := x 0 + s / 4) (b := x 0 + s / 2) (by linarith)
intro y hy
let r := y - x 0
let z := causalHardArc1 x s (-1) 1 r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.1]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.2]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨⟨?_, ?_⟩,
causalHardArc1_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· intro i
fin_cases i
· change -3 ≤ z 0 ∧ z 0 ≤ 3
simp only [z, causalHardArc1, scorePoint_apply_zero]
exact ⟨by linarith [hx'.1], by linarith [hx'.2.1]⟩
· change -3 ≤ z 1 ∧ z 1 ≤ 3
simp only [z, causalHardArc1, scorePoint_apply_one]
rw [hedge]
exact ⟨by linarith, by linarith⟩
· intro hA
simp only [causalHardArmOne, mem_setOf_eq] at hA
simp only [z, causalHardArc1, scorePoint_apply_one] at hA
rw [hedge] at hA
linarith
· simp [z, causalHardArc1, r, scorePoint_apply_zero]
· apply hausdorffMeasure_pos_of_scoreCoordinate_interval (i := 0)
(a := x 0 + s / 4) (b := x 0 + s / 2) (by linarith)
intro y hy
let r := y - x 0
let z := causalHardArc1 x s 1 1 r
have hr0 : 0 ≤ r := by dsimp [r]; linarith [hy.1]
have hr : r ≤ s / 2 := by dsimp [r]; linarith [hy.2]
have hsqrt := causalHardArc_sqrt_bounds hs hr0 hr
refine ⟨z, ⟨⟨?_, ?_⟩,
causalHardArc1_dist hs hr0 (hr.trans (by linarith)) (by norm_num) (by norm_num)⟩, ?_⟩
· intro i
fin_cases i
· change -3 ≤ z 0 ∧ z 0 ≤ 3
simp only [z, causalHardArc1, scorePoint_apply_zero]
exact ⟨by linarith [hx'.1], by linarith [hx'.2.1]⟩
· change -3 ≤ z 1 ∧ z 1 ≤ 3
simp only [z, causalHardArc1, scorePoint_apply_one]
rw [hedge]
exact ⟨by linarith, by linarith⟩
· intro hA
simp only [causalHardArmOne, mem_setOf_eq] at hA
simp only [z, causalHardArc1, scorePoint_apply_one] at hA
rw [hedge] at hA
linarith
· simp [z, causalHardArc1, r, scorePoint_apply_zero]
A uniformly positive and bounded density gives finite positive mass to each positive-length arm slice.
Formal statement
hypotheses
P :
hA1 :
P.A1 = causalHardArmOne
hA0 :
P.A0 = causalHardSquare \ causalHardArmOne
hdensMeas :
Measurable P.density
hlower :
∀ z, (1 / 48 : ℝ) ≤ P.density z
hupper :
∀ z, P.density z ≤ (5 / 144 : ℝ)
t :
x :
s :
ℝ
hx :
hs :
0 < s
hs1 :
s ≤ 1
conclusion
0 < armSliceDensityMass P t x s ∧ armSliceDensityMass P t x s < ∞
Proof (Lean source)
-- @node: causalHardDensitySlice_finite_pos
lemma causalHardDensitySlice_finite_pos (P : A1A2Law)
(hA1 : P.A1 = causalHardArmOne)
(hA0 : P.A0 = causalHardSquare \ causalHardArmOne)
(hdensMeas : Measurable P.density)
(hlower : ∀ z, (1 / 48 : ℝ) ≤ P.density z)
(hupper : ∀ z, P.density z ≤ (5 / 144 : ℝ))
(t : Bool) {x : Score} {s : ℝ}
(hx : x ∈ frontier causalHardArmOne) (hs : 0 < s) (hs1 : s ≤ 1) :
0 < armSliceDensityMass P t x s ∧ armSliceDensityMass P t x s < ∞ := by
let S : Set Score := {z | z ∈ (if t then P.A1 else P.A0) ∧ dist z x = s}
have hSpos : 0 < μH[1] S := by
cases t with
| false => simpa [S, hA0] using causalHardArmZero_slice_hausdorffMeasure_pos hx hs hs1
| true => simpa [S, hA1] using causalHardArmOne_slice_hausdorffMeasure_pos hx hs hs1
have hSfinite : μH[1] S < ∞ := by
apply lt_of_le_of_lt (measure_mono ?_) (causalHardSphere_hausdorffMeasure_lt_top x s)
intro z hz
exact hz.2
have hlo : ofReal (1 / 48 : ℝ) * μH[1] S ≤
∫⁻ z in S, ofReal (P.density z) ∂μH[1] := by
rw [← setLIntegral_const]
exact setLIntegral_mono (ENNReal.measurable_ofReal.comp hdensMeas)
(fun z _ => ENNReal.ofReal_le_ofReal (hlower z))
have hup : (∫⁻ z in S, ofReal (P.density z) ∂μH[1]) ≤
ofReal (5 / 144 : ℝ) * μH[1] S := by
rw [← setLIntegral_const]
exact setLIntegral_mono measurable_const
(fun z _ => ENNReal.ofReal_le_ofReal (hupper z))
unfold armSliceDensityMass
change 0 < ∫⁻ z in S, ofReal (P.density z) ∂μH[1] ∧
(∫⁻ z in S, ofReal (P.density z) ∂μH[1]) < ∞
constructor
· exact (ENNReal.mul_pos (ENNReal.ofReal_pos.mpr (by norm_num)).ne'
hSpos.ne').trans_le hlo
· exact hup.trans_lt (ENNReal.mul_lt_top ENNReal.ofReal_lt_top hSfinite)
theorem causalHardA1A2Law_slice_certificate
Every explicit angular hard law satisfies the class's finite-positive arm-slice condition once the envelope is at least 48.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, causalHardCell (centers j) w ⊆ causalHardSquare
L :
ℝ
hL :
48 ≤ L
conclusion
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA hdelta hw hsep hcell ∀ t x s, x ∈ P.boundary → 0 < s → s
≤ L⁻¹ → 0 < armSliceDensityMass P t x s ∧ armSliceDensityMass P t x s < ∞
Proof (Lean source)
-- @node: causalHardA1A2Law_slice_certificate
lemma causalHardA1A2Law_slice_certificate {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, causalHardCell (centers j) w ⊆ causalHardSquare)
{L : ℝ} (hL : 48 ≤ L) :
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
∀ t x s, x ∈ P.boundary → 0 < s → s ≤ L⁻¹ →
0 < armSliceDensityMass P t x s ∧ armSliceDensityMass P t x s < ∞ := by
dsimp only
intro t x s hx hs hsL
let P := causalHardA1A2Law b cA delta w centers omega hb hscale hcA
hdelta hw hsep hcell
have hgeom := causalHardA1A2Law_geometry b cA delta w centers omega hb
hscale hcA hdelta hw hsep hcell
have hLpos : 0 < L := lt_of_lt_of_le (by norm_num) hL
have hs1 : s ≤ 1 := hsL.trans ((inv_le_one₀ hLpos).2 (by linarith))
apply causalHardDensitySlice_finite_pos P hgeom.2.1 hgeom.2.2.1
· exact (causalHardScoreDensity_continuous centers omega hb hscale).measurable
· intro z
exact (causalHardScoreDensity_mem_Icc hcA hdelta hw hsep omega z).1
· intro z
exact (causalHardScoreDensity_mem_Icc hcA hdelta hw hsep omega z).2
· exact hgeom.2.2.2 ▸ hx
· exact hs
· exact hs1
Causal.Hypercube.PotentialOutcomeLaw 6 declarations This module assembles two pointwise Bernoulli selected kernels over a common score design into the (Y(0),Y(1),X) law carried by A1A2Law.
Explicit potential-outcome laws for the causal angular family
This module assembles two pointwise Bernoulli selected kernels over a common
score design into the (Y(0),Y(1),X) law carried by A1A2Law. In particular,
the selected kernels in the resulting decorated law are the same kernels used
to build its joint measure, so the disintegration field is exact.
def causalBernoulliPotentialOutcomeMeasure Definition causalBernoulliPotentialOutcomeMeasure in the paper ↗
The joint potential-outcome measure obtained by drawing the score and then two conditionally independent Bernoulli potential outcomes.
Definition (Lean source)
-- @node: causalBernoulliPotentialOutcomeMeasure
noncomputable def causalBernoulliPotentialOutcomeMeasure
(nu : Measure Score) (p0 p1 : Score → ℝ)
(hp0 : Measurable p0) (hp1 : Measurable p1) : Measure CausalObservation :=
Measure.map (fun z : Score × (ℝ × ℝ) => (z.2.1, z.2.2, z.1))
(Measure.compProd nu
(Kernel.prod (causalSelectedBernoulliKernel p0 hp0)
(causalSelectedBernoulliKernel p1 hp1)))
theorem causalBernoulliPotentialOutcomeMeasure_map_score
The score marginal of the explicit potential-outcome measure is its input design measure.
Formal statement
hypotheses
nu :
p0 p1 :
Score → ℝ
hp0 :
Measurable p0
hp1 :
Measurable p1
hp0lo :
∀ x, 0 ≤ p0 x
hp0hi :
∀ x, p0 x ≤ 1
hp1lo :
∀ x, 0 ≤ p1 x
hp1hi :
∀ x, p1 x ≤ 1
conclusion
Measure.map causalScore (causalBernoulliPotentialOutcomeMeasure nu p0 p1 hp0 hp1) = nu
Proof (Lean source)
-- @node: causalBernoulliPotentialOutcomeMeasure_map_score
lemma causalBernoulliPotentialOutcomeMeasure_map_score
(nu : Measure Score) [IsProbabilityMeasure nu]
(p0 p1 : Score → ℝ) (hp0 : Measurable p0) (hp1 : Measurable p1)
(hp0lo : ∀ x, 0 ≤ p0 x) (hp0hi : ∀ x, p0 x ≤ 1)
(hp1lo : ∀ x, 0 ≤ p1 x) (hp1hi : ∀ x, p1 x ≤ 1) :
Measure.map causalScore
(causalBernoulliPotentialOutcomeMeasure nu p0 p1 hp0 hp1) = nu := by
letI : IsMarkovKernel (causalSelectedBernoulliKernel p0 hp0) :=
causalSelectedBernoulliKernel_isMarkovKernel p0 hp0 hp0lo hp0hi
letI : IsMarkovKernel (causalSelectedBernoulliKernel p1 hp1) :=
causalSelectedBernoulliKernel_isMarkovKernel p1 hp1 hp1lo hp1hi
unfold causalBernoulliPotentialOutcomeMeasure
rw [Measure.map_map (by unfold causalScore; fun_prop) (by fun_prop)]
change Measure.map fst
(Measure.compProd nu
(Kernel.prod (causalSelectedBernoulliKernel p0 hp0)
(causalSelectedBernoulliKernel p1 hp1))) = nu
exact Measure.fst_compProd _ _
theorem causalBernoulliPotentialOutcomeMeasure_isProbabilityMeasure
The explicit potential-outcome measure is a probability law.
Formal statement
hypotheses
nu :
p0 p1 :
Score → ℝ
hp0 :
Measurable p0
hp1 :
Measurable p1
hp0lo :
∀ x, 0 ≤ p0 x
hp0hi :
∀ x, p0 x ≤ 1
hp1lo :
∀ x, 0 ≤ p1 x
hp1hi :
∀ x, p1 x ≤ 1
conclusion
IsProbabilityMeasure (causalBernoulliPotentialOutcomeMeasure nu p0 p1 hp0 hp1)
Proof (Lean source)
-- @node: causalBernoulliPotentialOutcomeMeasure_isProbabilityMeasure
lemma causalBernoulliPotentialOutcomeMeasure_isProbabilityMeasure
(nu : Measure Score) [IsProbabilityMeasure nu]
(p0 p1 : Score → ℝ) (hp0 : Measurable p0) (hp1 : Measurable p1)
(hp0lo : ∀ x, 0 ≤ p0 x) (hp0hi : ∀ x, p0 x ≤ 1)
(hp1lo : ∀ x, 0 ≤ p1 x) (hp1hi : ∀ x, p1 x ≤ 1) :
IsProbabilityMeasure
(causalBernoulliPotentialOutcomeMeasure nu p0 p1 hp0 hp1) := by
letI : IsMarkovKernel (causalSelectedBernoulliKernel p0 hp0) :=
causalSelectedBernoulliKernel_isMarkovKernel p0 hp0 hp0lo hp0hi
letI : IsMarkovKernel (causalSelectedBernoulliKernel p1 hp1) :=
causalSelectedBernoulliKernel_isMarkovKernel p1 hp1 hp1lo hp1hi
unfold causalBernoulliPotentialOutcomeMeasure
exact Measure.isProbabilityMeasure_map (by fun_prop)
theorem causalBernoulliPotentialOutcomeMeasure_restrict_score_eq
Restricting two explicit potential-outcome laws to a measurable score cell gives the same measure when their restricted score designs agree and both Bernoulli profiles agree throughout that cell.
Formal statement
hypotheses
p0 p1 p0' p1' :
Score → ℝ
hp0 :
Measurable p0
hp1 :
Measurable p1
hp0' :
Measurable p0'
hp1' :
Measurable p1'
hp0lo :
∀ x, 0 ≤ p0 x
hp0hi :
∀ x, p0 x ≤ 1
hp1lo :
∀ x, 0 ≤ p1 x
hp1hi :
∀ x, p1 x ≤ 1
hp0lo' :
∀ x, 0 ≤ p0' x
hp0hi' :
∀ x, p0' x ≤ 1
hp1lo' :
∀ x, 0 ≤ p1' x
hp1hi' :
∀ x, p1' x ≤ 1
hC :
hnu :
nu.restrict C = nu'.restrict C
hparam0 :
∀ x ∈ C, p0 x = p0' x
hparam1 :
∀ x ∈ C, p1 x = p1' x
conclusion
Proof (Lean source)
-- @node: causalBernoulliPotentialOutcomeMeasure_restrict_score_eq
lemma causalBernoulliPotentialOutcomeMeasure_restrict_score_eq
(nu nu' : Measure Score) [SFinite nu] [SFinite nu']
(p0 p1 p0' p1' : Score → ℝ)
(hp0 : Measurable p0) (hp1 : Measurable p1)
(hp0' : Measurable p0') (hp1' : Measurable p1')
(hp0lo : ∀ x, 0 ≤ p0 x) (hp0hi : ∀ x, p0 x ≤ 1)
(hp1lo : ∀ x, 0 ≤ p1 x) (hp1hi : ∀ x, p1 x ≤ 1)
(hp0lo' : ∀ x, 0 ≤ p0' x) (hp0hi' : ∀ x, p0' x ≤ 1)
(hp1lo' : ∀ x, 0 ≤ p1' x) (hp1hi' : ∀ x, p1' x ≤ 1)
{C : Set Score} (hC : MeasurableSet C)
(hnu : nu.restrict C = nu'.restrict C)
(hparam0 : ∀ x ∈ C, p0 x = p0' x)
(hparam1 : ∀ x ∈ C, p1 x = p1' x) :
(causalBernoulliPotentialOutcomeMeasure nu p0 p1 hp0 hp1).restrict
{z | causalScore z ∈ C} =
(causalBernoulliPotentialOutcomeMeasure nu' p0' p1' hp0' hp1').restrict
{z | causalScore z ∈ C} := by
let k0 := causalSelectedBernoulliKernel p0 hp0
let k1 := causalSelectedBernoulliKernel p1 hp1
let k0' := causalSelectedBernoulliKernel p0' hp0'
let k1' := causalSelectedBernoulliKernel p1' hp1'
letI : IsMarkovKernel k0 :=
causalSelectedBernoulliKernel_isMarkovKernel p0 hp0 hp0lo hp0hi
letI : IsMarkovKernel k1 :=
causalSelectedBernoulliKernel_isMarkovKernel p1 hp1 hp1lo hp1hi
letI : IsMarkovKernel k0' :=
causalSelectedBernoulliKernel_isMarkovKernel p0' hp0' hp0lo' hp0hi'
letI : IsMarkovKernel k1' :=
causalSelectedBernoulliKernel_isMarkovKernel p1' hp1' hp1lo' hp1hi'
ext s hs
rw [Measure.restrict_apply hs, Measure.restrict_apply hs]
unfold causalBernoulliPotentialOutcomeMeasure
have hE : MeasurableSet (s ∩ {z : CausalObservation | causalScore z ∈ C}) :=
hs.inter (hC.preimage (by unfold causalScore; fun_prop))
rw [Measure.map_apply (by fun_prop) hE, Measure.map_apply (by fun_prop) hE]
have hpre : MeasurableSet
((fun z : Score × (ℝ × ℝ) => (z.2.1, z.2.2, z.1)) ⁻¹'
(s ∩ {z : CausalObservation | causalScore z ∈ C})) :=
hE.preimage (by fun_prop)
rw [Measure.compProd_apply hpre, Measure.compProd_apply hpre]
have hsupp : support (fun x ↦
(Kernel.prod k0 k1 x)
(Prod.mk x ⁻¹' ((fun z : Score × (ℝ × ℝ) =>
(z.2.1, z.2.2, z.1)) ⁻¹'
(s ∩ {z : CausalObservation | causalScore z ∈ C})))) ⊆ C := by
intro x hx
by_contra hxC
apply hx
simp [causalScore, hxC]
have hsupp' : support (fun x ↦
(Kernel.prod k0' k1' x)
(Prod.mk x ⁻¹' ((fun z : Score × (ℝ × ℝ) =>
(z.2.1, z.2.2, z.1)) ⁻¹'
(s ∩ {z : CausalObservation | causalScore z ∈ C})))) ⊆ C := by
intro x hx
by_contra hxC
apply hx
simp [causalScore, hxC]
rw [← setLIntegral_eq_of_support_subset hsupp,
← setLIntegral_eq_of_support_subset hsupp', hnu]
apply lintegral_congr_ae
filter_upwards [ae_restrict_mem hC] with x hx
have hk0 : k0 x = k0' x := by
ext A hA
simp [k0, k0', causalSelectedBernoulliKernel, hparam0 x hx]
have hk1 : k1 x = k1' x := by
ext A hA
simp [k1, k1', causalSelectedBernoulliKernel, hparam1 x hx]
rw [Kernel.prod_apply, Kernel.prod_apply, hk0, hk1]
theorem causalBernoulliPotentialOutcomeMeasure_map_score_arm
Mapping the explicit law to (X,Y(t)) recovers composition with the selected arm-t Bernoulli kernel.
Formal statement
hypotheses
nu :
p0 p1 :
Score → ℝ
hp0 :
Measurable p0
hp1 :
Measurable p1
hp0lo :
∀ x, 0 ≤ p0 x
hp0hi :
∀ x, p0 x ≤ 1
hp1lo :
∀ x, 0 ≤ p1 x
hp1hi :
∀ x, p1 x ≤ 1
t :
conclusion
Measure.map (fun w => (causalScore w, armCoord t w)) (causalBernoulliPotentialOutcomeMeasure nu p0 p1 hp0 hp1)
= Measure.compProd nu (if t then causalSelectedBernoulliKernel p1 hp1 else causalSelectedBernoulliKernel p0 hp0)
Proof (Lean source)
-- @node: causalBernoulliPotentialOutcomeMeasure_map_score_arm
lemma causalBernoulliPotentialOutcomeMeasure_map_score_arm
(nu : Measure Score) [IsProbabilityMeasure nu]
(p0 p1 : Score → ℝ) (hp0 : Measurable p0) (hp1 : Measurable p1)
(hp0lo : ∀ x, 0 ≤ p0 x) (hp0hi : ∀ x, p0 x ≤ 1)
(hp1lo : ∀ x, 0 ≤ p1 x) (hp1hi : ∀ x, p1 x ≤ 1) (t : Bool) :
Measure.map (fun w => (causalScore w, armCoord t w))
(causalBernoulliPotentialOutcomeMeasure nu p0 p1 hp0 hp1) =
Measure.compProd nu
(if t then causalSelectedBernoulliKernel p1 hp1
else causalSelectedBernoulliKernel p0 hp0) := by
let k0 := causalSelectedBernoulliKernel p0 hp0
let k1 := causalSelectedBernoulliKernel p1 hp1
letI : IsMarkovKernel k0 :=
causalSelectedBernoulliKernel_isMarkovKernel p0 hp0 hp0lo hp0hi
letI : IsMarkovKernel k1 :=
causalSelectedBernoulliKernel_isMarkovKernel p1 hp1 hp1lo hp1hi
cases t with
| false =>
unfold causalBernoulliPotentialOutcomeMeasure
rw [Measure.map_map
(by
simp only [causalScore, armCoord]
exact (measurable_snd.comp measurable_snd).prodMk measurable_fst)
(by fun_prop)]
change Measure.map (map id fst)
(Measure.compProd nu (Kernel.prod k0 k1)) = Measure.compProd nu k0
rw [← Measure.compProd_map (μ := nu) (κ := Kernel.prod k0 k1)
measurable_fst]
rw [show (Kernel.prod k0 k1).map fst = k0 by
simpa [Kernel.fst_eq] using Kernel.fst_prod k0 k1]
| true =>
unfold causalBernoulliPotentialOutcomeMeasure
rw [Measure.map_map
(by
simp only [causalScore, armCoord]
exact (measurable_snd.comp measurable_snd).prodMk
(measurable_fst.comp measurable_snd))
(by fun_prop)]
change Measure.map (map id snd)
(Measure.compProd nu (Kernel.prod k0 k1)) = Measure.compProd nu k1
rw [← Measure.compProd_map (μ := nu) (κ := Kernel.prod k0 k1)
measurable_snd]
rw [show (Kernel.prod k0 k1).map snd = k1 by
simpa [Kernel.snd_eq] using Kernel.snd_prod k0 k1]
Package the explicit two-kernel construction as a decorated A1A2Law. All pointwise conditional fields are definitionally tied to the same selected Bernoulli kernels used to assemble the joint potential-outcome measure.
Definition (Lean source)
-- @node: causalBernoulliA1A2Law
noncomputable def causalBernoulliA1A2Law
(nu : Measure Score) [IsProbabilityMeasure nu]
(S A0 A1 B : Set Score) (density p0 p1 : Score → ℝ)
(hp0 : Measurable p0) (hp1 : Measurable p1)
(hp0lo : ∀ x, 0 ≤ p0 x) (hp0hi : ∀ x, p0 x ≤ 1)
(hp1lo : ∀ x, 0 ≤ p1 x) (hp1hi : ∀ x, p1 x ≤ 1)
(hA0 : MeasurableSet A0) (hA1 : MeasurableSet A1)
(hpartition : A0 ∪ A1 = S ∧ Disjoint A0 A1)
(hboundary : B = frontier A0 ∩ frontier A1)
(hboundaryInterior : B ⊆ interior S)
(hmarginal : nu = volume.withDensity
(fun x => ofReal (S.indicator density x)))
(hsupport : S = nu.support) : A1A2Law where
law := causalBernoulliPotentialOutcomeMeasure nu p0 p1 hp0 hp1
support := S
A0 := A0
A1 := A1
boundary := B
A0_measurable := hA0
A1_measurable := hA1
assignment_partition := hpartition
boundary_eq := hboundary
boundary_subset_interior := hboundaryInterior
density := density
muPO := fun t => if t then p1 else p0
sigmaSqPO := fun t x =>
let p := if t then p1 x else p0 x
p * (1 - p)
condKer := fun t => if t then causalSelectedBernoulliKernel p1 hp1
else causalSelectedBernoulliKernel p0 hp0
law_isProbability :=
causalBernoulliPotentialOutcomeMeasure_isProbabilityMeasure nu p0 p1 hp0 hp1
hp0lo hp0hi hp1lo hp1hi
condKer_markov := by
intro t
cases t with
| false =>
exact causalSelectedBernoulliKernel_isMarkovKernel p0 hp0 hp0lo hp0hi
| true =>
exact causalSelectedBernoulliKernel_isMarkovKernel p1 hp1 hp1lo hp1hi
marginal_eq := by
rw [causalBernoulliPotentialOutcomeMeasure_map_score nu p0 p1 hp0 hp1
hp0lo hp0hi hp1lo hp1hi]
exact hmarginal
support_eq_marginal_support := by
rw [causalBernoulliPotentialOutcomeMeasure_map_score nu p0 p1 hp0 hp1
hp0lo hp0hi hp1lo hp1hi]
exact hsupport
condKer_disint := by
intro t
rw [causalBernoulliPotentialOutcomeMeasure_map_score nu p0 p1 hp0 hp1
hp0lo hp0hi hp1lo hp1hi]
exact (causalBernoulliPotentialOutcomeMeasure_map_score_arm nu p0 p1 hp0 hp1
hp0lo hp0hi hp1lo hp1hi t).symm
mu_condMean := by
intro t
filter_upwards [] with x
cases t with
| false =>
exact (causalSelectedBernoulliKernel_integral_id p0 hp0 hp0lo hp0hi x).symm
| true =>
exact (causalSelectedBernoulliKernel_integral_id p1 hp1 hp1lo hp1hi x).symm
sigmaSq_condVar := by
intro t
filter_upwards [] with x
cases t with
| false =>
exact (causalSelectedBernoulliKernel_variance_id p0 hp0 hp0lo hp0hi x).symm
| true =>
exact (causalSelectedBernoulliKernel_variance_id p1 hp1 hp1lo hp1hi x).symm
Causal.Hypercube.Profiles 9 declarations This file specializes the existing smooth packing regression to the wider fixed square.
Bounded potential-outcome profiles for the causal hard square
This file specializes the existing smooth packing regression to the wider fixed square. The smaller affine slope leaves room for one positive local bump while keeping every Bernoulli parameter in the middle half.
The common control-arm Bernoulli success profile.
Definition (Lean source)
-- @node: causalHardControlProfile
noncomputable def causalHardControlProfile (_x : Score) : ℝ := 1 / 2
The treatment-arm profile with one smooth local bump per active bit.
Definition (Lean source)
-- @node: causalHardTreatmentProfile
noncomputable def causalHardTreatmentProfile {M : ℕ} (delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) : Score → ℝ :=
clippedPackingRegression (1 / 16) delta w centers omega
theorem causalHardProfiles_measurable
Both hard-family potential-outcome profiles are Borel measurable.
Formal statement
hypotheses
conclusion
Measurable (causalHardTreatmentProfile delta w centers omega)
Proof (Lean source)
-- @node: causalHardProfiles_measurable
lemma causalHardProfiles_measurable {M : ℕ} (delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) :
Measurable causalHardControlProfile ∧
Measurable (causalHardTreatmentProfile delta w centers omega) := by
exact ⟨measurable_const,
clippedPackingRegression_measurable (1 / 16) delta w centers omega⟩
theorem causalHardProfiles_mem_unitInterval
The globally clipped profiles take values in the unit interval.
Formal statement
hypotheses
conclusion
causalHardControlProfile x ∈ Icc (0 : ℝ) 1 ∧
causalHardTreatmentProfile delta w centers omega x ∈ Icc (0 : ℝ) 1
Proof (Lean source)
-- @node: causalHardProfiles_mem_unitInterval
lemma causalHardProfiles_mem_unitInterval {M : ℕ} (delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) (x : Score) :
causalHardControlProfile x ∈ Icc (0 : ℝ) 1 ∧
causalHardTreatmentProfile delta w centers omega x ∈ Icc (0 : ℝ) 1 := by
exact ⟨by norm_num [causalHardControlProfile],
clippedPackingRegression_mem_Icc (1 / 16) delta w centers omega x⟩
theorem causalHardPackingRegression_mem_middleHalf
On the fixed square, the underlying smooth packing regression remains in the middle half of the unit interval.
Formal statement
hypotheses
M :
ℕ
delta w :
ℝ
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
hx :
x ∈ causalHardSquare
conclusion
packingRegression (1 / 16) delta w centers omega x ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ)
Proof (Lean source)
-- @node: causalHardPackingRegression_mem_middleHalf
lemma causalHardPackingRegression_mem_middleHalf {M : ℕ} {delta w : ℝ}
(hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 16) (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {x : Score} (hx : x ∈ causalHardSquare) :
packingRegression (1 / 16) delta w centers omega x ∈
Icc (1 / 4 : ℝ) (3 / 4 : ℝ) := by
have hsum := packingRegression_bump_sum_mem_Icc hdelta0 hw hsep omega x
have hx0 := hx (0 : Fin 2)
unfold packingRegression packingAffineBaseline
constructor <;> nlinarith [hsum.1, hsum.2]
theorem causalHardTreatmentProfile_mem_middleHalf
On the fixed square, a bump of amplitude at most 1/16 keeps the treatment profile in [1/4,3/4], so global clipping is silent there.
Formal statement
hypotheses
M :
ℕ
delta w :
ℝ
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
hx :
x ∈ causalHardSquare
conclusion
causalHardTreatmentProfile delta w centers omega x ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ)
Proof (Lean source)
-- @node: causalHardTreatmentProfile_mem_middleHalf
lemma causalHardTreatmentProfile_mem_middleHalf {M : ℕ} {delta w : ℝ}
(hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 16) (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {x : Score} (hx : x ∈ causalHardSquare) :
causalHardTreatmentProfile delta w centers omega x ∈
Icc (1 / 4 : ℝ) (3 / 4 : ℝ) := by
have hraw := causalHardPackingRegression_mem_middleHalf
hdelta0 hdelta hw hsep omega hx
unfold causalHardTreatmentProfile
rw [clippedPackingRegression_eq_of_mem_Icc
(show packingRegression (1 / 16) delta w centers omega x ∈
Icc (0 : ℝ) 1 by
exact ⟨hraw.1.trans' (by norm_num), hraw.2.trans (by norm_num)⟩)]
exact hraw
theorem causalHardTreatmentProfile_eq_packingRegression_on_square
On the hard square the global clip is inactive, so the treatment profile agrees with the underlying smooth affine-plus-bump regression.
Formal statement
hypotheses
M :
ℕ
delta w :
ℝ
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
conclusion
EqOn (causalHardTreatmentProfile delta w centers omega) (packingRegression (1 / 16) delta w centers omega) causalHardSquare
Proof (Lean source)
-- @node: causalHardTreatmentProfile_eq_packingRegression_on_square
lemma causalHardTreatmentProfile_eq_packingRegression_on_square {M : ℕ}
{delta w : ℝ} (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 16)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) :
EqOn (causalHardTreatmentProfile delta w centers omega)
(packingRegression (1 / 16) delta w centers omega) causalHardSquare := by
intro x hx
unfold causalHardTreatmentProfile
apply clippedPackingRegression_eq_of_mem_Icc
have hm := causalHardPackingRegression_mem_middleHalf hdelta0 hdelta hw hsep
omega hx
exact ⟨hm.1.trans' (by norm_num), hm.2.trans (by norm_num)⟩
theorem causalHardTreatmentProfile_has_smooth_extension
The treatment profile on the hard square is the restriction of a globally smooth affine-plus-bump function.
Formal statement
Proof (Lean source)
-- @node: causalHardTreatmentProfile_has_smooth_extension
lemma causalHardTreatmentProfile_has_smooth_extension {M : ℕ} (j : ℕ)
{delta w : ℝ} (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 16)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) :
∃ g : Score → ℝ, ContDiff ℝ j g ∧
EqOn g (causalHardTreatmentProfile delta w centers omega)
causalHardSquare := by
refine ⟨packingRegression (1 / 16) delta w centers omega,
(packingRegression_contDiff (1 / 16) delta w centers omega).of_le
(WithTop.coe_le_coe.mpr le_top), ?_⟩
exact (causalHardTreatmentProfile_eq_packingRegression_on_square hdelta0
hdelta hw hsep omega).symm
theorem causalHardTreatmentProfile_center_flip
Flipping one bit changes the treatment regression at its center by exactly the bump amplitude.
Formal statement
hypotheses
M :
ℕ
delta w :
ℝ
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcenter :
∀ j, centers j ∈ causalHardSquare
j :
Fin M
conclusion
|causalHardTreatmentProfile delta w centers omega (centers j)
- causalHardTreatmentProfile delta w centers (update omega j (!omega j)) (centers j)|
= delta
Proof (Lean source)
-- @node: causalHardTreatmentProfile_center_flip
lemma causalHardTreatmentProfile_center_flip {M : ℕ} {delta w : ℝ}
(hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 16) (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcenter : ∀ j, centers j ∈ causalHardSquare)
(omega : Fin M → Bool) (j : Fin M) :
|causalHardTreatmentProfile delta w centers omega (centers j) -
causalHardTreatmentProfile delta w centers
(update omega j (!omega j)) (centers j)| = delta := by
have hraw (eta : Fin M → Bool) :
causalHardTreatmentProfile delta w centers eta (centers j) =
packingRegression (1 / 16) delta w centers eta (centers j) := by
unfold causalHardTreatmentProfile
apply clippedPackingRegression_eq_of_mem_Icc
have hm := causalHardPackingRegression_mem_middleHalf hdelta0 hdelta hw hsep
eta (hcenter j)
exact ⟨hm.1.trans' (by norm_num), hm.2.trans (by norm_num)⟩
rw [hraw omega, hraw (update omega j (!omega j)),
packingRegression_center omega j hw hsep,
packingRegression_center (update omega j (!omega j)) j hw hsep]
simp only [Function.update_self]
cases omega j <;> simp [abs_of_nonneg hdelta0]
Causal.Hypercube.Regression 1 declarations Regression, selected-kernel moment, and Gram certificates
Regression, selected-kernel moment, and Gram certificates
theorem a1a2Hypercube_member_certified
Every hard-family member satisfies the Euclidean extension, conditional moment, variance, local-mass, and Gram-floor clauses through the single class certificate bundled in A1A2HypercubeAt.
Formal statement
hypotheses
conclusion
∃ P : A1A2Law,
A1A2Class p ν L P ∧
(∀ t x, x ∈ P.support → selectedA1A2CondAbsMoment P ν L t x ≤ ofReal L)
Proof (Lean source)
lemma a1a2Hypercube_member_certified
(p : ℕ) (ν L Δ c A C C0 : ℝ)
(h : A1A2HypercubeAt p ν L Δ c A C C0) :
∃ P : A1A2Law, A1A2Class p ν L P ∧
(∀ t x, x ∈ P.support →
selectedA1A2CondAbsMoment P ν L t x ≤ ofReal L) := by
rcases h with
⟨M, w, ρ, x, P, Q, hc, hA, hC, hC0, hp0, hρ, hM, hw, hρeq,
hx, hcell, hsep, hdisjoint, hclass, _⟩
refine ⟨P (fun _ => false), hclass _, ?_⟩
exact (hclass _).2.2.2.2.2.2.2.2.2.1
Causal.Hypercube.ScoreLaw 11 declarations This module puts the existing smooth angular tilt over the fixed square [-3,3]² with baseline density 1/36.
Angular score law on the causal hard square
This module puts the existing smooth angular tilt over the fixed square
[-3,3]² with baseline density 1/36. Complete-disk cancellation gives
normalization and exact bit-independent cell mass.
The causal hard-family score density: uniform background 1/36 plus the disjoint smooth angular tilts.
Definition (Lean source)
-- @node: causalHardScoreDensity
noncomputable def causalHardScoreDensity {M : ℕ} (b cA delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) (x : Score) : ℝ :=
(1 / 36 : ℝ) * packingAngularDensity b cA delta w centers omega x
The causal score measure supported on the fixed hard square.
Definition (Lean source)
-- @node: causalHardScoreMeasure
noncomputable def causalHardScoreMeasure {M : ℕ} (b cA delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) : Measure Score :=
volume.withDensity fun x =>
ofReal (causalHardSquare.indicator
(causalHardScoreDensity b cA delta w centers omega) x)
theorem causalHardScoreDensity_continuous
The causal hard score density is continuous on the whole score plane.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
conclusion
Continuous (causalHardScoreDensity b cA delta w centers omega)
Proof (Lean source)
-- @node: causalHardScoreDensity_continuous
lemma causalHardScoreDensity_continuous {M : ℕ} {b cA delta w : ℝ}
(centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) :
Continuous (causalHardScoreDensity b cA delta w centers omega) := by
unfold causalHardScoreDensity
exact continuous_const.mul
(packingAngularDensity_continuous hb hscale centers omega)
theorem causalHardScoreDensity_mem_Icc
Under three-bandwidth separation the causal density lies in the exact paper envelope [1/48,5/144].
Formal statement
Proof (Lean source)
-- @node: causalHardScoreDensity_mem_Icc
lemma causalHardScoreDensity_mem_Icc {M : ℕ} {b cA delta w : ℝ}
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (x : Score) :
causalHardScoreDensity b cA delta w centers omega x ∈
Icc (1 / 48 : ℝ) (5 / 144 : ℝ) := by
have h := packingAngularDensity_mem_Icc (b := b)
hcA hdelta hw hsep omega x
unfold causalHardScoreDensity
constructor <;> norm_num at h ⊢ <;> linarith
theorem causalHardScoreMeasure_support
Every admissible causal hard score law has the whole hard square as its exact topological support.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
conclusion
Proof (Lean source)
-- @node: causalHardScoreMeasure_support
lemma causalHardScoreMeasure_support {M : ℕ} {b cA delta w : ℝ}
(centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k)) :
(causalHardScoreMeasure b cA delta w centers omega).support =
causalHardSquare := by
let f : Score → ENNReal := fun x => ofReal
(causalHardScoreDensity b cA delta w centers omega x)
have hf : Measurable f := ENNReal.measurable_ofReal.comp
(causalHardScoreDensity_continuous centers omega hb hscale).measurable
have hf0 : ∀ x, f x ≠ 0 := by
intro x
exact ne_of_gt (ENNReal.ofReal_pos.mpr
((by norm_num : (0 : ℝ) < 1 / 48).trans_le
(causalHardScoreDensity_mem_Icc hcA hdelta hw hsep omega x).1))
have hfun : (fun x => ofReal (causalHardSquare.indicator
(causalHardScoreDensity b cA delta w centers omega) x)) =
causalHardSquare.indicator f := by
funext x
by_cases hx : x ∈ causalHardSquare
· rw [indicator_of_mem hx, indicator_of_mem hx]
· rw [indicator_of_notMem hx, indicator_of_notMem hx]
simp
have heq : causalHardScoreMeasure b cA delta w centers omega =
(volume.restrict causalHardSquare).withDensity f := by
unfold causalHardScoreMeasure
rw [hfun]
rw [withDensity_indicator causalHardSquare_measurableSet]
apply Set.Subset.antisymm
· calc
_ ⊆ (volume.restrict causalHardSquare).support := by
rw [heq]
exact (withDensity_absolutelyContinuous _ _).support_mono
_ = _ := volume_restrict_causalHardSquare_support
· calc
_ = (volume.restrict causalHardSquare).support :=
volume_restrict_causalHardSquare_support.symm
_ ⊆ _ := by
rw [heq]
exact (withDensity_absolutelyContinuous' hf.aemeasurable
(Filter.Eventually.of_forall hf0)).support_mono
theorem causalHardScoreMeasure_restrict_cell_eq
Restricting the causal score design to one packing cell erases every bit except the bit indexing that cell.
Formal statement
Proof (Lean source)
-- @node: causalHardScoreMeasure_restrict_cell_eq
lemma causalHardScoreMeasure_restrict_cell_eq {M : ℕ} {b cA delta w : ℝ}
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
{omega omega' : Fin M → Bool} {j : Fin M} (hbit : omega j = omega' j) :
(causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardCell (centers j) w) =
(causalHardScoreMeasure b cA delta w centers omega').restrict
(causalHardCell (centers j) w) := by
have hC : MeasurableSet (causalHardCell (centers j) w) :=
Metric.isClosed_closedBall.measurableSet
ext s hs
rw [Measure.restrict_apply hs, Measure.restrict_apply hs]
unfold causalHardScoreMeasure
rw [withDensity_apply _ (hs.inter hC), withDensity_apply _ (hs.inter hC)]
apply lintegral_congr_ae
filter_upwards [ae_restrict_mem (hs.inter hC)] with x hx
apply congrArg ENNReal.ofReal
by_cases hxS : x ∈ causalHardSquare
· rw [indicator_of_mem hxS, indicator_of_mem hxS]
unfold causalHardScoreDensity
rw [packingAngularDensity_eq_on_cell hw hsep hbit hx.2]
· rw [indicator_of_notMem hxS, indicator_of_notMem hxS]
theorem causalHardScoreMeasure_restrict_off_cells_eq
Away from all packing cells, every causal hard score law has the same restriction.
Formal statement
hypotheses
conclusion
(causalHardScoreMeasure b cA delta w centers omega).restrict (causalHardSquare \ ⋃ j, causalHardCell (centers j) w)
= (causalHardScoreMeasure b cA delta w centers omega').restrict (causalHardSquare \ ⋃ j, causalHardCell (centers j) w)
Proof (Lean source)
-- @node: causalHardScoreMeasure_restrict_off_cells_eq
lemma causalHardScoreMeasure_restrict_off_cells_eq {M : ℕ}
{b cA delta w : ℝ} (hw : 0 < w) {centers : Fin M → Score}
(omega omega' : Fin M → Bool) :
(causalHardScoreMeasure b cA delta w centers omega).restrict
(causalHardSquare \ ⋃ j, causalHardCell (centers j) w) =
(causalHardScoreMeasure b cA delta w centers omega').restrict
(causalHardSquare \ ⋃ j, causalHardCell (centers j) w) := by
let C := causalHardSquare \ ⋃ j, causalHardCell (centers j) w
have hC : MeasurableSet C := causalHardSquare_measurableSet.diff
(MeasurableSet.iUnion fun _ => Metric.isClosed_closedBall.measurableSet)
ext s hs
rw [Measure.restrict_apply hs, Measure.restrict_apply hs]
unfold causalHardScoreMeasure
rw [withDensity_apply _ (hs.inter hC), withDensity_apply _ (hs.inter hC)]
apply lintegral_congr_ae
filter_upwards [ae_restrict_mem (hs.inter hC)] with x hx
have hxBalls : ∀ j, x ∉ closedBall (centers j) w := by
intro j hxj
exact hx.2.2 (Set.mem_iUnion.2 ⟨j, hxj⟩)
rw [indicator_of_mem hx.2.1, indicator_of_mem hx.2.1]
unfold causalHardScoreDensity
rw [packingAngularDensity_eq_one_off_cells hw omega hxBalls,
packingAngularDensity_eq_one_off_cells hw omega' hxBalls]
theorem causalHardScoreMeasure_restrict_compl_cells_eq
Restricting to the complement of all hard cells is bit-independent. This version includes the zero-mass region outside the hard square and therefore matches the full-law hypercube locality clause directly.
Formal statement
hypotheses
conclusion
= (causalHardScoreMeasure b cA delta w centers omega').restrict ((⋃ j, causalHardCell (centers j) w)ᶜ)
Proof (Lean source)
-- @node: causalHardScoreMeasure_restrict_compl_cells_eq
lemma causalHardScoreMeasure_restrict_compl_cells_eq {M : ℕ}
{b cA delta w : ℝ} (hw : 0 < w) {centers : Fin M → Score}
(omega omega' : Fin M → Bool) :
(causalHardScoreMeasure b cA delta w centers omega).restrict
((⋃ j, causalHardCell (centers j) w)ᶜ) =
(causalHardScoreMeasure b cA delta w centers omega').restrict
((⋃ j, causalHardCell (centers j) w)ᶜ) := by
let C := (⋃ j, causalHardCell (centers j) w)ᶜ
have hC : MeasurableSet C :=
(MeasurableSet.iUnion fun _ ↦ Metric.isClosed_closedBall.measurableSet).compl
ext s hs
rw [Measure.restrict_apply hs, Measure.restrict_apply hs]
unfold causalHardScoreMeasure
rw [withDensity_apply _ (hs.inter hC), withDensity_apply _ (hs.inter hC)]
apply lintegral_congr_ae
filter_upwards [ae_restrict_mem (hs.inter hC)] with x hx
by_cases hxS : x ∈ causalHardSquare
· rw [indicator_of_mem hxS, indicator_of_mem hxS]
unfold causalHardScoreDensity
have hxBalls : ∀ j, x ∉ causalHardCell (centers j) w := by
intro j hxj
exact hx.2 (Set.mem_iUnion.2 ⟨j, hxj⟩)
rw [packingAngularDensity_eq_one_off_cells hw omega hxBalls,
packingAngularDensity_eq_one_off_cells hw omega' hxBalls]
· rw [indicator_of_notMem hxS, indicator_of_notMem hxS]
theorem causalHardPackingDensity_integral_square
The unscaled angular density integrates to the hard square's area.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hw :
0 < w
hcell :
∀ j, closedBall (centers j) w ⊆ causalHardSquare
conclusion
Proof (Lean source)
-- @node: causalHardPackingDensity_integral_square
lemma causalHardPackingDensity_integral_square {M : ℕ}
{b cA delta w : ℝ} (centers : Fin M → Score)
(omega : Fin M → Bool) (hb : 0 < b) (hscale : 0 < cA * delta)
(hw : 0 < w)
(hcell : ∀ j, closedBall (centers j) w ⊆ causalHardSquare) :
(∫ x : Score in causalHardSquare,
packingAngularDensity b cA delta w centers omega x) = 36 := by
have hconst : IntegrableOn (fun _ : Score ↦ (1 : ℝ)) causalHardSquare :=
continuous_const.continuousOn.integrableOn_compact causalHardSquare_isCompact
have hterms : ∀ j : Fin M, IntegrableOn
(fun x : Score ↦ if omega j then
packingAngularTerm b cA delta w (centers j) x else 0)
causalHardSquare := by
intro j
by_cases hj : omega j = true
· simpa [hj] using
(packingAngularTerm_continuous hb hscale
(centers j)).continuousOn.integrableOn_compact causalHardSquare_isCompact
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simpa [hjf] using
continuous_const.continuousOn.integrableOn_compact
(K := causalHardSquare) causalHardSquare_isCompact
unfold packingAngularDensity
rw [integral_add hconst (integrable_finset_sum _ fun j _ ↦ hterms j)]
rw [integral_const]
change ((volume.restrict causalHardSquare) univ).toReal * 1 + _ = 36
rw [Measure.restrict_apply MeasurableSet.univ, Set.univ_inter,
causalHardSquare_volume]
norm_num
have hz : (∫ x : Score in causalHardSquare,
∑ j, if omega j then
packingAngularTerm b cA delta w (centers j) x else 0) = 0 := by
rw [integral_finset_sum _ fun j _ ↦ hterms j]
apply Finset.sum_eq_zero
intro j _
by_cases hj : omega j = true
· simp only [hj, if_true]
rw [setIntegral_eq_of_subset_of_forall_diff_eq_zero
causalHardSquare_measurableSet (hcell j)]
· exact packingAngularTerm_integral_closedBall (b := b) (cA := cA)
(delta := delta) (w := w) (centers j)
· rintro x ⟨_, hxBall⟩
apply packingAngularTerm_eq_zero_of_bandwidth_le_dist hw
exact (not_le.mp (by simpa [Metric.mem_closedBall] using hxBall)).le
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simp [hjf]
rw [hz]
theorem causalHardScoreMeasure_isProbabilityMeasure
The angular score measure is normalized to total mass one.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
∀ j, closedBall (centers j) w ⊆ causalHardSquare
conclusion
IsProbabilityMeasure (causalHardScoreMeasure b cA delta w centers omega)
Proof (Lean source)
-- @node: causalHardScoreMeasure_isProbabilityMeasure
lemma causalHardScoreMeasure_isProbabilityMeasure {M : ℕ}
{b cA delta w : ℝ} (centers : Fin M → Score)
(omega : Fin M → Bool) (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : ∀ j, closedBall (centers j) w ⊆ causalHardSquare) :
IsProbabilityMeasure (causalHardScoreMeasure b cA delta w centers omega) := by
rw [isProbabilityMeasure_iff, causalHardScoreMeasure,
withDensity_apply _ MeasurableSet.univ]
have hcont := causalHardScoreDensity_continuous (w := w)
centers omega hb hscale
have hint : Integrable
(causalHardSquare.indicator
(causalHardScoreDensity b cA delta w centers omega)) volume :=
(hcont.continuousOn.integrableOn_compact
causalHardSquare_isCompact).integrable_indicator causalHardSquare_measurableSet
have hnonneg : 0 ≤ᵐ[volume]
causalHardSquare.indicator
(causalHardScoreDensity b cA delta w centers omega) := by
filter_upwards with x
by_cases hx : x ∈ causalHardSquare
· rw [Set.indicator_of_mem hx]
exact (by norm_num : (0 : ℝ) ≤ 1 / 48).trans
(causalHardScoreDensity_mem_Icc hcA hdelta hw hsep omega x).1
· rw [Set.indicator_of_notMem hx]
exact le_rfl
simp only [Measure.restrict_univ]
rw [← ofReal_integral_eq_lintegral_ofReal hint hnonneg]
rw [integral_indicator causalHardSquare_measurableSet]
unfold causalHardScoreDensity
rw [integral_const_mul,
causalHardPackingDensity_integral_square centers omega hb hscale hw hcell]
norm_num
theorem causalHardScoreMeasure_cell_mass
Every complete packing cell has the exact bit-independent probability pi * w² / 36.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hcell :
closedBall (centers j) w ⊆ causalHardSquare
conclusion
causalHardScoreMeasure b cA delta w centers omega (closedBall (centers j) w)
Proof (Lean source)
-- @node: causalHardScoreMeasure_cell_mass
lemma causalHardScoreMeasure_cell_mass {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(hcell : closedBall (centers j) w ⊆ causalHardSquare) :
causalHardScoreMeasure b cA delta w centers omega
(closedBall (centers j) w) =
ofReal (pi * w ^ 2 / 36) := by
rw [causalHardScoreMeasure, withDensity_apply _
Metric.isClosed_closedBall.measurableSet]
have hcont := causalHardScoreDensity_continuous (w := w)
centers omega hb hscale
have hint : IntegrableOn
(causalHardScoreDensity b cA delta w centers omega)
(closedBall (centers j) w) :=
hcont.continuousOn.integrableOn_compact (isCompact_closedBall _ _)
have hnonneg : 0 ≤ᵐ[volume.restrict (closedBall (centers j) w)]
causalHardScoreDensity b cA delta w centers omega := by
filter_upwards with x
exact (by norm_num : (0 : ℝ) ≤ 1 / 48).trans
(causalHardScoreDensity_mem_Icc hcA hdelta hw hsep omega x).1
have hind : (∀ᵐ x ∂volume.restrict (closedBall (centers j) w),
causalHardSquare.indicator
(causalHardScoreDensity b cA delta w centers omega) x =
causalHardScoreDensity b cA delta w centers omega x) := by
filter_upwards [ae_restrict_mem Metric.isClosed_closedBall.measurableSet]
with x hx
rw [Set.indicator_of_mem (hcell hx)]
have hind' : (∀ᵐ x ∂volume.restrict (closedBall (centers j) w),
ofReal (causalHardSquare.indicator
(causalHardScoreDensity b cA delta w centers omega) x) =
ofReal (causalHardScoreDensity b cA delta w centers omega x)) := by
filter_upwards [hind] with x hx
rw [hx]
rw [lintegral_congr_ae hind']
rw [← ofReal_integral_eq_lintegral_ofReal hint hnonneg]
unfold causalHardScoreDensity
rw [integral_const_mul,
packingAngularDensity_integral_closedBall j centers omega hb hscale hw hsep]
rw [show volume (closedBall (centers j) w) =
ofReal (pi * w ^ 2) by
exact causalHardCell_volume (centers j) w hw.le]
rw [ENNReal.toReal_ofReal (by positivity : 0 ≤ pi * w ^ 2)]
congr 1
ring
Causal.Hypercube.SmoothEnvelope 3 declarations This module converts the normalized bump derivative bounds into the exact coordinate-partial extension envelope required by A1A2Class.
Smooth extension leaf for the hard-square treatment profile
This module converts the normalized bump derivative bounds into the exact
coordinate-partial extension envelope required by A1A2Class.
theorem causalHardTreatmentProfile_euclideanCExtEnvelope_of_scaling_bounds
If the finitely many normalized bump derivatives through order p + 1 obey their paper-scale bounds, the hard treatment profile has the required Euclidean smooth extension for every envelope at least 48.
Formal statement
hypotheses
M :
ℕ
p :
ℕ
L delta w :
ℝ
hL :
48 ≤ L
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
C :
ℕ → ℝ
hC0 :
∀ j, 0 ≤ C j
hC :
∀ j z, ‖iteratedFDeriv ℝ j packingBump z‖ ≤ C j
hscale :
∀ j
if
j ≤ p + 1
then
|delta| * (w⁻¹) ^ j * C j ≤ 1
conclusion
Proof (Lean source)
-- @node: causalHardTreatmentProfile_euclideanCExtEnvelope_of_scaling_bounds
lemma causalHardTreatmentProfile_euclideanCExtEnvelope_of_scaling_bounds
{M : ℕ} (p : ℕ) {L delta w : ℝ}
(hL : 48 ≤ L) (hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 16)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (C : ℕ → ℝ) (hC0 : ∀ j, 0 ≤ C j)
(hC : ∀ j z, ‖iteratedFDeriv ℝ j packingBump z‖ ≤ C j)
(hscale : ∀ j, j ≤ p + 1 → |delta| * (w⁻¹) ^ j * C j ≤ 1) :
EuclideanCExtEnvelope
(causalHardTreatmentProfile delta w centers omega) p L
causalHardSquare := by
let bumps : Score → ℝ := fun y ↦ ∑ i, if omega i then
localizedPackingBump delta w (centers i) y else 0
let g := packingRegression (1 / 16) delta w centers omega
have hbumps : ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) bumps :=
packingBumpSum_contDiff delta w centers omega
have hreg (j : ℕ) (x : Score) :
iteratedFDeriv ℝ j g x =
iteratedFDeriv ℝ j (packingAffineBaseline (1 / 16)) x +
iteratedFDeriv ℝ j bumps x := by
change iteratedFDeriv ℝ j (packingAffineBaseline (1 / 16) + bumps) x = _
rw [iteratedFDeriv_add_apply
((packingAffineBaseline_contDiff (1 / 16)).of_le
(WithTop.coe_le_coe.mpr le_top)).contDiffAt
(hbumps.of_le (WithTop.coe_le_coe.mpr le_top)).contDiffAt]
apply euclideanCExtEnvelope_of_iteratedFDeriv_bounds
(causalHardTreatmentProfile delta w centers omega) g p L 2 2
causalHardSquare
· exact ⟨scorePoint 0 0, by
intro i
fin_cases i <;> norm_num [causalHardSquare, scorePoint]⟩
· refine ⟨scorePoint 0 0, ?_, scorePoint 1 0, ?_, ?_⟩
· intro i
fin_cases i <;> norm_num [causalHardSquare, scorePoint]
· intro i
fin_cases i <;> norm_num [causalHardSquare, scorePoint]
· intro heq
have hcoord := congrArg (fun x : Score ↦ x 0) heq
norm_num [scorePoint] at hcoord
· exact (packingRegression_contDiff (1 / 16) delta w centers omega).of_le
(WithTop.coe_le_coe.mpr le_top)
· exact (causalHardTreatmentProfile_eq_packingRegression_on_square
hdelta.le hdeltaSmall hw hsep omega).symm
· linarith
· intro alpha ha x hx
rw [hreg]
calc
_ ≤ ‖iteratedFDeriv ℝ (coordinateMultiOrder alpha)
(packingAffineBaseline (1 / 16)) x‖ +
‖iteratedFDeriv ℝ (coordinateMultiOrder alpha) bumps x‖ :=
norm_add_le _ _
_ ≤ 1 + 1 := by
gcongr
· by_cases hj0 : coordinateMultiOrder alpha = 0
· rw [hj0, norm_iteratedFDeriv_zero, Real.norm_eq_abs]
have hx0 := hx (0 : Fin 2)
dsimp [causalHardSquare] at hx0
unfold packingAffineBaseline
rw [abs_le]
constructor <;> nlinarith [abs_nonneg (x 0)]
· rcases eq_or_lt_of_le (Nat.one_le_iff_ne_zero.mpr hj0) with
hj1 | hj2
· rw [← hj1]
exact (packingAffineBaseline_iteratedFDeriv_one_norm_le
(1 / 16) x).trans (by norm_num)
· rw [packingAffineBaseline_iteratedFDeriv_eq_zero (1 / 16)
_ (by omega) x, norm_zero]
norm_num
· exact (packingBumpSum_iteratedFDeriv_bound_with
(coordinateMultiOrder alpha) delta hw hsep omega
(hC0 _) (hC _) x).trans (hscale _ (by omega))
_ = 2 := by norm_num
· intro alpha ha x hx z hz
rw [hreg, hreg]
calc
_ = ‖(iteratedFDeriv ℝ (coordinateMultiOrder alpha)
(packingAffineBaseline (1 / 16)) x -
iteratedFDeriv ℝ (coordinateMultiOrder alpha)
(packingAffineBaseline (1 / 16)) z) +
(iteratedFDeriv ℝ (coordinateMultiOrder alpha) bumps x -
iteratedFDeriv ℝ (coordinateMultiOrder alpha) bumps z)‖ := by
congr 1 <;> abel
_ ≤ ‖iteratedFDeriv ℝ (coordinateMultiOrder alpha)
(packingAffineBaseline (1 / 16)) x -
iteratedFDeriv ℝ (coordinateMultiOrder alpha)
(packingAffineBaseline (1 / 16)) z‖ +
‖iteratedFDeriv ℝ (coordinateMultiOrder alpha) bumps x -
iteratedFDeriv ℝ (coordinateMultiOrder alpha) bumps z‖ :=
norm_add_le _ _
_ ≤ 1 * ‖x - z‖ + 1 * ‖x - z‖ := by
gcongr
· by_cases hj0 : coordinateMultiOrder alpha = 0
· rw [hj0]
simp only [iteratedFDeriv_zero_eq_comp, Function.comp_apply,
← map_sub, LinearIsometryEquiv.norm_map]
unfold packingAffineBaseline
rw [show (1 / 2 + (1 / 16) * x 0) -
(1 / 2 + (1 / 16) * z 0) = (1 / 16) * ((x - z) 0) by
rw [PiLp.sub_apply]
ring,
Real.norm_eq_abs, abs_mul]
calc
_ ≤ (1 / 16 : ℝ) * ‖x - z‖ := by
rw [abs_of_nonneg (by norm_num : (0 : ℝ) ≤ 1 / 16)]
gcongr
simpa [Real.norm_eq_abs] using PiLp.norm_apply_le (x - z) 0
_ ≤ 1 * ‖x - z‖ := by
gcongr <;> norm_num
· rw [packingAffineBaseline_iteratedFDeriv_sub_eq_zero (1 / 16)
_ (Nat.one_le_iff_ne_zero.mpr hj0) x z, norm_zero]
positivity
· exact (packingBumpSum_iteratedFDeriv_lipschitz_with
(coordinateMultiOrder alpha) delta hw hsep omega (hC0 _)
(hC _) x z).trans (by
have hs := hscale (coordinateMultiOrder alpha + 1) (by omega)
have hn := norm_nonneg (x - z)
nlinarith)
_ = 2 * ‖x - z‖ := by ring
theorem causalHardTreatmentProfile_powerBandwidth_derivative_scaling
At a power-law bandwidth, a bound on each normalized bump derivative by the bandwidth constant reduces the positive-order scaling inequalities to the elementary comparison delta * u⁻ʲ ≤ 1, where u^q = delta.
Formal statement
hypotheses
q :
ℕ
A delta :
ℝ
hq :
1 ≤ q
hA :
1 ≤ A
hdelta :
0 < delta
hdeltaOne :
delta ≤ 1
hAderiv :
∀ j
if
j ≤ q
then
hzero :
delta * packingBumpDerivativeBound 0 ≤ 1
conclusion
∀ j
if
j ≤ q
then
|delta| * ((A * rpow delta ((1 : ℝ) / q))⁻¹) ^ j * packingBumpDerivativeBound j ≤ 1
Proof (Lean source)
-- @node: causalHardTreatmentProfile_powerBandwidth_derivative_scaling
lemma causalHardTreatmentProfile_powerBandwidth_derivative_scaling
(q : ℕ) {A delta : ℝ} (hq : 1 ≤ q) (hA : 1 ≤ A)
(hdelta : 0 < delta) (hdeltaOne : delta ≤ 1)
(hAderiv : ∀ j, j ≤ q → packingBumpDerivativeBound j ≤ A)
(hzero : delta * packingBumpDerivativeBound 0 ≤ 1) :
∀ j, j ≤ q →
|delta| *
((A * rpow delta ((1 : ℝ) / q))⁻¹) ^ j *
packingBumpDerivativeBound j ≤ 1 := by
intro j hjq
by_cases hj0 : j = 0
· subst j
simpa [abs_of_pos hdelta] using hzero
let u := rpow delta ((1 : ℝ) / q)
have hu0 : 0 < u := Real.rpow_pos_of_pos hdelta _
have hueq : u ^ q = delta := by
dsimp [u]
simpa [one_div] using
(Real.rpow_inv_natCast_pow hdelta.le (show q ≠ 0 by omega))
have hu1 : u ≤ 1 := by
exact Real.rpow_le_one hdelta.le hdeltaOne (by positivity)
have hupows : u ^ q ≤ u ^ j :=
pow_le_pow_of_le_one hu0.le hu1 hjq
have huradial : delta * (u⁻¹) ^ j ≤ 1 := by
rw [inv_pow, ← hueq]
simpa [div_eq_mul_inv] using (div_le_one (pow_pos hu0 j)).2 hupows
have hAj : A ≤ A ^ j := by
obtain ⟨k, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hj0
rw [pow_succ]
exact le_mul_of_one_le_left (by linarith) (one_le_pow₀ hA)
have hfrac0 : 0 ≤ packingBumpDerivativeBound j / A ^ j :=
div_nonneg (packingBumpDerivativeBound_nonneg j) (by positivity)
have hfrac1 : packingBumpDerivativeBound j / A ^ j ≤ 1 :=
(div_le_one (by positivity : 0 < A ^ j)).2
((hAderiv j hjq).trans hAj)
have hmul := mul_le_one₀ huradial hfrac0 hfrac1
rw [abs_of_pos hdelta]
change delta * ((A * u)⁻¹) ^ j * packingBumpDerivativeBound j ≤ 1
calc
delta * ((A * u)⁻¹) ^ j * packingBumpDerivativeBound j =
(delta * (u⁻¹) ^ j) *
(packingBumpDerivativeBound j / A ^ j) := by ring
_ ≤ 1 := hmul
theorem causalHardTreatmentProfile_euclideanCExtEnvelope_powerBandwidth
The paper-scale power bandwidth supplies the treatment-profile smooth extension once its zeroth derivative is controlled and the bandwidth constant dominates all normalized derivatives through order p + 1.
Formal statement
hypotheses
M :
ℕ
p :
ℕ
L A delta :
ℝ
hL :
48 ≤ L
hA :
1 ≤ A
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 16
hAderiv :
∀ j
if
j ≤ p + 1
then
hzero :
delta * packingBumpDerivativeBound 0 ≤ 1
conclusion
EuclideanCExtEnvelope (causalHardTreatmentProfile delta (A * rpow delta ((1 : ℝ) / (p + 1 : ℝ))) centers omega) p L causalHardSquare
Proof (Lean source)
-- @node: causalHardTreatmentProfile_euclideanCExtEnvelope_powerBandwidth
lemma causalHardTreatmentProfile_euclideanCExtEnvelope_powerBandwidth
{M : ℕ} (p : ℕ) {L A delta : ℝ}
(hL : 48 ≤ L) (hA : 1 ≤ A) (hdelta : 0 < delta)
(hdeltaSmall : delta ≤ 1 / 16) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k →
3 * (A * rpow delta ((1 : ℝ) / (p + 1 : ℝ))) ≤
dist (centers i) (centers k))
(omega : Fin M → Bool)
(hAderiv : ∀ j, j ≤ p + 1 → packingBumpDerivativeBound j ≤ A)
(hzero : delta * packingBumpDerivativeBound 0 ≤ 1) :
EuclideanCExtEnvelope
(causalHardTreatmentProfile delta
(A * rpow delta ((1 : ℝ) / (p + 1 : ℝ))) centers omega)
p L causalHardSquare := by
have hdeltaOne : delta ≤ 1 := by linarith
have hw : 0 < A * rpow delta ((1 : ℝ) / (p + 1 : ℝ)) :=
mul_pos (lt_of_lt_of_le (by norm_num) hA)
(rpow_pos_of_pos hdelta _)
apply causalHardTreatmentProfile_euclideanCExtEnvelope_of_scaling_bounds
p hL hdelta hdeltaSmall hw hsep omega packingBumpDerivativeBound
packingBumpDerivativeBound_nonneg
packingBump_iteratedFDeriv_le_derivativeBound
simpa [Nat.cast_add, cast_one] using
(causalHardTreatmentProfile_powerBandwidth_derivative_scaling
(p + 1) (by omega) hA hdelta hdeltaOne hAderiv hzero)
Causal.LawClass 23 declarations The ten conjuncts below retain the Euclidean carrier, selected conditional kernel, open-neighborhood smooth extension, uniform-kernel VC condition, Gram floor, local mass, and Hausdorff slice requirements of the paper.
The exact uniformized CTY Assumptions 1--2 class
The ten conjuncts below retain the Euclidean carrier, selected conditional kernel, open-neighborhood smooth extension, uniform-kernel VC condition, Gram floor, local mass, and Hausdorff slice requirements of the paper.
A compact axis-aligned square contained in [-L,L]².
Definition (Lean source)
def RectangularScoreSupport (S : Set Score) (L : ℝ) : Prop :=
∃ lo hi : ℝ, lo ≤ hi ∧
S = {x | ∀ i, lo ≤ x i ∧ x i ≤ hi} ∧ S ⊆ scoreCube L
Rectifiability of a specified curve, rather than of a support frontier.
def coordinatePartialValues
Absolute coordinate partials of total order at most p on S.
Definition (Lean source)
def coordinatePartialValues (f : Score → ℝ) (p : ℕ) (S : Set Score) : Set ℝ :=
{r | ∃ alpha : Fin 2 → ℕ, coordinateMultiOrder alpha ≤ p ∧
∃ x ∈ S, r = |coordinatePartial f alpha x|}
def coordinatePartialLipschitzValues
Coordinate-partial Lipschitz quotients of total order at most p.
Definition (Lean source)
def coordinatePartialLipschitzValues (f : Score → ℝ) (p : ℕ)
(S : Set Score) : Set ℝ :=
{r | ∃ alpha : Fin 2 → ℕ, coordinateMultiOrder alpha ≤ p ∧
∃ x ∈ S, ∃ z ∈ S, x ≠ z ∧
r = |coordinatePartial f alpha x - coordinatePartial f alpha z| / ‖x - z‖}
The paper's Euclidean C^{p+1}-extension envelope, using exactly the displayed maxima of scalar coordinate multi-index partial derivatives and their Lipschitz quotients. The two bounded-above guards make the real suprema faithful to those finite displayed maxima.
Definition (Lean source)
def EuclideanCExtEnvelope (f : Score → ℝ) (p : ℕ) (L : ℝ)
(S : Set Score) : Prop :=
∃ U : Set Score, IsOpen U ∧ S ⊆ U ∧
∃ g : Score → ℝ,
ContDiffOn ℝ (p + 1 : ℕ) g U ∧
EqOn g f S ∧
BddAbove (coordinatePartialValues g p S) ∧
BddAbove (coordinatePartialLipschitzValues g p S) ∧
sSup (coordinatePartialValues g p S) +
sSup (coordinatePartialLipschitzValues g p S) ≤ L
def populationGram
The degree-p population Gram matrix from the signed-distance design.
Definition (Lean source)
noncomputable def populationGram (P : A1A2Law) (p : ℕ) (t : Bool)
(x : Score) (h : ℝ) : Matrix (Fin (p + 1)) (Fin (p + 1)) ℝ :=
fun j k => ∫ w,
h⁻¹ ^ 2 *
(if (if t then 0 ≤ signedDistance (knownGeometry P) x (causalScore w)
else signedDistance (knownGeometry P) x (causalScore w) < 0) then 1 else 0) *
uniformKernel (signedDistance (knownGeometry P) x (causalScore w) / h) *
polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) j *
polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) k ∂P.law
def matrixQuadratic
Quadratic form of a real square matrix.
Definition (Lean source)
def matrixQuadratic {d : ℕ} (A : Matrix (Fin d) (Fin d) ℝ)
(v : Fin d → ℝ) : ℝ :=
∑ i, ∑ j, v i * A i j * v j
The quantitative minimum-eigenvalue condition, expressed without a spectral API.
Definition (Lean source)
def PopulationGramFloor (P : A1A2Law) (p : ℕ) (L : ℝ) : Prop :=
∀ t x h, x ∈ P.boundary → 0 < h → h ≤ L⁻¹ → ∀ v : Fin (p + 1) → ℝ,
L⁻¹ * ∑ i, (v i) ^ 2 ≤ matrixQuadratic (populationGram P p t x h) v
def armLocalMass
Lebesgue mass of the arm-t uniform-kernel neighborhood.
Definition (Lean source)
noncomputable def armLocalMass (P : A1A2Law) (t : Bool)
(x : Score) (h : ℝ) : ℝ≥0∞ :=
∫⁻ z in (if t then P.A1 else P.A0),
ofReal (h⁻¹ ^ 2 *
uniformKernel (((if t then 1 else -1 : ℝ) * dist z x) / h)) ∂volume
def armSliceDensityMass
Hausdorff integral of the score density over an armwise distance slice.
structure A1A2KernelWitness
One admissible selected disintegration kernel for a bare causal law. The pointwise clauses are properties of this witness, not of the arbitrary kernel decoration stored in A1A2Law.
Definition (Lean source)
parameters
P :
ν L :
ℝ
fields
condKer_markov :
∀ t, IsMarkovKernel (condKer t)
condKer_disint :
∀ t,
(Measure.map causalScore P.law).compProd (condKer t)
= Measure.map (fun w => (causalScore w, armCoord t w)) P.law
mean_eq :
∀ t, ∀ x ∈ P.support, P.muPO t x = ∫ y, y ∂condKer t x
variance_eq :
∀ t, ∀ x ∈ P.support, P.sigmaSqPO t x = variance id (condKer t x)
def selectedA1A2CondKer
The kernel selected from an existential class-membership certificate.
Definition (Lean source)
noncomputable def selectedA1A2CondKer (P : A1A2Law) (ν L : ℝ) :
Bool → Kernel Score ℝ := by
classical
exact if h : Nonempty (A1A2KernelWitness P ν L) then
(Classical.choice h).condKer
else P.condKer
def selectedA1A2CondAbsMoment
Conditional absolute moment computed from the selected class witness.
Definition (Lean source)
noncomputable def selectedA1A2CondAbsMoment (P : A1A2Law) (ν L : ℝ)
(t : Bool) (x : Score) : ℝ≥0∞ :=
∫⁻ y, ofReal (|y| ^ (2 + ν)) ∂selectedA1A2CondKer P ν L t x
theorem selectedA1A2CondKer_markov
The stated conditional distribution is a Markov kernel: it is a probability law at each input and varies measurably with that input.
Formal statement
hypotheses
conclusion
IsMarkovKernel (selectedA1A2CondKer P ν L t)
Proof (Lean source)
lemma selectedA1A2CondKer_markov {P : A1A2Law} {ν L : ℝ}
(h : Nonempty (A1A2KernelWitness P ν L)) (t : Bool) :
IsMarkovKernel (selectedA1A2CondKer P ν L t) := by
simp only [selectedA1A2CondKer, dif_pos h]
exact (Classical.choice h).condKer_markov t
theorem selectedA1A2CondKer_disint
The selected conditional kernel disintegrates the causal law as stated.
Formal statement
hypotheses
conclusion
(Measure.map causalScore P.law).compProd (selectedA1A2CondKer P ν L t)
= Measure.map (fun w => (causalScore w, armCoord t w)) P.law
Proof (Lean source)
lemma selectedA1A2CondKer_disint {P : A1A2Law} {ν L : ℝ}
(h : Nonempty (A1A2KernelWitness P ν L)) (t : Bool) :
(Measure.map causalScore P.law).compProd (selectedA1A2CondKer P ν L t) =
Measure.map (fun w => (causalScore w, armCoord t w)) P.law := by
simp only [selectedA1A2CondKer, dif_pos h]
exact (Classical.choice h).condKer_disint t
theorem selectedA1A2CondKer_mean_eq
The two stated constructions agree under the theorem's assumptions.
Formal statement
hypotheses
conclusion
P.muPO t x = ∫ y, y ∂selectedA1A2CondKer P ν L t x
Proof (Lean source)
lemma selectedA1A2CondKer_mean_eq {P : A1A2Law} {ν L : ℝ}
(h : Nonempty (A1A2KernelWitness P ν L)) (t : Bool)
(x : Score) (hx : x ∈ P.support) :
P.muPO t x = ∫ y, y ∂selectedA1A2CondKer P ν L t x := by
simp only [selectedA1A2CondKer, dif_pos h]
exact (Classical.choice h).mean_eq t x hx
theorem selectedA1A2CondKer_variance_eq
The two stated constructions agree under the theorem's assumptions.
Formal statement
hypotheses
conclusion
P.sigmaSqPO t x = variance id (selectedA1A2CondKer P ν L t x)
Proof (Lean source)
lemma selectedA1A2CondKer_variance_eq {P : A1A2Law} {ν L : ℝ}
(h : Nonempty (A1A2KernelWitness P ν L)) (t : Bool)
(x : Score) (hx : x ∈ P.support) :
P.sigmaSqPO t x =
variance id (selectedA1A2CondKer P ν L t x) := by
simp only [selectedA1A2CondKer, dif_pos h]
exact (Classical.choice h).variance_eq t x hx
theorem selectedA1A2CondAbsMoment_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
conclusion
selectedA1A2CondAbsMoment P ν L t x ≤ ofReal L
Proof (Lean source)
lemma selectedA1A2CondAbsMoment_le {P : A1A2Law} {ν L : ℝ}
(h : Nonempty (A1A2KernelWitness P ν L)) (t : Bool)
(x : Score) (hx : x ∈ P.support) :
selectedA1A2CondAbsMoment P ν L t x ≤ ofReal L := by
simp only [selectedA1A2CondAbsMoment, selectedA1A2CondKer, dif_pos h]
exact (Classical.choice h).moment_le t x hx
def A1A2ClassWitness
Pointwise conditions on one admissible selected-kernel representative. In particular, the selected kernel's mean and variance are pinned pointwise on the support, rather than merely by the a.e. fields of A1A2Law.
Definition (Lean source)
def A1A2ClassWitness (p : ℕ) (ν L : ℝ) (P : A1A2Law) : Prop :=
2 ≤ ν ∧ -- @realizes \nu(regime ν≥2)
4 ≤ L ∧ -- @realizes L(regime L≥4)
RectangularScoreSupport P.support L ∧
-- @realizes \mathcal{X}_P(rectangular compact support inside [-L,L]²)
ContinuousOn P.density P.support ∧
(∀ x ∈ P.support, L⁻¹ ≤ P.density x ∧ P.density x ≤ L) ∧
-- @realizes f_P(continuous density in [L⁻¹,L])
(∀ t, EuclideanCExtEnvelope (P.muPO t) p L P.support) ∧
-- @realizes \mu_{t,P}(C^{p+1} extension and derivative envelope)
(∀ t, ContinuousOn (P.sigmaSqPO t) P.support ∧
∀ x ∈ P.support, L⁻¹ ≤ P.sigmaSqPO t x ∧ P.sigmaSqPO t x ≤ L) ∧
-- @realizes \sigma^2_{t,P}(continuous variance in [L⁻¹,L])
(Nonempty (A1A2KernelWitness P ν L) ∧
∀ t, ∀ x ∈ P.support,
P.muPO t x = ∫ y, y ∂selectedA1A2CondKer P ν L t x) ∧
-- @realizes \mu_{t,P}(pointwise mean of selected conditional law)
(∀ t, ∀ x ∈ P.support,
P.sigmaSqPO t x =
variance id (selectedA1A2CondKer P ν L t x)) ∧
-- @realizes \sigma^2_{t,P}(pointwise variance of selected conditional law)
(∀ t, ∀ x ∈ P.support,
selectedA1A2CondAbsMoment P ν L t x ≤ ofReal L) ∧
-- @realizes Y(t)(pointwise conditional (2+ν)-moment at most L)
(MeasurableSet P.A0 ∧ MeasurableSet P.A1 ∧
P.A0 ∪ P.A1 = P.support ∧ Disjoint P.A0 P.A1 ∧
P.boundary = frontier P.A0 ∩ frontier P.A1 ∧
IsCompact P.boundary ∧ P.boundary ⊆ interior P.support ∧
RectifiableCurve P.boundary ∧
ofReal L⁻¹ ≤ Measure.hausdorffMeasure 1 P.boundary ∧
Measure.hausdorffMeasure 1 P.boundary ≤ ofReal L) ∧
-- @realizes \mathcal{A}_{t,P}(Borel partition)
-- @realizes \mathcal{B}_P(compact rectifiable interior common interface with H¹ bounds)
EuclideanBallsVCProperty ∧
-- @realizes d_P(Euclidean metric) @realizes K_\square(uniform-kernel VC index ≤4)
PopulationGramFloor P p L ∧
-- @realizes \Psi_{t,P,x}(h)(quadratic-form floor L⁻¹)
(∀ t x h, x ∈ P.boundary → 0 < h → h ≤ L⁻¹ →
ofReal L⁻¹ ≤ armLocalMass P t x h) ∧
∀ t x s, x ∈ P.boundary → 0 < s → s ≤ L⁻¹ →
0 < armSliceDensityMass P t x s ∧ armSliceDensityMass P t x s < ∞
The exact displayed L-uniformized Euclidean-distance, uniform-kernel CTY Assumptions 1--2 plus Theorem-2-envelope class. Membership existentially selects one admissible disintegration kernel and constrains that same witness pointwise; it does not constrain the arbitrary kernel decoration of P.
Definition (Lean source)
theorem toA1A2Class
A pointwise-admissible decorated law belongs to the class.
Formal statement
Proof (Lean source)
lemma A1A2ClassWitness.toA1A2Class {p : ℕ} {ν L : ℝ} {P : A1A2Law}
(hP : A1A2ClassWitness p ν L P) : A1A2Class p ν L P := by
exact hP
def admissibleA1A2Laws
The class as a set of causal laws.
Definition (Lean source)
theorem memLp_armCoord_of_condAbsMoment_le
The pointwise selected-kernel moment envelope implies the global armwise L^(2+ν) scope required by conditional-mean and conditional-variance APIs.
Formal statement
Proof (Lean source)
-- @node: A1A2Law.memLp_armCoord_of_condAbsMoment_le
lemma A1A2Law.memLp_armCoord_of_condAbsMoment_le
(P : A1A2Law) (p : ℕ) (ν L : ℝ) (hP : A1A2Class p ν L P)
(t : Bool) :
MemLp (armCoord t) (ofReal (2 + ν)) P.law := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hK : Nonempty (A1A2KernelWitness P ν L) :=
hP.2.2.2.2.2.2.2.1.1
letI : IsMarkovKernel (selectedA1A2CondKer P ν L t) :=
selectedA1A2CondKer_markov hK t
have harm : Measurable (armCoord t) := by
cases t
· exact measurable_fst
· exact measurable_fst.comp measurable_snd
have hscore : Measurable causalScore := by
unfold causalScore
fun_prop
have hpair : Measurable (fun w => (causalScore w, armCoord t w)) :=
hscore.prodMk harm
have hnu : 0 < 2 + ν := by linarith [hP.1]
have hp0 : ofReal (2 + ν) ≠ 0 := (ENNReal.ofReal_pos.2 hnu).ne'
have hptop : ofReal (2 + ν) ≠ ∞ := ENNReal.ofReal_ne_top
refine ⟨harm.aestronglyMeasurable,
(eLpNorm_lt_top_iff_lintegral_rpow_enorm_lt_top hp0 hptop).2 ?_⟩
have hmap : Measure.map (fun w => (causalScore w, armCoord t w)) P.law =
(Measure.map causalScore P.law).compProd (selectedA1A2CondKer P ν L t) :=
(selectedA1A2CondKer_disint hK t).symm
have hmoment : ∀ x ∈ P.support,
selectedA1A2CondAbsMoment P ν L t x ≤ ofReal L :=
hP.2.2.2.2.2.2.2.2.2.1 t
have hsupport : ∀ᵐ x ∂Measure.map causalScore P.law, x ∈ P.support := by
rw [P.support_eq_marginal_support]
exact Measure.support_mem_ae
have hinner : ∀ᵐ x ∂Measure.map causalScore P.law,
(∫⁻ y, ‖y‖ₑ ^ (ofReal (2 + ν)).toReal
∂selectedA1A2CondKer P ν L t x) ≤
ofReal L := by
filter_upwards [hsupport] with x hx
have hintegrand (y : ℝ) :
‖y‖ₑ ^ (ofReal (2 + ν)).toReal =
ofReal (|y| ^ (2 + ν)) := by
rw [ENNReal.toReal_ofReal hnu.le, ← ofReal_norm_eq_enorm,
Real.norm_eq_abs,
ENNReal.ofReal_rpow_of_nonneg (abs_nonneg y) hnu.le]
simpa only [selectedA1A2CondAbsMoment, hintegrand] using hmoment x hx
have hfinite : (∫⁻ x, ∫⁻ y,
‖y‖ₑ ^ (ofReal (2 + ν)).toReal
∂selectedA1A2CondKer P ν L t x
∂Measure.map causalScore P.law) < ∞ := by
calc
_ ≤ ∫⁻ _x, ofReal L ∂Measure.map causalScore P.law :=
lintegral_mono_ae hinner
_ < ∞ := by
rw [lintegral_const]
have huniv : (Measure.map causalScore P.law) univ = 1 := by
rw [Measure.map_apply_of_aemeasurable hscore.aemeasurable MeasurableSet.univ]
simp
rw [huniv, mul_one]
exact ENNReal.ofReal_lt_top
rw [← lintegral_map (by fun_prop : Measurable
(fun z : Score × ℝ => ‖z.2‖ₑ ^ (ofReal (2 + ν)).toReal)) hpair]
rw [hmap, Measure.lintegral_compProd (by fun_prop)]
exact hfinite
Causal.T3_A1A2PointIndexedConverse 9 declarations The proof uses the fixed-geometry hypercube, binomial good-count conditioning, the decentralized direct-product certificate, and outer-integral packaging.
Point-indexed converse on the causal A1/A2 class
The proof uses the fixed-geometry hypercube, binomial good-count conditioning, the decentralized direct-product certificate, and outer-integral packaging.
theorem causalEuclideanCExtEnvelope_abs_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
conclusion
|f x| ≤ L
Proof (Lean source)
lemma causalEuclideanCExtEnvelope_abs_le {f : Score → ℝ} {p : ℕ} {L : ℝ}
{S : Set Score} (hf : EuclideanCExtEnvelope f p L S)
{x : Score} (hx : x ∈ S) : |f x| ≤ L := by
rcases hf with ⟨U, hU, hSU, g, hg, hgf, hpartialBdd, hlipBdd, hsum⟩
have hmem : |g x| ∈ coordinatePartialValues g p S := by
refine ⟨fun _ => 0, ?_, x, hx, ?_⟩
· simp [coordinateMultiOrder]
· unfold coordinatePartial
simp only [coordinateMultiOrder, Pi.zero_apply, add_zero]
exact congrArg abs
(iteratedFDeriv_zero_apply (𝕜 := ℝ) (f := g) (x := x)
(coordinateDirections (fun _ : Fin 2 => 0))).symm
have hle : |g x| ≤ sSup (coordinatePartialValues g p S) :=
le_csSup hpartialBdd hmem
have hlipnonneg : 0 ≤ sSup (coordinatePartialLipschitzValues g p S) := by
apply Real.sSup_nonneg
rintro r ⟨alpha, ha, y, hy, z, hz, hyz, rfl⟩
positivity
rw [← hgf hx]
linarith
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
conclusion
outerLIntegral μ f ≤ outerLIntegral μ g
Proof (Lean source)
lemma causalOuterLIntegral_mono {Ω : Type*} [MeasurableSpace Ω]
(μ : Measure Ω) {f g : Ω → ℝ≥0∞} (hfg : f ≤ g) :
outerLIntegral μ f ≤ outerLIntegral μ g := by
unfold outerLIntegral
apply le_iInf
intro G
apply le_iInf
intro hG
apply le_iInf
intro hgG
exact iInf_le_of_le G (iInf_le_of_le hG
(iInf_le_of_le (fun x => (hfg x).trans (hgG x)) le_rfl))
theorem causalFinitePackingLoss_le_boundaryLoss
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
n M :
ℕ
rho :
P :
hcenters :
∀ j, centers j ∈ P.boundary
conclusion
causalFinitePackingLoss rho P centers ≤ a1a2BoundaryLoss rho P
Proof (Lean source)
lemma causalFinitePackingLoss_le_boundaryLoss {n M : ℕ}
(rho : A1A2RuleFun n) (P : A1A2Law) (centers : Fin M → Score)
(hcenters : ∀ j, centers j ∈ P.boundary) :
causalFinitePackingLoss rho P centers ≤ a1a2BoundaryLoss rho P := by
intro w
unfold causalFinitePackingLoss a1a2BoundaryLoss
apply iSup_le
intro j
exact le_iSup_of_le (centers j) (le_iSup_of_le (hcenters j) le_rfl)
Membership in the single fixed support, assignment rectangle, and interior boundary used by the causal hard subclass.
Definition (Lean source)
def CausalHardGeometryLaw (P : A1A2Law) : Prop :=
P.support = causalHardSquare ∧
P.A1 = causalHardArmOne ∧
P.A0 = causalHardSquare \ causalHardArmOne ∧
P.boundary = frontier causalHardArmOne
theorem a1a2_finite_max_eventually_lower
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ L0 : ℝ,
48 ≤ L0 ∧
∀ ν : ℝ,
2
≤ ν → ∀ L : ℝ, L0 ≤ L → ∃ c : ℝ, 0 < c ∧ ∃ N : ℕ, ∀ n ≥ N, ∀ rhoRule : A1A2RuleFun n, rhoRule ∈ A1A2PointIndexedDecisionClass n p ν L → ∃ P : A1A2Law, ∃ M : ℕ, ∃ centers : Fin M → Score, A1A2Class p ν L P ∧ CausalHardGeometryLaw P ∧ (∀ j, centers j ∈ P.boundary) ∧ Measurable (causalFinitePackingLoss rhoRule P centers) ∧ ofReal (c * frontierRate n) ≤ ∫⁻ w, causalFinitePackingLoss rhoRule P centers w ∂causalSampleLaw P n
Proof (Lean source)
lemma a1a2_finite_max_eventually_lower (p : ℕ) :
∃ L0 : ℝ, 48 ≤ L0 ∧ ∀ ν : ℝ, 2 ≤ ν → ∀ L : ℝ, L0 ≤ L →
∃ c : ℝ, 0 < c ∧ ∃ N : ℕ, ∀ n ≥ N,
∀ rhoRule : A1A2RuleFun n,
rhoRule ∈ A1A2PointIndexedDecisionClass n p ν L →
∃ P : A1A2Law, ∃ M : ℕ, ∃ centers : Fin M → Score,
A1A2Class p ν L P ∧ CausalHardGeometryLaw P ∧
(∀ j, centers j ∈ P.boundary) ∧
Measurable (causalFinitePackingLoss rhoRule P centers) ∧
ofReal (c * frontierRate n) ≤
∫⁻ w, causalFinitePackingLoss rhoRule P centers w
∂causalSampleLaw P n := by
obtain ⟨L0, hL0, hcube⟩ := cty_a1_a2_rectangle_angular_hypercube p
refine ⟨L0, hL0, ?_⟩
intro ν hν L hL
obtain ⟨c0, A, C, C0, hc0, hA, hC, hC0, hp0, δ0, hδ0, hfamily⟩ :=
hcube ν hν L hL
let q := p + 1
have hq : 1 ≤ q := by omega
let z : ℝ := 128 * (q : ℝ) * C0
have hz : 0 < z := by dsimp [z]; positivity
let gamma : ℝ := min 1 z⁻¹
have hgamma : 0 < gamma := lt_min (by norm_num) (inv_pos.mpr hz)
have hgamma1 : gamma ≤ 1 := min_le_left _ _
have hgammaz : gamma ≤ z⁻¹ := min_le_right _ _
have hgamma4 : gamma ^ 4 ≤ gamma := by
nlinarith [sq_nonneg gamma, mul_self_le_mul_self (le_of_lt hgamma) hgamma1]
have hsmall : 128 * (q : ℝ) * C0 * gamma ^ 4 ≤ 1 := by
have hzgam : z * gamma ≤ 1 := by
calc z * gamma ≤ z * z⁻¹ := mul_le_mul_of_nonneg_left hgammaz hz.le
_ = 1 := mul_inv_cancel₀ hz.ne'
dsimp [z] at hzgam
nlinarith
let d : ℝ := (1 / 2 : ℝ) * (1 - exp (-(1 : ℝ) / 2))
have hd : 0 < d := by
dsimp [d]
exact mul_pos (by norm_num) (sub_pos.mpr (by
rw [Real.exp_lt_one_iff]
norm_num))
let c : ℝ := gamma * d / 8
have hc : 0 < c := div_pos (mul_pos hgamma hd) (by norm_num)
have hdeltaEvent : ∀ᶠ n : ℕ in atTop,
gamma * frontierRate n ≤ δ0 := by
have ht : Tendsto (fun n : ℕ => gamma * frontierRate n) atTop (nhds 0) := by
simpa using frontierRate_tendsto_zero.const_mul gamma
filter_upwards [ht.eventually (Iio_mem_nhds hδ0)] with n hn
exact hn.le
have hklEvent := causalScaledFrontier_eventually_klBudget q hq c0 gamma C0
hc0 hgamma hC0.le hsmall
have htailEvent : ∀ᶠ n : ℕ in atTop,
exp (-(n : ℝ) * (1 - log 2)) ≤
(c / (2 * L)) * frontierRate n := by
have hLpos : 0 < L := lt_of_lt_of_le (by norm_num) (hL0.trans hL)
have hcoef : 0 < c / (2 * L) := div_pos hc (mul_pos (by norm_num) hLpos)
have h := poisson_remainder_isLittleO_frontier.def hcoef
filter_upwards [h, eventually_ge_atTop (2 : ℕ)] with n hnrm hn
have he0 : 0 ≤ exp (-(n : ℝ) * (1 - log 2)) := Real.exp_pos _ |>.le
have hr0 : 0 ≤ frontierRate n := (frontierRate_pos hn).le
simpa [abs_of_nonneg he0, abs_of_nonneg hr0] using hnrm
obtain ⟨Nδ, hNδ⟩ := eventually_atTop.1 hdeltaEvent
obtain ⟨Nkl, hNkl⟩ := eventually_atTop.1 hklEvent
obtain ⟨Ntail, hNtail⟩ := eventually_atTop.1 htailEvent
refine ⟨c, hc, max 2 (max Nδ (max Nkl Ntail)), ?_⟩
intro n hn rhoRule hrule
have hn2 : 2 ≤ n := le_trans (le_max_left _ _) hn
have hnδ : Nδ ≤ n := le_trans (le_max_left _ _)
(le_trans (le_max_right _ _) hn)
have hnkl : Nkl ≤ n := le_trans (le_max_left _ _)
(le_trans (le_max_right _ _) (le_trans (le_max_right _ _) hn))
have hntail : Ntail ≤ n := le_trans (le_max_right _ _)
(le_trans (le_max_right _ _) (le_trans (le_max_right _ _) hn))
let Δ := gamma * frontierRate n
have hΔ : 0 < Δ := mul_pos hgamma (frontierRate_pos hn2)
have hΔ0 : Δ ≤ δ0 := hNδ n hnδ
obtain ⟨M, w, rhoCell, centers, laws, Q, _hc, _hA, _hC, _hC0,
_hp0, hrho, hMlower, hw, hrhoEq, hcenters, hcells, hsep, hdis,
hclass, hgeom, hmass, hlocal, hoff, hprob, hmap, htargetLocal,
htau, _hradius, _htail, hkl01, _hkl10⟩ := hfamily Δ hΔ hΔ0
have hqcast : (q : ℝ) = (p : ℝ) + 1 := by simp [q]
have hMlower' : c0 * rpow Δ (-(1 : ℝ) / (q : ℝ)) ≤ M := by
simpa [hqcast] using hMlower
have hM : 1 ≤ M := by
have hleft : 0 < c0 * rpow Δ (-(1 : ℝ) / (q : ℝ)) :=
mul_pos hc0 (rpow_pos_of_pos hΔ _)
have : (0 : ℝ) < M := hleft.trans_le hMlower'
exact_mod_cast this
have hbudget : C0 * (n : ℝ) * Δ ^ 4 ≤ (1 / 4 : ℝ) * log M :=
hNkl n hnkl M (by simpa [Δ] using hMlower')
have hcellKL : ∀ j, klDiv (Q j false) (Q j true) *
ofReal (2 * n * rhoCell) ≤
ofReal ((1 / 4 : ℝ) * log M) := by
intro j
calc
klDiv (Q j false) (Q j true) *
ofReal (2 * n * rhoCell) ≤
ofReal (C0 * Δ ^ 4 / w ^ 2) *
ofReal (2 * n * rhoCell) := mul_le_mul_left (hkl01 j) _
_ = ofReal ((C0 * Δ ^ 4 / w ^ 2) * (2 * n * rhoCell)) := by
rw [← ENNReal.ofReal_mul]
positivity
_ ≤ ofReal (C0 * (n : ℝ) * Δ ^ 4) := by
apply ENNReal.ofReal_le_ofReal
rw [hrhoEq]
have hpi : pi ≤ 4 := Real.pi_le_four
have hwne : w ≠ 0 := by
intro hwz
rw [hwz] at hrhoEq
norm_num at hrhoEq
linarith
have hw2 : 0 < w ^ 2 := sq_pos_of_ne_zero hwne
calc
(C0 * Δ ^ 4 / w ^ 2) *
(2 * (n : ℕ) * (pi * w ^ 2 / 36)) =
C0 * (n : ℝ) * Δ ^ 4 * (pi / 18) := by field_simp; ring
_ ≤ C0 * (n : ℝ) * Δ ^ 4 := by
have hbase : 0 ≤ C0 * (n : ℝ) * Δ ^ 4 := by positivity
have : pi / 18 ≤ 1 := by linarith [Real.pi_le_four]
nlinarith
_ ≤ _ := ENNReal.ofReal_le_ofReal hbudget
obtain ⟨T, hT⟩ := hrule
let omega0 : Fin M → Bool := fun _ => false
let P0 := laws omega0
let values : Fin M → Bool → ℝ := fun j b =>
(laws (causalPackingSingleBit j b)).tau (centers j)
have hgeomP0 : ∀ omega, (laws omega).support = P0.support ∧
(laws omega).A1 = P0.A1 ∧ (laws omega).A0 = P0.A0 ∧
(laws omega).boundary = P0.boundary := by
intro omega
simp only [P0]
exact ⟨(hgeom omega).1.trans (hgeom omega0).1.symm,
(hgeom omega).2.1.trans (hgeom omega0).2.1.symm,
(hgeom omega).2.2.1.trans (hgeom omega0).2.2.1.symm,
(hgeom omega).2.2.2.trans (hgeom omega0).2.2.2.symm⟩
have herror := causalPackingCoordinatewiseError_lower_bound hM T P0 centers
values w rhoCell (1 / 4) hdis laws Q hprob hrho hmass hmap hgeomP0
(by norm_num) hcellKL
have hfiniteCoeff : ofReal d ≤ ofReal
((1 / 2 : ℝ) * (1 - exp (-((M : ℝ) ^ (1 - (1 / 4 : ℝ))) / 2))) := by
apply ENNReal.ofReal_le_ofReal
have hpow : 1 ≤ (M : ℝ) ^ (1 - (1 / 4 : ℝ)) :=
Real.one_le_rpow (by exact_mod_cast hM) (by norm_num)
have hexp := Real.exp_le_exp.mpr (show
-((M : ℝ) ^ (1 - (1 / 4 : ℝ))) / 2 ≤ -(1 : ℝ) / 2 by linarith)
dsimp [d]
linarith
have hcoord : ofReal d ≤ coordinatewiseErrorProbability
(fun j b => causalPackingCellExperiment
(causalPackingFinitePartition centers w hdis) laws (2 * n) j b)
(causalPackingCommonExperiment
(causalPackingFinitePartition centers w hdis) laws (2 * n))
(fun j => compressCausalPackingCell P0 centers j)
(causalPackingPoissonDecoder T P0 centers values) := hfiniteCoeff.trans herror
have hvalues : ∀ omega j, (laws omega).tau (centers j) = values j (omega j) := by
intro omega j
exact htargetLocal omega (causalPackingSingleBit j (omega j)) j (by
simp [causalPackingSingleBit])
have hseparation : ∀ j, Δ ≤ |values j true - values j false| := by
intro j
have hh := htau (causalPackingSingleBit j false) j
have hup : update (causalPackingSingleBit j false) j
(!(causalPackingSingleBit j false j)) = causalPackingSingleBit j true := by
funext k
by_cases hk : k = j
· subst k; simp [causalPackingSingleBit]
· simp [update, causalPackingSingleBit, hk]
rw [hup] at hh
simpa [values, abs_sub_comm] using hh.symm.le
obtain ⟨omega, hpoisson⟩ :=
exists_vertex_causalPoissonLoss_ge_coordinatewiseError T P0 centers values
w rhoCell Δ hdis laws hrho hmass hlocal hoff hvalues hseparation
let P := laws omega
have hP := hclass omega
have hG : CausalHardGeometryLaw P := hgeom omega
have hcentersP : ∀ j, centers j ∈ P.boundary := by
intro j
rw [hG.2.2.2]
exact (mem_frontier_causalHardArmOne_iff (centers j)).2
⟨by linarith [(hcenters j).1], by linarith [(hcenters j).2.1],
by linarith [(hcenters j).2.2], by linarith [(hcenters j).2.2],
inr (inr (inl (hcenters j).2.2))⟩
have hmeas := causalFinitePackingLoss_measurable rhoRule ⟨T, hT⟩ P hP centers hcentersP
have hsection : ∀ sample j, rhoRule sample (knownGeometry P) (centers j) =
T.map (knownGeometry P) (centers j)
(signedDistanceData n P sample (centers j)) := by
intro sample j
exact hT P hP sample (centers j) (hcentersP j)
have hknown : knownGeometry P0 = knownGeometry P := by
exact knownGeometry_eq_of_components_eq P0 P
⟨(hgeomP0 omega).1.symm, (hgeomP0 omega).2.1.symm,
(hgeomP0 omega).2.2.1.symm, (hgeomP0 omega).2.2.2.symm⟩
have hbound : ∀ j, |values j (omega j)| ≤ 2 * L := by
intro j
rw [← hvalues omega j]
have hsupport : centers j ∈ P.support := by
rw [hG.1]
intro i
fin_cases i
· change -3 ≤ centers j 0 ∧ centers j 0 ≤ 3
exact ⟨by linarith [(hcenters j).1], by linarith [(hcenters j).2.1]⟩
· change -3 ≤ centers j 1 ∧ centers j 1 ≤ 3
exact ⟨by linarith [(hcenters j).2.2], by linarith [(hcenters j).2.2]⟩
have hmu (t : Bool) : |P.muPO t (centers j)| ≤ L :=
causalEuclideanCExtEnvelope_abs_le (hP.2.2.2.2.2.1 t) hsupport
unfold A1A2Law.tau
exact (abs_sub _ _).trans (by linarith [hmu true, hmu false])
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hdepois := globalCausalPackingPoissonRisk_le_fixedRisk_add_tail
T rhoRule P0 P centers values omega hknown hsection (hvalues omega) hmeas
(2 * L) hbound
have hmain : ofReal (Δ / 2) * ofReal d ≤
∫⁻ s, globalCausalPackingPoissonLoss T P0 centers values omega s
∂canonicalMarkedPoissonSampleLaw P.law packingMarkLaw (2 * n) :=
(mul_le_mul_right hcoord _).trans hpoisson
have htailReal : (2 * L) * exp (-(n : ℝ) * (1 - log 2)) ≤
c * frontierRate n := by
have hLpos : 0 < L := lt_of_lt_of_le (by norm_num) (hL0.trans hL)
have h2L : 0 ≤ 2 * L := mul_nonneg (by norm_num) hLpos.le
have := mul_le_mul_of_nonneg_left (hNtail n hntail) h2L
calc
_ ≤ (2 * L) * ((c / (2 * L)) * frontierRate n) := this
_ = _ := by field_simp
have h2L : 0 ≤ 2 * L := by
have hLpos : 0 < L := lt_of_lt_of_le (by norm_num) (hL0.trans hL)
positivity
have htailENN : ofReal (2 * L) *
ofReal (exp (-(n : ℝ) * (1 - log 2))) ≤
ofReal (c * frontierRate n) := by
rw [← ENNReal.ofReal_mul h2L]
exact ENNReal.ofReal_le_ofReal htailReal
have hmainEq : ofReal (Δ / 2) * ofReal d =
ofReal (4 * (c * frontierRate n)) := by
rw [← ENNReal.ofReal_mul (by positivity : 0 ≤ Δ / 2)]
congr 1
dsimp [Δ, c]
ring
refine ⟨P, M, centers, hP, hG, hcentersP, hmeas, ?_⟩
have hcr0 : 0 ≤ c * frontierRate n :=
mul_nonneg hc.le (frontierRate_pos hn2).le
have hsum : ofReal (c * frontierRate n) +
ofReal (c * frontierRate n) ≤
(∫⁻ sample, causalFinitePackingLoss rhoRule P centers sample
∂causalSampleLaw P n) + ofReal (c * frontierRate n) := by
calc
_ ≤ ofReal (4 * (c * frontierRate n)) := by
rw [← ENNReal.ofReal_add hcr0 hcr0]
apply ENNReal.ofReal_le_ofReal
linarith
_ = _ := hmainEq.symm
_ ≤ _ := hmain
-- … truncated; follow the source link for the rest …
def a1a2FixedGeometryOuterRisk
The causal outer risk after restricting the law supremum to the fixed hard geometry.
Definition (Lean source)
noncomputable def a1a2FixedGeometryOuterRisk
(n p : ℕ) (ν L : ℝ) : ℝ≥0∞ :=
⨅ rho : A1A2RuleFun n,
⨅ (_hrho : rho ∈ A1A2PointIndexedDecisionClass n p ν L),
⨆ P : A1A2Law, ⨆ (_hP : A1A2Class p ν L P),
⨆ (_hG : CausalHardGeometryLaw P),
outerLIntegral (causalSampleLaw P n) (a1a2BoundaryLoss rho P)
theorem lintegral_le_outerLIntegral_of_measurable Lemma lintegral_le_outerLIntegral_of_measurable in the paper ↗
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
(∫⁻ x, f x ∂μ) ≤ outerLIntegral μ f
Proof (Lean source)
lemma lintegral_le_outerLIntegral_of_measurable {Ω : Type*}
[TopologicalSpace Ω] [MeasurableSpace Ω] (μ : Measure Ω)
{f : Ω → ℝ≥0∞} (hf : Measurable f) :
(∫⁻ x, f x ∂μ) ≤ outerLIntegral μ f := by
unfold outerLIntegral
apply le_iInf
intro g
apply le_iInf
intro hg
apply le_iInf
intro hfg
exact lintegral_mono hfg
theorem a1a2OuterRisk_eventually_lower
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ L0 : ℝ,
48 ≤ L0 ∧
∀ ν : ℝ,
2
≤ ν → ∀ L : ℝ, L0 ≤ L → ∃ c : ℝ, 0 < c ∧ ∃ N : ℕ, ∀ n ≥ N, ofReal (c * frontierRate n) ≤ a1a2OuterRisk n p ν L ∧ ofReal (c * frontierRate n) ≤ a1a2FixedGeometryOuterRisk n p ν L
Proof (Lean source)
lemma a1a2OuterRisk_eventually_lower (p : ℕ) :
∃ L0 : ℝ, 48 ≤ L0 ∧ ∀ ν : ℝ, 2 ≤ ν → ∀ L : ℝ, L0 ≤ L →
∃ c : ℝ, 0 < c ∧ ∃ N : ℕ, ∀ n ≥ N,
ofReal (c * frontierRate n) ≤
a1a2OuterRisk n p ν L ∧
ofReal (c * frontierRate n) ≤
a1a2FixedGeometryOuterRisk n p ν L := by
obtain ⟨L0, hL0, hlower⟩ := a1a2_finite_max_eventually_lower p
refine ⟨L0, hL0, ?_⟩
intro ν hν L hL
obtain ⟨c, hc, N, hN⟩ := hlower ν hν L hL
refine ⟨c, hc, N, ?_⟩
intro n hn
constructor
· unfold a1a2OuterRisk
apply le_iInf
intro rho
apply le_iInf
intro hrho
obtain ⟨P, M, centers, hP, hG, hcenters, hmeas, hfin⟩ :=
hN n hn rho hrho
refine hfin.trans ?_
have houter : (∫⁻ w, causalFinitePackingLoss rho P centers w
∂causalSampleLaw P n) ≤
outerLIntegral (causalSampleLaw P n)
(a1a2BoundaryLoss rho P) := by
exact (lintegral_le_outerLIntegral_of_measurable _ hmeas).trans
(causalOuterLIntegral_mono _
(causalFinitePackingLoss_le_boundaryLoss rho P centers hcenters))
exact houter.trans (le_iSup_of_le P (le_iSup_of_le hP le_rfl))
· unfold a1a2FixedGeometryOuterRisk
apply le_iInf
intro rho
apply le_iInf
intro hrho
obtain ⟨P, M, centers, hP, hG, hcenters, hmeas, hfin⟩ :=
hN n hn rho hrho
refine hfin.trans ?_
have houter : (∫⁻ w, causalFinitePackingLoss rho P centers w
∂causalSampleLaw P n) ≤
outerLIntegral (causalSampleLaw P n)
(a1a2BoundaryLoss rho P) := by
exact (lintegral_le_outerLIntegral_of_measurable _ hmeas).trans
(causalOuterLIntegral_mono _
(causalFinitePackingLoss_le_boundaryLoss rho P centers hcenters))
exact houter.trans
(le_iSup_of_le P (le_iSup_of_le hP (le_iSup_of_le hG le_rfl)))
For every polynomial order and moment exponent, the causal point-indexed outer-expectation minimax risk has a positive normalized liminf once the uniform envelope exceeds a threshold depending only on p.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ L0 : ℝ,
48 ≤ L0 ∧
∀ ν : ℝ,
2
≤ ν → ∀ L : ℝ, L0 ≤ L → ∃ c : ℝ, 0 < c ∧ liminf (scaledRisk (fun n => a1a2OuterRisk n p ν L)) atTop = liminf (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ∧ ofReal c ≤ liminf (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ∧ ofReal c ≤ liminf (normalizedRisk (fun n => a1a2FixedGeometryOuterRisk n p ν L)) atTop
Proof (Lean source)
theorem cty_a1_a2_point_indexed_log_converse (p : ℕ) :
∃ L0 : ℝ, 48 ≤ L0 ∧ ∀ ν : ℝ, 2 ≤ ν → ∀ L : ℝ, L0 ≤ L →
∃ c : ℝ, 0 < c ∧
liminf (scaledRisk (fun n => a1a2OuterRisk n p ν L)) atTop =
liminf (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ∧
ofReal c ≤
liminf (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ∧
ofReal c ≤
liminf (normalizedRisk
(fun n => a1a2FixedGeometryOuterRisk n p ν L)) atTop := by
obtain ⟨L0, hL0, hlower⟩ := a1a2OuterRisk_eventually_lower p
refine ⟨L0, hL0, ?_⟩
intro ν hν L hL
obtain ⟨c, hc, N, hN⟩ := hlower ν hν L hL
refine ⟨c, hc, ?_, ?_, ?_⟩
· apply le_antisymm
· apply Filter.liminf_le_liminf
· exact scaledRisk_eventually_eq_normalizedRisk _ |>.le
· isBoundedDefault
· isBoundedDefault
· apply Filter.liminf_le_liminf
· exact scaledRisk_eventually_eq_normalizedRisk _ |>.symm.le
· isBoundedDefault
· isBoundedDefault
· apply le_liminf_of_le
· isBoundedDefault
· filter_upwards [eventually_ge_atTop (max N 2)] with n hn
have hnN : N ≤ n := le_trans (le_max_left _ _) hn
have hn2 : 2 ≤ n := le_trans (le_max_right _ _) hn
have hrate0 : ofReal (frontierRate n) ≠ 0 := by
simpa only [ne_eq, ENNReal.ofReal_eq_zero, not_le] using frontierRate_pos hn2
unfold normalizedRisk
apply (ENNReal.le_div_iff_mul_le
(inl hrate0) (inl ENNReal.ofReal_ne_top)).2
rw [← ENNReal.ofReal_mul hc.le]
exact (hN n hnN).1
· apply le_liminf_of_le
· isBoundedDefault
· filter_upwards [eventually_ge_atTop (max N 2)] with n hn
have hnN : N ≤ n := le_trans (le_max_left _ _) hn
have hn2 : 2 ≤ n := le_trans (le_max_right _ _) hn
have hrate0 : ofReal (frontierRate n) ≠ 0 := by
simpa only [ne_eq, ENNReal.ofReal_eq_zero, not_le] using frontierRate_pos hn2
unfold normalizedRisk
apply (ENNReal.le_div_iff_mul_le
(inl hrate0) (inl ENNReal.ofReal_ne_top)).2
rw [← ENNReal.ofReal_mul hc.le]
exact (hN n hnN).2
Causal.T4_WinsorizedUpper 41 declarations The result is conditional on exactly three cited CTY interfaces: identification, sequential first-order bias, and the supplement's expected Gram/raw-score bounds.
Outer-expected upper bound for the explicit winsorized estimator
The result is conditional on exactly three cited CTY interfaces: identification, sequential first-order bias, and the supplement's expected Gram/raw-score bounds. The bounded winsorized-score maximal inequality is proved in run and introduces no fourth hypothesis.
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
conclusion
outerLIntegral μ (fun ω => f ω + g ω)
≤ outerLIntegral μ f + outerLIntegral μ g
Proof (Lean source)
lemma outerLIntegral_add_le {Ω : Type*} [TopologicalSpace Ω]
[MeasurableSpace Ω] (μ : Measure Ω) (f g : Ω → ℝ≥0∞) :
outerLIntegral μ (fun ω => f ω + g ω) ≤
outerLIntegral μ f + outerLIntegral μ g := by
rw [outerLIntegral, outerLIntegral,
outerLIntegral]
simp_rw [ENNReal.iInf_add, ENNReal.add_iInf]
apply le_iInf
intro F
apply le_iInf
intro hF
apply le_iInf
intro hfF
apply le_iInf
intro G
apply le_iInf
intro hG
apply le_iInf
intro hgG
refine iInf_le_of_le (fun ω => F ω + G ω) ?_
refine iInf_le_of_le (hF.add hG) ?_
refine iInf_le_of_le (fun ω => add_le_add (hfF ω) (hgG ω)) ?_
rw [lintegral_add_left hF]
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
conclusion
outerLIntegral μ (fun _ => c) = c
Proof (Lean source)
lemma outerLIntegral_const_probability {Ω : Type*} [TopologicalSpace Ω]
[MeasurableSpace Ω] (μ : Measure Ω) [IsProbabilityMeasure μ]
(c : ℝ≥0∞) :
outerLIntegral μ (fun _ => c) = c := by
apply le_antisymm
· rw [outerLIntegral]
refine iInf_le_of_le (fun _ => c) ?_
refine iInf_le_of_le measurable_const ?_
refine iInf_le_of_le (fun _ => le_rfl) ?_
simp
· rw [outerLIntegral]
apply le_iInf
intro g
apply le_iInf
intro hg
apply le_iInf
intro hcg
have h : (∫⁻ _ω : Ω, c ∂μ) ≤ ∫⁻ ω, g ω ∂μ :=
lintegral_mono (fun ω => hcg ω)
simpa using h
theorem frontierRate_shift_antitone
The stated rate schedule is nonincreasing as sample size increases.
Formal statement
conclusion
Antitone (fun n : ℕ => frontierRate (n + 3))
Proof (Lean source)
lemma frontierRate_shift_antitone : Antitone (fun n : ℕ => frontierRate (n + 3)) := by
intro m n hmn
unfold frontierRate
apply Real.rpow_le_rpow
· positivity
· apply Real.log_div_self_antitoneOn
· have : exp 1 < 3 := Real.exp_one_lt_three
exact this.le.trans (by exact_mod_cast (show 3 ≤ m + 3 by omega))
· have : exp 1 < 3 := Real.exp_one_lt_three
exact this.le.trans (by exact_mod_cast (show 3 ≤ n + 3 by omega))
· exact_mod_cast (Nat.add_le_add_right hmn 3)
· norm_num
theorem t4_frontierRate_fourth_power
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
Proof (Lean source)
lemma t4_frontierRate_fourth_power (n : ℕ) (hn : 2 ≤ n) :
(n : ℝ) * frontierRate n ^ 4 = log n := by
have hn0 : (0 : ℝ) < n := by positivity
have hlog : 0 < log (n : ℝ) :=
Real.log_pos (by exact_mod_cast (show 1 < n by omega))
have hbase : 0 ≤ log (n : ℝ) / n := (div_pos hlog hn0).le
unfold frontierRate
have hr := Real.rpow_inv_natCast_pow hbase (by norm_num : (4 : ℕ) ≠ 0)
rw [show (1 / 4 : ℝ) = ((4 : ℕ) : ℝ)⁻¹ by norm_num]
calc
(n : ℝ) * (log n / n).rpow (((4 : ℕ) : ℝ)⁻¹) ^ 4 =
(n : ℝ) * (log n / n) := by
exact congrArg (fun z : ℝ => (n : ℝ) * z) hr
_ = log n := by field_simp
theorem frontierRate_shift_tendsto_zero
As sample size grows, the stated sequence converges to zero.
Formal statement
conclusion
Proof (Lean source)
lemma frontierRate_shift_tendsto_zero :
Tendsto (fun n : ℕ => frontierRate (n + 3)) atTop (nhds 0) :=
frontierRate_tendsto_zero.comp (Filter.tendsto_add_atTop_nat 3)
theorem frontierRate_shift_nh2_tendsto_top
As sample size grows, the stated effective sample-size sequence diverges to infinity.
Formal statement
conclusion
Proof (Lean source)
lemma frontierRate_shift_nh2_tendsto_top :
Tendsto (fun n : ℕ => ((n + 3 : ℕ) : ℝ) * frontierRate (n + 3) ^ 2)
atTop atTop := by
have hsqrt : Tendsto (fun n : ℕ => sqrt (n : ℝ)) atTop atTop :=
Real.tendsto_sqrt_atTop.comp tendsto_natCast_atTop_atTop
apply Filter.tendsto_atTop_mono' atTop _ hsqrt
filter_upwards [eventually_ge_atTop (3 : ℕ)] with n hn
have hlog : 1 ≤ log (n + 3 : ℕ) := by
rw [← Real.log_exp 1]
apply Real.strictMonoOn_log.monotoneOn (Real.exp_pos 1)
(by change (0 : ℝ) < (n + 3 : ℕ); positivity)
exact Real.exp_one_lt_three.le.trans (by exact_mod_cast (show 3 ≤ n + 3 by omega))
have hr := t4_frontierRate_fourth_power (n + 3) (by omega)
have ha : 0 ≤ frontierRate (n + 3) := (frontierRate_pos (by omega)).le
have hn0 : 0 ≤ (n : ℝ) := by positivity
apply (Real.sqrt_le_iff).2
constructor
· positivity
calc
(n : ℝ) ≤ (n + 3 : ℕ) := by exact_mod_cast (show n ≤ n + 3 by omega)
_ ≤ ((n + 3 : ℕ) : ℝ) * log (n + 3 : ℕ) := by
nlinarith [show (0 : ℝ) ≤ (n + 3 : ℕ) by positivity]
_ = (((n + 3 : ℕ) : ℝ) * frontierRate (n + 3) ^ 2) ^ 2 := by
nlinarith
theorem matrixQuadratic_sub_abs_le_entrywise Lemma matrixQuadratic_sub_abs_le_entrywise in the paper ↗
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
conclusion
|matrixQuadratic A v - matrixQuadratic S v| ≤ (q : ℝ) * δ * ∑ i, (v i) ^ 2
Proof (Lean source)
lemma matrixQuadratic_sub_abs_le_entrywise {q : ℕ}
(A S : Matrix (Fin q) (Fin q) ℝ) (v : Fin q → ℝ) (δ : ℝ)
(hδ : 0 ≤ δ) (hentry : ∀ i j, |A i j - S i j| ≤ δ) :
|matrixQuadratic A v - matrixQuadratic S v| ≤
(q : ℝ) * δ * ∑ i, (v i) ^ 2 := by
rw [show matrixQuadratic A v - matrixQuadratic S v =
∑ i, ∑ j, v i * (A i j - S i j) * v j by
simp only [matrixQuadratic]
rw [← Finset.sum_sub_distrib]
apply Finset.sum_congr rfl
intro i _
rw [← Finset.sum_sub_distrib]
apply Finset.sum_congr rfl
intro j _
ring]
calc
|∑ i, ∑ j, v i * (A i j - S i j) * v j| ≤
∑ i, ∑ j, |v i * (A i j - S i j) * v j| := by
exact (Finset.abs_sum_le_sum_abs _ _).trans
(Finset.sum_le_sum fun i _ => Finset.abs_sum_le_sum_abs _ _)
_ ≤ ∑ i, ∑ _j : Fin q, δ / 2 * ((v i) ^ 2 + (v _j) ^ 2) := by
apply Finset.sum_le_sum
intro i _
apply Finset.sum_le_sum
intro j _
rw [abs_mul, abs_mul]
have hp : 2 * (|v i| * |v j|) ≤ (v i) ^ 2 + (v j) ^ 2 := by
nlinarith [sq_nonneg (|v i| - |v j|), sq_abs (v i), sq_abs (v j)]
have hm := mul_le_mul_of_nonneg_left (hentry i j) (abs_nonneg (v i))
have hm' := mul_le_mul_of_nonneg_right hm (abs_nonneg (v j))
nlinarith [mul_nonneg hδ (add_nonneg (sq_nonneg (v i)) (sq_nonneg (v j)))]
_ = (q : ℝ) * δ * ∑ i, (v i) ^ 2 := by
simp_rw [mul_add, Finset.sum_add_distrib]
simp
simp_rw [Finset.mul_sum]
rw [← Finset.sum_add_distrib]
apply Finset.sum_congr rfl
intro i _
ring
theorem causalGramDeviation_entry_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
n p :
ℕ
P :
h δ :
ℝ
hδ :
0 ≤ δ
w :
hdev :
causalGramDeviation n p P h w ≤ ofReal δ
t :
x :
hx :
x ∈ P.boundary
j k :
Fin (p + 1)
conclusion
|empiricalGram n p t h (signedDistanceData n P w x) j k - populationGram P p t x h j k|
≤ δ
Proof (Lean source)
lemma causalGramDeviation_entry_le (n p : ℕ) (P : A1A2Law)
(h δ : ℝ) (hδ : 0 ≤ δ) (w : CausalSample n)
(hdev : causalGramDeviation n p P h w ≤ ofReal δ)
(t : Bool) (x : Score) (hx : x ∈ P.boundary)
(j k : Fin (p + 1)) :
|empiricalGram n p t h (signedDistanceData n P w x) j k -
populationGram P p t x h j k| ≤ δ := by
have he : ofReal
|empiricalGram n p t h (signedDistanceData n P w x) j k -
populationGram P p t x h j k| ≤ causalGramDeviation n p P h w := by
unfold causalGramDeviation
exact le_iSup_of_le t (le_iSup_of_le x (le_iSup_of_le hx
(le_iSup_of_le j (le_iSup_of_le k le_rfl))))
exact ENNReal.ofReal_le_ofReal_iff hδ |>.mp (he.trans hdev)
theorem empiricalGramGuard_of_deviation_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
n p :
ℕ
ν L :
ℝ
P :
hP :
A1A2Class p ν L P
h :
ℝ
hh :
0 < h
hhL :
h ≤ L⁻¹
w :
hdev :
causalGramDeviation n p P h w ≤ ofReal ((2 * L * (p + 1 : ℝ))⁻¹)
t :
x :
hx :
x ∈ P.boundary
conclusion
empiricalGramGuard L (empiricalGram n p t h (signedDistanceData n P w x))
Proof (Lean source)
lemma empiricalGramGuard_of_deviation_le (n p : ℕ) (ν L : ℝ)
(P : A1A2Law) (hP : A1A2Class p ν L P) (h : ℝ)
(hh : 0 < h) (hhL : h ≤ L⁻¹) (w : CausalSample n)
(hdev : causalGramDeviation n p P h w ≤
ofReal ((2 * L * (p + 1 : ℝ))⁻¹))
(t : Bool) (x : Score) (hx : x ∈ P.boundary) :
empiricalGramGuard L
(empiricalGram n p t h (signedDistanceData n P w x)) := by
have hL : 0 < L := lt_of_lt_of_le (by norm_num) hP.2.1
have hq : 0 < (p + 1 : ℝ) := by positivity
have hδ : 0 ≤ (2 * L * (p + 1 : ℝ))⁻¹ := by positivity
intro v
let A := empiricalGram n p t h (signedDistanceData n P w x)
let S := populationGram P p t x h
have hentry : ∀ i j, |A i j - S i j| ≤ (2 * L * (p + 1 : ℝ))⁻¹ := by
intro i j
exact causalGramDeviation_entry_le n p P h _ hδ w hdev t x hx i j
have herr := matrixQuadratic_sub_abs_le_entrywise A S v
(2 * L * (p + 1 : ℝ))⁻¹ hδ hentry
have hfloor := hP.2.2.2.2.2.2.2.2.2.2.2.2.1 t x h hx hh hhL v
have hs : 0 ≤ ∑ i, (v i) ^ 2 := sum_nonneg fun _ _ => sq_nonneg _
change (2 * L)⁻¹ * ∑ i, (v i) ^ 2 ≤ matrixQuadratic A v
have hscale : (p + 1 : ℝ) * (2 * L * (p + 1 : ℝ))⁻¹ = (2 * L)⁻¹ := by
field_simp
have hscale' : (((p + 1 : ℕ) : ℝ)) * (2 * L * (p + 1 : ℝ))⁻¹ =
(2 * L)⁻¹ := by
norm_num [Nat.cast_add, cast_one]
field_simp
have herr' : |matrixQuadratic A v - matrixQuadratic S v| ≤
(2 * L)⁻¹ * ∑ i, (v i) ^ 2 := by
calc
_ ≤ ((p + 1 : ℕ) : ℝ) * (2 * L * (p + 1 : ℝ))⁻¹ *
∑ i, (v i) ^ 2 := herr
_ = _ := by rw [hscale']
have hd : matrixQuadratic S v - (2 * L)⁻¹ * ∑ i, (v i) ^ 2 ≤
matrixQuadratic A v := by
have habs := (abs_le.mp herr').1
linarith
calc
(2 * L)⁻¹ * ∑ i, (v i) ^ 2 ≤
matrixQuadratic S v - (2 * L)⁻¹ * ∑ i, (v i) ^ 2 := by
have hi : L⁻¹ = 2 * (2 * L)⁻¹ := by field_simp
rw [hi] at hfloor
nlinarith
_ ≤ matrixQuadratic A v := hd
theorem empiricalGramGuard_inv_mulVec_euclidean_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
Proof (Lean source)
lemma empiricalGramGuard_inv_mulVec_euclidean_le {p : ℕ} {L : ℝ}
(hL : 0 < L) {A : Matrix (Fin (p + 1)) (Fin (p + 1)) ℝ}
(hA : empiricalGramGuard L A) (s : Fin (p + 1) → ℝ) :
sqrt (∑ k, (A⁻¹.mulVec s k) ^ 2) ≤
2 * L * sqrt (∑ k, (s k) ^ 2) := by
let z := A⁻¹.mulVec s
have hc : 0 < (2 * L)⁻¹ := by positivity
have hinj : Injective (mulVec A) := by
intro u v huv
have hzero : A.mulVec (u - v) = 0 := by
simpa [Matrix.mulVec_sub] using sub_eq_zero.mpr huv
have hq := hA (u - v)
have hquad : matrixQuadratic A (u - v) = 0 := by
rw [show matrixQuadratic A (u - v) =
dotProduct (u - v) (A.mulVec (u - v)) by
simp [matrixQuadratic, dotProduct, mulVec, Finset.mul_sum]; ring_nf,
hzero]
simp
have hsum : ∑ i, ((u - v) i) ^ 2 = 0 := by
have hs : 0 ≤ ∑ i, ((u - v) i) ^ 2 :=
sum_nonneg fun _ _ => sq_nonneg _
nlinarith
funext i
have hi : ((u - v) i) ^ 2 = 0 := by
exact le_antisymm
(hsum ▸ Finset.single_le_sum (fun j _ => sq_nonneg ((u - v) j))
(Finset.mem_univ i)) (sq_nonneg _)
exact sub_eq_zero.mp (sq_eq_zero_iff.mp hi)
have hu : IsUnit A := Matrix.mulVec_injective_iff_isUnit.mp hinj
have hudet : IsUnit A.det := (Matrix.isUnit_iff_isUnit_det A).mp hu
have hAz : A.mulVec z = s := by
change A.mulVec (A⁻¹.mulVec s) = s
calc
_ = (A * A⁻¹).mulVec s := Matrix.mulVec_mulVec s A A⁻¹
_ = s := by rw [Matrix.mul_nonsing_inv A hudet, Matrix.one_mulVec]
have hlower : (2 * L)⁻¹ * ∑ k, (z k) ^ 2 ≤ ∑ k, z k * s k := by
have hz := hA z
rw [show matrixQuadratic A z = dotProduct z (A.mulVec z) by
simp [matrixQuadratic, dotProduct, mulVec, Finset.mul_sum]; ring_nf,
hAz] at hz
simpa [dotProduct] using hz
have hcs := Real.sum_mul_le_sqrt_mul_sqrt Finset.univ z s
have hsquares : (2 * L)⁻¹ * (sqrt (∑ k, (z k) ^ 2)) ^ 2 ≤
sqrt (∑ k, (z k) ^ 2) * sqrt (∑ k, (s k) ^ 2) := by
rw [Real.sq_sqrt (sum_nonneg fun _ _ => sq_nonneg (z _))]
exact hlower.trans hcs
have hznonneg := Real.sqrt_nonneg (∑ k, (z k) ^ 2)
by_cases hz : sqrt (∑ k, (z k) ^ 2) = 0
· simp [z, hz]
positivity
· have hzpos : 0 < sqrt (∑ k, (z k) ^ 2) := lt_of_le_of_ne hznonneg (Ne.symm hz)
change sqrt (∑ k, (z k) ^ 2) ≤ _
have hcanc : sqrt (∑ k, (z k) ^ 2) ≤
(2 * L) * sqrt (∑ k, (s k) ^ 2) := by
have hi : (2 * L)⁻¹ * (2 * L) = 1 := inv_mul_cancel₀ (by positivity)
nlinarith
exact hcanc
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
Proof (Lean source)
lemma euclideanNorm_le_card_mul_piNorm {q : ℕ} (hq : 1 ≤ q)
(v : Fin q → ℝ) :
sqrt (∑ k, (v k) ^ 2) ≤ (q : ℝ) * ‖v‖ := by
have hsum : ∑ k, (v k) ^ 2 ≤ (q : ℝ) * ‖v‖ ^ 2 := by
calc
_ ≤ ∑ _k : Fin q, ‖v‖ ^ 2 := by
apply Finset.sum_le_sum
intro k _
have hk : |v k| ≤ ‖v‖ := by
simpa [Real.norm_eq_abs] using norm_le_pi_norm v k
have hs := (sq_le_sq₀ (abs_nonneg (v k)) (norm_nonneg v)).2 hk
simpa [sq_abs] using hs
_ = _ := by simp
have hq0 : 0 ≤ (q : ℝ) := by positivity
have hn : 0 ≤ ‖v‖ := norm_nonneg _
calc
_ ≤ sqrt ((q : ℝ) * ‖v‖ ^ 2) := Real.sqrt_le_sqrt hsum
_ ≤ (q : ℝ) * ‖v‖ := by
apply (Real.sqrt_le_iff).2
constructor
· positivity
· have hq1 : 1 ≤ (q : ℝ) := by exact_mod_cast hq
nlinarith [sq_nonneg ((q : ℝ) * ‖v‖)]
theorem empiricalGramGuard_isUnit
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
conclusion
IsUnit A
Proof (Lean source)
lemma empiricalGramGuard_isUnit {p : ℕ} {L : ℝ} (hL : 0 < L)
{A : Matrix (Fin (p + 1)) (Fin (p + 1)) ℝ}
(hA : empiricalGramGuard L A) : IsUnit A := by
apply Matrix.mulVec_injective_iff_isUnit.mp
intro u v huv
have hzero : A.mulVec (u - v) = 0 := by
simpa [Matrix.mulVec_sub] using sub_eq_zero.mpr huv
have hq := hA (u - v)
have hquad : matrixQuadratic A (u - v) = 0 := by
rw [show matrixQuadratic A (u - v) =
dotProduct (u - v) (A.mulVec (u - v)) by
simp [matrixQuadratic, dotProduct, mulVec, Finset.mul_sum]; ring_nf,
hzero]
simp
have hsum : ∑ i, ((u - v) i) ^ 2 = 0 := by
have hs : 0 ≤ ∑ i, ((u - v) i) ^ 2 :=
sum_nonneg fun _ _ => sq_nonneg _
have hc : 0 < (2 * L)⁻¹ := by positivity
nlinarith
funext i
have hi : ((u - v) i) ^ 2 = 0 := by
exact le_antisymm
(hsum ▸ Finset.single_le_sum (fun j _ => sq_nonneg ((u - v) j))
(Finset.mem_univ i)) (sq_nonneg _)
exact sub_eq_zero.mp (sq_eq_zero_iff.mp hi)
theorem guardedCoefficient_sub_populationCoefficient_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
n p :
ℕ
ν L h B :
ℝ
P :
hP :
A1A2Class p ν L P
t :
x :
hx :
x ∈ P.boundary
hh :
0 < h
hhL :
h ≤ L⁻¹
w :
hguard :
empiricalGramGuard L (empiricalGram n p t h (signedDistanceData n P w x))
conclusion
|guardedCoefficient n p L t h B (signedDistanceData n P w x) 0
- populationCoefficient P p t x h 0|
≤ 2 * L * (p + 1 : ℝ) * ‖winsorizedCenteredScore n p P t x h B w‖
Proof (Lean source)
lemma guardedCoefficient_sub_populationCoefficient_le
(n p : ℕ) (ν L h B : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) (t : Bool) (x : Score)
(hx : x ∈ P.boundary) (hh : 0 < h) (hhL : h ≤ L⁻¹)
(w : CausalSample n)
(hguard : empiricalGramGuard L
(empiricalGram n p t h (signedDistanceData n P w x))) :
|guardedCoefficient n p L t h B (signedDistanceData n P w x) 0 -
populationCoefficient P p t x h 0| ≤
2 * L * (p + 1 : ℝ) * ‖winsorizedCenteredScore n p P t x h B w‖ := by
let A := empiricalGram n p t h (signedDistanceData n P w x)
let β := populationCoefficient P p t x h
let o := winsorizedCenteredScore n p P t x h B w
have hL : 0 < L := lt_of_lt_of_le (by norm_num) hP.2.1
have hunit : IsUnit A := empiricalGramGuard_isUnit hL hguard
have hdet : IsUnit A.det := (Matrix.isUnit_iff_isUnit_det A).mp hunit
have hscore : empiricalScore n p t h B (signedDistanceData n P w x) =
o + A.mulVec β := by
funext j
simp only [o, A, β, winsorizedCenteredScore, Pi.add_apply]
simp [mulVec, dotProduct]
have hcoef : guardedCoefficient n p L t h B
(signedDistanceData n P w x) - β = A⁻¹.mulVec o := by
funext j
simp only [guardedCoefficient, hguard, if_pos, hscore, Matrix.mulVec_add,
Pi.add_apply, Pi.sub_apply]
have hc : A⁻¹.mulVec (A.mulVec β) = β := by
calc
_ = (A⁻¹ * A).mulVec β := Matrix.mulVec_mulVec β A⁻¹ A
_ = β := by rw [Matrix.nonsing_inv_mul A hdet, Matrix.one_mulVec]
rw [hc]
ring
have hcoord : |(A⁻¹.mulVec o) 0| ≤
sqrt (∑ k, (A⁻¹.mulVec o k) ^ 2) := by
apply (Real.le_sqrt (abs_nonneg _)
(sum_nonneg fun k _ => sq_nonneg (A⁻¹.mulVec o k))).2
rw [sq_abs]
exact Finset.single_le_sum (fun k _ => sq_nonneg (A⁻¹.mulVec o k))
(Finset.mem_univ 0)
rw [show guardedCoefficient n p L t h B (signedDistanceData n P w x) 0 -
populationCoefficient P p t x h 0 = (A⁻¹.mulVec o) 0 by
simpa [β] using congrFun hcoef 0]
calc
_ ≤ sqrt (∑ k, (A⁻¹.mulVec o k) ^ 2) := hcoord
_ ≤ 2 * L * sqrt (∑ k, (o k) ^ 2) :=
empiricalGramGuard_inv_mulVec_euclidean_le hL hguard o
_ ≤ 2 * L * ((p + 1 : ℝ) * ‖o‖) := by
gcongr
simpa [Nat.cast_add, cast_one] using
(euclideanNorm_le_card_mul_piNorm (by omega) o)
_ = _ := by simp [o]; ring
theorem condKer_winsorization_tail_lintegral_le Lemma condKer_winsorization_tail_lintegral_le in the paper ↗
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
Proof (Lean source)
lemma condKer_winsorization_tail_lintegral_le
(p : ℕ) (ν L B : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) (hB : 1 ≤ B) (t : Bool)
(x : Score) (hx : x ∈ P.support) :
(∫⁻ y, ofReal |winsorize B y - y|
∂selectedA1A2CondKer P ν L t x) ≤
ofReal (L * B ^ (-3 : ℤ)) := by
have hL : 0 ≤ L := le_trans (by norm_num) hP.2.1
have hBpow : 0 ≤ B ^ (-3 : ℤ) := by positivity
calc
_ ≤ ∫⁻ y, ofReal (|y| ^ (2 + ν) * B ^ (-3 : ℤ))
∂selectedA1A2CondKer P ν L t x := by
apply lintegral_mono
intro y
exact ENNReal.ofReal_le_ofReal (by
simpa [abs_sub_comm] using
(winsorize_tail_le_moment hP.1 hB (y := y)))
_ = selectedA1A2CondAbsMoment P ν L t x *
ofReal (B ^ (-3 : ℤ)) := by
simp_rw [ENNReal.ofReal_mul (Real.rpow_nonneg (abs_nonneg _) _)]
rw [lintegral_mul_const _ (by fun_prop)]
rfl
_ ≤ ofReal L * ofReal (B ^ (-3 : ℤ)) :=
mul_le_mul_left (hP.2.2.2.2.2.2.2.2.2.1 t x hx) _
_ = _ := by rw [← ENNReal.ofReal_mul hL]
theorem localized_arm_winsorization_tail_lintegral_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
Proof (Lean source)
lemma localized_arm_winsorization_tail_lintegral_le
(p : ℕ) (ν L B : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) (hB : 1 ≤ B) (t : Bool)
(x : Score) (h : ℝ) (hh : 0 < h) :
(∫⁻ w, (closedBall x h).indicator
(fun _ => ofReal |winsorize B (armCoord t w) - armCoord t w|)
(causalScore w) ∂P.law) ≤
ofReal ((L * B ^ (-3 : ℤ)) * (4 * L * h ^ 2)) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hK : Nonempty (A1A2KernelWitness P ν L) :=
hP.2.2.2.2.2.2.2.1.1
letI : IsMarkovKernel (selectedA1A2CondKer P ν L t) :=
selectedA1A2CondKer_markov hK t
let μ := Measure.map causalScore P.law
let F : (Score × ℝ) → ENNReal := fun q =>
(closedBall x h).indicator
(fun _ => ofReal |winsorize B q.2 - q.2|) q.1
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have harm : Measurable (armCoord t) := by
cases t <;> unfold armCoord <;> simp only [Bool.false_eq_true, if_false,
if_true] <;> fun_prop
have hpair : Measurable (fun w => (causalScore w, armCoord t w)) :=
hscore.prodMk harm
have hF : Measurable F := by
apply Measurable.indicator
· exact (((winsorize_measurable B).comp measurable_snd).sub measurable_snd).abs.ennreal_ofReal
· exact Metric.isClosed_closedBall.measurableSet.preimage measurable_fst
have hsupp : ∀ᵐ z ∂μ, z ∈ P.support := by
change ∀ᵐ z ∂Measure.map causalScore P.law, z ∈ P.support
rw [P.support_eq_marginal_support]
exact Measure.support_mem_ae
calc
_ = ∫⁻ q, F q ∂Measure.map (fun w => (causalScore w, armCoord t w)) P.law := by
rw [lintegral_map hF hpair]
_ = ∫⁻ z, ∫⁻ y, F (z, y) ∂selectedA1A2CondKer P ν L t z ∂μ := by
rw [← selectedA1A2CondKer_disint hK t, Measure.lintegral_compProd hF]
_ ≤ ∫⁻ z, (closedBall x h).indicator
(fun _ => ofReal (L * B ^ (-3 : ℤ))) z ∂μ := by
apply lintegral_mono_ae
filter_upwards [hsupp] with z hz
by_cases hzb : z ∈ closedBall x h
· simp only [F, indicator_of_mem hzb]
exact condKer_winsorization_tail_lintegral_le p ν L B P hP hB t z hz
· simp [F, indicator_of_notMem hzb]
_ = ofReal (L * B ^ (-3 : ℤ)) * μ (closedBall x h) := by
rw [lintegral_indicator Metric.isClosed_closedBall.measurableSet,
setLIntegral_const]
_ ≤ ofReal (L * B ^ (-3 : ℤ)) * ofReal (4 * L * h ^ 2) :=
mul_le_mul_right (marginal_closedBall_le p ν L P hP x h hh) _
_ = _ := by
rw [← ENNReal.ofReal_mul (mul_nonneg (le_trans (by norm_num) hP.2.1)
(by positivity : 0 ≤ B ^ (-3 : ℤ)))]
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Definition (Lean source)
noncomputable def winsorizedResidualTail (p : ℕ) (P : A1A2Law)
(t : Bool) (x : Score) (h B : ℝ) (j : Fin (p + 1))
(w : CausalObservation) : ℝ := by
classical
let d := signedDistance (knownGeometry P) x (causalScore w)
exact (if signedArm t d then 1 else 0) * uniformKernel (d / h) *
polyBasis p (d / h) j *
(winsorize B (observedOutcome P w) - observedOutcome P w)
theorem winsorizedResidualTail_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (winsorizedResidualTail p P t x h B j)
Proof (Lean source)
lemma winsorizedResidualTail_measurable (p : ℕ) (P : A1A2Law)
(t : Bool) (x : Score) (h B : ℝ) (j : Fin (p + 1)) :
Measurable (winsorizedResidualTail p P t x h B j) := by
classical
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have hA0 : MeasurableSet P.A0 := P.A0_measurable
have hA1 : MeasurableSet P.A1 := P.A1_measurable
have htreat : Measurable (treatment P) := by
unfold treatment
exact measurable_const.indicator (hA1.preimage hscore)
have harm (s : Bool) : Measurable (armCoord s) := by
cases s <;> unfold armCoord <;> simp only [Bool.false_eq_true, if_false,
if_true] <;> fun_prop
have hout : Measurable (observedOutcome P) := by
unfold observedOutcome
exact (htreat.mul (harm true)).add ((measurable_const.sub htreat).mul (harm false))
have hd : Measurable (fun w =>
signedDistance (knownGeometry P) x (causalScore w)) := by
have hi1 : Measurable (fun w => P.A1.indicator (fun _ => (1 : ℝ))
(causalScore w)) := measurable_const.indicator (hA1.preimage hscore)
have hi0 : Measurable (fun w => P.A0.indicator (fun _ => (1 : ℝ))
(causalScore w)) := measurable_const.indicator (hA0.preimage hscore)
have hdist : Measurable (fun w => dist (causalScore w) x) :=
hscore.dist measurable_const
exact (hi1.sub hi0).mul hdist
have hsigned : Measurable (fun w => if signedArm t
(signedDistance (knownGeometry P) x (causalScore w)) then (1 : ℝ) else 0) := by
cases t
· exact Measurable.ite (measurableSet_lt hd measurable_const)
measurable_const measurable_const
· exact Measurable.ite (measurableSet_le measurable_const hd)
measurable_const measurable_const
unfold winsorizedResidualTail
dsimp only
exact (((hsigned.mul (uniformKernel_measurable.comp (hd.div_const h))).mul
((polyBasis_apply_measurable p j).comp (hd.div_const h))).mul
(((winsorize_measurable B).comp hout).sub hout))
theorem winsorizedResidualTail_enorm_le_localized_arms
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
Proof (Lean source)
lemma winsorizedResidualTail_enorm_le_localized_arms
(p : ℕ) (P : A1A2Law) (t : Bool) (x : Score) (h B : ℝ)
(hh : 0 < h) (j : Fin (p + 1)) (w : CausalObservation)
(hw : causalScore w ∈ P.support) :
ofReal |winsorizedResidualTail p P t x h B j w| ≤
(closedBall x h).indicator (fun _ =>
ofReal |winsorize B (armCoord false w) - armCoord false w| +
ofReal |winsorize B (armCoord true w) - armCoord true w|)
(causalScore w) := by
classical
let z := causalScore w
let d := signedDistance (knownGeometry P) x z
have hpart : z ∈ P.A0 ∪ P.A1 := by
rw [P.assignment_partition.1]
exact hw
rcases hpart with hz0 | hz1
· have hz1n : z ∉ P.A1 := fun hz1 => P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
have hd : d = -dist z x := by
simp [d, signedDistance, knownGeometry, indicator_of_mem hz0,
indicator_of_notMem hz1n]
have hout : observedOutcome P w = armCoord false w := by
rw [observedOutcome, treatment,
indicator_of_notMem (by simpa [z] using hz1n)]
ring
by_cases hk : d / h ∈ Icc (-1 : ℝ) 1
· have hu : |d / h| ≤ 1 := by simpa [abs_le] using hk
have hball : z ∈ closedBall x h := by
rw [Metric.mem_closedBall]
rw [hd, abs_div, abs_neg, abs_of_pos hh] at hu
have := (div_le_iff₀ hh).mp hu
simpa [abs_of_nonneg (dist_nonneg : 0 ≤ dist z x)] using this
rw [show causalScore w = z by rfl, indicator_of_mem hball]
rw [← ENNReal.ofReal_add (abs_nonneg _) (abs_nonneg _)]
apply ENNReal.ofReal_le_ofReal
rw [winsorizedResidualTail, show observedOutcome P w = armCoord false w from hout,
uniformKernel, indicator_of_mem hk]
split_ifs
· rw [one_mul, one_mul, abs_mul]
exact (mul_le_mul_of_nonneg_right
(show |polyBasis p (d / h) j| ≤ 1 by
unfold polyBasis
rw [abs_pow]
exact pow_le_one₀ (abs_nonneg _) hu) (abs_nonneg _)).trans
(by simp)
· simp only [zero_mul, abs_zero]
exact add_nonneg (abs_nonneg _) (abs_nonneg _)
· rw [winsorizedResidualTail]
have hk' : signedDistance (knownGeometry P) x (causalScore w) / h ∉
Icc (-1 : ℝ) 1 := by simpa [d] using hk
simp [uniformKernel, hk']
· have hz0n : z ∉ P.A0 := fun hz0 => P.assignment_partition.2.le_bot ⟨hz0, hz1⟩
have hd : d = dist z x := by
simp [d, signedDistance, knownGeometry, indicator_of_mem hz1,
indicator_of_notMem hz0n]
have hout : observedOutcome P w = armCoord true w := by
rw [observedOutcome, treatment, indicator_of_mem (by simpa [z] using hz1)]
ring
by_cases hk : d / h ∈ Icc (-1 : ℝ) 1
· have hu : |d / h| ≤ 1 := by simpa [abs_le] using hk
have hball : z ∈ closedBall x h := by
rw [Metric.mem_closedBall]
rw [hd, abs_div, abs_of_pos hh] at hu
have := (div_le_iff₀ hh).mp hu
simpa [abs_of_nonneg (dist_nonneg : 0 ≤ dist z x)] using this
rw [show causalScore w = z by rfl, indicator_of_mem hball]
rw [← ENNReal.ofReal_add (abs_nonneg _) (abs_nonneg _)]
apply ENNReal.ofReal_le_ofReal
rw [winsorizedResidualTail, show observedOutcome P w = armCoord true w from hout,
uniformKernel, indicator_of_mem hk]
split_ifs
· rw [one_mul, one_mul, abs_mul]
exact (mul_le_mul_of_nonneg_right
(show |polyBasis p (d / h) j| ≤ 1 by
unfold polyBasis
rw [abs_pow]
exact pow_le_one₀ (abs_nonneg _) hu) (abs_nonneg _)).trans
(by simp)
· simp only [zero_mul, abs_zero]
exact add_nonneg (abs_nonneg _) (abs_nonneg _)
· rw [winsorizedResidualTail]
have hk' : signedDistance (knownGeometry P) x (causalScore w) / h ∉
Icc (-1 : ℝ) 1 := by simpa [d] using hk
simp [uniformKernel, hk']
theorem winsorizedResidualTail_lintegral_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
Proof (Lean source)
lemma winsorizedResidualTail_lintegral_le
(p : ℕ) (ν L B : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) (hB : 1 ≤ B) (t : Bool)
(x : Score) (h : ℝ) (hh : 0 < h) (j : Fin (p + 1)) :
(∫⁻ w, ofReal |winsorizedResidualTail p P t x h B j w| ∂P.law) ≤
ofReal (2 * ((L * B ^ (-3 : ℤ)) * (4 * L * h ^ 2))) := by
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have hsuppMap : ∀ᵐ z ∂Measure.map causalScore P.law, z ∈ P.support := by
rw [P.support_eq_marginal_support]
exact Measure.support_mem_ae
have hsupp : ∀ᵐ w ∂P.law, causalScore w ∈ P.support :=
MeasureTheory.ae_of_ae_map hscore.aemeasurable hsuppMap
have harmFalse : Measurable (armCoord false) := by
unfold armCoord
simp only [Bool.false_eq_true, if_false]
fun_prop
calc
_ ≤ ∫⁻ w, (closedBall x h).indicator (fun _ =>
ofReal |winsorize B (armCoord false w) - armCoord false w| +
ofReal |winsorize B (armCoord true w) - armCoord true w|)
(causalScore w) ∂P.law :=
lintegral_mono_ae (hsupp.mono fun w hw =>
winsorizedResidualTail_enorm_le_localized_arms p P t x h B hh j w hw)
_ = (∫⁻ w, (closedBall x h).indicator
(fun _ => ofReal |winsorize B (armCoord false w) - armCoord false w|)
(causalScore w) ∂P.law) +
∫⁻ w, (closedBall x h).indicator
(fun _ => ofReal |winsorize B (armCoord true w) - armCoord true w|)
(causalScore w) ∂P.law := by
rw [← lintegral_add_left]
· apply lintegral_congr
intro w
by_cases hw : causalScore w ∈ closedBall x h <;> simp [hw]
· apply Measurable.indicator
· exact (((winsorize_measurable B).comp harmFalse).sub
harmFalse).abs.ennreal_ofReal
· exact Metric.isClosed_closedBall.measurableSet.preimage hscore
_ ≤ ofReal ((L * B ^ (-3 : ℤ)) * (4 * L * h ^ 2)) +
ofReal ((L * B ^ (-3 : ℤ)) * (4 * L * h ^ 2)) :=
add_le_add
(localized_arm_winsorization_tail_lintegral_le p ν L B P hP hB false x h hh)
(localized_arm_winsorization_tail_lintegral_le p ν L B P hP hB true x h hh)
_ = _ := by
have hterm : 0 ≤ (L * B ^ (-3 : ℤ)) * (4 * L * h ^ 2) := by
exact mul_nonneg
(mul_nonneg (le_trans (by norm_num) hP.2.1) (by positivity))
(mul_nonneg (mul_nonneg (by norm_num) (le_trans (by norm_num) hP.2.1))
(sq_nonneg h))
rw [← ENNReal.ofReal_add hterm hterm]
congr 1
ring
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Definition (Lean source)
noncomputable def signedLocalPolynomialWeight (p : ℕ) (P : A1A2Law)
(t : Bool) (x : Score) (h : ℝ) (j : Fin (p + 1))
(w : CausalObservation) : ℝ := by
classical
let d := signedDistance (knownGeometry P) x (causalScore w)
exact (if signedArm t d then 1 else 0) * uniformKernel (d / h) *
polyBasis p (d / h) j
theorem causalSignedDistance_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Proof (Lean source)
lemma causalSignedDistance_measurable (P : A1A2Law) (x : Score) :
Measurable (fun w => signedDistance (knownGeometry P) x (causalScore w)) := by
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have hi1 : Measurable (fun w => P.A1.indicator (fun _ => (1 : ℝ))
(causalScore w)) := measurable_const.indicator (P.A1_measurable.preimage hscore)
have hi0 : Measurable (fun w => P.A0.indicator (fun _ => (1 : ℝ))
(causalScore w)) := measurable_const.indicator (P.A0_measurable.preimage hscore)
exact (hi1.sub hi0).mul (hscore.dist measurable_const)
theorem signedLocalPolynomialWeight_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (signedLocalPolynomialWeight p P t x h j)
Proof (Lean source)
lemma signedLocalPolynomialWeight_measurable (p : ℕ) (P : A1A2Law)
(t : Bool) (x : Score) (h : ℝ) (j : Fin (p + 1)) :
Measurable (signedLocalPolynomialWeight p P t x h j) := by
classical
have hd : Measurable (fun w =>
signedDistance (knownGeometry P) x (causalScore w)) :=
causalSignedDistance_measurable P x
have hsigned : Measurable (fun w => if signedArm t
(signedDistance (knownGeometry P) x (causalScore w)) then (1 : ℝ) else 0) := by
cases t
· exact Measurable.ite (measurableSet_lt hd measurable_const)
measurable_const measurable_const
· exact Measurable.ite (measurableSet_le measurable_const hd)
measurable_const measurable_const
unfold signedLocalPolynomialWeight
dsimp only
exact (hsigned.mul (uniformKernel_measurable.comp (hd.div_const h))).mul
((polyBasis_apply_measurable p j).comp (hd.div_const h))
theorem signedLocalPolynomialWeight_abs_le_one
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
conclusion
|signedLocalPolynomialWeight p P t x h j w| ≤ 1
Proof (Lean source)
lemma signedLocalPolynomialWeight_abs_le_one
(p : ℕ) (P : A1A2Law) (t : Bool) (x : Score) (h : ℝ)
(j : Fin (p + 1)) (w : CausalObservation) :
|signedLocalPolynomialWeight p P t x h j w| ≤ 1 := by
classical
let d := signedDistance (knownGeometry P) x (causalScore w)
by_cases hk : d / h ∈ Icc (-1 : ℝ) 1
· have hu : |d / h| ≤ 1 := by simpa [abs_le] using hk
rw [signedLocalPolynomialWeight, uniformKernel, indicator_of_mem hk]
split_ifs
· simp only [one_mul, abs_mul, abs_one, one_mul]
unfold polyBasis
rw [abs_pow]
exact pow_le_one₀ (abs_nonneg _) hu
· simp
· rw [signedLocalPolynomialWeight, uniformKernel]
have hk' : signedDistance (knownGeometry P) x (causalScore w) / h ∉
Icc (-1 : ℝ) 1 := by simpa [d] using hk
simp [hk']
theorem observedOutcome_integrable
The observed outcome is integrable under the stated causal law.
Formal statement
hypotheses
conclusion
Integrable (observedOutcome P) P.law
Proof (Lean source)
lemma observedOutcome_integrable (p : ℕ) (ν L : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) : Integrable (observedOutcome P) P.law := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hscore : Measurable causalScore := by unfold causalScore; fun_prop
have htreat : Measurable (treatment P) := by
unfold treatment
exact measurable_const.indicator (P.A1_measurable.preimage hscore)
have hexp : 1 ≤ ofReal (2 + ν) := by
rw [ENNReal.one_le_ofReal]
linarith [hP.1]
have hi0 : Integrable (armCoord false) P.law :=
(P.memLp_armCoord_of_condAbsMoment_le p ν L hP false).integrable hexp
have hi1 : Integrable (armCoord true) P.law :=
(P.memLp_armCoord_of_condAbsMoment_le p ν L hP true).integrable hexp
have htbound : ∀ᵐ w ∂P.law, ‖treatment P w‖ ≤ 1 := by
filter_upwards with w
unfold treatment
by_cases hw : causalScore w ∈ P.A1 <;> simp [hw]
have hctbound : ∀ᵐ w ∂P.law, ‖1 - treatment P w‖ ≤ 1 := by
filter_upwards with w
unfold treatment
by_cases hw : causalScore w ∈ P.A1 <;> simp [hw]
unfold observedOutcome
exact (hi1.bdd_mul htreat.aestronglyMeasurable htbound).add
(hi0.bdd_mul (measurable_const.sub htreat).aestronglyMeasurable hctbound)
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Definition (Lean source)
noncomputable def rawPopulationResidual (p : ℕ) (P : A1A2Law)
(t : Bool) (x : Score) (h : ℝ) (j : Fin (p + 1))
(w : CausalObservation) : ℝ := by
classical
let d := signedDistance (knownGeometry P) x (causalScore w)
exact signedLocalPolynomialWeight p P t x h j w *
(observedOutcome P w - ∑ k, polyBasis p (d / h) k *
populationCoefficient P p t x h k)
theorem rawPopulationResidual_integral_eq_zero
The two stated constructions agree under the theorem's assumptions.
Formal statement
Proof (Lean source)
lemma rawPopulationResidual_integral_eq_zero
(p : ℕ) (ν L : ℝ) (P : A1A2Law) (hP : A1A2Class p ν L P)
(t : Bool) (x : Score) (hx : x ∈ P.boundary)
(h : ℝ) (hh : 0 < h) (hhL : h ≤ L⁻¹) (j : Fin (p + 1)) :
∫ w, rawPopulationResidual p P t x h j w ∂P.law = 0 := by
classical
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hnormal := congrFun
(populationGram_mulVec_populationCoefficient p ν L P hP t x hx h hh hhL) j
rw [mulVec, dotProduct] at hnormal
have hh0 : h ≠ 0 := hh.ne'
have hscale : h ^ 2 * h⁻¹ ^ 2 = 1 := by field_simp
have hweightMeas := signedLocalPolynomialWeight_measurable p P t x h j
have hobs := observedOutcome_integrable p ν L P hP
have hfirst : Integrable (fun w =>
signedLocalPolynomialWeight p P t x h j w * observedOutcome P w) P.law :=
hobs.bdd_mul hweightMeas.aestronglyMeasurable
(ae_of_all _ fun w => by
simpa [Real.norm_eq_abs] using
signedLocalPolynomialWeight_abs_le_one p P t x h j w)
have hd := causalSignedDistance_measurable P x
have hsecondEach (k : Fin (p + 1)) : Integrable (fun w =>
signedLocalPolynomialWeight p P t x h j w *
(polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) k *
populationCoefficient P p t x h k)) P.law := by
have hi := Integrable.of_bound (μ := P.law)
((hweightMeas.fun_mul ((polyBasis_apply_measurable p k).comp
(hd.div_const h))).fun_mul measurable_const).aestronglyMeasurable
|populationCoefficient P p t x h k| (by
filter_upwards with w
rw [Real.norm_eq_abs, abs_mul, abs_mul]
have hwgt := signedLocalPolynomialWeight_abs_le_one p P t x h j w
let d := signedDistance (knownGeometry P) x (causalScore w)
by_cases hk : d / h ∈ Icc (-1 : ℝ) 1
· have hu : |d / h| ≤ 1 := by simpa [abs_le] using hk
have hpoly : |polyBasis p (d / h) k| ≤ 1 := by
unfold polyBasis
rw [abs_pow]
exact pow_le_one₀ (abs_nonneg _) hu
have hprod := mul_le_mul hwgt hpoly (abs_nonneg _)
(by norm_num : (0 : ℝ) ≤ 1)
simpa [d] using mul_le_mul_of_nonneg_right hprod
(abs_nonneg (populationCoefficient P p t x h k))
· have hk' : signedDistance (knownGeometry P) x (causalScore w) / h ∉
Icc (-1 : ℝ) 1 := by simpa [d] using hk
rw [signedLocalPolynomialWeight]
simp [uniformKernel, hk'])
simpa [mul_assoc] using hi
have hsecond : Integrable (fun w => ∑ k,
signedLocalPolynomialWeight p P t x h j w *
(polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) k *
populationCoefficient P p t x h k)) P.law :=
integrable_finset_sum _ (fun k _ => hsecondEach k)
have scale_integral (f : CausalObservation → ℝ) :
(∫ w, f w ∂P.law) = h ^ 2 * ∫ w, h⁻¹ ^ 2 * f w ∂P.law := by
rw [← integral_const_mul]
apply integral_congr_ae
filter_upwards with w
field_simp
have move_const (k : Fin (p + 1)) :
(∫ w, signedLocalPolynomialWeight p P t x h j w *
(polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) k *
populationCoefficient P p t x h k) ∂P.law) =
(∫ w, signedLocalPolynomialWeight p P t x h j w *
polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) k ∂P.law) *
populationCoefficient P p t x h k := by
rw [show (fun w => signedLocalPolynomialWeight p P t x h j w *
(polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) k *
populationCoefficient P p t x h k)) =
fun w => (signedLocalPolynomialWeight p P t x h j w *
polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) k) *
populationCoefficient P p t x h k by funext w; ring,
integral_mul_const]
calc
∫ w, rawPopulationResidual p P t x h j w ∂P.law =
h ^ 2 * (populationScore P p t x h j -
∑ k, populationGram P p t x h j k *
populationCoefficient P p t x h k) := by
simp only [rawPopulationResidual]
simp_rw [mul_sub, Finset.mul_sum]
rw [integral_sub hfirst hsecond,
integral_finset_sum _ (fun k _ => hsecondEach k)]
simp_rw [move_const]
rw [scale_integral _]
rw [show (∑ k, (∫ w, signedLocalPolynomialWeight p P t x h j w *
polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) k
∂P.law) * populationCoefficient P p t x h k) =
∑ k, (h ^ 2 * ∫ w, h⁻¹ ^ 2 *
(signedLocalPolynomialWeight p P t x h j w *
polyBasis p (signedDistance (knownGeometry P) x (causalScore w) / h) k)
∂P.law) * populationCoefficient P p t x h k by
apply Finset.sum_congr rfl
intro k _hk
rw [scale_integral]]
simp only [signedLocalPolynomialWeight, populationScore, populationGram]
simp only [signedArm]
ring_nf
_ = 0 := by rw [hnormal]; ring
theorem winsorizedCenteredScore_mean_norm_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
n p :
ℕ
ν L :
ℝ
P :
hP :
A1A2Class p ν L P
t :
x :
hx :
x ∈ P.boundary
h B :
ℝ
hn :
1 ≤ n
hh :
0 < h
hhL :
h ≤ L⁻¹
hB :
1 ≤ B
conclusion
‖fun j => ∫ w, winsorizedCenteredScore n p P t x h B w j ∂causalSampleLaw P n‖
≤ 8 * L ^ 2 * B ^ (-3 : ℤ)
Proof (Lean source)
lemma winsorizedCenteredScore_mean_norm_le
(n p : ℕ) (ν L : ℝ) (P : A1A2Law) (hP : A1A2Class p ν L P)
(t : Bool) (x : Score) (hx : x ∈ P.boundary)
(h B : ℝ) (hn : 1 ≤ n) (hh : 0 < h) (hhL : h ≤ L⁻¹) (hB : 1 ≤ B) :
‖fun j => ∫ w, winsorizedCenteredScore n p P t x h B w j
∂causalSampleLaw P n‖ ≤ 8 * L ^ 2 * B ^ (-3 : ℤ) := by
classical
letI : IsProbabilityMeasure P.law := P.law_isProbability
let R : ℝ := 1 + |L * (p + 1 : ℝ) * (16 * L * (2 + L))|
have hR : 0 < R := by dsimp [R]; positivity
have hbeta : ∀ k, |populationCoefficient P p t x h k| ≤ R := by
intro k
exact populationCoefficient_uniform_bound_explicit p ν L P hP t x h hx hh hhL k
obtain ⟨A, v, C₀, hC₀, hent⟩ :=
winsorizedScore_hasVCUniformEntropy_all_nu p L R hR
have hLpos : 0 < L := lt_of_lt_of_le (by norm_num) hP.2.1
have hhB : h < B := by
have hinv : L⁻¹ < 1 := inv_lt_one_of_one_lt₀
(lt_of_lt_of_le (by norm_num) hP.2.1)
exact (hhL.trans_lt hinv).trans_le hB
obtain ⟨_hσ, _hσU, _hA, _hv, hmeas, henv, _hL2, _hcover⟩ :=
hent ν P hP h B hh hhB hB
rw [pi_norm_le_iff_of_nonneg (by positivity)]
intro j
let idx : SeparableWinsorizedScoreIndex P p h :=
(⟨h, ⟨le_rfl, by linarith⟩⟩, t, ⟨x, hx⟩,
populationCoefficient P p t x h, j)
let g := separableWinsorizedScoreFunction P p h B R idx
let q := winsorizedResidualTail p P t x h B j
have hg : Integrable g P.law :=
Integrable.of_bound (μ := P.law) (hmeas idx).aestronglyMeasurable (C₀ * B)
(ae_of_all _ fun z => by
change |g z| ≤ C₀ * B
exact henv idx z)
have hqmeas : Measurable q := winsorizedResidualTail_measurable p P t x h B j
have hqlin := winsorizedResidualTail_lintegral_le p ν L B P hP hB t x h hh j
have hq : Integrable q P.law := by
refine ⟨hqmeas.aestronglyMeasurable, ?_⟩
rw [hasFiniteIntegral_iff_enorm]
calc
(∫⁻ w, ‖q w‖ₑ ∂P.law) =
∫⁻ w, ofReal |q w| ∂P.law := by
apply lintegral_congr
intro w
rw [← ofReal_norm_eq_enorm, Real.norm_eq_abs]
_ ≤ ofReal (2 * ((L * B ^ (-3 : ℤ)) * (4 * L * h ^ 2))) := hqlin
_ < ∞ := ENNReal.ofReal_lt_top
have hclip (k : Fin (p + 1)) :
clip R (populationCoefficient P p t x h k) =
populationCoefficient P p t x h k := by
have hk := hbeta k
rw [abs_le] at hk
simp [clip, min_eq_right hk.2, max_eq_right hk.1]
have hsplit (w : CausalObservation) :
g w = rawPopulationResidual p P t x h j w + q w := by
simp only [g, idx, q, separableWinsorizedScoreFunction,
rawPopulationResidual, winsorizedResidualTail, signedLocalPolynomialWeight]
simp_rw [hclip]
ring
have hraw : Integrable (rawPopulationResidual p P t x h j) P.law := by
have : rawPopulationResidual p P t x h j = g - q := by
funext w
change rawPopulationResidual p P t x h j w = g w - q w
linarith [hsplit w]
rw [this]
exact hg.sub hq
have hrawzero := rawPopulationResidual_integral_eq_zero
p ν L P hP t x hx h hh hhL j
have hgint : ∫ w, g w ∂P.law = ∫ w, q w ∂P.law := by
rw [integral_congr_ae (ae_of_all _ hsplit), integral_add hraw hq, hrawzero,
zero_add]
have hg' : Integrable (separableWinsorizedScoreFunction P p h B R idx) P.law := hg
have hgint' : (∫ z, separableWinsorizedScoreFunction P p h B R idx z ∂P.law) =
∫ z, q z ∂P.law := hgint
have hmean := winsorizedCenteredScore_integral_eq
n p P t x hx h B R hh hn hbeta j hg'
rw [hmean, hgint']
have hint := MeasureTheory.enorm_integral_le_lintegral_enorm q (μ := P.law)
have hint' : ofReal |∫ w, q w ∂P.law| ≤
∫⁻ w, ofReal |q w| ∂P.law := by
simpa only [← ofReal_norm_eq_enorm, Real.norm_eq_abs] using hint
have htailENN : ofReal |∫ w, q w ∂P.law| ≤
ofReal (2 * ((L * B ^ (-3 : ℤ)) * (4 * L * h ^ 2))) := by
exact hint'.trans hqlin
have htail : |∫ w, q w ∂P.law| ≤
2 * ((L * B ^ (-3 : ℤ)) * (4 * L * h ^ 2)) := by
exact (ENNReal.ofReal_le_ofReal_iff (by positivity)).mp htailENN
rw [Real.norm_eq_abs, abs_mul, abs_of_nonneg (by positivity : 0 ≤ h⁻¹ ^ 2)]
have hcancel : h⁻¹ ^ 2 * h ^ 2 = 1 := by field_simp
calc
h⁻¹ ^ 2 * |∫ w, q w ∂P.law| ≤
h⁻¹ ^ 2 * (2 * ((L * B ^ (-3 : ℤ)) * (4 * L * h ^ 2))) :=
mul_le_mul_of_nonneg_left htail (by positivity)
_ = (8 * L ^ 2 * B ^ (-3 : ℤ)) * (h⁻¹ ^ 2 * h ^ 2) := by ring
_ = 8 * L ^ 2 * B ^ (-3 : ℤ) := by rw [hcancel, mul_one]
theorem euclideanCExtEnvelope_abs_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
conclusion
|f x| ≤ L
Proof (Lean source)
lemma euclideanCExtEnvelope_abs_le {f : Score → ℝ} {p : ℕ} {L : ℝ}
{S : Set Score} (hf : EuclideanCExtEnvelope f p L S)
{x : Score} (hx : x ∈ S) : |f x| ≤ L := by
rcases hf with ⟨U, hU, hSU, g, hg, hgf, hpartialBdd, hlipBdd, hsum⟩
have hmem : |g x| ∈ coordinatePartialValues g p S := by
refine ⟨fun _ => 0, ?_, x, hx, ?_⟩
· simp [coordinateMultiOrder]
· unfold coordinatePartial
simp only [coordinateMultiOrder, Pi.zero_apply, add_zero]
exact congrArg abs
(iteratedFDeriv_zero_apply (𝕜 := ℝ) (f := g) (x := x)
(coordinateDirections (fun _ : Fin 2 => 0))).symm
have hle : |g x| ≤ sSup (coordinatePartialValues g p S) :=
le_csSup hpartialBdd hmem
have hlipnonneg : 0 ≤ sSup (coordinatePartialLipschitzValues g p S) := by
apply Real.sSup_nonneg
rintro r ⟨alpha, ha, y, hy, z, hz, hyz, rfl⟩
positivity
rw [← hgf hx]
linarith
theorem stabilizedLocalPolynomial_boundaryLoss_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
n p :
ℕ
ν L Cb h B :
ℝ
P :
hP :
A1A2Class p ν L P
hCb :
0 ≤ Cb
hn :
1 ≤ n
hh :
0 < h
hhL :
h ≤ L⁻¹
hB :
1 ≤ B
hBeq :
B = rpow h (-(1 : ℝ) / 3)
hbias :
causalUniformBiasRatio p ν L h ≤ ofReal Cb
w :
conclusion
a1a2BoundaryLoss (stabilizedLocalPolynomial n p L h) P w
≤ ofReal (Cb * h + 4 * L * (p + 1 : ℝ) * (8 * L ^ 2 * B ^ (-3 : ℤ)))
+ ofReal (4 * L * (p + 1 : ℝ)) * winsorizedScoreDeviation n p P h B w
+ ofReal (8 * L ^ 2 * (p + 1 : ℝ)) * causalGramDeviation n p P h w
Proof (Lean source)
lemma stabilizedLocalPolynomial_boundaryLoss_le
(n p : ℕ) (ν L Cb h B : ℝ) (P : A1A2Law)
(hP : A1A2Class p ν L P) (hCb : 0 ≤ Cb)
(hn : 1 ≤ n) (hh : 0 < h) (hhL : h ≤ L⁻¹) (hB : 1 ≤ B)
(hBeq : B = rpow h (-(1 : ℝ) / 3))
(hbias : causalUniformBiasRatio p ν L h ≤ ofReal Cb)
(w : CausalSample n) :
a1a2BoundaryLoss (stabilizedLocalPolynomial n p L h) P w ≤
ofReal (Cb * h +
4 * L * (p + 1 : ℝ) * (8 * L ^ 2 * B ^ (-3 : ℤ))) +
ofReal (4 * L * (p + 1 : ℝ)) *
winsorizedScoreDeviation n p P h B w +
ofReal (8 * L ^ 2 * (p + 1 : ℝ)) *
causalGramDeviation n p P h w := by
classical
have hLpos : 0 < L := lt_of_lt_of_le (by norm_num) hP.2.1
have hqpos : 0 < (p + 1 : ℝ) := by positivity
have hPfull := hP
obtain ⟨_hnu, _hL, _hSupport, _hDensCont, _hDens, hMu, _hVar,
_hMean, _hVariance, _hMoment, hGeom, _hVC, _hGram, _hMass, _hSlice⟩ := hP
rcases hGeom with ⟨_hA0, _hA1, _hpart, _hdisj, _hbEq, _hbCompact,
hbSupport, _hrect, _hbmassLo, _hbmassHi⟩
unfold a1a2BoundaryLoss
apply iSup_le
intro x
apply iSup_le
intro hx
have hxsupp : x ∈ P.support := interior_subset (hbSupport hx)
have hmu (t : Bool) : |P.muPO t x| ≤ L :=
euclideanCExtEnvelope_abs_le (hMu t) hxsupp
have htau : |P.tau x| ≤ 2 * L := by
unfold A1A2Law.tau
exact (abs_sub _ _).trans (by linarith [hmu true, hmu false])
let δ : ℝ := (2 * L * (p + 1 : ℝ))⁻¹
have hδ : 0 < δ := by dsimp [δ]; positivity
by_cases hgood : causalGramDeviation n p P h w ≤ ofReal δ
· have hguard (t : Bool) : empiricalGramGuard L
(empiricalGram n p t h (signedDistanceData n P w x)) :=
empiricalGramGuard_of_deviation_le n p ν L P hPfull h hh hhL w
(by simpa [δ] using hgood) t x hx
have hcoef (t : Bool) :
ofReal |guardedCoefficient n p L t h B
(signedDistanceData n P w x) 0 -
populationCoefficient P p t x h 0| ≤
ofReal (2 * L * (p + 1 : ℝ)) *
(winsorizedScoreDeviation n p P h B w +
ofReal (8 * L ^ 2 * B ^ (-3 : ℤ))) := by
let m : Fin (p + 1) → ℝ := fun j => ∫ w',
winsorizedCenteredScore n p P t x h B w' j ∂causalSampleLaw P n
let c := winsorizedCenteredScore n p P t x h B w - m
have hc : ofReal ‖c‖ ≤ winsorizedScoreDeviation n p P h B w := by
unfold winsorizedScoreDeviation
exact le_iSup_of_le t (le_iSup_of_le x (le_iSup_of_le hx le_rfl))
have hm : ‖m‖ ≤ 8 * L ^ 2 * B ^ (-3 : ℤ) :=
winsorizedCenteredScore_mean_norm_le n p ν L P hPfull t x hx h B hn hh hhL hB
have hnorm : ‖winsorizedCenteredScore n p P t x h B w‖ ≤
‖c‖ + ‖m‖ := by
have heq : winsorizedCenteredScore n p P t x h B w = c + m := by
funext j
simp [c, m]
rw [heq]
exact norm_add_le _ _
have hreal := guardedCoefficient_sub_populationCoefficient_le
n p ν L h B P hPfull t x hx hh hhL w (hguard t)
calc
_ ≤ ofReal (2 * L * (p + 1 : ℝ) *
‖winsorizedCenteredScore n p P t x h B w‖) :=
ENNReal.ofReal_le_ofReal hreal
_ ≤ ofReal (2 * L * (p + 1 : ℝ) * (‖c‖ + ‖m‖)) := by
apply ENNReal.ofReal_le_ofReal
gcongr
_ = ofReal (2 * L * (p + 1 : ℝ)) *
(ofReal ‖c‖ + ofReal ‖m‖) := by
rw [← ENNReal.ofReal_add (norm_nonneg _) (norm_nonneg _),
← ENNReal.ofReal_mul (by positivity : 0 ≤ 2 * L * (p + 1 : ℝ))]
_ ≤ _ := by
gcongr
have hbiasPoint : |(populationCoefficient P p true x h 0 -
populationCoefficient P p false x h 0) - P.tau x| ≤ Cb * h := by
have hb : ofReal
(|(populationCoefficient P p true x h 0 -
populationCoefficient P p false x h 0) - P.tau x| / h) ≤
causalUniformBiasRatio p ν L h := by
unfold causalUniformBiasRatio
exact le_iSup_of_le P (le_iSup_of_le hPfull
(le_iSup_of_le x (le_iSup_of_le hx le_rfl)))
have hb' := hb.trans hbias
have hr : |(populationCoefficient P p true x h 0 -
populationCoefficient P p false x h 0) - P.tau x| / h ≤ Cb :=
(ENNReal.ofReal_le_ofReal_iff hCb).mp hb'
exact (div_le_iff₀ hh).mp hr
have hclip : |clip (2 * L)
(guardedCoefficient n p L true h B (signedDistanceData n P w x) 0 -
guardedCoefficient n p L false h B (signedDistanceData n P w x) 0) -
P.tau x| ≤
|(guardedCoefficient n p L true h B (signedDistanceData n P w x) 0 -
guardedCoefficient n p L false h B (signedDistanceData n P w x) 0) -
P.tau x| := by
simpa [clip, clipIcc] using
(abs_clipIcc_sub_le
(a := -2 * L) (b := 2 * L) (x :=
guardedCoefficient n p L true h B (signedDistanceData n P w x) 0 -
guardedCoefficient n p L false h B (signedDistanceData n P w x) 0)
(t := P.tau x) (show P.tau x ∈ Icc (-2 * L) (2 * L) from
⟨by linarith [(abs_le.mp htau).1], (abs_le.mp htau).2⟩))
have herr : |(guardedCoefficient n p L true h B
(signedDistanceData n P w x) 0 -
guardedCoefficient n p L false h B (signedDistanceData n P w x) 0) -
P.tau x| ≤
|guardedCoefficient n p L true h B (signedDistanceData n P w x) 0 -
populationCoefficient P p true x h 0| +
|guardedCoefficient n p L false h B (signedDistanceData n P w x) 0 -
populationCoefficient P p false x h 0| + Cb * h := by
have hab := abs_add_three
(guardedCoefficient n p L true h B (signedDistanceData n P w x) 0 -
populationCoefficient P p true x h 0)
(populationCoefficient P p false x h 0 -
guardedCoefficient n p L false h B (signedDistanceData n P w x) 0)
(populationCoefficient P p true x h 0 -
populationCoefficient P p false x h 0 - P.tau x)
calc
_ = |(guardedCoefficient n p L true h B (signedDistanceData n P w x) 0 -
populationCoefficient P p true x h 0) +
(populationCoefficient P p false x h 0 -
guardedCoefficient n p L false h B (signedDistanceData n P w x) 0) +
(populationCoefficient P p true x h 0 -
populationCoefficient P p false x h 0 - P.tau x)| := by ring_nf
_ ≤ _ := hab.trans (by
rw [abs_sub_comm (populationCoefficient P p false x h 0)]
exact add_le_add (add_le_add le_rfl le_rfl) hbiasPoint)
have hu : geometrySignedDistanceData n (knownGeometry P) w x =
signedDistanceData n P w x := by
funext i
apply Prod.ext
· simp only [geometrySignedDistanceData, signedDistanceData,
observedOutcome, treatment, knownGeometry]
by_cases hi : causalScore (w i) ∈ P.A1 <;>
simp [indicator, hi]
· rfl
simp only [stabilizedLocalPolynomial, hBeq.symm]
rw [hu]
apply (ENNReal.ofReal_le_ofReal hclip).trans
apply (ENNReal.ofReal_le_ofReal herr).trans
rw [ENNReal.ofReal_add (by positivity) (by positivity),
ENNReal.ofReal_add (abs_nonneg _) (abs_nonneg _)]
have hc1 := hcoef true
have hc0 := hcoef false
have hgram0 : ofReal (8 * L ^ 2 * (p + 1 : ℝ)) *
causalGramDeviation n p P h w ≥ 0 := bot_le
calc
_ ≤ (ofReal (2 * L * (p + 1 : ℝ)) *
(winsorizedScoreDeviation n p P h B w +
ofReal (8 * L ^ 2 * B ^ (-3 : ℤ)))) * 2 +
ofReal (Cb * h) := by
calc
_ ≤ (ofReal (2 * L * (p + 1 : ℝ)) *
(winsorizedScoreDeviation n p P h B w +
ofReal (8 * L ^ 2 * B ^ (-3 : ℤ)))) +
(ofReal (2 * L * (p + 1 : ℝ)) *
(winsorizedScoreDeviation n p P h B w +
ofReal (8 * L ^ 2 * B ^ (-3 : ℤ)))) +
ofReal (Cb * h) := add_le_add (add_le_add hc1 hc0) le_rfl
_ = _ := by ring
_ ≤ _ := by
have hCbH : 0 ≤ Cb * h := mul_nonneg hCb hh.le
have hK : 0 ≤ 2 * L * (p + 1 : ℝ) := by positivity
have hM : 0 ≤ 8 * L ^ 2 * B ^ (-3 : ℤ) := by positivity
have hKM : 0 ≤ 4 * L * (p + 1 : ℝ) *
(8 * L ^ 2 * B ^ (-3 : ℤ)) := by positivity
have hK2 : ofReal (2 * L * (p + 1 : ℝ)) * 2 =
ofReal (4 * L * (p + 1 : ℝ)) := by
rw [show (2 : ENNReal) = ofReal 2 by norm_num,
← ENNReal.ofReal_mul hK]
congr 1
ring
have hKM2 : ofReal (2 * L * (p + 1 : ℝ)) *
ofReal (8 * L ^ 2 * B ^ (-3 : ℤ)) * 2 =
ofReal (4 * L * (p + 1 : ℝ) *
(8 * L ^ 2 * B ^ (-3 : ℤ))) := by
rw [← ENNReal.ofReal_mul hK, show (2 : ENNReal) = ofReal 2 by norm_num,
← ENNReal.ofReal_mul (mul_nonneg hK hM)]
congr 1
ring
have halg :
(ofReal (2 * L * (p + 1 : ℝ)) *
(winsorizedScoreDeviation n p P h B w +
ofReal (8 * L ^ 2 * B ^ (-3 : ℤ)))) * 2 +
ofReal (Cb * h) =
ofReal (Cb * h + 4 * L * (p + 1 : ℝ) *
(8 * L ^ 2 * B ^ (-3 : ℤ))) +
ofReal (4 * L * (p + 1 : ℝ)) *
winsorizedScoreDeviation n p P h B w := by
rw [ENNReal.ofReal_add hCbH hKM]
calc
_ = ofReal (Cb * h) +
(ofReal (2 * L * (p + 1 : ℝ)) * 2) *
winsorizedScoreDeviation n p P h B w +
ofReal (2 * L * (p + 1 : ℝ)) *
ofReal (8 * L ^ 2 * B ^ (-3 : ℤ)) * 2 := by ring
_ = _ := by rw [hK2, hKM2]; ring
rw [halg]
exact le_add_of_nonneg_right bot_le
· have hest : |stabilizedLocalPolynomial n p L h w (knownGeometry P) x| ≤ 2 * L := by
simp only [stabilizedLocalPolynomial]
simpa [clip, clipIcc] using
abs_clipIcc_neg_le (mul_nonneg (by norm_num) hLpos.le)
(guardedCoefficient n p L true h (rpow h (-(1 : ℝ) / 3))
(geometrySignedDistanceData n (knownGeometry P) w x) 0 -
guardedCoefficient n p L false h (rpow h (-(1 : ℝ) / 3))
(geometrySignedDistanceData n (knownGeometry P) w x) 0)
have hloss : |stabilizedLocalPolynomial n p L h w (knownGeometry P) x - P.tau x| ≤
4 * L := (abs_sub _ _).trans (by linarith)
have hδle : ofReal δ ≤ causalGramDeviation n p P h w :=
le_of_not_ge hgood
have hbad : ofReal (4 * L) ≤
ofReal (8 * L ^ 2 * (p + 1 : ℝ)) *
causalGramDeviation n p P h w := by
calc
ofReal (4 * L) =
ofReal (8 * L ^ 2 * (p + 1 : ℝ)) * ofReal δ := by
rw [← ENNReal.ofReal_mul (by positivity : 0 ≤ 8 * L ^ 2 * (p + 1 : ℝ))]
apply congrArg ofReal
dsimp [δ]
field_simp
ring
_ ≤ _ := mul_le_mul_right hδle _
exact (ENNReal.ofReal_le_ofReal hloss).trans
(hbad.trans (le_add_of_nonneg_left bot_le))
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Definition (Lean source)
theorem t4Bandwidth_eventually_eq_frontierRate
From a sufficiently large sample size onward, the two stated bandwidth schedules coincide.
Formal statement
conclusion
Proof (Lean source)
lemma t4Bandwidth_eventually_eq_frontierRate :
t4Bandwidth =ᶠ[atTop] frontierRate := by
filter_upwards [eventually_ge_atTop (3 : ℕ)] with n hn
simp [t4Bandwidth, max_eq_left hn]
theorem t4Bandwidth_pos
The T4 bandwidth is strictly positive at every sample size.
Formal statement
Proof (Lean source)
theorem t4Bandwidth_antitone
The T4 bandwidth is nonincreasing as sample size increases.
Formal statement
conclusion
Proof (Lean source)
lemma t4Bandwidth_antitone : Antitone t4Bandwidth := by
intro m n hmn
unfold t4Bandwidth frontierRate
apply Real.rpow_le_rpow
· positivity
· apply Real.log_div_self_antitoneOn
· exact Real.exp_one_lt_three.le.trans
(by exact_mod_cast (show 3 ≤ max m 3 by omega))
· exact Real.exp_one_lt_three.le.trans
(by exact_mod_cast (show 3 ≤ max n 3 by omega))
· exact_mod_cast (max_le_max_right 3 hmn)
· norm_num
theorem t4Bandwidth_tendsto_zero
As sample size grows, the T4 bandwidth converges to zero.
Formal statement
conclusion
Proof (Lean source)
lemma t4Bandwidth_tendsto_zero : Tendsto t4Bandwidth atTop (nhds 0) :=
frontierRate_tendsto_zero.congr' t4Bandwidth_eventually_eq_frontierRate.symm
theorem frontierRate_nh2_tendsto_top
As sample size grows, the stated effective sample-size sequence diverges to infinity.
Formal statement
conclusion
Proof (Lean source)
lemma frontierRate_nh2_tendsto_top :
Tendsto (fun n : ℕ => (n : ℝ) * frontierRate n ^ 2) atTop atTop := by
rw [← tendsto_add_atTop_iff_nat 3]
simpa [Nat.cast_add, Nat.cast_ofNat] using frontierRate_shift_nh2_tendsto_top
theorem t4Bandwidth_nh2_tendsto_top
As sample size grows, the stated effective sample-size sequence diverges to infinity.
Formal statement
conclusion
Proof (Lean source)
lemma t4Bandwidth_nh2_tendsto_top :
Tendsto (fun n : ℕ => (n : ℝ) * t4Bandwidth n ^ 2) atTop atTop :=
frontierRate_nh2_tendsto_top.congr' (by
filter_upwards [t4Bandwidth_eventually_eq_frontierRate] with n hn
rw [hn])
theorem t4Bandwidth_maximal_regime_tendsto_top
As sample size grows, the stated effective sample-size sequence diverges to infinity.
Formal statement
hypotheses
ν :
ℝ
hν :
2 ≤ ν
conclusion
Tendsto (fun n : ℕ => (n : ℝ) ^ ((1 + ν) / (2 + ν)) * t4Bandwidth n ^ 2 / log ((t4Bandwidth n)⁻¹)) atTop atTop
Proof (Lean source)
lemma t4Bandwidth_maximal_regime_tendsto_top (ν : ℝ) (hν : 2 ≤ ν) :
Tendsto (fun n : ℕ =>
(n : ℝ) ^ ((1 + ν) / (2 + ν)) * t4Bandwidth n ^ 2 /
log ((t4Bandwidth n)⁻¹)) atTop atTop := by
have hexp : 0 < ν / (4 * (2 + ν)) := by positivity
have hpoly : Tendsto (fun n : ℕ => (n : ℝ) ^ (ν / (4 * (2 + ν))))
atTop atTop := (tendsto_rpow_atTop hexp).comp tendsto_natCast_atTop_atTop
have hloglittle := (isLittleO_log_rpow_atTop (r := ν / (4 * (2 + ν))) hexp)
|>.tendsto_div_nhds_zero.comp tendsto_natCast_atTop_atTop
have hinvlog : Tendsto (fun n : ℕ =>
((log (n : ℝ) / (n : ℝ) ^ (ν / (4 * (2 + ν)))))⁻¹)
atTop atTop := by
apply Filter.Tendsto.inv_tendsto_nhdsGT_zero
refine tendsto_nhdsWithin_iff.2 ⟨hloglittle, ?_⟩
filter_upwards [eventually_ge_atTop (3 : ℕ)] with n hn
exact div_pos (Real.log_pos (by exact_mod_cast (show 1 < n by omega)))
(rpow_pos_of_pos (by positivity) _)
have hmain : Tendsto (fun n : ℕ =>
(n : ℝ) ^ ((1 + ν) / (2 + ν)) * frontierRate n ^ 2 /
log ((frontierRate n)⁻¹)) atTop atTop := by
apply Filter.tendsto_atTop_mono' atTop _ hinvlog
filter_upwards [eventually_ge_atTop (3 : ℕ)] with n hn
have hn0 : (0 : ℝ) < n := by positivity
have hlogn : 0 < log (n : ℝ) :=
Real.log_pos (by exact_mod_cast (show 1 < n by omega))
have ha : 0 < frontierRate n := frontierRate_pos (by omega)
have hloga : log ((frontierRate n)⁻¹) =
(log (n : ℝ) - log (log (n : ℝ))) / 4 := by
unfold frontierRate
rw [Real.log_inv]
change -log (rpow (log (n : ℝ) / n) (1 / 4)) = _
rw [show log (rpow (log (n : ℝ) / n) (1 / 4)) =
(1 / 4 : ℝ) * log (log (n : ℝ) / n) from
Real.log_rpow (div_pos hlogn hn0) _,
Real.log_div hlogn.ne' hn0.ne']
ring
have hbaseLt : log (n : ℝ) / n < 1 := by
rw [div_lt_one hn0]
exact (Real.log_lt_sub_one_of_pos hn0 (by exact_mod_cast (show n ≠ 1 by omega))).trans
(by linarith)
have haLt : frontierRate n < 1 := by
unfold frontierRate
exact Real.rpow_lt_one (div_pos hlogn hn0).le hbaseLt (by norm_num)
have hdenpos : 0 < log ((frontierRate n)⁻¹) :=
Real.log_pos (one_lt_inv_iff₀.mpr ⟨ha, haLt⟩)
have hloglog : 0 < log (log (n : ℝ)) := by
apply Real.log_pos
rw [← Real.log_exp 1]
exact Real.strictMonoOn_log (Real.exp_pos 1) hn0
(Real.exp_one_lt_three.trans_le (by exact_mod_cast hn))
have hdenle : log ((frontierRate n)⁻¹) ≤ log (n : ℝ) := by
rw [hloga]
linarith
have hpow : frontierRate n ^ 2 =
(log (n : ℝ) / n).rpow (1 / 2 : ℝ) := by
unfold frontierRate
have hr := Real.rpow_mul_natCast (div_pos hlogn hn0).le (1 / 4 : ℝ) 2
norm_num at hr ⊢
exact hr.symm
have hnum : (n : ℝ) ^ ((1 + ν) / (2 + ν)) * frontierRate n ^ 2 =
(n : ℝ) ^ (ν / (2 * (2 + ν))) * sqrt (log (n : ℝ)) := by
rw [hpow]
change rpow (n : ℝ) ((1 + ν) / (2 + ν)) *
rpow (log (n : ℝ) / n) (1 / 2) = _
rw [show rpow (log (n : ℝ) / n) (1 / 2) =
rpow (log (n : ℝ)) (1 / 2) /
rpow (n : ℝ) (1 / 2) from
Real.div_rpow hlogn.le hn0.le _,
show rpow (log (n : ℝ)) (1 / 2) =
sqrt (log (n : ℝ)) from (Real.sqrt_eq_rpow _).symm,
show rpow (n : ℝ) (1 / 2) = sqrt (n : ℝ) from
(Real.sqrt_eq_rpow _).symm]
have hsqrtn : sqrt (n : ℝ) = (n : ℝ) ^ (1 / 2 : ℝ) :=
Real.sqrt_eq_rpow _
rw [hsqrtn]
field_simp
rw [← Real.rpow_add hn0]
congr 1
field_simp
ring
rw [hnum]
have hsqrtlog : 0 < sqrt (log (n : ℝ)) := Real.sqrt_pos.2 hlogn
have hsqrtbound : sqrt (log (n : ℝ)) ≤ log (n : ℝ) := by
apply (Real.sqrt_le_iff).2
constructor
· exact hlogn.le
· have hlogone : 1 ≤ log (n : ℝ) := by
rw [← Real.log_exp 1]
apply Real.strictMonoOn_log.monotoneOn (Real.exp_pos 1) hn0
exact Real.exp_one_lt_three.le.trans
(by exact_mod_cast hn)
nlinarith
rw [inv_div]
apply div_le_div₀
· exact mul_nonneg (Real.rpow_nonneg hn0.le _) (Real.sqrt_nonneg _)
· have hpowone : 1 ≤ (n : ℝ) ^ (ν / (4 * (2 + ν))) :=
Real.one_le_rpow (by exact_mod_cast (show 1 ≤ n by omega)) hexp.le
have hpowmono : (n : ℝ) ^ (ν / (4 * (2 + ν))) ≤
(n : ℝ) ^ (ν / (2 * (2 + ν))) := by
apply Real.rpow_le_rpow_of_exponent_le
(by exact_mod_cast (show 1 ≤ n by omega))
have hden : 0 < 2 + ν := by linarith
field_simp [hden.ne']
nlinarith [hν]
have hsqrtone : 1 ≤ sqrt (log (n : ℝ)) := by
apply (Real.le_sqrt (by norm_num) hlogn.le).2
have hlogone : 1 ≤ log (n : ℝ) := by
rw [← Real.log_exp 1]
apply Real.strictMonoOn_log.monotoneOn (Real.exp_pos 1) hn0
exact Real.exp_one_lt_three.le.trans (by exact_mod_cast hn)
nlinarith
calc
(n : ℝ) ^ (ν / (4 * (2 + ν))) =
(n : ℝ) ^ (ν / (4 * (2 + ν))) * 1 := by ring
_ ≤ (n : ℝ) ^ (ν / (2 * (2 + ν))) *
sqrt (log (n : ℝ)) :=
mul_le_mul hpowmono hsqrtone (by norm_num)
(Real.rpow_nonneg hn0.le _)
· exact hdenpos
· exact hdenle
exact hmain.congr' (by
filter_upwards [t4Bandwidth_eventually_eq_frontierRate] with n hn
simp only [hn])
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
Proof (Lean source)
lemma t4_winsorization_power {h : ℝ} (hh : 0 < h) :
(rpow h (-(1 : ℝ) / 3)) ^ (-3 : ℤ) = h := by
calc
_ = rpow h ((-(1 : ℝ) / 3) * (-3 : ℤ)) :=
(Real.rpow_mul_intCast hh.le _ _).symm
_ = h := by
rw [show ((-(1 : ℝ) / 3) * (-3 : ℤ)) = 1 by norm_num]
exact Real.rpow_one h
theorem t4_frontier_rate_terms_le
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
Proof (Lean source)
lemma t4_frontier_rate_terms_le (n : ℕ) (hn : 3 ≤ n) :
let h := frontierRate n
let B := rpow h (-(1 : ℝ) / 3)
B ^ (-3 : ℤ) ≤ h ∧
sqrt (log (B / h) / ((n : ℝ) * h ^ 2)) ≤ 2 * h ∧
B * log (B / h) / ((n : ℝ) * h ^ 2) ≤ 2 * h ∧
sqrt (log (h⁻¹) / ((n : ℝ) * h ^ 2)) ≤ h := by
dsimp only
let h := frontierRate n
let B := rpow h (-(1 : ℝ) / 3)
have hn0 : (0 : ℝ) < n := by positivity
have hlogn : 0 < log (n : ℝ) :=
Real.log_pos (by exact_mod_cast (show 1 < n by omega))
have hh : 0 < h := frontierRate_pos (by omega)
have hbaseLt : log (n : ℝ) / n < 1 := by
rw [div_lt_one hn0]
exact (Real.log_lt_sub_one_of_pos hn0
(by exact_mod_cast (show n ≠ 1 by omega))).trans (by linarith)
have hhLt : h < 1 := by
dsimp [h]
unfold frontierRate
exact Real.rpow_lt_one (div_pos hlogn hn0).le hbaseLt (by norm_num)
have hloglog : 0 < log (log (n : ℝ)) := by
apply Real.log_pos
rw [← Real.log_exp 1]
exact Real.strictMonoOn_log (Real.exp_pos 1) hn0
(Real.exp_one_lt_three.trans_le (by exact_mod_cast hn))
have hlogh : log (h⁻¹) =
(log (n : ℝ) - log (log (n : ℝ))) / 4 := by
dsimp [h]
unfold frontierRate
rw [Real.log_inv]
change -log (rpow (log (n : ℝ) / n) (1 / 4)) = _
rw [show log (rpow (log (n : ℝ) / n) (1 / 4)) =
(1 / 4 : ℝ) * log (log (n : ℝ) / n) from
Real.log_rpow (div_pos hlogn hn0) _,
Real.log_div hlogn.ne' hn0.ne']
ring
have hlogh0 : 0 ≤ log (h⁻¹) :=
Real.log_nonneg ((one_le_inv₀ hh).2 hhLt.le)
have hloghle : log (h⁻¹) ≤ log (n : ℝ) := by
rw [hlogh]
linarith
have hBpos : 0 < B := Real.rpow_pos_of_pos hh _
have hlogB : log (B / h) = (4 / 3 : ℝ) * log (h⁻¹) := by
rw [Real.log_div hBpos.ne' hh.ne', show log B =
(-(1 : ℝ) / 3) * log h from Real.log_rpow hh _,
Real.log_inv]
ring
have hlogB0 : 0 ≤ log (B / h) := by rw [hlogB]; positivity
have hlogBle : log (B / h) ≤ 2 * log (n : ℝ) := by
rw [hlogB]
nlinarith
have hfour := t4_frontierRate_fourth_power n (by omega)
have hden : 0 < (n : ℝ) * h ^ 2 := mul_pos hn0 (sq_pos_of_pos hh)
have hratio : log (n : ℝ) / ((n : ℝ) * h ^ 2) = h ^ 2 := by
rw [← hfour]
field_simp
ring
have hBmul : B * h ≤ 1 := by
have heq : B * h = rpow h (2 / 3 : ℝ) := by
dsimp [B]
calc
rpow h (-(1 : ℝ) / 3) * h =
rpow h (-(1 : ℝ) / 3) * rpow h 1 := by
exact congrArg (fun z => rpow h (-(1 : ℝ) / 3) * z)
(Real.rpow_one h).symm
_ = rpow h ((-(1 : ℝ) / 3) + 1) :=
(Real.rpow_add hh _ _).symm
_ = rpow h (2 / 3 : ℝ) := by congr 1 <;> ring
rw [heq]
exact Real.rpow_le_one hh.le hhLt.le (by norm_num)
refine ⟨le_of_eq (t4_winsorization_power hh), ?_, ?_, ?_⟩
· apply (Real.sqrt_le_iff).2
constructor
· positivity
· have hfrac : log (B / h) / ((n : ℝ) * h ^ 2) ≤ 2 * h ^ 2 := by
calc
_ ≤ (2 * log (n : ℝ)) / ((n : ℝ) * h ^ 2) :=
div_le_div_of_nonneg_right hlogBle hden.le
_ = 2 * h ^ 2 := by rw [mul_div_assoc, hratio]
exact hfrac.trans (by nlinarith [sq_nonneg h])
· calc
B * log (B / h) / ((n : ℝ) * h ^ 2) =
B * (log (B / h) / ((n : ℝ) * h ^ 2)) := by ring
_ ≤ B * (2 * h ^ 2) := by
gcongr
calc
_ ≤ (2 * log (n : ℝ)) / ((n : ℝ) * h ^ 2) :=
div_le_div_of_nonneg_right hlogBle hden.le
_ = 2 * h ^ 2 := by rw [mul_div_assoc, hratio]
_ ≤ 2 * h := by nlinarith [hBmul]
· apply (Real.sqrt_le_iff).2
constructor
· exact hh.le
· calc
log (h⁻¹) / ((n : ℝ) * h ^ 2) ≤
log (n : ℝ) / ((n : ℝ) * h ^ 2) :=
div_le_div_of_nonneg_right hloghle hden.le
_ = h ^ 2 := hratio
def stabilizedLocalPolynomialOuterRisk Definition aux_stabilizedLocalPolynomialOuterRisk in the paper ↗
Uniform outer risk of the explicit estimator at the frontier bandwidth.
Definition (Lean source)
noncomputable def stabilizedLocalPolynomialOuterRisk
(n p : ℕ) (ν L : ℝ) : ℝ≥0∞ :=
⨆ P : A1A2Law, ⨆ (_hP : A1A2Class p ν L P),
outerLIntegral (causalSampleLaw P n)
(a1a2BoundaryLoss
(stabilizedLocalPolynomial n p L (frontierRate n)) P)
At h_n=a_n and B_n=a_n⁻¹ᐟ³, the explicit clipped and Gram-stabilized rule has uniform outer risk at most a constant multiple of a_n.
Formal statement
hypotheses
p :
ℕ
ν L :
ℝ
hν :
2 ≤ ν
hL :
4 ≤ L
hId :
hBias :
hMax :
conclusion
∃ C : ℝ
if
0 < C ∧ ∃ N : ℕ, ∀ n : ℕ, N ≤ n
then
Proof (Lean source)
theorem cty_a1_a2_winsorized_expected_outer_upper
(p : ℕ) (ν L : ℝ) (hν : 2 ≤ ν) (hL : 4 ≤ L)
(hId : CtyDistanceIdentification p ν L)
(hBias : CtyUniformFirstOrderBias p L)
(hMax : CtyExpectedLocalPolynomialMaximalBounds p ν L) :
∃ C : ℝ, 0 < C ∧ ∃ N : ℕ, ∀ n : ℕ, N ≤ n →
stabilizedLocalPolynomialOuterRisk n p ν L ≤
ofReal (C * frontierRate n) := by
obtain ⟨Cb₀, hCb₀, hBiasBound⟩ := hBias
obtain ⟨Cg, hCg, hMaxBound⟩ := hMax
obtain ⟨Cs, hCs, hScoreBound⟩ :=
cty_winsorized_score_maximal_bound p L
let Cb : ℝ := Cb₀ + 1
let q : ℝ := p + 1
let C : ℝ := Cb + 32 * L ^ 3 * q +
16 * L * q * Cs + 8 * L ^ 2 * q * Cg
have hLpos : 0 < L := by linarith
have hqpos : 0 < q := by dsimp [q]; positivity
have hCb : 0 < Cb := by dsimp [Cb]; linarith
have hC : 0 < C := by dsimp [C]; positivity
refine ⟨C, hC, ?_⟩
have hbiasLim := hBiasBound ν hν t4Bandwidth t4Bandwidth_pos
t4Bandwidth_antitone t4Bandwidth_tendsto_zero t4Bandwidth_nh2_tendsto_top
have hCbLt : ofReal Cb₀ < ofReal Cb := by
apply (ENNReal.ofReal_lt_ofReal_iff hCb).2
dsimp [Cb]
linarith
have hbiasT4 : ∀ᶠ n in atTop,
causalUniformBiasRatio p ν L (t4Bandwidth n) ≤ ofReal Cb :=
(eventually_lt_of_limsup_lt (hbiasLim.trans_lt hCbLt)).mono
(fun _ hn => hn.le)
have hbiasEv : ∀ᶠ n in atTop,
causalUniformBiasRatio p ν L (frontierRate n) ≤ ofReal Cb := by
filter_upwards [hbiasT4, t4Bandwidth_eventually_eq_frontierRate] with n hb hn
simpa [hn] using hb
have hmaxT4 := hMaxBound t4Bandwidth t4Bandwidth_pos
t4Bandwidth_tendsto_zero (t4Bandwidth_maximal_regime_tendsto_top ν hν)
have hmaxEv : ∀ᶠ n in atTop, ∀ P : A1A2Law, A1A2Class p ν L P →
outerLIntegral (causalSampleLaw P n)
(causalGramDeviation n p P (frontierRate n)) ≤
ofReal (Cg * sqrt
(log ((frontierRate n)⁻¹) /
((n : ℝ) * (frontierRate n) ^ 2))) := by
filter_upwards [hmaxT4, t4Bandwidth_eventually_eq_frontierRate] with n hm hn
simpa [hn] using fun P hP => (hm P hP).1
have hhLEv : ∀ᶠ n in atTop, frontierRate n ≤ L⁻¹ :=
((tendsto_order.1 frontierRate_tendsto_zero).2 _ (by positivity)).mono
(fun _ hn => hn.le)
apply Filter.eventually_atTop.1
filter_upwards [eventually_ge_atTop (3 : ℕ), hbiasEv, hmaxEv, hhLEv] with
n hn hbiasN hgramN hhL
unfold stabilizedLocalPolynomialOuterRisk
apply iSup_le
intro P
apply iSup_le
intro hP
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hn1 : 1 ≤ n := by omega
have hh : 0 < frontierRate n := frontierRate_pos (by omega)
have hhOne : frontierRate n ≤ 1 := by
have hbaseLt : log (n : ℝ) / n < 1 := by
have hn0 : (0 : ℝ) < n := by positivity
rw [div_lt_one hn0]
exact (Real.log_lt_sub_one_of_pos hn0
(by exact_mod_cast (show n ≠ 1 by omega))).trans (by linarith)
unfold frontierRate
exact (Real.rpow_lt_one
(div_nonneg (Real.log_nonneg (by exact_mod_cast (show 1 ≤ n by omega)))
(by positivity)) hbaseLt (by norm_num)).le
let B : ℝ := rpow (frontierRate n) (-(1 : ℝ) / 3)
have hB : 1 ≤ B := by
dsimp [B]
exact Real.one_le_rpow_of_pos_of_le_one_of_nonpos hh hhOne (by norm_num)
obtain ⟨hBtail, hscoreRoot, hscoreLinear, hgramRoot⟩ :=
t4_frontier_rate_terms_le n hn
change B ^ (-3 : ℤ) ≤ frontierRate n at hBtail
change sqrt (log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2)) ≤ 2 * frontierRate n at hscoreRoot
change B * log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2) ≤ 2 * frontierRate n at hscoreLinear
have hpoint (w : CausalSample n) :=
stabilizedLocalPolynomial_boundaryLoss_le n p ν L Cb
(frontierRate n) B P hP hCb.le hn1 hh hhL hB rfl hbiasN w
let μ := causalSampleLaw P n
letI : IsProbabilityMeasure μ := by
dsimp [μ, causalSampleLaw]
infer_instance
let c₀ : ℝ≥0∞ := ofReal (Cb * frontierRate n +
4 * L * q * (8 * L ^ 2 * B ^ (-3 : ℤ)))
let cs : ℝ≥0∞ := ofReal (4 * L * q)
let cg : ℝ≥0∞ := ofReal (8 * L ^ 2 * q)
have hcs0 : cs ≠ 0 := ne_of_gt (ENNReal.ofReal_pos.mpr (by
positivity))
have hcg0 : cg ≠ 0 := ne_of_gt (ENNReal.ofReal_pos.mpr (by
positivity))
have houter :
outerLIntegral μ
(a1a2BoundaryLoss
(stabilizedLocalPolynomial n p L (frontierRate n)) P) ≤
c₀ +
cs * outerLIntegral μ
(winsorizedScoreDeviation n p P (frontierRate n) B) +
cg * outerLIntegral μ
(causalGramDeviation n p P (frontierRate n)) := by
calc
_ ≤ outerLIntegral μ (fun w =>
c₀ + (cs * winsorizedScoreDeviation n p P (frontierRate n) B w +
cg * causalGramDeviation n p P (frontierRate n) w)) := by
apply outerLIntegral_mono
intro w
simpa [c₀, cs, cg, q, add_assoc] using hpoint w
_ ≤ outerLIntegral μ (fun _ => c₀) +
outerLIntegral μ (fun w =>
cs * winsorizedScoreDeviation n p P (frontierRate n) B w +
cg * causalGramDeviation n p P (frontierRate n) w) :=
outerLIntegral_add_le _ _ _
_ ≤ c₀ + (outerLIntegral μ (fun w =>
cs * winsorizedScoreDeviation n p P (frontierRate n) B w) +
outerLIntegral μ (fun w =>
cg * causalGramDeviation n p P (frontierRate n) w)) := by
gcongr
· exact (outerLIntegral_const_probability μ c₀).le
· exact outerLIntegral_add_le _ _ _
_ ≤ c₀ +
cs * outerLIntegral μ
(winsorizedScoreDeviation n p P (frontierRate n) B) +
cg * outerLIntegral μ
(causalGramDeviation n p P (frontierRate n)) := by
rw [add_assoc]
gcongr
· exact outerLIntegral_const_mul_le μ cs hcs0 ENNReal.ofReal_ne_top _
· exact outerLIntegral_const_mul_le μ cg hcg0 ENNReal.ofReal_ne_top _
have hscoreN := hScoreBound ν P hP n (frontierRate n) B
hn1 hh hhL hB
have hc₀ : c₀ ≤ ofReal ((Cb + 32 * L ^ 3 * q) * frontierRate n) := by
dsimp [c₀]
apply ENNReal.ofReal_le_ofReal
calc
Cb * frontierRate n + 4 * L * q * (8 * L ^ 2 * B ^ (-3 : ℤ)) ≤
Cb * frontierRate n + 4 * L * q * (8 * L ^ 2 * frontierRate n) := by
gcongr
_ = (Cb + 32 * L ^ 3 * q) * frontierRate n := by ring
have hscoreTerm : cs * outerLIntegral μ
(winsorizedScoreDeviation n p P (frontierRate n) B) ≤
ofReal ((16 * L * q * Cs) * frontierRate n) := by
calc
_ ≤ cs * ofReal (Cs *
(sqrt (log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2)) +
B * log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2))) :=
mul_le_mul_right hscoreN cs
_ = ofReal ((4 * L * q) * (Cs *
(sqrt (log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2)) +
B * log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2)))) := by
dsimp [cs]
rw [ENNReal.ofReal_mul (by positivity : 0 ≤ 4 * L * q)]
_ ≤ _ := by
apply ENNReal.ofReal_le_ofReal
have hsum : sqrt (log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2)) +
B * log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2) ≤ 4 * frontierRate n := by
linarith
calc
(4 * L * q) * (Cs * (sqrt (log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2)) +
B * log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2))) =
(4 * L * q * Cs) *
(sqrt (log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2)) +
B * log (B / frontierRate n) /
((n : ℝ) * frontierRate n ^ 2)) := by ring
_ ≤ (4 * L * q * Cs) * (4 * frontierRate n) := by
exact mul_le_mul_of_nonneg_left hsum (by positivity)
_ = (16 * L * q * Cs) * frontierRate n := by ring
have hgramTerm : cg * outerLIntegral μ
(causalGramDeviation n p P (frontierRate n)) ≤
ofReal ((8 * L ^ 2 * q * Cg) * frontierRate n) := by
calc
_ ≤ cg * ofReal (Cg * sqrt
(log ((frontierRate n)⁻¹) /
((n : ℝ) * frontierRate n ^ 2))) :=
mul_le_mul_right (hgramN P hP) cg
_ = ofReal ((8 * L ^ 2 * q) *
(Cg * sqrt (log ((frontierRate n)⁻¹) /
((n : ℝ) * frontierRate n ^ 2)))) := by
dsimp [cg]
rw [ENNReal.ofReal_mul (by positivity : 0 ≤ 8 * L ^ 2 * q)]
_ ≤ _ := by
apply ENNReal.ofReal_le_ofReal
calc
(8 * L ^ 2 * q) *
(Cg * sqrt (log ((frontierRate n)⁻¹) /
((n : ℝ) * frontierRate n ^ 2))) =
(8 * L ^ 2 * q * Cg) *
sqrt (log ((frontierRate n)⁻¹) /
((n : ℝ) * frontierRate n ^ 2)) := by ring
_ ≤ (8 * L ^ 2 * q * Cg) * frontierRate n := by
exact mul_le_mul_of_nonneg_left hgramRoot (by positivity)
apply houter.trans
calc
c₀ + cs * outerLIntegral μ
(winsorizedScoreDeviation n p P (frontierRate n) B) +
cg * outerLIntegral μ
(causalGramDeviation n p P (frontierRate n)) ≤
ofReal ((Cb + 32 * L ^ 3 * q) * frontierRate n) +
ofReal ((16 * L * q * Cs) * frontierRate n) +
ofReal ((8 * L ^ 2 * q * Cg) * frontierRate n) := by
gcongr
_ = ofReal (C * frontierRate n) := by
rw [← ENNReal.ofReal_add
(by positivity : 0 ≤ (Cb + 32 * L ^ 3 * q) * frontierRate n)
(by positivity : 0 ≤ (16 * L * q * Cs) * frontierRate n),
← ENNReal.ofReal_add
(by positivity : 0 ≤
(Cb + 32 * L ^ 3 * q) * frontierRate n +
(16 * L * q * Cs) * frontierRate n)
(by positivity : 0 ≤ (8 * L ^ 2 * q * Cg) * frontierRate n)]
apply congrArg ofReal
dsimp [C]
ring
Causal.T5_MatchedFrontier 3 declarations This theorem combines the point-indexed converse with the explicit estimator.
Matched causal frontier
This theorem combines the point-indexed converse with the explicit estimator.
It is about the exact P₁₂(p,ν,L) class, not the distinct full
P_NP(L,q) support-boundary problem.
theorem a1a2OuterRisk_le_stabilizedLocalPolynomialOuterRisk
The minimax outer risk is bounded by the outer risk of the explicit stabilized local-polynomial rule once its frontier bandwidth is positive.
Formal statement
hypotheses
n p :
ℕ
ν L :
ℝ
hn :
2 ≤ n
conclusion
a1a2OuterRisk n p ν L ≤ stabilizedLocalPolynomialOuterRisk n p ν L
Proof (Lean source)
lemma a1a2OuterRisk_le_stabilizedLocalPolynomialOuterRisk
(n p : ℕ) (ν L : ℝ) (hn : 2 ≤ n) :
a1a2OuterRisk n p ν L ≤ stabilizedLocalPolynomialOuterRisk n p ν L := by
unfold a1a2OuterRisk stabilizedLocalPolynomialOuterRisk
refine (iInf_le (fun rho : A1A2RuleFun n =>
⨅ (_hrho : rho ∈ A1A2PointIndexedDecisionClass n p ν L),
⨆ P : A1A2Law, ⨆ (_hP : A1A2Class p ν L P),
outerLIntegral (causalSampleLaw P n)
(a1a2BoundaryLoss rho P))
(stabilizedLocalPolynomial n p L (frontierRate n))).trans ?_
exact iInf_le_of_le
(stabilizedLocalPolynomial_mem n p ν L (frontierRate n) (frontierRate_pos hn))
(le_refl _)
theorem stabilizedLocalPolynomial_normalizedRisk_limsup_le
An eventual constant-times-frontier-rate bound for the explicit rule gives the corresponding normalized limsup bound.
Formal statement
Proof (Lean source)
lemma stabilizedLocalPolynomial_normalizedRisk_limsup_le
(p : ℕ) (ν L C : ℝ) (hC : 0 < C) (N : ℕ)
(hupper : ∀ n : ℕ, N ≤ n →
stabilizedLocalPolynomialOuterRisk n p ν L ≤
ofReal (C * frontierRate n)) :
limsup (normalizedRisk
(fun n => stabilizedLocalPolynomialOuterRisk n p ν L)) atTop ≤
ofReal C := by
apply Filter.limsup_le_of_le
(Filter.isCoboundedUnder_le_of_le atTop (fun _ => bot_le))
filter_upwards [eventually_ge_atTop N, eventually_ge_atTop (2 : ℕ)] with n hnN hn2
unfold normalizedRisk
calc
stabilizedLocalPolynomialOuterRisk n p ν L /
ofReal (frontierRate n) ≤
ofReal (C * frontierRate n) /
ofReal (frontierRate n) := by gcongr; exact hupper n hnN
_ = ofReal C := by
rw [ENNReal.ofReal_mul hC.le]
have hr0 : ofReal (frontierRate n) ≠ 0 :=
(ENNReal.ofReal_pos.mpr (frontierRate_pos hn2)).ne'
rw [ENNReal.mul_div_cancel_right hr0 ENNReal.ofReal_ne_top]
The outer-expected minimax rate on the exact Euclidean/uniform-kernel causal class is a_n, for every L ≥ L₀(p). The three cited CTY interfaces remain explicit antecedents. The conclusion contains exactly the lower and upper frontier for a1a2OuterRisk and the explicit stabilized-estimator upper bound.
Formal statement
hypotheses
p :
ℕ
conclusion
∃ L0 : ℝ,
48 ≤ L0 ∧
∀ ν : ℝ,
2
≤ ν → ∀ L : ℝ, L0 ≤ L → CtyDistanceIdentification p ν L → CtyUniformFirstOrderBias p L → CtyExpectedLocalPolynomialMaximalBounds p ν L → ∃ c C : ℝ, 0 < c ∧ c ≤ C ∧ ofReal c ≤ liminf (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ∧ liminf (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ≤ limsup (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ∧ limsup (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ≤ ofReal C ∧ limsup (normalizedRisk (fun n => stabilizedLocalPolynomialOuterRisk n p ν L)) atTop ≤ ofReal C
Proof (Lean source)
theorem cty_a1_a2_winsorized_matched_frontier
(p : ℕ) :
∃ L0 : ℝ, 48 ≤ L0 ∧ ∀ ν : ℝ, 2 ≤ ν → ∀ L : ℝ, L0 ≤ L →
CtyDistanceIdentification p ν L →
CtyUniformFirstOrderBias p L →
CtyExpectedLocalPolynomialMaximalBounds p ν L →
∃ c C : ℝ, 0 < c ∧ c ≤ C ∧
ofReal c ≤
liminf (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ∧
liminf (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ≤
limsup (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ∧
limsup (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ≤
ofReal C ∧
limsup (normalizedRisk
(fun n => stabilizedLocalPolynomialOuterRisk n p ν L)) atTop ≤
ofReal C := by
rcases cty_a1_a2_point_indexed_log_converse p with ⟨L0, hL0, hconv⟩
refine ⟨max L0 4, hL0.trans (le_max_left _ _), ?_⟩
intro ν hν L hL hId hBias hMax
have hL0L : L0 ≤ L := (le_max_left L0 4).trans hL
have h4L : 4 ≤ L := (le_max_right L0 4).trans hL
rcases hconv ν hν L hL0L with ⟨c, hc, _hscale, hlower, _hfixed⟩
rcases cty_a1_a2_winsorized_expected_outer_upper p ν L hν h4L hId hBias hMax with
⟨C0, hC0, N, hupper⟩
let C := max C0 c
have hC0C : C0 ≤ C := le_max_left _ _
have hcC : c ≤ C := le_max_right _ _
have hexplicit :
limsup (normalizedRisk
(fun n => stabilizedLocalPolynomialOuterRisk n p ν L)) atTop ≤
ofReal C0 :=
stabilizedLocalPolynomial_normalizedRisk_limsup_le p ν L C0 hC0 N hupper
have hrisk_eventually :
(fun n => normalizedRisk (fun m => a1a2OuterRisk m p ν L) n) ≤ᶠ[atTop]
(fun n => normalizedRisk
(fun m => stabilizedLocalPolynomialOuterRisk m p ν L) n) := by
filter_upwards [eventually_ge_atTop (2 : ℕ)] with n hn
unfold normalizedRisk
gcongr
exact a1a2OuterRisk_le_stabilizedLocalPolynomialOuterRisk n p ν L hn
have hrisk_explicit :
limsup (normalizedRisk (fun n => a1a2OuterRisk n p ν L)) atTop ≤
limsup (normalizedRisk
(fun n => stabilizedLocalPolynomialOuterRisk n p ν L)) atTop := by
exact Filter.limsup_le_limsup hrisk_eventually
refine ⟨c, C, hc, hcC, hlower,
Filter.liminf_le_limsup, ?_, ?_⟩
· exact hrisk_explicit.trans (hexplicit.trans (ENNReal.ofReal_le_ofReal hC0C))
· exact hexplicit.trans (ENNReal.ofReal_le_ofReal hC0C)
Causal.WinsorizedScoreMaximal 8 declarations The score-specific VC closure, envelope, and variance calculation are local.
Expected maximal bound for the bounded winsorized score
The score-specific VC closure, envelope, and variance calculation are local.
The final step calls the in-run vcExpectedMaximalInequality; there is no
external empirical-process assumption.
def winsorizedCenteredScore
Winsorized empirical residual score evaluated at the original population coefficient.
Definition (Lean source)
noncomputable def winsorizedCenteredScore (n p : ℕ) (P : A1A2Law)
(t : Bool) (x : Score) (h B : ℝ) (w : CausalSample n) :
Fin (p + 1) → ℝ := by
classical
let u := signedDistanceData n P w x
exact fun j => empiricalScore n p t h B u j -
∑ k, empiricalGram n p t h u j k * populationCoefficient P p t x h k
def winsorizedScoreDeviation
Interface supremum of the centered winsorized score process.
Definition (Lean source)
noncomputable def winsorizedScoreDeviation (n p : ℕ) (P : A1A2Law)
(h B : ℝ) (w : CausalSample n) : ℝ≥0∞ :=
⨆ t : Bool, ⨆ x : Score, ⨆ (_hx : x ∈ P.boundary),
ofReal ‖winsorizedCenteredScore n p P t x h B w -
fun j => ∫ w', winsorizedCenteredScore n p P t x h B w' j
∂causalSampleLaw P n‖
theorem winsorizedCenteredScore_apply_eq_separableAverage Lemma winsorizedCenteredScore_apply_eq_separableAverage in the paper ↗
The two stated constructions agree under the theorem's assumptions.
Formal statement
hypotheses
n p :
ℕ
P :
t :
x :
hx :
x ∈ P.boundary
h B R :
ℝ
hh :
0 < h
hbeta :
∀ k, |populationCoefficient P p t x h k| ≤ R
w :
j :
Fin (p + 1)
conclusion
winsorizedCenteredScore n p P t x h B w j
= h⁻¹ ^ 2 * (n : ℝ)⁻¹ * ∑ a, separableWinsorizedScoreFunction P p h B R (⟨h, ⟨le_rfl, by linarith⟩⟩, t, ⟨x, hx⟩, populationCoefficient P p t x h, j) (w a)
Proof (Lean source)
lemma winsorizedCenteredScore_apply_eq_separableAverage
(n p : ℕ) (P : A1A2Law) (t : Bool) (x : Score)
(hx : x ∈ P.boundary) (h B R : ℝ) (hh : 0 < h)
(hbeta : ∀ k, |populationCoefficient P p t x h k| ≤ R)
(w : CausalSample n) (j : Fin (p + 1)) :
winsorizedCenteredScore n p P t x h B w j =
h⁻¹ ^ 2 * (n : ℝ)⁻¹ * ∑ a,
separableWinsorizedScoreFunction P p h B R
(⟨h, ⟨le_rfl, by linarith⟩⟩, t, ⟨x, hx⟩,
populationCoefficient P p t x h, j) (w a) := by
classical
have hclip (k : Fin (p + 1)) :
clip R (populationCoefficient P p t x h k) =
populationCoefficient P p t x h k := by
have hk := hbeta k
rw [abs_le] at hk
simp [clip, min_eq_right hk.2, max_eq_right hk.1]
simp only [winsorizedCenteredScore, empiricalScore, empiricalGram,
signedDistanceData, separableWinsorizedScoreFunction]
simp_rw [hclip]
simp_rw [mul_sub]
simp only [Finset.mul_sum, Finset.sum_mul]
rw [Finset.sum_comm]
ring_nf
rw [Finset.sum_sub_distrib]
congr 1
apply Finset.sum_congr rfl
intro i _hi
rw [Finset.mul_sum]
apply Finset.sum_congr rfl
intro k _hk
by_cases hs : signedArm t
(signedDistance (knownGeometry P) x (causalScore (w i))) <;>
simp [hs] <;> ring
theorem winsorizedCenteredScore_integral_eq Lemma winsorizedCenteredScore_integral_eq in the paper ↗
The two stated constructions agree under the theorem's assumptions.
Formal statement
hypotheses
n p :
ℕ
P :
t :
x :
hx :
x ∈ P.boundary
h B R :
ℝ
hh :
0 < h
hn :
1 ≤ n
hbeta :
∀ k, |populationCoefficient P p t x h k| ≤ R
j :
Fin (p + 1)
hg :
Integrable (separableWinsorizedScoreFunction P p h B R (⟨h, ⟨le_rfl, by linarith⟩⟩, t, ⟨x, hx⟩, populationCoefficient P p t x h, j)) P.law
conclusion
(∫ w', winsorizedCenteredScore n p P t x h B w' j ∂causalSampleLaw P n)
= h⁻¹ ^ 2 * ∫ z, separableWinsorizedScoreFunction P p h B R (⟨h, ⟨le_rfl, by linarith⟩⟩, t, ⟨x, hx⟩, populationCoefficient P p t x h, j) z ∂P.law
Proof (Lean source)
lemma winsorizedCenteredScore_integral_eq
(n p : ℕ) (P : A1A2Law) (t : Bool) (x : Score)
(hx : x ∈ P.boundary) (h B R : ℝ) (hh : 0 < h) (hn : 1 ≤ n)
(hbeta : ∀ k, |populationCoefficient P p t x h k| ≤ R)
(j : Fin (p + 1))
(hg : Integrable (separableWinsorizedScoreFunction P p h B R
(⟨h, ⟨le_rfl, by linarith⟩⟩, t, ⟨x, hx⟩,
populationCoefficient P p t x h, j)) P.law) :
(∫ w', winsorizedCenteredScore n p P t x h B w' j
∂causalSampleLaw P n) =
h⁻¹ ^ 2 * ∫ z, separableWinsorizedScoreFunction P p h B R
(⟨h, ⟨le_rfl, by linarith⟩⟩, t, ⟨x, hx⟩,
populationCoefficient P p t x h, j) z ∂P.law := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
let g := separableWinsorizedScoreFunction P p h B R
(⟨h, ⟨le_rfl, by linarith⟩⟩, t, ⟨x, hx⟩,
populationCoefficient P p t x h, j)
have heq (w : CausalSample n) :
winsorizedCenteredScore n p P t x h B w j =
h⁻¹ ^ 2 * (n : ℝ)⁻¹ * ∑ a, g (w a) :=
winsorizedCenteredScore_apply_eq_separableAverage n p P t x hx h B R hh hbeta w j
rw [integral_congr_ae (ae_of_all _ heq), integral_const_mul]
simp only [causalSampleLaw]
rw [integral_sum_pi_eq P.law g hg]
dsimp only [g]
field_simp
theorem winsorizedScoreDeviation_le_empiricalProcessSup Lemma winsorizedScoreDeviation_le_empiricalProcessSup in the paper ↗
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
n p :
ℕ
P :
h B R U :
ℝ
hh :
0 < h
hn :
1 ≤ n
hbeta :
∀ t x
if
x ∈ P.boundary
then
∀ k, |populationCoefficient P p t x h k| ≤ R
hmeas :
∀ i : SeparableWinsorizedScoreIndex P p h,
Measurable (separableWinsorizedScoreFunction P p h B R i)
henv :
∀ i z, |separableWinsorizedScoreFunction P p h B R i z| ≤ U
w :
conclusion
winsorizedScoreDeviation n p P h B w
Proof (Lean source)
lemma winsorizedScoreDeviation_le_empiricalProcessSup
(n p : ℕ) (P : A1A2Law) (h B R U : ℝ)
(hh : 0 < h) (hn : 1 ≤ n)
(hbeta : ∀ t x, x ∈ P.boundary → ∀ k,
|populationCoefficient P p t x h k| ≤ R)
(hmeas : ∀ i : SeparableWinsorizedScoreIndex P p h,
Measurable (separableWinsorizedScoreFunction P p h B R i))
(henv : ∀ i z, |separableWinsorizedScoreFunction P p h B R i z| ≤ U)
(w : CausalSample n) :
winsorizedScoreDeviation n p P h B w ≤ ofReal (h⁻¹ ^ 2) *
empiricalProcessSup P.law
(separableWinsorizedScoreFunction P p h B R) w := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
unfold winsorizedScoreDeviation
apply iSup_le
intro t
apply iSup_le
intro x
apply iSup_le
intro hx
let v := winsorizedCenteredScore n p P t x h B w -
fun j => ∫ w', winsorizedCenteredScore n p P t x h B w' j
∂causalSampleLaw P n
obtain ⟨j0, _hj0, hj0max⟩ := Finset.exists_max_image univ
(fun j : Fin (p + 1) => |v j|) Finset.univ_nonempty
have hnorm : ‖v‖ = |v j0| := by
apply le_antisymm
· rw [pi_norm_le_iff_of_nonneg (abs_nonneg (v j0))]
intro k
simpa [Real.norm_eq_abs] using hj0max k (Finset.mem_univ k)
· simpa [Real.norm_eq_abs] using norm_le_pi_norm v j0
let idx : SeparableWinsorizedScoreIndex P p h :=
(⟨h, ⟨le_rfl, by linarith⟩⟩, t, ⟨x, hx⟩,
populationCoefficient P p t x h, j0)
have hg : Integrable (separableWinsorizedScoreFunction P p h B R idx) P.law :=
Integrable.of_bound (hmeas idx).aestronglyMeasurable U
(ae_of_all _ fun z => by simpa [Real.norm_eq_abs] using henv idx z)
have hsample := winsorizedCenteredScore_apply_eq_separableAverage
n p P t x hx h B R hh (hbeta t x hx) w j0
have hmean := winsorizedCenteredScore_integral_eq
n p P t x hx h B R hh hn (hbeta t x hx) j0 (by simpa only [idx] using hg)
have hdiff : v j0 = h⁻¹ ^ 2 * centeredEmpiricalAverage P.law w
(separableWinsorizedScoreFunction P p h B R idx) := by
simp only [v, Pi.sub_apply]
rw [hsample, hmean]
unfold centeredEmpiricalAverage
dsimp only [idx]
ring
rw [show ‖winsorizedCenteredScore n p P t x h B w -
(fun j => ∫ w', winsorizedCenteredScore n p P t x h B w' j
∂causalSampleLaw P n)‖ = ‖v‖ by rfl, hnorm, hdiff, abs_mul,
abs_of_nonneg (by positivity : 0 ≤ h⁻¹ ^ 2),
ENNReal.ofReal_mul (by positivity : 0 ≤ h⁻¹ ^ 2)]
exact mul_le_mul_right (le_iSup
(fun i : SeparableWinsorizedScoreIndex P p h =>
ofReal |centeredEmpiricalAverage P.law w
(separableWinsorizedScoreFunction P p h B R i)|) idx) _
Under the stated assumptions, the theorem gives the displayed quantitative upper or lower bound.
Formal statement
hypotheses
conclusion
outerLIntegral μ (fun x => c * f x) ≤ c * outerLIntegral μ f
Proof (Lean source)
lemma outerLIntegral_const_mul_le {Ω : Type*} [MeasurableSpace Ω]
(μ : Measure Ω) (c : ℝ≥0∞) (hc0 : c ≠ 0) (hct : c ≠ ∞)
(f : Ω → ℝ≥0∞) :
outerLIntegral μ (fun x => c * f x) ≤
c * outerLIntegral μ f := by
rw [outerLIntegral]
rw [outerLIntegral, ENNReal.mul_iInf_of_ne hc0 hct]
apply le_iInf
intro g
rw [ENNReal.mul_iInf_of_ne hc0 hct]
apply le_iInf
intro hg
rw [ENNReal.mul_iInf_of_ne hc0 hct]
apply le_iInf
intro hfg
refine iInf_le_of_le (fun x => c * g x) ?_
refine iInf_le_of_le (hg.const_mul c) ?_
refine iInf_le_of_le (fun x => mul_le_mul_right (hfg x) c) ?_
rw [lintegral_const_mul _ hg]
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
conclusion
outerLIntegral μ f ≤ outerLIntegral μ g
Proof (Lean source)
lemma outerLIntegral_mono {Ω : Type*} [MeasurableSpace Ω]
(μ : Measure Ω) {f g : Ω → ℝ≥0∞} (hfg : f ≤ g) :
outerLIntegral μ f ≤ outerLIntegral μ g := by
rw [outerLIntegral, outerLIntegral]
apply le_iInf
intro G
apply le_iInf
intro hG
apply le_iInf
intro hgG
exact iInf_le_of_le G (iInf_le_of_le hG
(iInf_le_of_le (fun x => (hfg x).trans (hgG x)) le_rfl))
The bounded-envelope adaptation of the CTY expected maximal argument. The continuum-index empirical-process engine is proved in this repository by vcExpectedMaximalInequality; the constant is uniform in the moment offset and depends only on p and L.
Formal statement
hypotheses
p :
ℕ
L :
ℝ
conclusion
∃ C : ℝ,
0 < C ∧
∀ ν : ℝ,
∀ P : A1A2Law,
A1A2Class p ν L P → ∀ (n : ℕ) (h B : ℝ), 1
≤ n → 0 < h → h ≤ L⁻¹ → 1 ≤ B → outerLIntegral (causalSampleLaw P n) (winsorizedScoreDeviation n p P h B) ≤ ofReal (C * (sqrt (log (B / h) / ((n : ℝ) * h ^ 2)) + B * log (B / h) / ((n : ℝ) * h ^ 2)))
Proof (Lean source)
lemma cty_winsorized_score_maximal_bound (p : ℕ) (L : ℝ) :
∃ C : ℝ, 0 < C ∧ ∀ ν : ℝ,
∀ P : A1A2Law, A1A2Class p ν L P →
∀ (n : ℕ) (h B : ℝ), 1 ≤ n → 0 < h → h ≤ L⁻¹ → 1 ≤ B →
outerLIntegral (causalSampleLaw P n)
(winsorizedScoreDeviation n p P h B) ≤
ofReal (C *
(sqrt (Real.log (B / h) / ((n : ℝ) * h ^ 2)) +
B * Real.log (B / h) / ((n : ℝ) * h ^ 2))) := by
let R : ℝ := 1 + |L * (p + 1 : ℝ) * (16 * L * (2 + L))|
have hR : 0 < R := by dsimp [R]; positivity
obtain ⟨A, v, C₀, hC₀, hent⟩ :=
winsorizedScore_hasVCUniformEntropy_all_nu p L R hR
let k : ℝ := 1 + Real.log A
let C : ℝ := 1 + |varianceAdaptiveVCConstant * C₀ *
(sqrt (v * k) + v * k)|
refine ⟨C, ?_, ?_⟩
· dsimp [C]
positivity
· intro ν P hP n h B hn hh hhL hB
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hL : 0 < L := lt_of_lt_of_le (by norm_num) hP.2.1
have hhB : h < B := by
have hinv : L⁻¹ < 1 := inv_lt_one_of_one_lt₀
(lt_of_lt_of_le (by norm_num) hP.2.1)
exact (hhL.trans_lt hinv).trans_le hB
have hentropy := hent ν P hP h B hh hhB hB
rcases hentropy with ⟨hσ, hσU, hA, hv, hmeas, henv, hL2, hcover⟩
have hsep := winsorizedScore_hasCountableEmpiricalSupReduction_at
p ν L R hR P hP h B hh hB
have hproc := vcExpectedMaximalInequality_explicit P.law
(separableWinsorizedScoreFunction P p h B R) (C₀ * B) (C₀ * h) A v
hsep ⟨hσ, hσU, hA, hv, hmeas, henv, hL2, hcover⟩ n hn
have hbeta : ∀ t x, x ∈ P.boundary → ∀ j,
|populationCoefficient P p t x h j| ≤ R := by
intro t x hx j
exact populationCoefficient_uniform_bound_explicit p ν L P hP t x h hx hh hhL j
have hpoint : winsorizedScoreDeviation n p P h B ≤
fun w => ofReal (h⁻¹ ^ 2) *
empiricalProcessSup P.law
(separableWinsorizedScoreFunction P p h B R) w := by
intro w
exact winsorizedScoreDeviation_le_empiricalProcessSup n p P h B R
(C₀ * B) hh hn hbeta hmeas henv w
have hc0 : ofReal (h⁻¹ ^ 2) ≠ 0 :=
ne_of_gt (ENNReal.ofReal_pos.mpr (by positivity))
have hct : ofReal (h⁻¹ ^ 2) ≠ ∞ := ENNReal.ofReal_ne_top
have houter : outerLIntegral (causalSampleLaw P n)
(winsorizedScoreDeviation n p P h B) ≤
ofReal (h⁻¹ ^ 2) *
ofReal (varianceAdaptiveVCConstant *
vcExpectedMaximalRate (C₀ * B) (C₀ * h) A v n) := by
calc
_ ≤ outerLIntegral (causalSampleLaw P n)
(fun w => ofReal (h⁻¹ ^ 2) *
empiricalProcessSup P.law
(separableWinsorizedScoreFunction P p h B R) w) :=
outerLIntegral_mono _ hpoint
_ ≤ ofReal (h⁻¹ ^ 2) *
outerLIntegral (causalSampleLaw P n)
(empiricalProcessSup P.law
(separableWinsorizedScoreFunction P p h B R)) :=
outerLIntegral_const_mul_le _ _ hc0 hct _
_ ≤ _ := mul_le_mul_right (by simpa [causalSampleLaw] using hproc) _
apply houter.trans
rw [← ENNReal.ofReal_mul (by positivity : 0 ≤ h⁻¹ ^ 2)]
apply ENNReal.ofReal_le_ofReal
have hnR : 0 < (n : ℝ) := Nat.cast_pos.mpr (Nat.zero_lt_of_lt hn)
have hratio4 : 4 ≤ B / h := by
apply (le_div_iff₀ hh).2
have hLh : L * h ≤ 1 := by
calc
L * h ≤ L * L⁻¹ := mul_le_mul_of_nonneg_left hhL hL.le
_ = 1 := mul_inv_cancel₀ hL.ne'
calc
4 * h ≤ L * h := mul_le_mul_of_nonneg_right hP.2.1 hh.le
_ ≤ 1 := hLh
_ ≤ B := hB
have hratio : 0 < B / h := div_pos (lt_of_lt_of_le zero_lt_one hB) hh
have hlog1 : 1 ≤ Real.log (B / h) := by
rw [← Real.log_exp 1]
exact Real.strictMonoOn_log.monotoneOn
(Real.exp_pos 1) hratio
((Real.exp_one_lt_three.le.trans (by norm_num : (3 : ℝ) ≤ 4)).trans hratio4)
have hA1 : 1 ≤ A := (Real.one_le_exp (by norm_num)).trans hA
have hApos : 0 < A := zero_lt_one.trans_le hA1
have hbase : max (exp 1) (A * (C₀ * B) / (C₀ * h)) = A * (B / h) := by
have hcancel : A * (C₀ * B) / (C₀ * h) = A * (B / h) := by
field_simp [hC₀.ne']
rw [hcancel, max_eq_right]
exact hA.trans (le_mul_of_one_le_right hApos.le (le_trans (by norm_num) hratio4))
have hlogA : 1 ≤ Real.log A := by
rw [← Real.log_exp 1]
exact Real.strictMonoOn_log.monotoneOn (Real.exp_pos 1) hApos hA
have hlogBound : vcMaximalLog A (C₀ * B) (C₀ * h) ≤
k * Real.log (B / h) := by
rw [vcMaximalLog, hbase, Real.log_mul hApos.ne' hratio.ne']
dsimp [k]
nlinarith [mul_nonneg (sub_nonneg.mpr hlogA) (sub_nonneg.mpr hlog1)]
have hk : 0 ≤ k := by dsimp [k]; positivity
have hv0 : 0 ≤ v := le_trans (by norm_num) hv
have hsqrt : sqrt (v * vcMaximalLog A (C₀ * B) (C₀ * h) / n) ≤
sqrt (v * k) * sqrt (Real.log (B / h) / n) := by
rw [← Real.sqrt_mul (mul_nonneg hv0 hk)]
apply Real.sqrt_le_sqrt
calc
v * vcMaximalLog A (C₀ * B) (C₀ * h) / (n : ℝ) ≤
v * (k * Real.log (B / h)) / n := by gcongr
_ = (v * k) * (Real.log (B / h) / n) := by ring
have hrate : h⁻¹ ^ 2 * (varianceAdaptiveVCConstant *
vcExpectedMaximalRate (C₀ * B) (C₀ * h) A v n) ≤
C * (sqrt (Real.log (B / h) / ((n : ℝ) * h ^ 2)) +
B * Real.log (B / h) / ((n : ℝ) * h ^ 2)) := by
unfold vcExpectedMaximalRate
have hsqrtScale : h⁻¹ ^ 2 * (C₀ * h *
sqrt (v * vcMaximalLog A (C₀ * B) (C₀ * h) / n)) ≤
C₀ * sqrt (v * k) *
sqrt (Real.log (B / h) / ((n : ℝ) * h ^ 2)) := by
have hsqrtH : sqrt (Real.log (B / h) / ((n : ℝ) * h ^ 2)) =
h⁻¹ * sqrt (Real.log (B / h) / n) := by
rw [show Real.log (B / h) / ((n : ℝ) * h ^ 2) =
h⁻¹ ^ 2 * (Real.log (B / h) / n) by field_simp,
Real.sqrt_mul (by positivity : 0 ≤ h⁻¹ ^ 2),
Real.sqrt_sq_eq_abs, abs_of_pos (inv_pos.mpr hh)]
calc
_ = (h⁻¹ ^ 2 * (C₀ * h)) *
sqrt (v * vcMaximalLog A (C₀ * B) (C₀ * h) / n) := by ring
_ ≤ (h⁻¹ ^ 2 * (C₀ * h)) *
(sqrt (v * k) * sqrt (Real.log (B / h) / n)) :=
mul_le_mul_of_nonneg_left hsqrt
(mul_nonneg (by positivity) (mul_nonneg hC₀.le hh.le))
_ = _ := by rw [hsqrtH]; field_simp
have hsecond : h⁻¹ ^ 2 *
(v * (C₀ * B) * vcMaximalLog A (C₀ * B) (C₀ * h) / n) ≤
C₀ * v * k * (B * Real.log (B / h) / ((n : ℝ) * h ^ 2)) := by
calc
_ ≤ h⁻¹ ^ 2 * (v * (C₀ * B) * (k * Real.log (B / h)) / n) := by
gcongr
_ = _ := by field_simp
dsimp [C]
let X := sqrt (Real.log (B / h) / ((n : ℝ) * h ^ 2))
let Y := B * Real.log (B / h) / ((n : ℝ) * h ^ 2)
have hX : 0 ≤ X :=
Real.sqrt_nonneg _
have hY : 0 ≤ Y := by
exact div_nonneg (mul_nonneg (le_trans (by norm_num) hB)
(by linarith : 0 ≤ Real.log (B / h)))
(mul_nonneg hnR.le (sq_nonneg h))
have hDnonneg : 0 ≤ varianceAdaptiveVCConstant * C₀ *
(sqrt (v * k) + v * k) := by
exact mul_nonneg
(mul_nonneg (by norm_num [varianceAdaptiveVCConstant]) hC₀.le)
(add_nonneg (Real.sqrt_nonneg _) (mul_nonneg hv0 hk))
have hvc : 0 ≤ varianceAdaptiveVCConstant := by
norm_num [varianceAdaptiveVCConstant]
have hs1 := mul_le_mul_of_nonneg_left hsqrtScale hvc
have hs2 := mul_le_mul_of_nonneg_left hsecond hvc
let D := varianceAdaptiveVCConstant * C₀ *
(sqrt (v * k) + v * k)
have hcross1 : 0 ≤ sqrt (v * k) *
Y := mul_nonneg (Real.sqrt_nonneg _) hY
have hcross2 : 0 ≤ v * k *
X := mul_nonneg (mul_nonneg hv0 hk) hX
calc
_ = varianceAdaptiveVCConstant *
(h⁻¹ ^ 2 * (C₀ * h *
sqrt (v * vcMaximalLog A (C₀ * B) (C₀ * h) / n))) +
varianceAdaptiveVCConstant *
(h⁻¹ ^ 2 * (v * (C₀ * B) *
vcMaximalLog A (C₀ * B) (C₀ * h) / n)) := by ring
_ ≤ varianceAdaptiveVCConstant *
(C₀ * sqrt (v * k) * X) +
varianceAdaptiveVCConstant * (C₀ * v * k * Y) := by
simpa only [X, Y] using add_le_add hs1 hs2
_ ≤ D * (X + Y) := by
dsimp [D]
nlinarith [mul_nonneg (mul_nonneg hvc hC₀.le) hcross1,
mul_nonneg (mul_nonneg hvc hC₀.le) hcross2]
_ ≤ (1 + |D|) * (X + Y) :=
mul_le_mul_of_nonneg_right ((le_abs_self D).trans (by linarith))
(add_nonneg hX hY)
_ = _ := by simp only [D, X, Y]
exact hrate
Helpers.AnalyticMeasurability 5 declarations The common-map loss is jointly Borel, so its boundary-superlevel projections are analytic.
Analytic-set interface for completed boundary risks
The common-map loss is jointly Borel, so its boundary-superlevel projections are analytic. Causalean's universal-measurability substrate turns those analytic projections into completion-measurable sets and identifies completed integration with outer integration.
theorem commonMapBoundarySup_jointlyBorel
The loss generated by one common measurable map is jointly Borel on the compact boundary and the sample space.
Formal statement
hypotheses
conclusion
Measurable (fun z : {x : Score // x ∈ frontier P.support} × Sample n => ofReal |T.map (distanceData n z.2 z.1.1) - P.mu z.1.1|)
Proof (Lean source)
lemma commonMapBoundarySup_jointlyBorel
{n q : ℕ} {L : ℝ} (P : CtyLaw) (hP : CtyNonparametricClass q L P)
(T : CtyRule n) :
Measurable
(fun z : {x : Score // x ∈ frontier P.support} × Sample n =>
ofReal
|T.map (distanceData n z.2 z.1.1) - P.mu z.1.1|) := by
rcases hP with ⟨hq, hL, hdensity, hcompact, hcube, hdenv,
hrect, hholder, hsigma, hsigmaenv⟩
have hfrontier : frontier P.support ⊆ P.support := by
exact frontier_subset_closure.trans_eq P.support_closed.closure_eq
have hmu : ContinuousOn P.mu P.support := hholder.1.continuousOn
have hmu' : Continuous (fun x : {x : Score // x ∈ frontier P.support} => P.mu x.1) :=
continuousOn_iff_continuous_restrict.mp (hmu.mono hfrontier)
have hdist : Measurable
(fun z : {x : Score // x ∈ frontier P.support} × Sample n =>
distanceData n z.2 z.1.1) := by
unfold distanceData
fun_prop
have hT : Measurable
(fun z : {x : Score // x ∈ frontier P.support} × Sample n =>
T.map (distanceData n z.2 z.1.1)) := T.measurable.comp hdist
have hmuM : Measurable
(fun z : {x : Score // x ∈ frontier P.support} × Sample n => P.mu z.1.1) :=
hmu'.measurable.comp measurable_fst
exact ENNReal.measurable_ofReal.comp (hT.sub hmuM).norm
theorem commonMapBoundarySup_upperSemianalytic
The common-map boundary loss is upper-semi-analytic: each strict superlevel set is an analytic projection of a Borel set.
Formal statement
hypotheses
n q :
ℕ
L :
ℝ
P :
hP :
CtyNonparametricClass q L P
rho :
RuleFun n
hrho :
rho ∈ CtyDistanceDecisionClass n q L
conclusion
UpperSemianalytic (boundaryLoss rho P)
Proof (Lean source)
lemma commonMapBoundarySup_upperSemianalytic
{n q : ℕ} {L : ℝ} (P : CtyLaw) (hP : CtyNonparametricClass q L P)
(rho : RuleFun n) (hrho : rho ∈ CtyDistanceDecisionClass n q L) :
UpperSemianalytic (boundaryLoss rho P) := by
rcases hrho with ⟨T, hT⟩
intro a
let B := {x : Score // x ∈ frontier P.support}
letI : PolishSpace B := isClosed_frontier.polishSpace
let loss : B × Sample n → ℝ≥0∞ := fun z =>
ofReal |T.map (distanceData n z.2 z.1.1) - P.mu z.1.1|
have hloss : Measurable loss := commonMapBoundarySup_jointlyBorel P hP T
have hevent : {w | a < boundaryLoss rho P w} =
snd '' {z : B × Sample n | a < loss z} := by
ext w
constructor
· intro hw
simp only [boundaryLoss, lt_iSup_iff] at hw
rcases hw with ⟨x, hx, hax⟩
refine ⟨⟨⟨x, hx⟩, w⟩, ?_, rfl⟩
change a < ofReal |T.map (distanceData n w x) - P.mu x|
simpa only [hT P hP w x hx] using hax
· rintro ⟨⟨⟨x, hx⟩, w'⟩, hax, rfl⟩
change a < ofReal |T.map (distanceData n w' x) - P.mu x| at hax
rw [← hT P hP w' x hx] at hax
exact hax.trans_le (le_iSup_of_le x (le_iSup_of_le hx le_rfl))
rw [hevent]
exact (hloss measurableSet_Ioi).analyticSet_image measurable_snd
theorem commonMapBoundarySup_completionMeasurable
The boundary supremum of a common-map rule is measurable on the completed sample space.
Formal statement
hypotheses
n q :
ℕ
L :
ℝ
P :
hP :
CtyNonparametricClass q L P
rho :
RuleFun n
hrho :
rho ∈ CtyDistanceDecisionClass n q L
conclusion
Proof (Lean source)
lemma commonMapBoundarySup_completionMeasurable
{n q : ℕ} {L : ℝ} (P : CtyLaw) (hP : CtyNonparametricClass q L P)
(rho : RuleFun n) (hrho : rho ∈ CtyDistanceDecisionClass n q L) :
Measurable
(fun w : NullMeasurableSpace (Sample n) (sampleLaw P n) =>
boundaryLoss rho P w) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
letI : IsProbabilityMeasure (sampleLaw P n) := by
unfold sampleLaw
infer_instance
exact (commonMapBoundarySup_upperSemianalytic P hP rho hrho).measurable_completion
(sampleLaw P n)
theorem ctyBoundarySup_completed_eq_outer
The completed expectation of a common-map boundary loss equals its outer expectation.
Formal statement
hypotheses
n q :
ℕ
L :
ℝ
P :
hP :
CtyNonparametricClass q L P
rho :
RuleFun n
hrho :
rho ∈ CtyDistanceDecisionClass n q L
conclusion
Proof (Lean source)
lemma ctyBoundarySup_completed_eq_outer
{n q : ℕ} {L : ℝ} (P : CtyLaw) (hP : CtyNonparametricClass q L P)
(rho : RuleFun n) (hrho : rho ∈ CtyDistanceDecisionClass n q L) :
(∫⁻ w, boundaryLoss rho P w ∂(sampleLaw P n).completion) =
outerLIntegral (sampleLaw P n) (boundaryLoss rho P) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
letI : IsProbabilityMeasure (sampleLaw P n) := by
unfold sampleLaw
infer_instance
exact (commonMapBoundarySup_upperSemianalytic P hP rho hrho).lintegral_completion_eq_outerLIntegral
(sampleLaw P n)
theorem ctyRisk_ge_pointIndexedRisk
The completed common-map risk dominates the outer point-indexed risk.
Formal statement
Proof (Lean source)
lemma ctyRisk_ge_pointIndexedRisk
(n q : ℕ) (L : ℝ) :
pointIndexedDistanceRisk n q L ≤ ctyDistanceRisk n q L := by
unfold pointIndexedDistanceRisk ctyDistanceRisk
refine le_iInf fun rho => le_iInf fun hrho => ?_
have hpi : rho ∈ PointIndexedDecisionClass n q L := by
rcases hrho with ⟨T, hT⟩
let Tpi : PIRule n :=
{ map := fun _x => T.map
section_measurable := fun _x => T.measurable }
refine ⟨Tpi, ?_⟩
intro P hP w x hx
exact hT P hP w x hx
refine iInf₂_le_of_le rho hpi ?_
refine iSup_le fun P => iSup_le fun hP => ?_
refine le_iSup_of_le P (le_iSup_of_le hP ?_)
exact le_of_eq (ctyBoundarySup_completed_eq_outer P hP rho hrho).symm
Helpers.AngularCellMass 2 declarations This module proves that angular tilting does not change the mass of any grid-centered half-disc.
Common cell masses for the angular packing
This module proves that angular tilting does not change the mass of any grid-centered half-disc. It isolates the cell-mass part of the finite hard family certificate from the later joint-law and KL arguments.
theorem packingAngularDensity_integral_gridCell
The angular density integrates over a grid cell to the cell's Lebesgue volume, independently of the packing vertex.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
(∫ x : Score in closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2), packingAngularDensity b cA delta w (angularGridCenter M) omega x)
Proof (Lean source)
-- @node: packingAngularDensity_integral_gridCell
lemma packingAngularDensity_integral_gridCell {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hw0 : 0 < w) (hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) :
(∫ x : Score in
closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2),
packingAngularDensity b cA delta w (angularGridCenter M) omega x) =
(volume (closedBall (angularGridCenter M j) w ∩
scoreCube (1 / 2))).toReal := by
let C := closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)
let omega' : Fin M → Bool := fun k => if k = j then omega j else false
have hpoint : ∀ x ∈ C,
packingAngularDensity b cA delta w (angularGridCenter M) omega x =
1 + if omega j then
packingAngularTerm b cA delta w (angularGridCenter M j) x else 0 := by
intro x hx
rw [packingAngularDensity_eq_on_cell hw0 hsep
(omega' := omega') (j := j) (by simp [omega']) hx.1]
simp only [packingAngularDensity, omega']
rw [Finset.sum_eq_single j]
· simp
· intro k _ hkj
simp [hkj]
· simp
rw [setIntegral_congr_fun (Metric.isClosed_closedBall.measurableSet.inter
(scoreCube_measurableSet _)) hpoint]
have hconst : IntegrableOn (fun _ : Score => (1 : ℝ)) C := by
exact continuous_const.continuousOn.integrableOn_compact
((isCompact_closedBall (angularGridCenter M j) w).inter_right
packingScoreCube_isCompact.isClosed)
have hterm : IntegrableOn
(fun x : Score => if omega j then
packingAngularTerm b cA delta w (angularGridCenter M j) x else 0) C := by
by_cases hj : omega j = true
· simpa [hj] using
((packingAngularTerm_continuous hb hscale
(angularGridCenter M j)).continuousOn.integrableOn_compact
((isCompact_closedBall (angularGridCenter M j) w).inter_right
packingScoreCube_isCompact.isClosed) :
IntegrableOn
(packingAngularTerm b cA delta w (angularGridCenter M j)) C volume)
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simpa [hjf] using
(continuous_const.continuousOn.integrableOn_compact
((isCompact_closedBall (angularGridCenter M j) w).inter_right
packingScoreCube_isCompact.isClosed) :
IntegrableOn (fun _ : Score => (0 : ℝ)) C volume)
rw [integral_add hconst hterm, integral_const]
simp only [Measure.real, Measure.restrict_apply_univ, C]
have hz : (∫ x : Score in C,
if omega j then
packingAngularTerm b cA delta w (angularGridCenter M j) x else 0) = 0 := by
by_cases hj : omega j = true
· simpa [C, hj] using
(packingAngularTerm_integral_gridCell (b := b) (cA := cA)
(delta := delta) j hw)
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simp [hjf]
rw [hz]
simp
theorem angularDesignMeasure_gridCell_eq_volume
Every angular design assigns a grid cell exactly its Lebesgue volume; in particular, its mass is independent of the Boolean packing vertex.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
angularDesignMeasure b cA delta w (angularGridCenter M) omega (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))
Proof (Lean source)
-- @node: angularDesignMeasure_gridCell_eq_volume
lemma angularDesignMeasure_gridCell_eq_volume {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw0 : 0 < w)
(hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) :
angularDesignMeasure b cA delta w (angularGridCenter M) omega
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) =
volume (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) := by
let C := closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)
have hC : MeasurableSet C :=
Metric.isClosed_closedBall.measurableSet.inter (scoreCube_measurableSet _)
rw [angularDesignMeasure, withDensity_apply _ hC]
have hint : IntegrableOn
(packingAngularDensity b cA delta w (angularGridCenter M) omega) C volume :=
(packingAngularDensity_continuous hb hscale
(angularGridCenter M) omega).continuousOn.integrableOn_compact
((isCompact_closedBall (angularGridCenter M j) w).inter_right
packingScoreCube_isCompact.isClosed)
have hnonneg : 0 ≤ᵐ[volume.restrict C]
packingAngularDensity b cA delta w (angularGridCenter M) omega := by
filter_upwards with x
exact (packingAngularDensity_mem_Icc hcA hdelta hw0 hsep omega x).1.trans'
(by norm_num)
have heq : (fun x => ofReal
(angularDesignDensity b cA delta w (angularGridCenter M) omega x)) =ᵐ[volume.restrict C]
fun x => ofReal
(packingAngularDensity b cA delta w (angularGridCenter M) omega x) := by
filter_upwards [ae_restrict_mem hC] with x hx
rw [angularDesignDensity_eq_on_square hx.2]
rw [lintegral_congr_ae heq]
rw [← ofReal_integral_eq_lintegral_ofReal hint hnonneg]
rw [show (∫ x : Score in C,
packingAngularDensity b cA delta w (angularGridCenter M) omega x) =
(volume C).toReal by
exact packingAngularDensity_integral_gridCell j hb hscale hw0 hw hsep omega]
exact ENNReal.ofReal_toReal
(((isCompact_closedBall (angularGridCenter M j) w).inter_right
packingScoreCube_isCompact.isClosed).measure_lt_top.ne)
Helpers.AngularCoordinates 7 declarations This file relates the Euclidean-space representation of CTY scores to the ordinary product plane used by Mathlib's polar-coordinate integration lemmas.
Coordinate bridge for the angular packing
This file relates the Euclidean-space representation of CTY scores to the ordinary product plane used by Mathlib's polar-coordinate integration lemmas.
The two ordinary real coordinates of a Euclidean CTY score.
Definition (Lean source)
theorem scoreCoordinates_measurePreserving
Coordinate extraction preserves planar Lebesgue measure.
Formal statement
conclusion
Proof (Lean source)
-- @node: scoreCoordinates_measurePreserving
lemma scoreCoordinates_measurePreserving :
MeasurePreserving scoreCoordinates (volume : Measure Score)
(volume : Measure (ℝ × ℝ)) := by
exact (volume_preserving_finTwoArrow ℝ).comp
(EuclideanSpace.volume_preserving_symm_measurableEquiv_toLp (Fin 2))
theorem scoreCoordinates_measurableEmbedding
Coordinate extraction is a measurable embedding as well as measure-preserving.
Formal statement
conclusion
Proof (Lean source)
-- @node: scoreCoordinates_measurableEmbedding
lemma scoreCoordinates_measurableEmbedding :
MeasurableEmbedding scoreCoordinates := by
exact ((MeasurableEquiv.toLp 2 (Fin 2 → ℝ)).symm.trans
(MeasurableEquiv.finTwoArrow (α := ℝ))).measurableEmbedding
theorem scoreCoordinates_sub
Coordinate extraction commutes with subtraction.
Formal statement
hypotheses
x y :
conclusion
Proof (Lean source)
-- @node: scoreCoordinates_sub
lemma scoreCoordinates_sub (x y : Score) :
scoreCoordinates (x - y) = scoreCoordinates x - scoreCoordinates y := by
ext <;> simp [scoreCoordinates]
theorem planarRadius_scoreCoordinates_sub
The explicit planar radius of the coordinate difference is exactly the Euclidean distance between the corresponding CTY scores.
Formal statement
Proof (Lean source)
-- @node: planarRadius_scoreCoordinates_sub
lemma planarRadius_scoreCoordinates_sub (x y : Score) :
planarRadius (scoreCoordinates x - scoreCoordinates y) = dist x y := by
rw [dist_eq_norm, EuclideanSpace.norm_eq]
simp [planarRadius, scoreCoordinates, Fin.sum_univ_two,
Real.norm_eq_abs, sq_abs]
theorem mem_angularGrid_closedBall_iff_planarRadius
Relative to a lower-edge grid center, membership in its Euclidean closed ball is the same as the corresponding planar-radius inequality.
Formal statement
hypotheses
conclusion
x ∈ closedBall (angularGridCenter M j) w
Proof (Lean source)
-- @node: mem_angularGrid_closedBall_iff_planarRadius
lemma mem_angularGrid_closedBall_iff_planarRadius
{M : ℕ} (j : Fin M) (w : ℝ) (x : Score) :
x ∈ closedBall (angularGridCenter M j) w ↔
planarRadius
(scoreCoordinates x - scoreCoordinates (angularGridCenter M j)) ≤ w := by
rw [Metric.mem_closedBall, planarRadius_scoreCoordinates_sub]
theorem mem_angularGrid_packingCell_iff_closedUpperHalfDisc
A sufficiently small ball around a lower-edge grid center is cut by the packing square exactly along the horizontal diameter: in centered planar coordinates, its packing cell is the closed upper half-disc.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: mem_angularGrid_packingCell_iff_closedUpperHalfDisc
lemma mem_angularGrid_packingCell_iff_closedUpperHalfDisc
{M : ℕ} (j : Fin M) {w : ℝ} (hw : w ≤ 1 / 4) (x : Score) :
x ∈ closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2) ↔
0 ≤ (scoreCoordinates x - scoreCoordinates (angularGridCenter M j)).2 ∧
planarRadius
(scoreCoordinates x - scoreCoordinates (angularGridCenter M j)) ≤ w := by
rw [mem_inter_iff, mem_angularGrid_closedBall_iff_planarRadius]
constructor
· rintro ⟨hr, hsquare⟩
constructor
· have hcoord := (abs_le.mp (hsquare (1 : Fin 2))).1
simp [scoreCoordinates, angularGridCenter_apply_one] at hcoord ⊢
linarith
· exact hr
· rintro ⟨hy, hr⟩
refine ⟨hr, ?_⟩
have hdist : dist x (angularGridCenter M j) ≤ w := by
rw [← planarRadius_scoreCoordinates_sub]
exact hr
intro i
have hnorm : |x i - angularGridCenter M j i| ≤ w := by
have hle : |x i - angularGridCenter M j i| ≤
dist x (angularGridCenter M j) := by
simpa [dist_eq_norm, Real.norm_eq_abs] using
(PiLp.norm_apply_le (x - angularGridCenter M j) i)
exact hle.trans hdist
fin_cases i
· change |x 0| ≤ (1 / 2 : ℝ)
have hnorm0 : |x 0 - angularGridCenter M j 0| ≤ w := by
simpa using hnorm
have hc := angularGridCenter_first_abs_lt_quarter M j
rw [abs_le] at hnorm0 ⊢
rw [abs_lt] at hc
constructor <;> linarith
· change |x 1| ≤ (1 / 2 : ℝ)
have hnorm1 : |x 1 - angularGridCenter M j 1| ≤ w := by
simpa using hnorm
rw [angularGridCenter_apply_one] at hnorm1
rw [abs_le] at hnorm1 ⊢
change 0 ≤ x 1 - angularGridCenter M j 1 at hy
rw [angularGridCenter_apply_one] at hy
constructor <;> linarith
Helpers.AngularDesign 28 declarations This file packages the paper's angular density as a Lebesgue density supported on the fixed square.
Angular packing design measure
This file packages the paper's angular density as a Lebesgue density supported
on the fixed square. It records the measurable-density, continuity, envelope,
positivity, and absolute-continuity facts needed by the eventual CtyLaw
constructor.
Coordinate cubes are Borel measurable.
Formal statement
Proof (Lean source)
-- @node: scoreCube_measurableSet
lemma scoreCube_measurableSet (r : ℝ) : MeasurableSet (scoreCube r) := by
apply IsClosed.measurableSet
unfold scoreCube
rw [show {x : Score | ∀ i, |x i| ≤ r} =
⋂ i : Fin 2, {x : Score | |x i| ≤ r} by
ext x
simp]
apply isClosed_iInter
intro i
exact isClosed_le
((PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) i).abs)
continuous_const
The fixed square supporting the angular packing has unit Lebesgue mass.
Proof (Lean source)
-- @node: packingSquare_volume
lemma packingSquare_volume : volume (scoreCube (1 / 2 : ℝ)) = 1 := by
have hset : scoreCube (1 / 2 : ℝ) =
((MeasurableEquiv.toLp 2 (Fin 2 → ℝ)).symm) ⁻¹'
Icc (fun _ => -(1 / 2 : ℝ)) (fun _ => 1 / 2) := by
ext x
simp only [scoreCube, mem_setOf_eq, mem_preimage, mem_Icc, Pi.le_def]
constructor
· intro hx
constructor
· intro i
exact (abs_le.mp (hx i)).1
· intro i
exact (abs_le.mp (hx i)).2
· rintro ⟨hlo, hhi⟩ i
exact abs_le.mpr ⟨hlo i, hhi i⟩
rw [hset, (EuclideanSpace.volume_preserving_symm_measurableEquiv_toLp
(Fin 2)).measure_preimage]
· rw [Real.volume_Icc_pi]
simp only [Fin.prod_const]
rw [show (1 / 2 : ℝ) - -(1 / 2) = 1 by norm_num, ENNReal.ofReal_one]
norm_num
· exact (measurableSet_Icc : MeasurableSet
(Icc (fun _ : Fin 2 => -(1 / 2 : ℝ)) (fun _ => 1 / 2))).nullMeasurableSet
The square supporting the angular construction is convex.
Proof (Lean source)
-- @node: packingScoreCube_convex
lemma packingScoreCube_convex : Convex ℝ (scoreCube (1 / 2 : ℝ)) := by
intro x hx y hy a b ha hb hab i
unfold scoreCube at hx hy
simp only [PiLp.add_apply, PiLp.smul_apply, smul_eq_mul]
rw [abs_le]
constructor
· have := add_le_add (mul_le_mul_of_nonneg_left (abs_le.mp (hx i)).1 ha)
(mul_le_mul_of_nonneg_left (abs_le.mp (hy i)).1 hb)
nlinarith
· have := add_le_add (mul_le_mul_of_nonneg_left (abs_le.mp (hx i)).2 ha)
(mul_le_mul_of_nonneg_left (abs_le.mp (hy i)).2 hb)
nlinarith
The square supporting the angular packing is compact.
Proof (Lean source)
-- @node: packingScoreCube_isCompact
lemma packingScoreCube_isCompact : IsCompact (scoreCube (1 / 2 : ℝ)) := by
rw [Metric.isCompact_iff_isClosed_bounded]
constructor
· unfold scoreCube
rw [show {x : Score | ∀ i, |x i| ≤ (1 / 2 : ℝ)} =
⋂ i : Fin 2, {x : Score | |x i| ≤ (1 / 2 : ℝ)} by ext; simp]
exact isClosed_iInter fun i => isClosed_le
((PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) i).abs)
continuous_const
· rw [Metric.isBounded_iff_subset_closedBall 0]
refine ⟨1, ?_⟩
intro x hx
rw [Metric.mem_closedBall, dist_zero_right, EuclideanSpace.norm_eq]
have h0 := hx (0 : Fin 2)
have h1 := hx (1 : Fin 2)
have h0sq : |x 0| ^ 2 ≤ ((1 / 2 : ℝ) ^ 2) := by
nlinarith [abs_nonneg (x 0)]
have h1sq : |x 1| ^ 2 ≤ ((1 / 2 : ℝ) ^ 2) := by
nlinarith [abs_nonneg (x 1)]
simp only [Fin.sum_univ_two, Real.norm_eq_abs]
rw [Real.sqrt_le_one]
nlinarith
The origin is an interior point of the square supporting the angular construction.
Proof (Lean source)
-- @node: zero_mem_interior_packingScoreCube
lemma zero_mem_interior_packingScoreCube :
(0 : Score) ∈ interior (scoreCube (1 / 2 : ℝ)) := by
rw [mem_interior_iff_mem_nhds]
apply Filter.mem_of_superset
(Metric.ball_mem_nhds (0 : Score) (show (0 : ℝ) < 1 / 2 by norm_num))
intro x hx
unfold scoreCube
intro i
rw [Metric.mem_ball, dist_zero_right] at hx
exact (PiLp.norm_apply_le x i).trans hx.le
The closure of the interior of the supporting square is the whole square.
Proof (Lean source)
-- @node: closure_interior_packingScoreCube
lemma closure_interior_packingScoreCube :
closure (interior (scoreCube (1 / 2 : ℝ))) = scoreCube (1 / 2 : ℝ) := by
have hclosed : IsClosed (scoreCube (1 / 2 : ℝ)) := by
unfold scoreCube
rw [show {x : Score | ∀ i, |x i| ≤ (1 / 2 : ℝ)} =
⋂ i : Fin 2, {x : Score | |x i| ≤ (1 / 2 : ℝ)} by ext; simp]
exact isClosed_iInter fun i => isClosed_le
((PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) i).abs)
continuous_const
rw [packingScoreCube_convex.closure_interior_eq_closure_of_nonempty_interior
⟨0, zero_mem_interior_packingScoreCube⟩,
hclosed.closure_eq]
theorem volume_restrict_packingScoreCube_support Lemma volume_restrict_packingScoreCube_support in the paper ↗
Restricting planar Lebesgue measure to the closed supporting square has exactly that square as its topological support.
Formal statement
Proof (Lean source)
-- @node: volume_restrict_packingScoreCube_support
lemma volume_restrict_packingScoreCube_support :
(volume.restrict (scoreCube (1 / 2 : ℝ))).support =
scoreCube (1 / 2 : ℝ) := by
have hclosed : IsClosed (scoreCube (1 / 2 : ℝ)) := by
unfold scoreCube
rw [show {x : Score | ∀ i, |x i| ≤ (1 / 2 : ℝ)} =
⋂ i : Fin 2, {x : Score | |x i| ≤ (1 / 2 : ℝ)} by ext; simp]
exact isClosed_iInter fun i => isClosed_le
((PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) i).abs)
continuous_const
apply Set.Subset.antisymm
· intro x hx
have hmem := (Measure.support_restrict_subset hx).1
rwa [hclosed.closure_eq] at hmem
· have hi : interior (scoreCube (1 / 2 : ℝ)) ⊆
(volume.restrict (scoreCube (1 / 2 : ℝ))).support := by
intro x hx
exact Measure.interior_inter_support ⟨hx, by simp [Measure.support_eq_univ]⟩
have hc := closure_mono hi
rw [closure_interior_packingScoreCube,
Measure.isClosed_support.closure_eq] at hc
exact hc
The real-valued angular design density, extended by zero away from the fixed square.
Definition (Lean source)
-- @node: angularDesignDensity
noncomputable def angularDesignDensity {M : ℕ} (b cA delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) : Score → ℝ :=
(scoreCube (1 / 2 : ℝ)).indicator
(packingAngularDensity b cA delta w centers omega)
theorem angularDesignDensity_eq_on_square
On the square, the extended design density is the angular density.
Formal statement
hypotheses
conclusion
angularDesignDensity b cA delta w centers omega x
= packingAngularDensity b cA delta w centers omega x
Proof (Lean source)
-- @node: angularDesignDensity_eq_on_square
lemma angularDesignDensity_eq_on_square {M : ℕ} {b cA delta w : ℝ}
{centers : Fin M → Score} {omega : Fin M → Bool} {x : Score}
(hx : x ∈ scoreCube (1 / 2 : ℝ)) :
angularDesignDensity b cA delta w centers omega x =
packingAngularDensity b cA delta w centers omega x := by
rw [angularDesignDensity, Set.indicator_of_mem hx]
theorem angularDesignDensity_eq_zero_off_square
Away from the square, the extended design density vanishes.
Formal statement
Proof (Lean source)
-- @node: angularDesignDensity_eq_zero_off_square
lemma angularDesignDensity_eq_zero_off_square {M : ℕ} {b cA delta w : ℝ}
{centers : Fin M → Score} {omega : Fin M → Bool} {x : Score}
(hx : x ∉ scoreCube (1 / 2 : ℝ)) :
angularDesignDensity b cA delta w centers omega x = 0 := by
rw [angularDesignDensity, Set.indicator_of_notMem hx]
theorem angularDesignDensity_eq_on_cell
Within one square-truncated packing cell, the extended design density depends on a vertex only through that cell's Boolean coordinate.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
j :
Fin M
hbit :
omega j = omega' j
x :
hx :
x ∈ closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ)
conclusion
angularDesignDensity b cA delta w centers omega x
= angularDesignDensity b cA delta w centers omega' x
Proof (Lean source)
-- @node: angularDesignDensity_eq_on_cell
lemma angularDesignDensity_eq_on_cell {M : ℕ} {b cA delta w : ℝ}
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
{omega omega' : Fin M → Bool} {j : Fin M} (hbit : omega j = omega' j)
{x : Score}
(hx : x ∈ closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ)) :
angularDesignDensity b cA delta w centers omega x =
angularDesignDensity b cA delta w centers omega' x := by
rw [angularDesignDensity_eq_on_square hx.2,
angularDesignDensity_eq_on_square hx.2]
exact packingAngularDensity_eq_on_cell hw hsep hbit hx.1
theorem angularDesignDensity_eq_one_off_cells
Outside all packing cells, the extended design density is independent of the packing vertex (and equals one on the supporting square).
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hw :
0 < w
x :
hxSquare :
x ∈ scoreCube (1 / 2 : ℝ)
hxCells :
∀ j, x ∉ closedBall (centers j) w
conclusion
angularDesignDensity b cA delta w centers omega x = 1
Proof (Lean source)
-- @node: angularDesignDensity_eq_one_off_cells
lemma angularDesignDensity_eq_one_off_cells {M : ℕ} {b cA delta w : ℝ}
(hw : 0 < w) {centers : Fin M → Score} (omega : Fin M → Bool)
{x : Score} (hxSquare : x ∈ scoreCube (1 / 2 : ℝ))
(hxCells : ∀ j, x ∉ closedBall (centers j) w) :
angularDesignDensity b cA delta w centers omega x = 1 := by
rw [angularDesignDensity_eq_on_square hxSquare]
exact packingAngularDensity_eq_one_off_cells hw omega hxCells
theorem angularDesignDensity_measurable
The square-supported angular density is Borel measurable.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
conclusion
Measurable (angularDesignDensity b cA delta w centers omega)
Proof (Lean source)
-- @node: angularDesignDensity_measurable
lemma angularDesignDensity_measurable {M : ℕ} {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (centers : Fin M → Score)
(omega : Fin M → Bool) :
Measurable (angularDesignDensity b cA delta w centers omega) := by
exact (packingAngularDensity_measurable hb hscale centers omega).indicator
(scoreCube_measurableSet (1 / 2 : ℝ))
theorem angularDesignDensity_continuousOn
Restricted to the square, the angular design density is continuous.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
conclusion
Proof (Lean source)
-- @node: angularDesignDensity_continuousOn
lemma angularDesignDensity_continuousOn {M : ℕ} {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (centers : Fin M → Score)
(omega : Fin M → Bool) :
ContinuousOn (angularDesignDensity b cA delta w centers omega)
(scoreCube (1 / 2 : ℝ)) := by
refine (packingAngularDensity_continuous (w := w) hb hscale centers omega).continuousOn.congr ?_
intro x hx
exact angularDesignDensity_eq_on_square (b := b) (cA := cA) (delta := delta)
(w := w) (centers := centers) (omega := omega) hx
theorem angularDesignDensity_mem_Icc
The extended density inherits the paper's uniform envelope on its square support.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
hx :
x ∈ scoreCube (1 / 2 : ℝ)
conclusion
angularDesignDensity b cA delta w centers omega x ∈ Icc (3 / 4 : ℝ) (5 / 4 : ℝ)
Proof (Lean source)
-- @node: angularDesignDensity_mem_Icc
lemma angularDesignDensity_mem_Icc {M : ℕ} {b cA delta w : ℝ}
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {x : Score} (hx : x ∈ scoreCube (1 / 2 : ℝ)) :
angularDesignDensity b cA delta w centers omega x ∈
Icc (3 / 4 : ℝ) (5 / 4 : ℝ) := by
rw [angularDesignDensity_eq_on_square hx]
exact packingAngularDensity_mem_Icc hcA hdelta hw hsep omega x
theorem angularDesignDensity_pos
In particular, the angular design density is strictly positive at every point of the square.
Formal statement
Proof (Lean source)
-- @node: angularDesignDensity_pos
lemma angularDesignDensity_pos {M : ℕ} {b cA delta w : ℝ}
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {x : Score} (hx : x ∈ scoreCube (1 / 2 : ℝ)) :
0 < angularDesignDensity b cA delta w centers omega x := by
exact (by norm_num : (0 : ℝ) < 3 / 4).trans_le
(angularDesignDensity_mem_Icc hcA hdelta hw hsep omega hx).1
The covariate design measure associated with an angular packing vertex.
Definition (Lean source)
-- @node: angularDesignMeasure
noncomputable def angularDesignMeasure {M : ℕ} (b cA delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) : Measure Score :=
volume.withDensity fun x =>
ofReal (angularDesignDensity b cA delta w centers omega x)
theorem angularDesignMeasure_restrict_cell_eq
Restricting the score design to one packing cell erases every Boolean coordinate except the coordinate indexing that cell.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
j :
Fin M
hbit :
omega j = omega' j
conclusion
(angularDesignMeasure b cA delta w centers omega).restrict (closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ))
= (angularDesignMeasure b cA delta w centers omega').restrict (closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ))
Proof (Lean source)
-- @node: angularDesignMeasure_restrict_cell_eq
lemma angularDesignMeasure_restrict_cell_eq {M : ℕ} {b cA delta w : ℝ}
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
{omega omega' : Fin M → Bool} {j : Fin M} (hbit : omega j = omega' j) :
(angularDesignMeasure b cA delta w centers omega).restrict
(closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ)) =
(angularDesignMeasure b cA delta w centers omega').restrict
(closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ)) := by
let C := closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ)
have hC : MeasurableSet C :=
Metric.isClosed_closedBall.measurableSet.inter (scoreCube_measurableSet _)
ext s hs
rw [Measure.restrict_apply hs, Measure.restrict_apply hs]
unfold angularDesignMeasure
rw [withDensity_apply _ (hs.inter hC), withDensity_apply _ (hs.inter hC)]
apply lintegral_congr_ae
filter_upwards [ae_restrict_mem (hs.inter hC)] with x hx
apply congrArg ofReal
exact angularDesignDensity_eq_on_cell hw hsep hbit hx.2
theorem angularDesignMeasure_restrict_off_cells_eq
Outside the union of the square-truncated packing cells, every angular design restricts to the same unit-density square measure.
Formal statement
hypotheses
conclusion
(angularDesignMeasure b cA delta w centers omega).restrict (scoreCube (1 / 2 : ℝ) \ ⋃ j, closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ))
= (angularDesignMeasure b cA delta w centers omega').restrict (scoreCube (1 / 2 : ℝ) \ ⋃ j, closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ))
Proof (Lean source)
-- @node: angularDesignMeasure_restrict_off_cells_eq
lemma angularDesignMeasure_restrict_off_cells_eq {M : ℕ}
{b cA delta w : ℝ} (hw : 0 < w) {centers : Fin M → Score}
(omega omega' : Fin M → Bool) :
(angularDesignMeasure b cA delta w centers omega).restrict
(scoreCube (1 / 2 : ℝ) \ ⋃ j,
closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ)) =
(angularDesignMeasure b cA delta w centers omega').restrict
(scoreCube (1 / 2 : ℝ) \ ⋃ j,
closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ)) := by
let C := scoreCube (1 / 2 : ℝ) \ ⋃ j,
closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ)
have hC : MeasurableSet C :=
(scoreCube_measurableSet _).diff (MeasurableSet.iUnion fun _ =>
Metric.isClosed_closedBall.measurableSet.inter (scoreCube_measurableSet _))
ext s hs
rw [Measure.restrict_apply hs, Measure.restrict_apply hs]
unfold angularDesignMeasure
rw [withDensity_apply _ (hs.inter hC), withDensity_apply _ (hs.inter hC)]
apply lintegral_congr_ae
filter_upwards [ae_restrict_mem (hs.inter hC)] with x hx
have hxBalls : ∀ j, x ∉ closedBall (centers j) w := by
intro j hxj
exact hx.2.2 (Set.mem_iUnion.2 ⟨j, hxj, hx.2.1⟩)
rw [angularDesignDensity_eq_one_off_cells hw omega hx.2.1 hxBalls,
angularDesignDensity_eq_one_off_cells hw omega' hx.2.1 hxBalls]
theorem angularDesignMeasure_eq_restrict_withDensity
An angular design is the restriction of Lebesgue measure to the square, tilted there by the untruncated angular density.
Formal statement
hypotheses
conclusion
angularDesignMeasure b cA delta w centers omega
= (volume.restrict (scoreCube (1 / 2 : ℝ))).withDensity (fun x => ofReal (packingAngularDensity b cA delta w centers omega x))
Proof (Lean source)
-- @node: angularDesignMeasure_eq_restrict_withDensity
lemma angularDesignMeasure_eq_restrict_withDensity {M : ℕ}
{b cA delta w : ℝ} (centers : Fin M → Score) (omega : Fin M → Bool) :
angularDesignMeasure b cA delta w centers omega =
(volume.restrict (scoreCube (1 / 2 : ℝ))).withDensity
(fun x => ofReal
(packingAngularDensity b cA delta w centers omega x)) := by
rw [angularDesignMeasure]
have hfun : (fun x => ofReal
(angularDesignDensity b cA delta w centers omega x)) =
(scoreCube (1 / 2 : ℝ)).indicator (fun x => ofReal
(packingAngularDensity b cA delta w centers omega x)) := by
funext x
by_cases hx : x ∈ scoreCube (1 / 2 : ℝ)
· rw [angularDesignDensity, indicator_of_mem hx, indicator_of_mem hx]
· rw [angularDesignDensity, indicator_of_notMem hx, indicator_of_notMem hx]
simp
rw [hfun, withDensity_indicator (scoreCube_measurableSet (1 / 2 : ℝ))]
theorem angularDesignMeasure_support
Every admissibly separated angular design has the fixed square as its exact topological support.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
conclusion
Proof (Lean source)
-- @node: angularDesignMeasure_support
lemma angularDesignMeasure_support {M : ℕ} {b cA delta w : ℝ} (hb : 0 < b)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA) (hdelta : 0 < delta)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) :
(angularDesignMeasure b cA delta w centers omega).support =
scoreCube (1 / 2 : ℝ) := by
let f : Score → ENNReal := fun x => ofReal
(packingAngularDensity b cA delta w centers omega x)
have hf : Measurable f :=
ENNReal.measurable_ofReal.comp
(packingAngularDensity_measurable hb hscale centers omega)
have hf0 : ∀ x, f x ≠ 0 := by
intro x
exact ne_of_gt (ENNReal.ofReal_pos.mpr
((by norm_num : (0 : ℝ) < 3 / 4).trans_le
(packingAngularDensity_mem_Icc hcA hdelta hw hsep omega x).1))
have heq : angularDesignMeasure b cA delta w centers omega =
(volume.restrict (scoreCube (1 / 2 : ℝ))).withDensity f := by
simpa [f] using angularDesignMeasure_eq_restrict_withDensity centers omega
apply Set.Subset.antisymm
· calc
_ ⊆ (volume.restrict (scoreCube (1 / 2 : ℝ))).support := by
rw [heq]
exact (withDensity_absolutelyContinuous _ _).support_mono
_ = _ := volume_restrict_packingScoreCube_support
· calc
_ = (volume.restrict (scoreCube (1 / 2 : ℝ))).support :=
volume_restrict_packingScoreCube_support.symm
_ ⊆ _ := by
rw [heq]
exact (withDensity_absolutelyContinuous' hf.aemeasurable
(Filter.Eventually.of_forall hf0)).support_mono
theorem angularDesignMeasure_allFalse_eq_restrict
The all-false angular design is exactly Lebesgue measure restricted to the supporting square.
Formal statement
hypotheses
conclusion
angularDesignMeasure b cA delta w centers (fun _ => false)
= volume.restrict (scoreCube (1 / 2 : ℝ))
Proof (Lean source)
-- @node: angularDesignMeasure_allFalse_eq_restrict
lemma angularDesignMeasure_allFalse_eq_restrict {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) :
angularDesignMeasure b cA delta w centers (fun _ => false) =
volume.restrict (scoreCube (1 / 2 : ℝ)) := by
ext s hs
rw [angularDesignMeasure, withDensity_apply _ hs, Measure.restrict_apply hs]
have hfun : (fun x => ofReal
(angularDesignDensity b cA delta w centers (fun _ => false) x)) =
(scoreCube (1 / 2 : ℝ)).indicator (fun _ => (1 : ENNReal)) := by
funext x
by_cases hx : x ∈ scoreCube (1 / 2 : ℝ)
· rw [angularDesignDensity, Set.indicator_of_mem hx,
Set.indicator_of_mem hx]
simp [packingAngularDensity]
· rw [angularDesignDensity, Set.indicator_of_notMem hx,
Set.indicator_of_notMem hx]
simp
rw [hfun, lintegral_indicator (scoreCube_measurableSet (1 / 2 : ℝ))]
rw [lintegral_one]
simp only [Measure.restrict_apply, scoreCube_measurableSet,
MeasurableSet.univ, univ_inter]
rw [inter_comm]
theorem angularDesignMeasure_allFalse_support
The all-false angular design has the supporting square as its exact topological support.
Formal statement
Proof (Lean source)
-- @node: angularDesignMeasure_allFalse_support
lemma angularDesignMeasure_allFalse_support {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) :
(angularDesignMeasure b cA delta w centers (fun _ => false)).support =
scoreCube (1 / 2 : ℝ) := by
rw [angularDesignMeasure_allFalse_eq_restrict,
volume_restrict_packingScoreCube_support]
theorem angularDesignMeasure_absolutelyContinuous
Every angular design measure is absolutely continuous with respect to Lebesgue measure.
Formal statement
Proof (Lean source)
-- @node: angularDesignMeasure_absolutelyContinuous
lemma angularDesignMeasure_absolutelyContinuous {M : ℕ} (b cA delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) :
angularDesignMeasure b cA delta w centers omega ≪ volume := by
exact withDensity_absolutelyContinuous volume _
theorem packingAngularTerm_integral_square
A grid-centered angular correction has zero integral over the whole supporting square, because it vanishes away from its own half-disc cell.
Formal statement
hypotheses
conclusion
= 0
Proof (Lean source)
-- @node: packingAngularTerm_integral_square
lemma packingAngularTerm_integral_square {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hw0 : 0 < w) (hw : w ≤ 1 / 4) :
(∫ x : Score in scoreCube (1 / 2),
packingAngularTerm b cA delta w (angularGridCenter M j) x) = 0 := by
rw [setIntegral_eq_of_subset_of_forall_diff_eq_zero
(scoreCube_measurableSet (1 / 2 : ℝ)) inter_subset_right]
· exact packingAngularTerm_integral_gridCell j hw
· rintro x ⟨hxSquare, hxCell⟩
have hxBall : x ∉ closedBall (angularGridCenter M j) w := by
intro hx
exact hxCell ⟨hx, hxSquare⟩
apply packingAngularTerm_eq_zero_of_bandwidth_le_dist hw0
exact (not_le.mp (by simpa [Metric.mem_closedBall] using hxBall)).le
theorem packingAngularDensity_integral_square
Every separated angular grid density integrates to one over the square.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
conclusion
(∫ x : Score in scoreCube (1 / 2), packingAngularDensity b cA delta w (angularGridCenter M) omega x)
= 1
Proof (Lean source)
-- @node: packingAngularDensity_integral_square
lemma packingAngularDensity_integral_square {M : ℕ} {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (hw0 : 0 < w) (hw : w ≤ 1 / 4)
(omega : Fin M → Bool) :
(∫ x : Score in scoreCube (1 / 2),
packingAngularDensity b cA delta w (angularGridCenter M) omega x) = 1 := by
have hconst : IntegrableOn (fun _ : Score => (1 : ℝ)) (scoreCube (1 / 2)) :=
continuous_const.continuousOn.integrableOn_compact packingScoreCube_isCompact
have hterms : ∀ j : Fin M, IntegrableOn
(fun x : Score => if omega j then
packingAngularTerm b cA delta w (angularGridCenter M j) x else 0)
(scoreCube (1 / 2)) := by
intro j
by_cases hj : omega j = true
· simpa [hj] using
(packingAngularTerm_continuous hb hscale
(angularGridCenter M j)).continuousOn.integrableOn_compact
packingScoreCube_isCompact
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simpa [hjf] using
continuous_const.continuousOn.integrableOn_compact
(K := scoreCube (1 / 2 : ℝ)) packingScoreCube_isCompact
unfold packingAngularDensity
rw [integral_add hconst (integrable_finset_sum _ fun j _ => hterms j)]
rw [integral_const]
change ((volume.restrict (scoreCube (1 / 2 : ℝ))) univ).toReal * 1 + _ = 1
rw [Measure.restrict_apply MeasurableSet.univ,
univ_inter, packingSquare_volume, ENNReal.toReal_one]
simp only [one_mul]
have hz : (∫ x : Score in scoreCube (1 / 2),
∑ j, if omega j then
packingAngularTerm b cA delta w (angularGridCenter M j) x else 0) = 0 := by
rw [integral_finset_sum _ fun j _ => hterms j]
apply Finset.sum_eq_zero
intro j _
by_cases hj : omega j = true
· simp only [hj, if_true]
exact packingAngularTerm_integral_square (b := b) (cA := cA)
(delta := delta) j hw0 hw
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simp [hjf]
rw [hz]
norm_num
theorem angularDesignMeasure_isProbabilityMeasure
Every admissibly separated angular design on the explicit grid is a probability measure.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
Proof (Lean source)
-- @node: angularDesignMeasure_isProbabilityMeasure
lemma angularDesignMeasure_isProbabilityMeasure {M : ℕ}
{b cA delta w : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw0 : 0 < w) (hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) :
IsProbabilityMeasure
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) := by
rw [isProbabilityMeasure_iff, angularDesignMeasure,
withDensity_apply _ MeasurableSet.univ]
have hint : Integrable
(angularDesignDensity b cA delta w (angularGridCenter M) omega) volume := by
have hzero : angularDesignDensity b cA delta w (angularGridCenter M) omega =
(scoreCube (1 / 2 : ℝ)).indicator
(packingAngularDensity b cA delta w (angularGridCenter M) omega) := rfl
rw [hzero]
have hOn : IntegrableOn
(packingAngularDensity b cA delta w (angularGridCenter M) omega)
(scoreCube (1 / 2 : ℝ)) volume :=
(packingAngularDensity_continuous hb hscale
(angularGridCenter M) omega).continuousOn.integrableOn_compact
packingScoreCube_isCompact
exact hOn.integrable_indicator (scoreCube_measurableSet (1 / 2 : ℝ))
have hnonneg : 0 ≤ᵐ[volume]
angularDesignDensity b cA delta w (angularGridCenter M) omega := by
filter_upwards with x
by_cases hx : x ∈ scoreCube (1 / 2 : ℝ)
· have hlo := (angularDesignDensity_mem_Icc (b := b)
hcA hdelta hw0 hsep omega hx).1
norm_num at hlo ⊢
linarith
· rw [angularDesignDensity_eq_zero_off_square hx]
simp
simp only [Measure.restrict_univ]
rw [← ofReal_integral_eq_lintegral_ofReal hint hnonneg]
rw [show (∫ x, angularDesignDensity b cA delta w (angularGridCenter M) omega x) =
∫ x in scoreCube (1 / 2),
packingAngularDensity b cA delta w (angularGridCenter M) omega x by
rw [angularDesignDensity]
exact integral_indicator (scoreCube_measurableSet (1 / 2 : ℝ))]
rw [packingAngularDensity_integral_square hb hscale hw0 hw omega]
simp
theorem angularDesignMeasure_allFalse_isProbabilityMeasure
With every angular bit off, the square-supported design is a probability measure. Later normalization reduces the general vertex to this baseline by showing that each active cosine tilt has zero integral.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: angularDesignMeasure_allFalse_isProbabilityMeasure
lemma angularDesignMeasure_allFalse_isProbabilityMeasure {M : ℕ}
(b cA delta w : ℝ) (centers : Fin M → Score) :
IsProbabilityMeasure
(angularDesignMeasure b cA delta w centers (fun _ => false)) := by
constructor
rw [angularDesignMeasure, withDensity_apply _ MeasurableSet.univ]
have hfun : (fun x => ofReal
(angularDesignDensity b cA delta w centers (fun _ => false) x)) =
(scoreCube (1 / 2 : ℝ)).indicator (fun _ => (1 : ENNReal)) := by
funext x
by_cases hx : x ∈ scoreCube (1 / 2 : ℝ)
· rw [angularDesignDensity, Set.indicator_of_mem hx,
Set.indicator_of_mem hx]
simp [packingAngularDensity]
· rw [angularDesignDensity, Set.indicator_of_notMem hx,
Set.indicator_of_notMem hx]
simp
rw [hfun, lintegral_indicator (scoreCube_measurableSet (1 / 2 : ℝ))]
simp only [Measure.restrict_apply_univ, lintegral_one]
simpa using packingSquare_volume
Helpers.AngularFullDisc 2 declarations The causal hard-square construction places its angular cells on an interior assignment boundary.
Full-disc angular cancellation
The causal hard-square construction places its angular cells on an interior assignment boundary. Its score cells are therefore complete disks rather than the support-boundary half-disks used by the original angular packing. This module supplies the corresponding zero-mass cancellation.
theorem packingAngularTerm_integral_closedBall
A radial angular correction integrates to zero on every complete disk. Point reflection through the disk center preserves Lebesgue measure and the disk while negating the direction cosine.
Formal statement
hypotheses
b cA delta w :
ℝ
center :
conclusion
Proof (Lean source)
-- @node: packingAngularTerm_integral_closedBall
lemma packingAngularTerm_integral_closedBall {b cA delta w : ℝ}
(center : Score) :
(∫ x : Score in closedBall center w,
packingAngularTerm b cA delta w center x) = 0 := by
let T : Score → Score := fun x => (2 : ℝ) • center - x
have hT : MeasurePreserving T (volume : Measure Score) volume := by
exact (measurePreserving_add_left volume ((2 : ℝ) • center)).comp
(Measure.measurePreserving_neg volume)
have hTemb : MeasurableEmbedding T := by
let e : Score ≃ₜ Score := (Homeomorph.neg Score).trans
(Homeomorph.addLeft ((2 : ℝ) • center))
exact e.measurableEmbedding
have himage : T '' closedBall center w = closedBall center w := by
ext x
constructor
· rintro ⟨y, hy, rfl⟩
rw [Metric.mem_closedBall] at hy ⊢
have hid : (2 : ℝ) • center - y - center = -(y - center) := by module
have hd : dist (T y) center = dist y center := by
rw [dist_eq_norm, dist_eq_norm, show T y - center = -(y - center) by
exact hid]
exact norm_neg _
simpa [hd] using hy
· intro hx
refine ⟨T x, ?_, ?_⟩
· rw [Metric.mem_closedBall] at hx ⊢
have hid : (2 : ℝ) • center - x - center = -(x - center) := by module
have hd : dist (T x) center = dist x center := by
rw [dist_eq_norm, dist_eq_norm, show T x - center = -(x - center) by
exact hid]
exact norm_neg _
simpa [hd] using hx
· simp [T]
have hodd : ∀ x, packingAngularTerm b cA delta w center (T x) =
-packingAngularTerm b cA delta w center x := by
intro x
unfold packingAngularTerm packingDirectionCos
have hdist : dist (T x) center = dist x center := by
rw [dist_eq_norm, dist_eq_norm, show T x - center = -(x - center) by
dsimp [T]
module]
exact norm_neg _
rw [hdist]
by_cases hx : dist x center = 0
· simp [hx]
· simp only [hx, if_false]
simp [T]
ring
have hchange := hT.setIntegral_image_emb hTemb
(packingAngularTerm b cA delta w center) (closedBall center w)
rw [himage] at hchange
simp_rw [hodd] at hchange
rw [integral_neg] at hchange
linarith [hchange]
theorem packingAngularDensity_integral_closedBall
A separated angular density integrates over each complete packing disk to the disk's ordinary Lebesgue area, independently of every Boolean bit.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
conclusion
= (volume (closedBall (centers j) w)).toReal
Proof (Lean source)
-- @node: packingAngularDensity_integral_closedBall
lemma packingAngularDensity_integral_closedBall {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (centers : Fin M → Score) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k)) :
(∫ x : Score in closedBall (centers j) w,
packingAngularDensity b cA delta w centers omega x) =
(volume (closedBall (centers j) w)).toReal := by
have hconst : IntegrableOn (fun _ : Score ↦ (1 : ℝ))
(closedBall (centers j) w) :=
continuous_const.continuousOn.integrableOn_compact (isCompact_closedBall _ _)
have hterms : ∀ i : Fin M, IntegrableOn
(fun x : Score ↦ if omega i then
packingAngularTerm b cA delta w (centers i) x else 0)
(closedBall (centers j) w) := by
intro i
by_cases hi : omega i = true
· simpa [hi] using
(packingAngularTerm_continuous hb hscale
(centers i)).continuousOn.integrableOn_compact (isCompact_closedBall _ _)
· have hif : omega i = false := Bool.eq_false_of_not_eq_true hi
simpa [hif] using continuous_const.continuousOn.integrableOn_compact
(K := closedBall (centers j) w) (isCompact_closedBall _ _)
unfold packingAngularDensity
rw [integral_add hconst (integrable_finset_sum _ fun i _ ↦ hterms i),
integral_const]
rw [Measure.real, Measure.restrict_apply MeasurableSet.univ, Set.univ_inter]
simp only [smul_eq_mul, mul_one]
rw [integral_finset_sum _ fun i _ ↦ hterms i, add_eq_left]
apply Finset.sum_eq_zero
intro i _
by_cases hi : omega i = true
· simp only [hi, if_true]
by_cases hij : i = j
· subst i
exact packingAngularTerm_integral_closedBall (b := b) (cA := cA)
(delta := delta) (w := w) (centers j)
· apply integral_eq_zero_of_ae
filter_upwards [ae_restrict_mem
Metric.isClosed_closedBall.measurableSet] with x hx
apply packingAngularTerm_eq_zero_of_bandwidth_le_dist hw
rw [Metric.mem_closedBall] at hx
have htri : dist (centers i) (centers j) ≤
dist (centers i) x + dist x (centers j) := dist_triangle _ _ _
have hs := hsep i j hij
rw [dist_comm (centers i) x] at htri
linarith
· have hif : omega i = false := Bool.eq_false_of_not_eq_true hi
simp [hif]
Helpers.AngularGrid 32 declarations This file constructs an explicit equispaced family of centers on the middle half of the lower edge of the unit square.
Lower-edge angular packing grid
This file constructs an explicit equispaced family of centers on the middle half of the lower edge of the unit square. It proves boundary membership, exact pairwise distances, quantitative separation, and disjointness of the associated closed half-disc cells.
A point of the Euclidean score plane specified by its two coordinates.
Definition (Lean source)
-- @node: scorePoint
noncomputable def scorePoint (x y : ℝ) : Score :=
(EuclideanSpace.equiv (Fin 2) ℝ).symm ![x, y]
theorem scorePoint_apply_zero
The first coordinate of an explicitly specified score point.
Formal statement
Proof (Lean source)
-- @node: scorePoint_apply_zero
lemma scorePoint_apply_zero (x y : ℝ) : scorePoint x y 0 = x := by
simp [scorePoint]
theorem scorePoint_apply_one
The second coordinate of an explicitly specified score point.
Formal statement
Proof (Lean source)
-- @node: scorePoint_apply_one
lemma scorePoint_apply_one (x y : ℝ) : scorePoint x y 1 = y := by
simp [scorePoint]
theorem dist_scorePoint_same_second
Euclidean distance between two points on a horizontal line is their one-dimensional horizontal distance.
Formal statement
Proof (Lean source)
-- @node: dist_scorePoint_same_second
lemma dist_scorePoint_same_second (x x' y : ℝ) :
dist (scorePoint x y) (scorePoint x' y) = |x - x'| := by
rw [dist_eq_norm, EuclideanSpace.norm_eq]
simp [scorePoint, Fin.sum_univ_two, Real.norm_eq_abs]
exact Real.sqrt_sq_eq_abs _
theorem dist_scorePoint_same_first
Euclidean distance between two points on a vertical line is their one-dimensional vertical distance.
Formal statement
Proof (Lean source)
-- @node: dist_scorePoint_same_first
lemma dist_scorePoint_same_first (x y y' : ℝ) :
dist (scorePoint x y) (scorePoint x y') = |y - y'| := by
rw [dist_eq_norm, EuclideanSpace.norm_eq]
simp [scorePoint, Fin.sum_univ_two, Real.norm_eq_abs]
exact Real.sqrt_sq_eq_abs _
theorem lowerEdgePoint_mem_frontier
Every non-corner point on the lower edge belongs to the frontier of the unit square.
Formal statement
hypotheses
x :
ℝ
hx :
|x| < (1 / 2 : ℝ)
conclusion
Proof (Lean source)
-- @node: lowerEdgePoint_mem_frontier
lemma lowerEdgePoint_mem_frontier (x : ℝ) (hx : |x| < (1 / 2 : ℝ)) :
scorePoint x (-1 / 2) ∈ frontier (scoreCube (1 / 2)) := by
rw [frontier_eq_closure_inter_closure]
constructor
· have hclosed : IsClosed (scoreCube (1 / 2 : ℝ)) := by
unfold scoreCube
rw [show {z : Score | ∀ i, |z i| ≤ (1 / 2 : ℝ)} =
⋂ i : Fin 2, {z : Score | |z i| ≤ (1 / 2 : ℝ)} by ext z; simp]
exact isClosed_iInter (fun i => isClosed_le
((PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) i).abs)
continuous_const)
rw [hclosed.closure_eq]
intro i
fin_cases i
· simpa [scoreCube, scorePoint] using hx.le
· norm_num [scoreCube, scorePoint]
· rw [mem_closure_iff]
intro U hU hxU
obtain ⟨ε, hε, hball⟩ := Metric.isOpen_iff.mp hU _ hxU
let z := scorePoint x (-1 / 2 - ε / 2)
have hzdist : dist z (scorePoint x (-1 / 2)) = ε / 2 := by
unfold z
rw [dist_scorePoint_same_first]
rw [show -1 / 2 - ε / 2 - -1 / 2 = -(ε / 2) by ring,
abs_neg, abs_of_pos (half_pos hε)]
have hzU : z ∈ U := hball (by simpa [hzdist] using half_lt_self hε)
refine ⟨z, hzU, ?_⟩
intro hzS
have hzbound := hzS (1 : Fin 2)
simp [z, scorePoint] at hzbound
have hlow := neg_le_of_abs_le hzbound
norm_num at hlow
linarith
The explicit equispaced Fin M grid on the middle half of the square's lower edge.
Definition (Lean source)
-- @node: angularGridCenter
noncomputable def angularGridCenter (M : ℕ) (j : Fin M) : Score :=
scorePoint (-1 / 4 + ((j : ℕ) + 1 : ℝ) / (2 * (M + 1 : ℕ))) (-1 / 2)
theorem angularGridCenter_apply_zero
Formula for the horizontal coordinate of a grid center.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
conclusion
angularGridCenter M j 0 = -1 / 4 + ((j : ℕ) + 1 : ℝ) / (2 * (M + 1 : ℕ))
Proof (Lean source)
-- @node: angularGridCenter_apply_zero
lemma angularGridCenter_apply_zero (M : ℕ) (j : Fin M) :
angularGridCenter M j 0 =
-1 / 4 + ((j : ℕ) + 1 : ℝ) / (2 * (M + 1 : ℕ)) := by
simp [angularGridCenter, scorePoint_apply_zero]
theorem angularGridCenter_apply_one
Every grid center lies on the lower edge.
Formal statement
Proof (Lean source)
-- @node: angularGridCenter_apply_one
lemma angularGridCenter_apply_one (M : ℕ) (j : Fin M) :
angularGridCenter M j 1 = -1 / 2 := by
simp [angularGridCenter, scorePoint_apply_one]
theorem angularGridCenter_first_abs_lt
Grid centers remain strictly inside the middle horizontal span, hence avoid both lower corners.
Formal statement
Proof (Lean source)
-- @node: angularGridCenter_first_abs_lt
lemma angularGridCenter_first_abs_lt (M : ℕ) (j : Fin M) :
|angularGridCenter M j 0| < (1 / 2 : ℝ) := by
have hj : (j : ℕ) + 1 ≤ M := j.isLt
have hnum : (((j : ℕ) + 1 : ℕ) : ℝ) < ((M + 1 : ℕ) : ℝ) := by
exact_mod_cast Nat.lt_succ_of_le hj
have hden : 0 < (2 * (M + 1 : ℕ) : ℝ) := by positivity
have hfrac0 : 0 < (((j : ℕ) + 1 : ℝ) / (2 * (M + 1 : ℕ))) := by positivity
have hfrac : (((j : ℕ) + 1 : ℝ) / (2 * (M + 1 : ℕ))) < 1 / 2 := by
apply (div_lt_iff₀ hden).2
push_cast at hnum ⊢
nlinarith
rw [angularGridCenter_apply_zero, abs_lt]
constructor <;> linarith
theorem angularGridCenter_first_abs_lt_quarter
Grid centers lie strictly in the middle half of the lower edge, so in particular none of them is a corner of the square.
Formal statement
Proof (Lean source)
-- @node: angularGridCenter_first_abs_lt_quarter
lemma angularGridCenter_first_abs_lt_quarter (M : ℕ) (j : Fin M) :
|angularGridCenter M j 0| < (1 / 4 : ℝ) := by
have hj : (j : ℕ) + 1 ≤ M := j.isLt
have hnum : (((j : ℕ) + 1 : ℕ) : ℝ) < ((M + 1 : ℕ) : ℝ) := by
exact_mod_cast Nat.lt_succ_of_le hj
have hden : 0 < (2 * (M + 1 : ℕ) : ℝ) := by positivity
have hfrac0 : 0 < (((j : ℕ) + 1 : ℝ) / (2 * (M + 1 : ℕ))) := by
positivity
have hfrac : (((j : ℕ) + 1 : ℝ) / (2 * (M + 1 : ℕ))) < 1 / 2 := by
apply (div_lt_iff₀ hden).2
push_cast at hnum ⊢
nlinarith
rw [angularGridCenter_apply_zero, abs_lt]
constructor <;> linarith
theorem angularGridCenter_mem_frontier
Every grid center lies on the frontier of the unit square.
Formal statement
Proof (Lean source)
-- @node: angularGridCenter_mem_frontier
lemma angularGridCenter_mem_frontier (M : ℕ) (j : Fin M) :
angularGridCenter M j ∈ frontier (scoreCube (1 / 2)) := by
rw [angularGridCenter]
exact lowerEdgePoint_mem_frontier _ (angularGridCenter_first_abs_lt M j)
theorem angularGridCenter_dist
Exact pairwise distance formula for the equispaced lower-edge grid.
Formal statement
Proof (Lean source)
-- @node: angularGridCenter_dist
lemma angularGridCenter_dist (M : ℕ) (i j : Fin M) :
dist (angularGridCenter M i) (angularGridCenter M j) =
|((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)| / (2 * (M + 1 : ℕ)) := by
rw [angularGridCenter, angularGridCenter, dist_scorePoint_same_second]
have hden : 0 ≤ (2 * (M + 1 : ℕ) : ℝ) := by positivity
have hinner :
-1 / 4 + (((i : ℕ) : ℝ) + 1) / (2 * (M + 1 : ℕ)) -
(-1 / 4 + (((j : ℕ) : ℝ) + 1) / (2 * (M + 1 : ℕ))) =
(((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)) / (2 * (M + 1 : ℕ)) := by ring
rw [hinner, abs_div, abs_of_nonneg hden]
theorem angularGridCenter_separated
Distinct grid centers are separated by at least one grid spacing.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: angularGridCenter_separated
lemma angularGridCenter_separated (M : ℕ) (i j : Fin M) (hij : i ≠ j) :
1 / (2 * (M + 1 : ℕ) : ℝ) ≤
dist (angularGridCenter M i) (angularGridCenter M j) := by
rw [angularGridCenter_dist]
have hcast : ((i : ℕ) : ℝ) ≠ ((j : ℕ) : ℝ) := by
exact_mod_cast (Fin.val_ne_of_ne hij)
have habs : 1 ≤ |((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)| := by
rcases lt_or_gt_of_ne hcast with hlt | hgt
· rw [abs_of_nonpos (sub_nonpos.mpr hlt.le)]
have hnat : (i : ℕ) + 1 ≤ (j : ℕ) := Nat.succ_le_iff.mpr (by exact_mod_cast hlt)
have hnatR : (((i : ℕ) : ℝ) + 1) ≤ ((j : ℕ) : ℝ) := by exact_mod_cast hnat
linarith
· rw [abs_of_nonneg (sub_nonneg.mpr hgt.le)]
have hnat : (j : ℕ) + 1 ≤ (i : ℕ) := Nat.succ_le_iff.mpr (by exact_mod_cast hgt)
have hnatR : (((j : ℕ) : ℝ) + 1) ≤ ((i : ℕ) : ℝ) := by exact_mod_cast hnat
linarith
exact div_le_div_of_nonneg_right habs (by positivity)
theorem angularGridCells_disjoint
If twice the radius is smaller than one grid spacing, the square-truncated closed balls around distinct centers are disjoint.
Formal statement
hypotheses
conclusion
Disjoint (closedBall (angularGridCenter M i) w ∩ scoreCube (1 / 2)) (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))
Proof (Lean source)
-- @node: angularGridCells_disjoint
lemma angularGridCells_disjoint (M : ℕ) (w : ℝ)
(hw : 2 * w < 1 / (2 * (M + 1 : ℕ) : ℝ))
(i j : Fin M) (hij : i ≠ j) :
Disjoint
(closedBall (angularGridCenter M i) w ∩ scoreCube (1 / 2))
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) := by
apply (Metric.closedBall_disjoint_closedBall ?_).mono inter_subset_left inter_subset_left
simpa [two_mul] using hw.trans_le (angularGridCenter_separated M i j hij)
theorem angularGridCenter_three_radius_separated
A radius at most one third of the grid spacing gives the paper's 3w center separation.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: angularGridCenter_three_radius_separated
lemma angularGridCenter_three_radius_separated (M : ℕ) (w : ℝ)
(hw : 3 * w ≤ 1 / (2 * (M + 1 : ℕ) : ℝ))
(i j : Fin M) (hij : i ≠ j) :
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M j) := by
exact hw.trans (angularGridCenter_separated M i j hij)
theorem angularGridPacking_three_radius
Positive cells whose radius is at most one third of the grid spacing are pairwise disjoint after truncation to the square.
Formal statement
hypotheses
conclusion
Disjoint (closedBall (angularGridCenter M i) w ∩ scoreCube (1 / 2)) (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))
Proof (Lean source)
-- @node: angularGridPacking_three_radius
lemma angularGridPacking_three_radius (M : ℕ) (w : ℝ) (hw0 : 0 < w)
(hw : 3 * w ≤ 1 / (2 * (M + 1 : ℕ) : ℝ))
(i j : Fin M) (hij : i ≠ j) :
Disjoint
(closedBall (angularGridCenter M i) w ∩ scoreCube (1 / 2))
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) := by
exact angularGridCells_disjoint M w (by linarith) i j hij
Number of lower-edge grid points used at cell radius w. The factor 12 leaves enough slack for the paper's 3w separation.
Definition (Lean source)
-- @node: angularGridSize
noncomputable def angularGridSize (w : ℝ) : ℕ :=
⌊(1 / (12 * w) : ℝ)⌋₊
The paper-scale radius: the qth power scale of the frontier rate.
Definition (Lean source)
-- @node: angularGridRadius
noncomputable def angularGridRadius (n q : ℕ) : ℝ :=
rpow (frontierRate n) ((1 : ℝ) / q)
theorem angularGridRadius_eventually_small
At every positive smoothness order, the paper-scale radius is eventually positive and small enough for the explicit grid geometry.
Formal statement
hypotheses
q :
ℕ
hq :
1 ≤ q
conclusion
Proof (Lean source)
-- @node: angularGridRadius_eventually_small
lemma angularGridRadius_eventually_small (q : ℕ) (hq : 1 ≤ q) :
∀ᶠ n in atTop,
0 < angularGridRadius n q ∧ angularGridRadius n q ≤ 1 / 24 := by
have hqR : (0 : ℝ) < q := by
exact_mod_cast (lt_of_lt_of_le Nat.zero_lt_one hq)
have hp : 0 < (1 : ℝ) / q := by positivity
have ht : Tendsto (fun n => angularGridRadius n q) atTop (nhds 0) := by
unfold angularGridRadius
convert frontierRate_tendsto_zero.rpow_const (inr hp.le) using 1
case e'_3 => rfl
case e'_5 => rw [Real.zero_rpow hp.ne']
have hsmall : ∀ᶠ n in atTop, angularGridRadius n q < 1 / 24 :=
ht.eventually (Iio_mem_nhds (by norm_num : (0 : ℝ) < 1 / 24))
filter_upwards [eventually_ge_atTop (2 : ℕ), hsmall] with n hn hs
exact ⟨Real.rpow_pos_of_pos (frontierRate_pos hn) _, hs.le⟩
theorem angularGridSize_lower
For small positive radii, the explicit grid has at least a constant multiple of w⁻¹ points.
Formal statement
hypotheses
w :
ℝ
hw0 :
0 < w
hw :
w ≤ 1 / 24
conclusion
1 / (24 * w) ≤ (angularGridSize w : ℝ)
Proof (Lean source)
-- @node: angularGridSize_lower
lemma angularGridSize_lower (w : ℝ) (hw0 : 0 < w) (hw : w ≤ 1 / 24) :
1 / (24 * w) ≤ (angularGridSize w : ℝ) := by
have hfloor : (1 / (12 * w) : ℝ) < angularGridSize w + 1 := by
simpa [angularGridSize] using Nat.lt_floor_add_one (1 / (12 * w) : ℝ)
have hlarge : 2 ≤ (1 / (12 * w) : ℝ) := by
apply (le_div_iff₀ (by positivity : 0 < 12 * w)).2
nlinarith
have hhalf : 1 / (24 * w) = (1 / (12 * w)) / 2 := by
field_simp
ring
rw [hhalf]
linarith
theorem angularGridSize_frontier_lower
At the frontier-rate radius, the explicit grid meets the theorem's a_n⁻¹ᐟᵠ cardinality lower bound with constant 1/24.
Formal statement
hypotheses
conclusion
(1 / 24 : ℝ) * rpow (frontierRate n) (-(1 : ℝ) / q)
≤ (angularGridSize (angularGridRadius n q) : ℝ)
Proof (Lean source)
-- @node: angularGridSize_frontier_lower
lemma angularGridSize_frontier_lower (n q : ℕ) (hn : 2 ≤ n)
(hsmall : angularGridRadius n q ≤ 1 / 24) :
(1 / 24 : ℝ) * rpow (frontierRate n) (-(1 : ℝ) / q) ≤
(angularGridSize (angularGridRadius n q) : ℝ) := by
have hr0 : 0 < frontierRate n := frontierRate_pos hn
have hw0 : 0 < angularGridRadius n q := Real.rpow_pos_of_pos hr0 _
have hid :
(1 / 24 : ℝ) * rpow (frontierRate n) (-(1 : ℝ) / q) =
1 / (24 * angularGridRadius n q) := by
have hneg :
rpow (frontierRate n) (-((1 : ℝ) / q)) =
(rpow (frontierRate n) ((1 : ℝ) / q))⁻¹ :=
Real.rpow_neg hr0.le _
rw [show -(1 : ℝ) / q = -((1 : ℝ) / q) by ring, hneg]
unfold angularGridRadius
field_simp
rw [hid]
exact angularGridSize_lower _ hw0 hsmall
theorem angularGridSize_spacing
The spacing of the grid selected by angularGridSize is at least three times its cell radius.
Formal statement
hypotheses
w :
ℝ
hw0 :
0 < w
hw :
w ≤ 1 / 24
conclusion
3 * w ≤ 1 / (2 * (angularGridSize w + 1 : ℕ) : ℝ)
Proof (Lean source)
-- @node: angularGridSize_spacing
lemma angularGridSize_spacing (w : ℝ) (hw0 : 0 < w) (hw : w ≤ 1 / 24) :
3 * w ≤ 1 / (2 * (angularGridSize w + 1 : ℕ) : ℝ) := by
have hfloor : (angularGridSize w : ℝ) ≤ 1 / (12 * w) := by
exact_mod_cast Nat.floor_le (by positivity : 0 ≤ (1 / (12 * w) : ℝ))
have hsum : (angularGridSize w + 1 : ℕ) ≤ 1 / (6 * w) := by
push_cast
have hone : (1 : ℝ) ≤ 1 / (12 * w) := by
apply (le_div_iff₀ (by positivity : 0 < 12 * w)).2
nlinarith
have hdouble : 1 / (6 * w) = 2 * (1 / (12 * w)) := by
field_simp
ring
rw [hdouble]
linarith
apply (le_div_iff₀
(by positivity : 0 < (2 * (angularGridSize w + 1 : ℕ) : ℝ))).2
have hcast : ((angularGridSize w + 1 : ℕ) : ℝ) ≤ 1 / (6 * w) := by
exact_mod_cast hsum
have hmul := mul_le_mul_of_nonneg_left hcast (show 0 ≤ 6 * w by positivity)
field_simp at hmul ⊢
nlinarith
theorem angularGridSize_geometry
The radius-dependent explicit grid simultaneously has the required cardinality, frontier membership, corner avoidance, 3w separation, and pairwise-disjoint square-truncated cells.
Formal statement
hypotheses
w :
ℝ
hw0 :
0 < w
hw :
w ≤ 1 / 24
conclusion
1 / (24 * w) ≤ (angularGridSize w : ℝ) ∧
(∀ j : Fin (angularGridSize w), angularGridCenter (angularGridSize w) j ∈ frontier (scoreCube (1 / 2)) ∧ |angularGridCenter (angularGridSize w) j 0| < (1 / 4 : ℝ)) ∧
(∀ i j : Fin (angularGridSize w), i ≠ j → 3 * w ≤ dist (angularGridCenter (angularGridSize w) i) (angularGridCenter (angularGridSize w) j) ∧ Disjoint (closedBall (angularGridCenter (angularGridSize w) i) w ∩ scoreCube (1 / 2)) (closedBall (angularGridCenter (angularGridSize w) j) w ∩ scoreCube (1 / 2)))
Proof (Lean source)
-- @node: angularGridSize_geometry
lemma angularGridSize_geometry (w : ℝ) (hw0 : 0 < w) (hw : w ≤ 1 / 24) :
1 / (24 * w) ≤ (angularGridSize w : ℝ) ∧
(∀ j : Fin (angularGridSize w),
angularGridCenter (angularGridSize w) j ∈ frontier (scoreCube (1 / 2)) ∧
|angularGridCenter (angularGridSize w) j 0| < (1 / 4 : ℝ)) ∧
(∀ i j : Fin (angularGridSize w), i ≠ j →
3 * w ≤ dist (angularGridCenter (angularGridSize w) i)
(angularGridCenter (angularGridSize w) j) ∧
Disjoint
(closedBall (angularGridCenter (angularGridSize w) i) w ∩
scoreCube (1 / 2))
(closedBall (angularGridCenter (angularGridSize w) j) w ∩
scoreCube (1 / 2))) := by
refine ⟨angularGridSize_lower w hw0 hw, ?_, ?_⟩
· intro j
exact ⟨angularGridCenter_mem_frontier _ j,
angularGridCenter_first_abs_lt_quarter _ j⟩
· intro i j hij
have hspacing := angularGridSize_spacing w hw0 hw
exact ⟨angularGridCenter_three_radius_separated _ w hspacing i j hij,
angularGridPacking_three_radius _ w hw0 hspacing i j hij⟩
theorem angularGrid_frontierRate_geometry
Eventually, the frontier-rate grid simultaneously realizes every geometric part of the angular packing: the sharp radius scale, inverse-radius cardinality, non-corner frontier centers, three-radius separation, and pairwise-disjoint square-truncated cells.
Formal statement
hypotheses
q :
ℕ
hq :
1 ≤ q
conclusion
∀ᶠ n in atTop,
let w := angularGridRadius n q let M := angularGridSize w 0 < w ∧
w = rpow (frontierRate n) ((1 : ℝ) / q) ∧
(1 / 24 : ℝ) * rpow (frontierRate n) (-(1 : ℝ) / q) ≤ M ∧
(∀ j : Fin M, angularGridCenter M j ∈ frontier (scoreCube (1 / 2)) ∧ |angularGridCenter M j 0| < (1 / 4 : ℝ)) ∧
(∀ i j : Fin M, i ≠ j → 3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M j) ∧ Disjoint (closedBall (angularGridCenter M i) w ∩ scoreCube (1 / 2)) (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)))
Proof (Lean source)
-- @node: angularGrid_frontierRate_geometry
lemma angularGrid_frontierRate_geometry (q : ℕ) (hq : 1 ≤ q) :
∀ᶠ n in atTop,
let w := angularGridRadius n q
let M := angularGridSize w
0 < w ∧
w = rpow (frontierRate n) ((1 : ℝ) / q) ∧
(1 / 24 : ℝ) * rpow (frontierRate n) (-(1 : ℝ) / q) ≤ M ∧
(∀ j : Fin M,
angularGridCenter M j ∈ frontier (scoreCube (1 / 2)) ∧
|angularGridCenter M j 0| < (1 / 4 : ℝ)) ∧
(∀ i j : Fin M, i ≠ j →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M j) ∧
Disjoint
(closedBall (angularGridCenter M i) w ∩ scoreCube (1 / 2))
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))) := by
filter_upwards [angularGridRadius_eventually_small q hq,
eventually_ge_atTop (2 : ℕ)] with n hnSmall hn
let w := angularGridRadius n q
let M := angularGridSize w
have hgeometry := angularGridSize_geometry w hnSmall.1 hnSmall.2
refine ⟨hnSmall.1, rfl, angularGridSize_frontier_lower n q hn hnSmall.2,
hgeometry.2.1, ?_⟩
exact hgeometry.2.2
theorem frontierRate_le_angularGridRadius
Once the frontier rate is at most one, it is no larger than its qth-root bandwidth for every positive integer smoothness order.
Formal statement
hypotheses
conclusion
frontierRate n ≤ angularGridRadius n q
Proof (Lean source)
-- @node: frontierRate_le_angularGridRadius
lemma frontierRate_le_angularGridRadius (n q : ℕ) (hq : 1 ≤ q) (hn : 2 ≤ n)
(hrate : frontierRate n ≤ 1) :
frontierRate n ≤ angularGridRadius n q := by
have hqR : (1 : ℝ) ≤ q := by exact_mod_cast hq
have hexp : (1 : ℝ) / q ≤ 1 := by
rw [div_le_one (by positivity)]
exact hqR
have h := Real.rpow_le_rpow_of_exponent_ge
(frontierRate_pos hn) hrate hexp
simpa [angularGridRadius] using h
theorem frontierRate_eventually_le_one
The frontier rate is eventually at most one.
Formal statement
conclusion
∀ᶠ n in atTop, frontierRate n ≤ 1
Proof (Lean source)
-- @node: frontierRate_eventually_le_one
lemma frontierRate_eventually_le_one :
∀ᶠ n in atTop, frontierRate n ≤ 1 := by
have h := frontierRate_tendsto_zero.eventually
(Iic_mem_nhds (show (0 : ℝ) < 1 by norm_num))
simpa only [mem_Iic] using h
The deliberately small regression-bump amplitude used by the angular construction. The factor 1024 leaves room for the clipped angular tilt.
Definition (Lean source)
-- @node: angularPackingDelta
noncomputable def angularPackingDelta (n : ℕ) : ℝ :=
frontierRate n / 1024
theorem angularPackingDelta_eventually_admissible
Eventually the packing amplitude is positive, lies below the regression envelope, and its full angular-cutoff radius fits inside the packing bandwidth.
Formal statement
hypotheses
q :
ℕ
hq :
1 ≤ q
conclusion
∀ᶠ n in atTop,
0 < angularPackingDelta n ∧
angularPackingDelta n ≤ 1 / 8 ∧
2 * (8 * angularPackingDelta n) ≤ (1 / 4 : ℝ) * angularGridRadius n q
Proof (Lean source)
-- @node: angularPackingDelta_eventually_admissible
lemma angularPackingDelta_eventually_admissible (q : ℕ) (hq : 1 ≤ q) :
∀ᶠ n in atTop,
0 < angularPackingDelta n ∧
angularPackingDelta n ≤ 1 / 8 ∧
2 * (8 * angularPackingDelta n) ≤
(1 / 4 : ℝ) * angularGridRadius n q := by
filter_upwards [eventually_ge_atTop (2 : ℕ), frontierRate_eventually_le_one]
with n hn hrate
have hpos := frontierRate_pos hn
have hdom := frontierRate_le_angularGridRadius n q hq hn hrate
unfold angularPackingDelta
constructor
· positivity
constructor <;> nlinarith
theorem angularPacking_eventually_geometry_admissible
Eventually the explicit grid geometry and all elementary amplitude/cutoff side conditions needed by the angular hard family hold at the same sample size. This is the common threshold consumed by the family constructor.
Formal statement
hypotheses
q :
ℕ
hq :
1 ≤ q
conclusion
∀ᶠ n in atTop,
let w := angularGridRadius n q let M := angularGridSize w let delta := angularPackingDelta n 0 < w ∧
w = rpow (frontierRate n) ((1 : ℝ) / q) ∧
(1 / 24 : ℝ) * rpow (frontierRate n) (-(1 : ℝ) / q) ≤ M ∧
(∀ j : Fin M, angularGridCenter M j ∈ frontier (scoreCube (1 / 2)) ∧ |angularGridCenter M j 0| < (1 / 4 : ℝ)) ∧
(∀ i j : Fin M, i ≠ j → 3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M j) ∧ Disjoint (closedBall (angularGridCenter M i) w ∩ scoreCube (1 / 2)) (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))) ∧
0 < delta ∧
delta ≤ 1 / 8 ∧
2 * (8 * delta) ≤ (1 / 4 : ℝ) * w
Proof (Lean source)
-- @node: angularPacking_eventually_geometry_admissible
lemma angularPacking_eventually_geometry_admissible (q : ℕ) (hq : 1 ≤ q) :
∀ᶠ n in atTop,
let w := angularGridRadius n q
let M := angularGridSize w
let delta := angularPackingDelta n
0 < w ∧
w = rpow (frontierRate n) ((1 : ℝ) / q) ∧
(1 / 24 : ℝ) * rpow (frontierRate n) (-(1 : ℝ) / q) ≤ M ∧
(∀ j : Fin M,
angularGridCenter M j ∈ frontier (scoreCube (1 / 2)) ∧
|angularGridCenter M j 0| < (1 / 4 : ℝ)) ∧
(∀ i j : Fin M, i ≠ j →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M j) ∧
Disjoint
(closedBall (angularGridCenter M i) w ∩ scoreCube (1 / 2))
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))) ∧
0 < delta ∧ delta ≤ 1 / 8 ∧
2 * (8 * delta) ≤ (1 / 4 : ℝ) * w := by
filter_upwards [angularGrid_frontierRate_geometry q hq,
angularPackingDelta_eventually_admissible q hq] with n hgeom hadm
exact ⟨hgeom.1, hgeom.2.1, hgeom.2.2.1, hgeom.2.2.2.1,
hgeom.2.2.2.2, hadm.1, hadm.2.1, hadm.2.2⟩
theorem frontierRate_fourth_power
The fourth power of the frontier rate exactly cancels the sample size, leaving the logarithmic budget used in the adjacent KL calculation.
Formal statement
Proof (Lean source)
-- @node: frontierRate_fourth_power
lemma frontierRate_fourth_power (n : ℕ) (hn : 2 ≤ n) :
(n : ℝ) * frontierRate n ^ 4 = log n := by
have hn0 : (0 : ℝ) < n := by positivity
have hlog : 0 < log (n : ℝ) :=
Real.log_pos (by exact_mod_cast (show 1 < n by omega))
have hbase : 0 ≤ log (n : ℝ) / n := (div_pos hlog hn0).le
unfold frontierRate
have hr := Real.rpow_inv_natCast_pow hbase (by norm_num : (4 : ℕ) ≠ 0)
rw [show (1 / 4 : ℝ) = ((4 : ℕ) : ℝ)⁻¹ by norm_num]
calc
(n : ℝ) * (log n / n).rpow (((4 : ℕ) : ℝ)⁻¹) ^ 4 =
(n : ℝ) * (log n / n) := by
exact congrArg (fun z : ℝ => (n : ℝ) * z) hr
_ = log n := by field_simp
theorem angularPackingDelta_fourth_power
The selected packing amplitude spends exactly a 1024⁻⁴ fraction of the logarithmic KL budget before construction-specific constants.
Formal statement
Proof (Lean source)
-- @node: angularPackingDelta_fourth_power
lemma angularPackingDelta_fourth_power (n : ℕ) (hn : 2 ≤ n) :
(n : ℝ) * angularPackingDelta n ^ 4 =
log n / 1024 ^ 4 := by
unfold angularPackingDelta
rw [div_pow]
calc
(n : ℝ) * (frontierRate n ^ 4 / 1024 ^ 4) =
((n : ℝ) * frontierRate n ^ 4) / 1024 ^ 4 := by ring
_ = _ := by rw [frontierRate_fourth_power n hn]
Helpers.AngularHolder 17 declarations This module records the support fact that turns the pointwise derivative scaling estimates into bounds independent of the number of packing cells.
Hölder assembly for separated packing bumps
This module records the support fact that turns the pointwise derivative scaling estimates into bounds independent of the number of packing cells. It is the first step in the Hölder-ball certificate for the angular family.
theorem euclideanHolderBallStd_nat_iff
At a positive integer smoothness order, the standard Euclidean Hölder ball is exactly a bounded-derivative ball whose top required derivative is Lipschitz. This removes the ceiling and real-power bookkeeping from the angular packing's eventual Hölder certificate.
Formal statement
hypotheses
conclusion
EuclideanHolderBallStd f (q : ℝ) L S ↔ ContDiffOn ℝ (q - 1) f S ∧
(∀ j : ℕ, j ≤ q - 1 → ∀ x ∈ S, ‖iteratedFDeriv ℝ j f x‖ ≤ L) ∧
(∀ x ∈ S, ∀ y ∈ S, ‖iteratedFDeriv ℝ (q - 1) f x - iteratedFDeriv ℝ (q - 1) f y‖ ≤ L * ‖x - y‖)
Proof (Lean source)
-- @node: euclideanHolderBallStd_nat_iff
lemma euclideanHolderBallStd_nat_iff (f : Score → ℝ) (q : ℕ) (L : ℝ)
(S : Set Score) (hq : 1 ≤ q) :
EuclideanHolderBallStd f (q : ℝ) L S ↔
ContDiffOn ℝ (q - 1) f S ∧
(∀ j : ℕ, j ≤ q - 1 → ∀ x ∈ S,
‖iteratedFDeriv ℝ j f x‖ ≤ L) ∧
(∀ x ∈ S, ∀ y ∈ S,
‖iteratedFDeriv ℝ (q - 1) f x -
iteratedFDeriv ℝ (q - 1) f y‖ ≤ L * ‖x - y‖) := by
unfold EuclideanHolderBallStd
rw [Nat.ceil_natCast]
have hexp : (q : ℝ) - ((q - 1 : ℕ) : ℝ) = 1 := by
rw [Nat.cast_sub hq]
norm_num
rw [hexp]
simp
theorem packingAffineBaseline_iteratedFDeriv_one_norm_le
The first Fréchet derivative of the affine baseline has operator norm at most the absolute slope.
Formal statement
Proof (Lean source)
-- @node: packingAffineBaseline_iteratedFDeriv_one_norm_le
lemma packingAffineBaseline_iteratedFDeriv_one_norm_le (b : ℝ) (x : Score) :
‖iteratedFDeriv ℝ 1 (packingAffineBaseline b) x‖ ≤ |b| := by
unfold packingAffineBaseline
rw [show (fun x : Score => 1 / 2 + b * x 0) =
(fun _ => 1 / 2) + (fun x => b * x 0) by rfl]
rw [iteratedFDeriv_add_apply (by fun_prop) (by fun_prop)]
simp only [iteratedFDeriv_const_of_ne one_ne_zero, Pi.zero_apply, zero_add]
rw [norm_iteratedFDeriv_one]
rw [show fderiv ℝ (fun x : Score => b * x 0) x =
b • (PiLp.proj 2 (fun _ : Fin 2 => ℝ) 0) by
convert ((PiLp.hasFDerivAt_apply (𝕜 := ℝ) 2 x 0).const_mul b).fderiv]
rw [norm_smul, Real.norm_eq_abs]
exact mul_le_of_le_one_right (abs_nonneg b) (by
apply ContinuousLinearMap.opNorm_le_bound _ (by norm_num)
intro z
simpa using PiLp.norm_apply_le z 0)
theorem packingAffineBaseline_iteratedFDeriv_eq_zero
Every derivative of the affine baseline of order at least two vanishes.
Formal statement
hypotheses
conclusion
iteratedFDeriv ℝ j (packingAffineBaseline b) x = 0
Proof (Lean source)
-- @node: packingAffineBaseline_iteratedFDeriv_eq_zero
lemma packingAffineBaseline_iteratedFDeriv_eq_zero (b : ℝ) (j : ℕ)
(hj : 2 ≤ j) (x : Score) :
iteratedFDeriv ℝ j (packingAffineBaseline b) x = 0 := by
obtain ⟨k, rfl⟩ := Nat.exists_eq_add_of_le hj
rw [show 2 + k = (k + 1) + 1 by omega]
rw [iteratedFDeriv_succ_eq_comp_right]
have hf : fderiv ℝ (packingAffineBaseline b) =
fun _ => b • (PiLp.proj 2 (fun _ : Fin 2 => ℝ) 0) := by
funext y
unfold packingAffineBaseline
rw [show (fun x : Score => 1 / 2 + b * x 0) =
(fun _ => 1 / 2) + (fun x => b * x 0) by rfl]
rw [fderiv_add (by fun_prop) (by fun_prop), fderiv_const_apply]
simp only [zero_add]
convert ((PiLp.hasFDerivAt_apply (𝕜 := ℝ) 2 y 0).const_mul b).fderiv
rw [hf, iteratedFDeriv_const_of_ne (by omega)]
exact LinearIsometryEquiv.map_zero _
theorem packingAffineBaseline_iteratedFDeriv_sub_eq_zero
Every positive-order derivative of the affine baseline is independent of the evaluation point.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: packingAffineBaseline_iteratedFDeriv_sub_eq_zero
lemma packingAffineBaseline_iteratedFDeriv_sub_eq_zero (b : ℝ) (j : ℕ)
(hj : 1 ≤ j) (x y : Score) :
iteratedFDeriv ℝ j (packingAffineBaseline b) x -
iteratedFDeriv ℝ j (packingAffineBaseline b) y = 0 := by
rcases eq_or_lt_of_le hj with rfl | hj'
· have hx : fderiv ℝ (packingAffineBaseline b) x =
b • (PiLp.proj 2 (fun _ : Fin 2 => ℝ) 0) := by
unfold packingAffineBaseline
rw [show (fun z : Score => 1 / 2 + b * z 0) =
(fun _ => 1 / 2) + (fun z => b * z 0) by rfl]
rw [fderiv_add (by fun_prop) (by fun_prop), fderiv_const_apply]
simp only [zero_add]
convert ((PiLp.hasFDerivAt_apply (𝕜 := ℝ) 2 x 0).const_mul b).fderiv
have hy : fderiv ℝ (packingAffineBaseline b) y =
b • (PiLp.proj 2 (fun _ : Fin 2 => ℝ) 0) := by
unfold packingAffineBaseline
rw [show (fun z : Score => 1 / 2 + b * z 0) =
(fun _ => 1 / 2) + (fun z => b * z 0) by rfl]
rw [fderiv_add (by fun_prop) (by fun_prop), fderiv_const_apply]
simp only [zero_add]
convert ((PiLp.hasFDerivAt_apply (𝕜 := ℝ) 2 y 0).const_mul b).fderiv
rw [show iteratedFDeriv ℝ 1 (packingAffineBaseline b) x -
iteratedFDeriv ℝ 1 (packingAffineBaseline b) y = 0 by
apply sub_eq_zero.mpr
apply ContinuousMultilinearMap.ext
intro m
simp only [iteratedFDeriv_one_apply, hx, hy]]
· rw [packingAffineBaseline_iteratedFDeriv_eq_zero b j (by omega) x,
packingAffineBaseline_iteratedFDeriv_eq_zero b j (by omega) y, sub_zero]
theorem packingBumpSum_contDiff
A finite sum of selected localized packing bumps is smooth to every finite order. This is the smoothness half of the eventual Hölder-ball certificate; separation is only needed for its uniform derivative bounds.
Formal statement
Proof (Lean source)
-- @node: packingBumpSum_contDiff
lemma packingBumpSum_contDiff {M : ℕ} (delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) :
ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)
(fun y : Score => ∑ i, if omega i then
localizedPackingBump delta w (centers i) y else 0) := by
apply ContDiff.sum
intro i _
split
· exact localizedPackingBump_contDiff delta w (centers i)
· exact contDiff_const
theorem localizedPackingBump_support_iteratedFDeriv_subset
Every iterated derivative of a positive-bandwidth localized bump is supported in the corresponding closed ball.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: localizedPackingBump_support_iteratedFDeriv_subset
lemma localizedPackingBump_support_iteratedFDeriv_subset (j : ℕ)
(delta : ℝ) {w : ℝ} (hw : 0 < w) (center : Score) :
support (iteratedFDeriv ℝ j (localizedPackingBump delta w center)) ⊆
closedBall center w := by
refine (support_iteratedFDeriv_subset j).trans ?_
apply closure_minimal
· intro x hx
by_contra hball
have hfar : w ≤ dist x center := by
exact (by simpa [Metric.mem_closedBall, not_le] using hball : w < dist x center).le
exact hx (localizedPackingBump_eq_zero_of_bandwidth_le_dist hw hfar)
· exact Metric.isClosed_closedBall
theorem localizedPackingBump_iteratedFDeriv_pairwise_exclusive
At a point, derivatives of two distinct separated packing bumps cannot both be nonzero.
Formal statement
hypotheses
M :
ℕ
j :
ℕ
delta :
ℝ
w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
i k :
Fin M
hik :
i ≠ k
x :
conclusion
iteratedFDeriv ℝ j (localizedPackingBump delta w (centers i)) x
= 0 ∨ iteratedFDeriv ℝ j (localizedPackingBump delta w (centers k)) x = 0
Proof (Lean source)
-- @node: localizedPackingBump_iteratedFDeriv_pairwise_exclusive
lemma localizedPackingBump_iteratedFDeriv_pairwise_exclusive {M : ℕ}
(j : ℕ) (delta : ℝ) {w : ℝ} (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
{i k : Fin M} (hik : i ≠ k) (x : Score) :
iteratedFDeriv ℝ j (localizedPackingBump delta w (centers i)) x = 0 ∨
iteratedFDeriv ℝ j (localizedPackingBump delta w (centers k)) x = 0 := by
by_contra h
push_neg at h
have hi : x ∈ closedBall (centers i) w :=
localizedPackingBump_support_iteratedFDeriv_subset j delta hw (centers i) h.1
have hk : x ∈ closedBall (centers k) w :=
localizedPackingBump_support_iteratedFDeriv_subset j delta hw (centers k) h.2
have htri : dist (centers i) (centers k) ≤
dist (centers i) x + dist x (centers k) := dist_triangle _ _ _
rw [Metric.mem_closedBall] at hi
rw [Metric.mem_closedBall] at hk
rw [dist_comm (centers i) x] at htri
linarith [hsep i k hik]
theorem localizedPackingBump_iteratedFDeriv_unique_active
A separated family of localized bumps has at most one nonzero iterated derivative at each point.
Formal statement
hypotheses
M :
ℕ
j :
ℕ
delta :
ℝ
w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
conclusion
∀ i k : Fin M
if
iteratedFDeriv ℝ j (localizedPackingBump delta w (centers i)) x ≠ 0
and
iteratedFDeriv ℝ j (localizedPackingBump delta w (centers k)) x ≠ 0
then
i = k
Proof (Lean source)
-- @node: localizedPackingBump_iteratedFDeriv_unique_active
lemma localizedPackingBump_iteratedFDeriv_unique_active {M : ℕ}
(j : ℕ) (delta : ℝ) {w : ℝ} (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(x : Score) :
∀ i k : Fin M,
iteratedFDeriv ℝ j (localizedPackingBump delta w (centers i)) x ≠ 0 →
iteratedFDeriv ℝ j (localizedPackingBump delta w (centers k)) x ≠ 0 →
i = k := by
intro i k hi hk
by_contra hik
rcases localizedPackingBump_iteratedFDeriv_pairwise_exclusive
j delta hw hsep hik x with hzero | hzero
· exact hi hzero
· exact hk hzero
theorem packingBumpSum_iteratedFDeriv_bound_with
An explicit normalized-bump derivative bound transfers to a separated bump sum without acquiring a factor depending on the grid size.
Formal statement
hypotheses
M :
ℕ
j :
ℕ
delta :
ℝ
w C :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hC0 :
0 ≤ C
hC :
∀ z : Score, ‖iteratedFDeriv ℝ j packingBump z‖ ≤ C
x :
conclusion
‖iteratedFDeriv ℝ j (fun y : Score => ∑ i, if omega i then localizedPackingBump delta w (centers i) y else 0) x‖
≤ |delta| * (w⁻¹) ^ j * C
Proof (Lean source)
-- @node: packingBumpSum_iteratedFDeriv_bound_with
lemma packingBumpSum_iteratedFDeriv_bound_with {M : ℕ}
(j : ℕ) (delta : ℝ) {w C : ℝ} (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (hC0 : 0 ≤ C)
(hC : ∀ z : Score, ‖iteratedFDeriv ℝ j packingBump z‖ ≤ C)
(x : Score) :
‖iteratedFDeriv ℝ j
(fun y : Score => ∑ i, if omega i then
localizedPackingBump delta w (centers i) y else 0) x‖ ≤
|delta| * (w⁻¹) ^ j * C := by
let f : Fin M → Score → ℝ := fun i y =>
if omega i then localizedPackingBump delta w (centers i) y else 0
have hf : ∀ i ∈ (Finset.univ : Finset (Fin M)), ContDiff ℝ j (f i) := by
intro i _
dsimp [f]
split
· exact (localizedPackingBump_contDiff delta w (centers i)).of_le
(WithTop.coe_le_coe.mpr le_top)
· exact contDiff_const
rw [show (fun y : Score => ∑ i, if omega i then
localizedPackingBump delta w (centers i) y else 0) =
(fun y : Score => ∑ i, f i y) by rfl]
rw [iteratedFDeriv_sum hf]
simp only [Finset.sum_apply]
by_cases hex : ∃ i : Fin M, iteratedFDeriv ℝ j (f i) x ≠ 0
· obtain ⟨i, hi⟩ := hex
have hbit : omega i = true := by
by_contra hbit
have hfalse : omega i = false := Bool.eq_false_of_not_eq_true hbit
simp [f, hfalse] at hi
have hi' : iteratedFDeriv ℝ j
(localizedPackingBump delta w (centers i)) x ≠ 0 := by
simpa [f, hbit] using hi
rw [Finset.sum_eq_single i]
· dsimp [f] at hi ⊢
simp only [hbit, if_true]
rw [localizedPackingBump_iteratedFDeriv, norm_smul, norm_smul,
Real.norm_eq_abs, Real.norm_eq_abs, abs_pow, abs_inv, abs_of_pos hw]
simpa only [mul_assoc] using
mul_le_mul_of_nonneg_left (hC (w⁻¹ • (x - centers i)))
(mul_nonneg (abs_nonneg delta) (pow_nonneg (inv_nonneg.mpr hw.le) j))
· intro k _ hki
by_cases hbit : omega k = true
· dsimp [f]
simp only [hbit, if_true]
rcases localizedPackingBump_iteratedFDeriv_pairwise_exclusive
j delta hw hsep (Ne.symm hki) x with hz | hz
· exact (hi' hz).elim
· exact hz
· have hfalse : omega k = false := Bool.eq_false_of_not_eq_true hbit
simp [f, hfalse]
· simp
· have hzero : ∀ i : Fin M, iteratedFDeriv ℝ j (f i) x = 0 := by
intro i
exact not_ne_iff.mp (not_exists.mp hex i)
rw [Finset.sum_eq_zero fun i _ => hzero i]
rw [norm_zero]
exact mul_nonneg
(mul_nonneg (abs_nonneg delta) (pow_nonneg (inv_nonneg.mpr hw.le) j)) hC0
theorem packingBumpSum_iteratedFDeriv_bound
The norm of any derivative of a separated bump sum is bounded by the single-bump scaling bound, with no factor depending on the grid size.
Formal statement
hypotheses
M :
ℕ
j :
ℕ
delta :
ℝ
w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
conclusion
∃ C : ℝ,
0 ≤ C ∧
‖iteratedFDeriv ℝ j (fun y : Score => ∑ i, if omega i then localizedPackingBump delta w (centers i) y else 0) x‖
≤ |delta| * (w⁻¹) ^ j * C
Proof (Lean source)
-- @node: packingBumpSum_iteratedFDeriv_bound
lemma packingBumpSum_iteratedFDeriv_bound {M : ℕ}
(j : ℕ) (delta : ℝ) {w : ℝ} (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (x : Score) :
∃ C : ℝ, 0 ≤ C ∧
‖iteratedFDeriv ℝ j
(fun y : Score => ∑ i, if omega i then
localizedPackingBump delta w (centers i) y else 0) x‖ ≤
|delta| * (w⁻¹) ^ j * C := by
rcases packingBump_iteratedFDeriv_bound j with ⟨C, hC0, hC⟩
exact ⟨C, hC0,
packingBumpSum_iteratedFDeriv_bound_with j delta hw hsep omega hC0 hC x⟩
theorem packingBumpSum_iteratedFDeriv_lipschitz
The top derivative of a separated bump sum is globally Lipschitz, with the one-bump scaling constant and no dependence on the number of cells.
Formal statement
hypotheses
M :
ℕ
j :
ℕ
delta :
ℝ
w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x y :
conclusion
∃ C : ℝ,
0 ≤ C ∧
‖iteratedFDeriv ℝ j (fun z : Score => ∑ i, if omega i then localizedPackingBump delta w (centers i) z else 0) x - iteratedFDeriv ℝ j (fun z : Score => ∑ i, if omega i then localizedPackingBump delta w (centers i) z else 0) y‖
≤ |delta| * (w⁻¹) ^ (j + 1) * C * ‖x - y‖
Proof (Lean source)
-- @node: packingBumpSum_iteratedFDeriv_lipschitz
lemma packingBumpSum_iteratedFDeriv_lipschitz {M : ℕ}
(j : ℕ) (delta : ℝ) {w : ℝ} (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (x y : Score) :
∃ C : ℝ, 0 ≤ C ∧
‖iteratedFDeriv ℝ j
(fun z : Score => ∑ i, if omega i then
localizedPackingBump delta w (centers i) z else 0) x -
iteratedFDeriv ℝ j
(fun z : Score => ∑ i, if omega i then
localizedPackingBump delta w (centers i) z else 0) y‖ ≤
|delta| * (w⁻¹) ^ (j + 1) * C * ‖x - y‖ := by
let f : Score → ℝ := fun z => ∑ i, if omega i then
localizedPackingBump delta w (centers i) z else 0
rcases packingBump_iteratedFDeriv_bound (j + 1) with ⟨C, hC0, hC⟩
refine ⟨C, hC0, ?_⟩
have hf := packingBumpSum_contDiff delta w centers omega
have hd : ∀ z ∈ (Set.univ : Set Score),
DifferentiableAt ℝ (iteratedFDeriv ℝ j f) z := by
intro z _
have hj : ((j : ℕ∞) : WithTop ℕ∞) <
((⊤ : ℕ∞) : WithTop ℕ∞) :=
WithTop.coe_lt_coe.mpr (WithTop.coe_lt_top j)
exact (ContDiff.differentiable_iteratedFDeriv hj hf) z
have hb : ∀ z ∈ (Set.univ : Set Score),
‖fderiv ℝ (iteratedFDeriv ℝ j f) z‖ ≤
|delta| * (w⁻¹) ^ (j + 1) * C := by
intro z _
rw [norm_fderiv_iteratedFDeriv]
exact packingBumpSum_iteratedFDeriv_bound_with (j + 1) delta hw hsep
omega hC0 hC z
simpa [f, norm_sub_rev, mul_assoc] using
(convex_univ.norm_image_sub_le_of_norm_fderiv_le hd hb
(Set.mem_univ y) (Set.mem_univ x))
theorem packingBumpSum_iteratedFDeriv_lipschitz_with
A supplied normalized-bump derivative bound gives the corresponding Lipschitz estimate for a separated bump sum. This explicit-constant variant lets the final Hölder assembly use one finite family of constants.
Formal statement
hypotheses
M :
ℕ
j :
ℕ
delta :
ℝ
w C :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hC0 :
0 ≤ C
hC :
∀ z : Score, ‖iteratedFDeriv ℝ (j + 1) packingBump z‖ ≤ C
x y :
conclusion
‖iteratedFDeriv ℝ j (fun z : Score ↦ ∑ i, if omega i then localizedPackingBump delta w (centers i) z else 0) x - iteratedFDeriv ℝ j (fun z : Score ↦ ∑ i, if omega i then localizedPackingBump delta w (centers i) z else 0) y‖
≤ |delta| * (w⁻¹) ^ (j + 1) * C * ‖x - y‖
Proof (Lean source)
-- @node: packingBumpSum_iteratedFDeriv_lipschitz_with
lemma packingBumpSum_iteratedFDeriv_lipschitz_with {M : ℕ}
(j : ℕ) (delta : ℝ) {w C : ℝ} (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (hC0 : 0 ≤ C)
(hC : ∀ z : Score, ‖iteratedFDeriv ℝ (j + 1) packingBump z‖ ≤ C)
(x y : Score) :
‖iteratedFDeriv ℝ j
(fun z : Score ↦ ∑ i, if omega i then
localizedPackingBump delta w (centers i) z else 0) x -
iteratedFDeriv ℝ j
(fun z : Score ↦ ∑ i, if omega i then
localizedPackingBump delta w (centers i) z else 0) y‖ ≤
|delta| * (w⁻¹) ^ (j + 1) * C * ‖x - y‖ := by
let f : Score → ℝ := fun z ↦ ∑ i, if omega i then
localizedPackingBump delta w (centers i) z else 0
have hf := packingBumpSum_contDiff delta w centers omega
have hd : ∀ z ∈ (Set.univ : Set Score),
DifferentiableAt ℝ (iteratedFDeriv ℝ j f) z := by
intro z _
have hj : ((j : ℕ∞) : WithTop ℕ∞) <
((⊤ : ℕ∞) : WithTop ℕ∞) :=
WithTop.coe_lt_coe.mpr (WithTop.coe_lt_top j)
exact (ContDiff.differentiable_iteratedFDeriv hj hf) z
have hb : ∀ z ∈ (Set.univ : Set Score),
‖fderiv ℝ (iteratedFDeriv ℝ j f) z‖ ≤
|delta| * (w⁻¹) ^ (j + 1) * C := by
intro z _
rw [norm_fderiv_iteratedFDeriv]
exact packingBumpSum_iteratedFDeriv_bound_with (j + 1) delta hw hsep
omega hC0 hC z
simpa [f, norm_sub_rev, mul_assoc] using
(convex_univ.norm_image_sub_le_of_norm_fderiv_le hd hb
(Set.mem_univ y) (Set.mem_univ x))
theorem clippedPackingRegression_eventuallyEq_packingRegression_at_square
At every point of the supporting square, clipping is inactive throughout a neighborhood. This is stronger than pointwise equality on the square and therefore transfers ambient Fréchet derivatives at boundary points.
Formal statement
hypotheses
M :
ℕ
b delta w :
ℝ
hb :
|b| ≤ 1 / 4
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
hx :
x ∈ scoreCube (1 / 2)
conclusion
clippedPackingRegression b delta w centers omega
=ᶠ[𝓝 x] packingRegression b delta w centers omega
Proof (Lean source)
-- @node: clippedPackingRegression_eventuallyEq_packingRegression_at_square
lemma clippedPackingRegression_eventuallyEq_packingRegression_at_square
{M : ℕ} {b delta w : ℝ}
(hb : |b| ≤ 1 / 4) (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 8)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {x : Score} (hx : x ∈ scoreCube (1 / 2)) :
clippedPackingRegression b delta w centers omega =ᶠ[𝓝 x]
packingRegression b delta w centers omega := by
let p := packingRegression b delta w centers omega
have hpx := packingRegression_mem_Icc hb hdelta0 hdelta hw hsep omega hx
have hpx' : p x ∈ Ioo (0 : ℝ) 1 := by
dsimp [p]
constructor <;> linarith [hpx.1, hpx.2]
have hpcont : Continuous p := by
exact (packingRegression_contDiff b delta w centers omega).continuous
have hevent : ∀ᶠ y in 𝓝 x, p y ∈ Ioo (0 : ℝ) 1 :=
hpcont.continuousAt.eventually_mem (isOpen_Ioo.mem_nhds hpx')
filter_upwards [hevent] with y hy
exact clippedPackingRegression_eq_of_mem_Icc ⟨hy.1.le, hy.2.le⟩
theorem clippedPackingRegression_contDiffOn_square
On the supporting square, the clipped packing regression is smooth to every finite order. This packages the neighborhood-level inactivity of the clip into the first conjunct of the eventual Hölder-ball certificate.
Formal statement
hypotheses
M :
ℕ
j :
ℕ
b delta w :
ℝ
hb :
|b| ≤ 1 / 4
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
conclusion
Proof (Lean source)
-- @node: clippedPackingRegression_contDiffOn_square
lemma clippedPackingRegression_contDiffOn_square {M : ℕ} (j : ℕ)
{b delta w : ℝ}
(hb : |b| ≤ 1 / 4) (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 8)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) :
ContDiffOn ℝ j (clippedPackingRegression b delta w centers omega)
(scoreCube (1 / 2)) := by
intro x hx
have hp : ContDiffAt ℝ j (packingRegression b delta w centers omega) x :=
(packingRegression_contDiff b delta w centers omega).contDiffAt.of_le
(WithTop.coe_le_coe.mpr le_top)
have heq := clippedPackingRegression_eventuallyEq_packingRegression_at_square
hb hdelta0 hdelta hw hsep omega hx
exact (hp.congr_of_eventuallyEq heq).contDiffWithinAt
theorem clippedPackingRegression_iteratedFDeriv_eq_on_square
On the supporting square, every ambient iterated derivative of the clipped kernel regression equals that of the smooth packing regression.
Formal statement
hypotheses
M :
ℕ
j :
ℕ
b delta w :
ℝ
hb :
|b| ≤ 1 / 4
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
hx :
x ∈ scoreCube (1 / 2)
conclusion
iteratedFDeriv ℝ j (clippedPackingRegression b delta w centers omega) x
= iteratedFDeriv ℝ j (packingRegression b delta w centers omega) x
Proof (Lean source)
-- @node: clippedPackingRegression_iteratedFDeriv_eq_on_square
lemma clippedPackingRegression_iteratedFDeriv_eq_on_square
{M : ℕ} (j : ℕ) {b delta w : ℝ}
(hb : |b| ≤ 1 / 4) (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 8)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {x : Score} (hx : x ∈ scoreCube (1 / 2)) :
iteratedFDeriv ℝ j (clippedPackingRegression b delta w centers omega) x =
iteratedFDeriv ℝ j (packingRegression b delta w centers omega) x := by
exact ((clippedPackingRegression_eventuallyEq_packingRegression_at_square
hb hdelta0 hdelta hw hsep omega hx).iteratedFDeriv ℝ j).eq_of_nhds
theorem clippedPackingRegression_mem_holder_of_bump_bounds
Unit derivative and top-derivative Lipschitz bounds for the separated bump sum assemble with the small affine baseline to put the clipped regression in every envelope-L integer Hölder ball with L ≥ 4. The two bump bounds are exactly the conclusions supplied by the scaling lemmas above once their paper-scale scalar factors have been bounded.
Formal statement
hypotheses
M q :
ℕ
L b delta w :
ℝ
hq :
1 ≤ q
hL :
4 ≤ L
hb :
|b| ≤ 1 / 4
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
hderiv :
∀ j : ℕ
if
j ≤ q - 1
and
1 ≤ j
then
∀ x : Score,
‖iteratedFDeriv ℝ j (fun y : Score ↦ ∑ i, if omega i then localizedPackingBump delta w (centers i) y else 0) x‖
≤ 1
hlip :
∀ x y : Score,
‖iteratedFDeriv ℝ (q - 1) (fun z : Score ↦ ∑ i, if omega i then localizedPackingBump delta w (centers i) z else 0) x - iteratedFDeriv ℝ (q - 1) (fun z : Score ↦ ∑ i, if omega i then localizedPackingBump delta w (centers i) z else 0) y‖
≤ ‖x - y‖
conclusion
EuclideanHolderBallStd (clippedPackingRegression b delta w centers omega) (q : ℝ) L (scoreCube (1 / 2))
Proof (Lean source)
-- @node: clippedPackingRegression_mem_holder_of_bump_bounds
lemma clippedPackingRegression_mem_holder_of_bump_bounds
{M q : ℕ} {L b delta w : ℝ} (hq : 1 ≤ q) (hL : 4 ≤ L)
(hb : |b| ≤ 1 / 4) (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 8)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool)
(hderiv : ∀ j : ℕ, j ≤ q - 1 → 1 ≤ j → ∀ x : Score,
‖iteratedFDeriv ℝ j
(fun y : Score ↦ ∑ i, if omega i then
localizedPackingBump delta w (centers i) y else 0) x‖ ≤ 1)
(hlip : ∀ x y : Score,
‖iteratedFDeriv ℝ (q - 1)
(fun z : Score ↦ ∑ i, if omega i then
localizedPackingBump delta w (centers i) z else 0) x -
iteratedFDeriv ℝ (q - 1)
(fun z : Score ↦ ∑ i, if omega i then
localizedPackingBump delta w (centers i) z else 0) y‖ ≤ ‖x - y‖) :
EuclideanHolderBallStd
(clippedPackingRegression b delta w centers omega)
(q : ℝ) L (scoreCube (1 / 2)) := by
rw [euclideanHolderBallStd_nat_iff _ q L _ hq]
let bumps : Score → ℝ := fun y ↦ ∑ i, if omega i then
localizedPackingBump delta w (centers i) y else 0
have hbumps : ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) bumps :=
packingBumpSum_contDiff delta w centers omega
have hreg_deriv (j : ℕ) (x : Score) :
iteratedFDeriv ℝ j (packingRegression b delta w centers omega) x =
iteratedFDeriv ℝ j (packingAffineBaseline b) x +
iteratedFDeriv ℝ j bumps x := by
change iteratedFDeriv ℝ j (packingAffineBaseline b + bumps) x = _
rw [iteratedFDeriv_add_apply
((packingAffineBaseline_contDiff b).of_le
(WithTop.coe_le_coe.mpr le_top)).contDiffAt
(hbumps.of_le (WithTop.coe_le_coe.mpr le_top)).contDiffAt]
constructor
· exact clippedPackingRegression_contDiffOn_square (q - 1) hb hdelta0
hdelta hw hsep omega
constructor
· intro j hj x hx
rw [clippedPackingRegression_iteratedFDeriv_eq_on_square j hb hdelta0
hdelta hw hsep omega hx]
by_cases hj0 : j = 0
· subst j
rw [norm_iteratedFDeriv_zero, Real.norm_eq_abs, abs_le]
have hp := packingRegression_mem_Icc hb hdelta0 hdelta hw hsep omega hx
constructor <;> linarith [hp.1, hp.2]
· rw [hreg_deriv]
calc
‖iteratedFDeriv ℝ j (packingAffineBaseline b) x +
iteratedFDeriv ℝ j bumps x‖ ≤
‖iteratedFDeriv ℝ j (packingAffineBaseline b) x‖ +
‖iteratedFDeriv ℝ j bumps x‖ := norm_add_le _ _
_ ≤ 1 / 4 + 1 := by
gcongr
· rcases eq_or_lt_of_le (Nat.one_le_iff_ne_zero.mpr hj0) with rfl | hj'
· exact (packingAffineBaseline_iteratedFDeriv_one_norm_le b x).trans hb
· rw [packingAffineBaseline_iteratedFDeriv_eq_zero b j (by omega) x,
norm_zero]
norm_num
· exact hderiv j hj (Nat.one_le_iff_ne_zero.mpr hj0) x
_ ≤ L := by linarith
· intro x hx y hy
rw [clippedPackingRegression_iteratedFDeriv_eq_on_square (q - 1) hb
hdelta0 hdelta hw hsep omega hx,
clippedPackingRegression_iteratedFDeriv_eq_on_square (q - 1) hb
hdelta0 hdelta hw hsep omega hy, hreg_deriv, hreg_deriv]
have hbase :
‖iteratedFDeriv ℝ (q - 1) (packingAffineBaseline b) x -
iteratedFDeriv ℝ (q - 1) (packingAffineBaseline b) y‖ ≤
(1 / 4 : ℝ) * ‖x - y‖ := by
by_cases hq1 : q = 1
· subst q
rw [show (1 : ℕ) - 1 = 0 by omega]
simp only [iteratedFDeriv_zero_eq_comp, Function.comp_apply, ← map_sub,
LinearIsometryEquiv.norm_map]
unfold packingAffineBaseline
rw [show (1 / 2 + b * x 0) - (1 / 2 + b * y 0) =
b * ((x - y) 0) by rw [PiLp.sub_apply]; ring,
Real.norm_eq_abs, abs_mul]
calc
|b| * |(x - y) 0| ≤ |b| * ‖x - y‖ := by
gcongr
simpa [Real.norm_eq_abs] using PiLp.norm_apply_le (x - y) 0
_ ≤ (1 / 4 : ℝ) * ‖x - y‖ := by gcongr
· rw [packingAffineBaseline_iteratedFDeriv_sub_eq_zero b (q - 1)
(by omega) x y, norm_zero]
positivity
calc
‖(iteratedFDeriv ℝ (q - 1) (packingAffineBaseline b) x +
iteratedFDeriv ℝ (q - 1) bumps x) -
(iteratedFDeriv ℝ (q - 1) (packingAffineBaseline b) y +
iteratedFDeriv ℝ (q - 1) bumps y)‖ =
‖(iteratedFDeriv ℝ (q - 1) (packingAffineBaseline b) x -
iteratedFDeriv ℝ (q - 1) (packingAffineBaseline b) y) +
(iteratedFDeriv ℝ (q - 1) bumps x -
iteratedFDeriv ℝ (q - 1) bumps y)‖ := by congr 1 <;> abel
_ ≤ (1 / 4 : ℝ) * ‖x - y‖ + ‖x - y‖ :=
(norm_add_le _ _).trans (add_le_add hbase (hlip x y))
_ ≤ L * ‖x - y‖ := by
have hnorm : 0 ≤ ‖x - y‖ := norm_nonneg _
nlinarith
theorem clippedPackingRegression_mem_holder_of_scaling_bounds
Uniform normalized-bump derivative constants whose paper-scale factors are at most one imply the complete clipped-regression Hölder certificate.
Formal statement
hypotheses
M q :
ℕ
L b delta w :
ℝ
hq :
1 ≤ q
hL :
4 ≤ L
hb :
|b| ≤ 1 / 4
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
C :
ℕ → ℝ
hC0 :
∀ j, 0 ≤ C j
hC :
∀ j z, ‖iteratedFDeriv ℝ j packingBump z‖ ≤ C j
hscale :
∀ j
if
j ≤ q
then
|delta| * (w⁻¹) ^ j * C j ≤ 1
conclusion
EuclideanHolderBallStd (clippedPackingRegression b delta w centers omega) (q : ℝ) L (scoreCube (1 / 2))
Proof (Lean source)
-- @node: clippedPackingRegression_mem_holder_of_scaling_bounds
lemma clippedPackingRegression_mem_holder_of_scaling_bounds
{M q : ℕ} {L b delta w : ℝ} (hq : 1 ≤ q) (hL : 4 ≤ L)
(hb : |b| ≤ 1 / 4) (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 8)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (C : ℕ → ℝ)
(hC0 : ∀ j, 0 ≤ C j)
(hC : ∀ j z, ‖iteratedFDeriv ℝ j packingBump z‖ ≤ C j)
(hscale : ∀ j, j ≤ q → |delta| * (w⁻¹) ^ j * C j ≤ 1) :
EuclideanHolderBallStd
(clippedPackingRegression b delta w centers omega)
(q : ℝ) L (scoreCube (1 / 2)) := by
apply clippedPackingRegression_mem_holder_of_bump_bounds hq hL hb hdelta0
hdelta hw hsep omega
· intro j hj _ x
exact (packingBumpSum_iteratedFDeriv_bound_with j delta hw hsep omega
(hC0 j) (hC j) x).trans (hscale j (by omega))
· intro x y
have htop := packingBumpSum_iteratedFDeriv_lipschitz_with (q - 1) delta hw
hsep omega (hC0 q) (by
intro z
rw [Nat.sub_add_cancel hq]
exact hC q z) x y
calc
_ ≤ |delta| * (w⁻¹) ^ q * C q * ‖x - y‖ := by
simpa [Nat.sub_add_cancel hq] using htop
_ ≤ ‖x - y‖ := by
have hn : 0 ≤ ‖x - y‖ := norm_nonneg _
nlinarith [hscale q le_rfl]
Helpers.AngularLaw 11 declarations This file packages the measure-theoretic assembly common to every vertex of the angular hard family.
Faithful Bernoulli--Gaussian regression laws
This file packages the measure-theoretic assembly common to every vertex of
the angular hard family. Given a normalized score design with its exact
support and a bounded measurable regression, it constructs a CtyLaw whose
declared density, regression, and conditional variance are the corresponding
functionals of the joint Bernoulli-plus-Gaussian law.
def bernoulliGaussianCtyLaw
The faithful CTY law obtained from a score design and a measurable Bernoulli regression by adding independent standard Gaussian noise.
Definition (Lean source)
-- @node: bernoulliGaussianCtyLaw
noncomputable def bernoulliGaussianCtyLaw
(nu : Measure Score) [IsProbabilityMeasure nu]
(S : Set Score) (density p : Score → ℝ)
(hp : Measurable p) (hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1)
(hmarginal : nu = volume.withDensity
(fun x => ofReal (S.indicator density x)))
(hsupport : S = nu.support) (hclosed : IsClosed S)
(hdensityPos : ∀ x ∈ S, 0 < density x) : CtyLaw where
law := jointBernoulliGaussianLaw nu p hp
support := S
density := density
mu := p
sigmaSq := fun x => 1 + p x * (1 - p x)
law_isProbability :=
jointBernoulliGaussianLaw_isProbabilityMeasure nu p hp hp0 hp1
sq_integrable :=
jointBernoulliGaussianLaw_memLp_fst_two nu p hp hp0 hp1
marginal_eq := by
rw [jointBernoulliGaussianLaw_map_snd nu p hp hp0 hp1]
exact hmarginal
support_eq_marginal_support := by
rw [jointBernoulliGaussianLaw_map_snd nu p hp hp0 hp1]
exact hsupport
support_closed := hclosed
density_pos := hdensityPos
mu_condMean := by
simpa [jointBernoulliGaussianLaw_map_snd nu p hp hp0 hp1] using
jointBernoulliGaussianLaw_condMean nu p hp hp0 hp1
sigmaSq_condVar := by
simpa [jointBernoulliGaussianLaw_map_snd nu p hp hp0 hp1] using
jointBernoulliGaussianLaw_condVar nu p hp hp0 hp1
theorem bernoulliGaussianCtyLaw_mem_nonparametricClass
The packaged Bernoulli--Gaussian law belongs to the CTY class once the geometric, density, Holder, and variance certificates for its supplied profiles have been established.
Formal statement
hypotheses
nu :
q :
ℕ
L :
ℝ
density p :
Score → ℝ
hp :
hp0 :
∀ x, 0 ≤ p x
hp1 :
∀ x, p x ≤ 1
hmarginal :
nu = volume.withDensity (fun x => ofReal (S.indicator density x))
hsupport :
S = nu.support
hclosed :
IsClosed S
hdensityPos :
∀ x ∈ S, 0 < density x
hq :
1 ≤ q
hL :
4 ≤ L
hdensityContinuous :
ContinuousOn density S
hcompact :
hsubset :
S ⊆ scoreCube L
hdensityEnvelope :
∀ x ∈ S, L⁻¹ ≤ density x ∧ density x ≤ L
hrectifiable :
hholder :
EuclideanHolderBallStd p (q : ℝ) L S
hvarianceContinuous :
ContinuousOn (fun x => 1 + p x * (1 - p x)) S
hvarianceEnvelope :
∀ x ∈ S, L⁻¹ ≤ 1 + p x * (1 - p x) ∧ 1 + p x * (1 - p x) ≤ L
conclusion
CtyNonparametricClass q L (bernoulliGaussianCtyLaw nu S density p hp hp0 hp1 hmarginal hsupport hclosed hdensityPos)
Proof (Lean source)
-- @node: bernoulliGaussianCtyLaw_mem_nonparametricClass
lemma bernoulliGaussianCtyLaw_mem_nonparametricClass
(nu : Measure Score) [IsProbabilityMeasure nu]
(q : ℕ) (L : ℝ) (S : Set Score) (density p : Score → ℝ)
(hp : Measurable p) (hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1)
(hmarginal : nu = volume.withDensity
(fun x => ofReal (S.indicator density x)))
(hsupport : S = nu.support) (hclosed : IsClosed S)
(hdensityPos : ∀ x ∈ S, 0 < density x)
(hq : 1 ≤ q) (hL : 4 ≤ L)
(hdensityContinuous : ContinuousOn density S)
(hcompact : IsCompact S) (hsubset : S ⊆ scoreCube L)
(hdensityEnvelope : ∀ x ∈ S, L⁻¹ ≤ density x ∧ density x ≤ L)
(hrectifiable : RectifiableBoundary S)
(hholder : EuclideanHolderBallStd p (q : ℝ) L S)
(hvarianceContinuous : ContinuousOn (fun x => 1 + p x * (1 - p x)) S)
(hvarianceEnvelope :
∀ x ∈ S, L⁻¹ ≤ 1 + p x * (1 - p x) ∧ 1 + p x * (1 - p x) ≤ L) :
CtyNonparametricClass q L
(bernoulliGaussianCtyLaw nu S density p hp hp0 hp1 hmarginal
hsupport hclosed hdensityPos) := by
exact ⟨hq, hL, hdensityContinuous, hcompact, hsubset, hdensityEnvelope,
hrectifiable, hholder, hvarianceContinuous, hvarianceEnvelope⟩
theorem bernoulliGaussianCtyLaw_map_snd
The score marginal of the packaged CTY law is the input design measure.
Formal statement
hypotheses
nu :
density p :
Score → ℝ
hp :
hp0 :
∀ x, 0 ≤ p x
hp1 :
∀ x, p x ≤ 1
hmarginal :
nu = volume.withDensity (fun x => ofReal (S.indicator density x))
hsupport :
S = nu.support
hclosed :
IsClosed S
hdensityPos :
∀ x ∈ S, 0 < density x
conclusion
Measure.map snd (bernoulliGaussianCtyLaw nu S density p hp hp0 hp1 hmarginal hsupport hclosed hdensityPos).law
= nu
Proof (Lean source)
-- @node: bernoulliGaussianCtyLaw_map_snd
lemma bernoulliGaussianCtyLaw_map_snd
(nu : Measure Score) [IsProbabilityMeasure nu]
(S : Set Score) (density p : Score → ℝ)
(hp : Measurable p) (hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1)
(hmarginal : nu = volume.withDensity
(fun x => ofReal (S.indicator density x)))
(hsupport : S = nu.support) (hclosed : IsClosed S)
(hdensityPos : ∀ x ∈ S, 0 < density x) :
Measure.map snd
(bernoulliGaussianCtyLaw nu S density p hp hp0 hp1 hmarginal
hsupport hclosed hdensityPos).law = nu := by
exact jointBernoulliGaussianLaw_map_snd nu p hp hp0 hp1
theorem bernoulliGaussianCtyLaw_mu
The packaged CTY law exposes the supplied regression pointwise, including at boundary points where the conditional-mean identity itself is only a.e.
Formal statement
hypotheses
nu :
density p :
Score → ℝ
hp :
hp0 :
∀ x, 0 ≤ p x
hp1 :
∀ x, p x ≤ 1
hmarginal :
nu = volume.withDensity (fun x => ofReal (S.indicator density x))
hsupport :
S = nu.support
hclosed :
IsClosed S
hdensityPos :
∀ x ∈ S, 0 < density x
conclusion
(bernoulliGaussianCtyLaw nu S density p hp hp0 hp1 hmarginal hsupport hclosed hdensityPos).mu
= p
Proof (Lean source)
-- @node: bernoulliGaussianCtyLaw_mu
lemma bernoulliGaussianCtyLaw_mu
(nu : Measure Score) [IsProbabilityMeasure nu]
(S : Set Score) (density p : Score → ℝ)
(hp : Measurable p) (hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1)
(hmarginal : nu = volume.withDensity
(fun x => ofReal (S.indicator density x)))
(hsupport : S = nu.support) (hclosed : IsClosed S)
(hdensityPos : ∀ x ∈ S, 0 < density x) :
(bernoulliGaussianCtyLaw nu S density p hp hp0 hp1 hmarginal
hsupport hclosed hdensityPos).mu = p := rfl
theorem bernoulliGaussianCtyLaw_sigmaSq
The packaged CTY law exposes the Bernoulli-plus-Gaussian conditional variance pointwise.
Formal statement
hypotheses
nu :
density p :
Score → ℝ
hp :
hp0 :
∀ x, 0 ≤ p x
hp1 :
∀ x, p x ≤ 1
hmarginal :
nu = volume.withDensity (fun x => ofReal (S.indicator density x))
hsupport :
S = nu.support
hclosed :
IsClosed S
hdensityPos :
∀ x ∈ S, 0 < density x
conclusion
(bernoulliGaussianCtyLaw nu S density p hp hp0 hp1 hmarginal hsupport hclosed hdensityPos).sigmaSq
= fun x => 1 + p x * (1 - p x)
Proof (Lean source)
-- @node: bernoulliGaussianCtyLaw_sigmaSq
lemma bernoulliGaussianCtyLaw_sigmaSq
(nu : Measure Score) [IsProbabilityMeasure nu]
(S : Set Score) (density p : Score → ℝ)
(hp : Measurable p) (hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1)
(hmarginal : nu = volume.withDensity
(fun x => ofReal (S.indicator density x)))
(hsupport : S = nu.support) (hclosed : IsClosed S)
(hdensityPos : ∀ x ∈ S, 0 < density x) :
(bernoulliGaussianCtyLaw nu S density p hp hp0 hp1 hmarginal
hsupport hclosed hdensityPos).sigmaSq =
fun x => 1 + p x * (1 - p x) := rfl
def angularPackingCtyLaw
The faithful law at one vertex of the angular packing family. Its score design is the angularly tilted square density and its Bernoulli regression is the globally clipped packing regression, which agrees with the smooth paper regression throughout the square.
Definition (Lean source)
-- @node: angularPackingCtyLaw
noncomputable def angularPackingCtyLaw {M : ℕ}
(b cA delta w : ℝ) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k)) : CtyLaw := by
let nu : Measure Score :=
angularDesignMeasure b cA delta w (angularGridCenter M) omega
let density : Score → ℝ :=
angularDesignDensity b cA delta w (angularGridCenter M) omega
let p : Score → ℝ :=
clippedPackingRegression b delta w (angularGridCenter M) omega
letI : IsProbabilityMeasure nu :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw hwQuarter hsep omega
apply bernoulliGaussianCtyLaw nu packingSquare density p
(clippedPackingRegression_measurable b delta w (angularGridCenter M) omega)
(fun x ↦ (clippedPackingRegression_mem_Icc
b delta w (angularGridCenter M) omega x).1)
(fun x ↦ (clippedPackingRegression_mem_Icc
b delta w (angularGridCenter M) omega x).2)
· unfold nu density packingSquare angularDesignMeasure
congr 1
funext x
by_cases hx : x ∈ scoreCube (1 / 2 : ℝ)
· rw [Set.indicator_of_mem hx]
· rw [Set.indicator_of_notMem hx]
simp [angularDesignDensity_eq_zero_off_square hx]
· unfold nu packingSquare
exact (angularDesignMeasure_support hb hscale hcA hdelta hw hsep omega).symm
· exact packingSquare_isCompact.isClosed
· intro x hx
exact angularDesignDensity_pos hcA hdelta hw hsep omega hx
theorem angularPackingCtyLaw_support
Every angular packing law has the fixed square as its declared support.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep).support
Proof (Lean source)
-- @node: angularPackingCtyLaw_support
lemma angularPackingCtyLaw_support {M : ℕ}
(b cA delta w : ℝ) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k)) :
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep).support = packingSquare := rfl
theorem angularPackingCtyLaw_map_snd
The score marginal of an angular packing law is exactly its explicitly constructed angular design measure.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
Measure.map snd (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep).law
= angularDesignMeasure b cA delta w (angularGridCenter M) omega
Proof (Lean source)
-- @node: angularPackingCtyLaw_map_snd
lemma angularPackingCtyLaw_map_snd {M : ℕ}
(b cA delta w : ℝ) (omega : Fin M → Bool)
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k)) :
Measure.map snd
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep).law =
angularDesignMeasure b cA delta w (angularGridCenter M) omega := by
letI : IsProbabilityMeasure
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw
hwQuarter hsep omega
unfold angularPackingCtyLaw
exact jointBernoulliGaussianLaw_map_snd
(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
(clippedPackingRegression b delta w (angularGridCenter M) omega)
(clippedPackingRegression_measurable b delta w (angularGridCenter M) omega)
(fun x ↦ (clippedPackingRegression_mem_Icc
b delta w (angularGridCenter M) omega x).1)
(fun x ↦ (clippedPackingRegression_mem_Icc
b delta w (angularGridCenter M) omega x).2)
theorem angularPackingCtyLaw_mu_eq_on_square
On the square, the angular packing law's regression is exactly the smooth packing regression used in the paper construction.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
x :
hx :
x ∈ packingSquare
conclusion
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep).mu x
= packingRegression b delta w (angularGridCenter M) omega x
Proof (Lean source)
-- @node: angularPackingCtyLaw_mu_eq_on_square
lemma angularPackingCtyLaw_mu_eq_on_square {M : ℕ}
{b cA delta w : ℝ} {omega : Fin M → Bool}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
{x : Score} (hx : x ∈ packingSquare) :
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep).mu x =
packingRegression b delta w (angularGridCenter M) omega x := by
change clippedPackingRegression b delta w (angularGridCenter M) omega x = _
exact clippedPackingRegression_eq_on_square
hbSmall hdelta.le hdeltaSmall hw hsep omega hx
theorem angularPackingCtyLaw_mu_center
At every grid center, the faithful law's regression equals the Boolean center value used by the finite packing certificate.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
j :
Fin M
conclusion
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep).mu (angularGridCenter M j)
= packingCenterValue b delta (angularGridCenter M) j (omega j)
Proof (Lean source)
-- @node: angularPackingCtyLaw_mu_center
lemma angularPackingCtyLaw_mu_center {M : ℕ}
{b cA delta w : ℝ} {omega : Fin M → Bool}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(j : Fin M) :
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep).mu (angularGridCenter M j) =
packingCenterValue b delta (angularGridCenter M) j (omega j) := by
rw [angularPackingCtyLaw_mu_eq_on_square hb hbSmall hscale hcA hdelta
hdeltaSmall hw hwQuarter hsep
(packingSquare_isCompact.isClosed.frontier_subset
(angularGridCenter_mem_packingSquare_frontier M j))]
exact packingRegression_eq_packingCenterValue omega j hw hsep
theorem angularPackingCtyLaw_mem_nonparametricClass_of_holder
All non-Hölder obligations for membership of an angular packing vertex in the CTY class follow from the explicit square design and Bernoulli--Gaussian construction. The remaining hypothesis is precisely the scaled-bump Hölder estimate.
Formal statement
hypotheses
M q :
ℕ
L b cA delta w :
ℝ
hq :
1 ≤ q
hL :
4 ≤ L
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
hholder :
EuclideanHolderBallStd (clippedPackingRegression b delta w (angularGridCenter M) omega) (q : ℝ) L packingSquare
conclusion
CtyNonparametricClass q L (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep)
Proof (Lean source)
-- @node: angularPackingCtyLaw_mem_nonparametricClass_of_holder
lemma angularPackingCtyLaw_mem_nonparametricClass_of_holder {M q : ℕ}
{L b cA delta w : ℝ} (omega : Fin M → Bool)
(hq : 1 ≤ q) (hL : 4 ≤ L) (hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(hholder : EuclideanHolderBallStd
(clippedPackingRegression b delta w (angularGridCenter M) omega)
(q : ℝ) L packingSquare) :
CtyNonparametricClass q L
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep) := by
let nu : Measure Score :=
angularDesignMeasure b cA delta w (angularGridCenter M) omega
let density : Score → ℝ :=
angularDesignDensity b cA delta w (angularGridCenter M) omega
let p : Score → ℝ :=
clippedPackingRegression b delta w (angularGridCenter M) omega
letI : IsProbabilityMeasure nu :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw hwQuarter hsep omega
have hmarginal : nu = volume.withDensity
(fun x ↦ ofReal (packingSquare.indicator density x)) := by
unfold nu density packingSquare angularDesignMeasure
congr 1
funext x
by_cases hx : x ∈ scoreCube (1 / 2 : ℝ)
· rw [Set.indicator_of_mem hx]
· rw [Set.indicator_of_notMem hx]
simp [angularDesignDensity_eq_zero_off_square hx]
have hsupport : packingSquare = nu.support := by
unfold nu packingSquare
exact (angularDesignMeasure_support hb hscale hcA hdelta hw hsep omega).symm
have hdensityPos : ∀ x ∈ packingSquare, 0 < density x := by
intro x hx
exact angularDesignDensity_pos hcA hdelta hw hsep omega hx
have hdensityContinuous : ContinuousOn density packingSquare := by
exact angularDesignDensity_continuousOn hb hscale _ omega
have hdensityEnvelope : ∀ x ∈ packingSquare,
L⁻¹ ≤ density x ∧ density x ≤ L := by
intro x hx
change L⁻¹ ≤
angularDesignDensity b cA delta w (angularGridCenter M) omega x ∧
angularDesignDensity b cA delta w (angularGridCenter M) omega x ≤ L
have hd := angularDesignDensity_mem_Icc
(b := b) hcA hdelta hw hsep omega hx
have hLpos : 0 < L := by linarith
constructor
· have hinv : L⁻¹ ≤ (4 : ℝ)⁻¹ :=
(inv_le_inv₀ hLpos (by norm_num)).2 hL
norm_num at hinv
exact hinv.trans (by linarith [hd.1])
· linarith [hd.2]
have hvarianceContinuous : ContinuousOn (fun x ↦ 1 + p x * (1 - p x))
packingSquare := by
have hpcont : Continuous p := by
exact clippedPackingRegression_continuous
b delta w (angularGridCenter M) omega
exact (continuous_const.add (hpcont.mul (continuous_const.sub hpcont))).continuousOn
have hvarianceEnvelope : ∀ x ∈ packingSquare,
L⁻¹ ≤ 1 + p x * (1 - p x) ∧ 1 + p x * (1 - p x) ≤ L := by
intro x hx
have hp : clippedPackingRegression b delta w (angularGridCenter M) omega x ∈
Icc (1 / 4 : ℝ) (3 / 4 : ℝ) := by
rw [clippedPackingRegression_eq_on_square hbSmall hdelta.le hdeltaSmall
hw hsep omega hx]
exact packingRegression_mem_Icc hbSmall hdelta.le hdeltaSmall hw hsep omega hx
have hv :=
Causalean.Mathlib.InformationTheory.one_add_mul_one_sub_mem_Icc hp
have hLpos : 0 < L := by linarith
constructor
· exact ((inv_le_one₀ hLpos).2 (by linarith)).trans hv.1
· exact hv.2.trans (by linarith)
exact bernoulliGaussianCtyLaw_mem_nonparametricClass
(nu := nu) (q := q) (L := L) (S := packingSquare)
(density := density) (p := p)
(clippedPackingRegression_measurable b delta w (angularGridCenter M) omega)
(fun x ↦ (clippedPackingRegression_mem_Icc
b delta w (angularGridCenter M) omega x).1)
(fun x ↦ (clippedPackingRegression_mem_Icc
b delta w (angularGridCenter M) omega x).2)
hmarginal hsupport packingSquare_isCompact.isClosed hdensityPos hq hL
hdensityContinuous packingSquare_isCompact
(packingSquare_subset_scoreCube (by linarith)) hdensityEnvelope
packingSquare_rectifiableBoundary hholder hvarianceContinuous hvarianceEnvelope
Helpers.AngularLocality 3 declarations This module lifts locality of the score design and regression kernel to locality of the faithful joint Bernoulli--Gaussian law.
Cellwise locality of the angular hard family
This module lifts locality of the score design and regression kernel to locality of the faithful joint Bernoulli--Gaussian law. It then applies that bridge to one square-truncated packing cell.
theorem jointBernoulliGaussianLaw_restrict_score_eq
Two Bernoulli--Gaussian joint laws have identical restrictions over a measurable score cell when their restricted score designs agree and their Bernoulli parameters agree throughout that cell.
Formal statement
hypotheses
p p' :
Score → ℝ
hp :
hp' :
Measurable p'
hp0 :
∀ x, 0 ≤ p x
hp1 :
∀ x, p x ≤ 1
hp0' :
∀ x, 0 ≤ p' x
hp1' :
∀ x, p' x ≤ 1
hC :
hnu :
nu.restrict C = nu'.restrict C
hparam :
∀ x ∈ C, p x = p' x
conclusion
(jointBernoulliGaussianLaw nu p hp).restrict {o | o.2 ∈ C}
= (jointBernoulliGaussianLaw nu' p' hp').restrict {o | o.2 ∈ C}
Proof (Lean source)
-- @node: jointBernoulliGaussianLaw_restrict_score_eq
lemma jointBernoulliGaussianLaw_restrict_score_eq
(nu nu' : Measure Score) [SFinite nu] [SFinite nu']
(p p' : Score → ℝ) (hp : Measurable p) (hp' : Measurable p')
(hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1)
(hp0' : ∀ x, 0 ≤ p' x) (hp1' : ∀ x, p' x ≤ 1)
{C : Set Score} (hC : MeasurableSet C)
(hnu : nu.restrict C = nu'.restrict C)
(hparam : ∀ x ∈ C, p x = p' x) :
(jointBernoulliGaussianLaw nu p hp).restrict {o | o.2 ∈ C} =
(jointBernoulliGaussianLaw nu' p' hp').restrict {o | o.2 ∈ C} := by
letI : IsMarkovKernel (bernoulliGaussianKernel p hp) :=
bernoulliGaussianKernel_isMarkovKernel p hp hp0 hp1
letI : IsMarkovKernel (bernoulliGaussianKernel p' hp') :=
bernoulliGaussianKernel_isMarkovKernel p' hp' hp0' hp1'
ext s hs
rw [Measure.restrict_apply hs, Measure.restrict_apply hs]
unfold jointBernoulliGaussianLaw
have hE : MeasurableSet (s ∩ {o : Observation | o.2 ∈ C}) :=
hs.inter (hC.preimage measurable_snd)
rw [Measure.map_apply measurable_swap hE,
Measure.map_apply measurable_swap hE]
have hpre : MeasurableSet
(swap ⁻¹' (s ∩ {o : Observation | o.2 ∈ C})) :=
hE.preimage measurable_swap
rw [Measure.compProd_apply hpre, Measure.compProd_apply hpre]
have hsupp : support (fun x ↦
(bernoulliGaussianKernel p hp x)
(Prod.mk x ⁻¹' (swap ⁻¹' (s ∩ {o : Observation | o.2 ∈ C})))) ⊆ C := by
intro x hx
by_contra hxC
apply hx
simp [hxC]
have hsupp' : support (fun x ↦
(bernoulliGaussianKernel p' hp' x)
(Prod.mk x ⁻¹' (swap ⁻¹' (s ∩ {o : Observation | o.2 ∈ C})))) ⊆ C := by
intro x hx
by_contra hxC
apply hx
simp [hxC]
rw [← setLIntegral_eq_of_support_subset hsupp,
← setLIntegral_eq_of_support_subset hsupp']
rw [hnu]
apply lintegral_congr_ae
filter_upwards [ae_restrict_mem hC] with x hx
change (bernoulliGaussianLaw (p x))
(Prod.mk x ⁻¹' (swap ⁻¹' (s ∩ {o : Observation | o.2 ∈ C}))) =
(bernoulliGaussianLaw (p' x))
(Prod.mk x ⁻¹' (swap ⁻¹' (s ∩ {o : Observation | o.2 ∈ C})))
rw [hparam x hx]
theorem angularPackingCtyLaw_restrict_cell_eq
The joint law restricted to a packing cell depends on the Boolean vertex only through the bit indexing that cell.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
j :
Fin M
hbit :
omega j = omega' j
conclusion
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep).law.restrict {o | o.2 ∈ packingCell (angularGridCenter M) w j}
= (angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw hwQuarter hsep).law.restrict {o | o.2 ∈ packingCell (angularGridCenter M) w j}
Proof (Lean source)
-- @node: angularPackingCtyLaw_restrict_cell_eq
lemma angularPackingCtyLaw_restrict_cell_eq {M : ℕ} {b cA delta w : ℝ}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
{omega omega' : Fin M → Bool} {j : Fin M}
(hbit : omega j = omega' j) :
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep).law.restrict
{o | o.2 ∈ packingCell (angularGridCenter M) w j} =
(angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw
hwQuarter hsep).law.restrict
{o | o.2 ∈ packingCell (angularGridCenter M) w j} := by
letI : IsProbabilityMeasure
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw
hwQuarter hsep omega
letI : IsProbabilityMeasure
(angularDesignMeasure b cA delta w (angularGridCenter M) omega') :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw
hwQuarter hsep omega'
let C := packingCell (angularGridCenter M) w j
have hC : MeasurableSet C :=
Metric.isClosed_closedBall.measurableSet.inter
packingSquare_isCompact.isClosed.measurableSet
have hnu := angularDesignMeasure_restrict_cell_eq
(b := b) (cA := cA) (delta := delta) hw hsep hbit
have hp : ∀ x ∈ C,
clippedPackingRegression b delta w (angularGridCenter M) omega x =
clippedPackingRegression b delta w (angularGridCenter M) omega' x := by
intro x hx
exact clippedPackingRegression_eq_on_cell hbSmall hdelta.le hdeltaSmall
hw hsep hbit hx
simpa only [angularPackingCtyLaw, bernoulliGaussianCtyLaw] using
jointBernoulliGaussianLaw_restrict_score_eq
(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
(angularDesignMeasure b cA delta w (angularGridCenter M) omega')
(clippedPackingRegression b delta w (angularGridCenter M) omega)
(clippedPackingRegression b delta w (angularGridCenter M) omega')
(clippedPackingRegression_measurable b delta w (angularGridCenter M) omega)
(clippedPackingRegression_measurable b delta w (angularGridCenter M) omega')
(fun x ↦ (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega x).1)
(fun x ↦ (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega x).2)
(fun x ↦ (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega' x).1)
(fun x ↦ (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega' x).2)
hC hnu hp
theorem angularPackingCtyLaw_restrict_off_cells_eq
The joint law outside all square-truncated packing cells is independent of the Boolean packing vertex.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep).law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell (angularGridCenter M) w j}
= (angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw hwQuarter hsep).law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell (angularGridCenter M) w j}
Proof (Lean source)
-- @node: angularPackingCtyLaw_restrict_off_cells_eq
lemma angularPackingCtyLaw_restrict_off_cells_eq {M : ℕ}
{b cA delta w : ℝ}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega omega' : Fin M → Bool) :
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep).law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j,
packingCell (angularGridCenter M) w j} =
(angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw
hwQuarter hsep).law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j,
packingCell (angularGridCenter M) w j} := by
letI : IsProbabilityMeasure
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw
hwQuarter hsep omega
letI : IsProbabilityMeasure
(angularDesignMeasure b cA delta w (angularGridCenter M) omega') :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw
hwQuarter hsep omega'
let C := packingSquare \ ⋃ j,
packingCell (angularGridCenter M) w j
have hC : MeasurableSet C :=
packingSquare_isCompact.isClosed.measurableSet.diff
(MeasurableSet.iUnion fun _ =>
Metric.isClosed_closedBall.measurableSet.inter
packingSquare_isCompact.isClosed.measurableSet)
have hnu := angularDesignMeasure_restrict_off_cells_eq
(b := b) (cA := cA) (delta := delta) hw
(centers := angularGridCenter M) omega omega'
have hp : ∀ x ∈ C,
clippedPackingRegression b delta w (angularGridCenter M) omega x =
clippedPackingRegression b delta w (angularGridCenter M) omega' x := by
intro x hx
have hxBalls : ∀ j, x ∉ closedBall (angularGridCenter M j) w := by
intro j hxj
exact hx.2 (Set.mem_iUnion.2 ⟨j, hxj, hx.1⟩)
rw [clippedPackingRegression_eq_on_square hbSmall hdelta.le hdeltaSmall
hw hsep omega hx.1,
clippedPackingRegression_eq_on_square hbSmall hdelta.le hdeltaSmall
hw hsep omega' hx.1,
packingRegression_eq_off_cells hw omega hxBalls,
packingRegression_eq_off_cells hw omega' hxBalls]
exact jointBernoulliGaussianLaw_restrict_score_eq
(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
(angularDesignMeasure b cA delta w (angularGridCenter M) omega')
(clippedPackingRegression b delta w (angularGridCenter M) omega)
(clippedPackingRegression b delta w (angularGridCenter M) omega')
(clippedPackingRegression_measurable b delta w (angularGridCenter M) omega)
(clippedPackingRegression_measurable b delta w (angularGridCenter M) omega')
(fun x ↦ (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega x).1)
(fun x ↦ (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega x).2)
(fun x ↦ (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega' x).1)
(fun x ↦ (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega' x).2)
hC hnu hp
Helpers.AngularMeasure 38 declarations This file defines the smooth radial cutoff and cosine tilt used to perturb the design density inside a packing cell.
Angular density profile for the square packing
This file defines the smooth radial cutoff and cosine tilt used to perturb the
design density inside a packing cell. It proves the cutoff identities, the
uniform tilt envelope, and the zero-mass polar cancellation. The denominator
is clipped below by the cutoff scale; on the region where the cutoff is one it
is exactly the paper's b r denominator.
Smooth cutoff which is zero when b r ≤ cA δ and one when 2 cA δ ≤ b r.
Definition (Lean source)
-- @node: angularCutoff
noncomputable def angularCutoff (b cA delta r : ℝ) : ℝ :=
Real.smoothTransition (b * r / (cA * delta) - 1)
theorem angularCutoff_mem_Icc
The angular cutoff always takes values in the unit interval.
Formal statement
Proof (Lean source)
-- @node: angularCutoff_mem_Icc
lemma angularCutoff_mem_Icc (b cA delta r : ℝ) :
angularCutoff b cA delta r ∈ Icc (0 : ℝ) 1 := by
exact ⟨Real.smoothTransition.nonneg _, Real.smoothTransition.le_one _⟩
theorem angularCutoff_eq_zero
The angular cutoff vanishes below its inner radial threshold.
Formal statement
hypotheses
b cA delta r :
ℝ
hscale :
0 < cA * delta
h :
b * r ≤ cA * delta
conclusion
angularCutoff b cA delta r = 0
Proof (Lean source)
-- @node: angularCutoff_eq_zero
lemma angularCutoff_eq_zero {b cA delta r : ℝ} (hscale : 0 < cA * delta)
(h : b * r ≤ cA * delta) : angularCutoff b cA delta r = 0 := by
apply Real.smoothTransition.zero_of_nonpos
rw [sub_nonpos, div_le_one hscale]
exact h
theorem angularCutoff_eq_one
The angular cutoff equals one beyond twice its inner radial threshold.
Formal statement
hypotheses
b cA delta r :
ℝ
hscale :
0 < cA * delta
h :
2 * (cA * delta) ≤ b * r
conclusion
angularCutoff b cA delta r = 1
Proof (Lean source)
-- @node: angularCutoff_eq_one
lemma angularCutoff_eq_one {b cA delta r : ℝ} (hscale : 0 < cA * delta)
(h : 2 * (cA * delta) ≤ b * r) : angularCutoff b cA delta r = 1 := by
apply Real.smoothTransition.one_of_one_le
rw [le_sub_iff_add_le, ← two_mul, le_div_iff₀ hscale]
simpa [two_mul] using h
theorem angularCutoff_continuous
The cutoff is a continuous function of the radius.
Formal statement
Proof (Lean source)
-- @node: angularCutoff_continuous
lemma angularCutoff_continuous (b cA delta : ℝ) :
Continuous (angularCutoff b cA delta) := by
unfold angularCutoff
fun_prop
The radial bump profile appearing in the angular density correction.
Definition (Lean source)
-- @node: angularRadialProfile
noncomputable def angularRadialProfile (w r : ℝ) : ℝ :=
packingBump (w⁻¹ • scorePoint r 0)
theorem angularRadialProfile_mem_Icc
The radial profile takes values in the unit interval.
Formal statement
Proof (Lean source)
-- @node: angularRadialProfile_mem_Icc
lemma angularRadialProfile_mem_Icc (w r : ℝ) :
angularRadialProfile w r ∈ Icc (0 : ℝ) 1 := by
exact packingBump_mem_Icc _
theorem angularRadialProfile_eq_zero_of_bandwidth_le_abs
A positive-bandwidth radial profile vanishes at every radius outside its bandwidth.
Formal statement
Proof (Lean source)
-- @node: angularRadialProfile_eq_zero_of_bandwidth_le_abs
lemma angularRadialProfile_eq_zero_of_bandwidth_le_abs {w r : ℝ}
(hw : 0 < w) (hr : w ≤ |r|) : angularRadialProfile w r = 0 := by
apply packingBump_eq_zero_of_one_le_norm
rw [norm_smul, Real.norm_eq_abs, abs_inv, abs_of_pos hw]
have hnorm : ‖scorePoint r 0‖ = |r| := by
rw [← dist_zero_right]
rw [show (0 : Score) = scorePoint 0 0 by
ext i
fin_cases i <;> simp [scorePoint]]
simpa using dist_scorePoint_same_second r 0 0
rw [hnorm, inv_mul_eq_div, one_le_div hw]
exact hr
theorem angularRadialProfile_continuous
The radial profile is continuous.
Formal statement
Proof (Lean source)
-- @node: angularRadialProfile_continuous
lemma angularRadialProfile_continuous (w : ℝ) :
Continuous (angularRadialProfile w) := by
unfold angularRadialProfile
apply packingBump_contDiff.continuous.comp
apply Continuous.fun_const_smul
unfold scorePoint
apply (EuclideanSpace.equiv (Fin 2) ℝ).symm.continuous.comp
apply continuous_pi
intro i
fin_cases i
· exact continuous_id
· exact continuous_const
theorem localizedPackingBump_eq_delta_mul_angularRadialProfile
The scaled Euclidean bump used in the regression is exactly the radial profile used in the angular cancellation formula.
Formal statement
hypotheses
delta w :
ℝ
center x :
conclusion
Proof (Lean source)
-- @node: localizedPackingBump_eq_delta_mul_angularRadialProfile
lemma localizedPackingBump_eq_delta_mul_angularRadialProfile
{delta w : ℝ} (center x : Score) :
localizedPackingBump delta w center x =
delta * angularRadialProfile w (dist x center) := by
simpa [angularRadialProfile] using
(localizedPackingBump_eq_delta_mul_radial (delta := delta) (w := w) center x)
The clipped angular tilt. Clipping only regularizes the denominator in the transition region; once the cutoff is one this is exactly -2 δ φ(r/w) / (b r).
Definition (Lean source)
-- @node: angularTilt
noncomputable def angularTilt (b cA delta w r : ℝ) : ℝ :=
-(2 * delta * angularRadialProfile w r * angularCutoff b cA delta r) /
max (b * r) (cA * delta)
theorem angularTilt_continuous
The angular tilt is continuous in the radius at every positive cutoff scale.
Formal statement
hypotheses
b cA delta w :
ℝ
hscale :
0 < cA * delta
conclusion
Continuous (angularTilt b cA delta w)
Proof (Lean source)
-- @node: angularTilt_continuous
lemma angularTilt_continuous {b cA delta w : ℝ} (hscale : 0 < cA * delta) :
Continuous (angularTilt b cA delta w) := by
unfold angularTilt
apply Continuous.div
· exact (((continuous_const.mul (angularRadialProfile_continuous w)).mul
(angularCutoff_continuous b cA delta))).neg
· exact (continuous_const.mul continuous_id).max continuous_const
· intro r
exact (lt_of_lt_of_le hscale (le_max_right _ _)).ne'
theorem angularTilt_abs_le
At envelope parameter cA, the angular tilt has absolute value at most 2/cA.
Formal statement
hypotheses
b cA delta w r :
ℝ
hcA :
0 < cA
hdelta :
0 < delta
conclusion
|angularTilt b cA delta w r| ≤ 2 / cA
Proof (Lean source)
-- @node: angularTilt_abs_le
lemma angularTilt_abs_le {b cA delta w r : ℝ} (hcA : 0 < cA)
(hdelta : 0 < delta) : |angularTilt b cA delta w r| ≤ 2 / cA := by
have hscale : 0 < cA * delta := mul_pos hcA hdelta
have hden : 0 < max (b * r) (cA * delta) :=
hscale.trans_le (le_max_right _ _)
have hprofile := angularRadialProfile_mem_Icc w r
have hcutoff := angularCutoff_mem_Icc b cA delta r
have hprod :
angularRadialProfile w r * angularCutoff b cA delta r ≤ 1 := by
calc
angularRadialProfile w r * angularCutoff b cA delta r ≤ 1 * 1 :=
mul_le_mul hprofile.2 hcutoff.2 hcutoff.1 (by norm_num)
_ = 1 := by ring
rw [angularTilt, abs_div, abs_neg, abs_of_pos hden]
have hnum :
|2 * delta * angularRadialProfile w r * angularCutoff b cA delta r| ≤
2 * delta := by
rw [abs_mul, abs_mul, abs_mul, abs_of_nonneg (by norm_num : (0 : ℝ) ≤ 2),
abs_of_pos hdelta, abs_of_nonneg hprofile.1, abs_of_nonneg hcutoff.1]
nlinarith
calc
_ ≤ (2 * delta) / max (b * r) (cA * delta) :=
div_le_div_of_nonneg_right hnum hden.le
_ ≤ (2 * delta) / (cA * delta) := by
exact div_le_div_of_nonneg_left (by positivity) hscale
(le_max_right _ _)
_ = 2 / cA := by field_simp
theorem angularTilt_abs_le_quarter
With the paper's choice cA ≥ 8, the density tilt is bounded by one quarter.
Formal statement
hypotheses
b cA delta w r :
ℝ
hcA :
8 ≤ cA
hdelta :
0 < delta
conclusion
|angularTilt b cA delta w r| ≤ 1 / 4
Proof (Lean source)
-- @node: angularTilt_abs_le_quarter
lemma angularTilt_abs_le_quarter {b cA delta w r : ℝ} (hcA : 8 ≤ cA)
(hdelta : 0 < delta) : |angularTilt b cA delta w r| ≤ 1 / 4 := by
have hcA0 : 0 < cA := lt_of_lt_of_le (by norm_num) hcA
exact (angularTilt_abs_le hcA0 hdelta).trans <| by
rw [div_le_iff₀ hcA0]
nlinarith
The multiplicative density factor in polar coordinates.
Definition (Lean source)
-- @node: angularDensityFactor
noncomputable def angularDensityFactor
(b cA delta w r theta : ℝ) : ℝ :=
1 + angularTilt b cA delta w r * cos theta
theorem angularDensityFactor_mem_Icc
The paper's choice cA ≥ 8 keeps the angular density factor in [3/4, 5/4], uniformly over radius and angle.
Formal statement
hypotheses
b cA delta w r theta :
ℝ
hcA :
8 ≤ cA
hdelta :
0 < delta
conclusion
angularDensityFactor b cA delta w r theta ∈ Icc (3 / 4 : ℝ) (5 / 4 : ℝ)
Proof (Lean source)
-- @node: angularDensityFactor_mem_Icc
lemma angularDensityFactor_mem_Icc {b cA delta w r theta : ℝ}
(hcA : 8 ≤ cA) (hdelta : 0 < delta) :
angularDensityFactor b cA delta w r theta ∈
Icc (3 / 4 : ℝ) (5 / 4 : ℝ) := by
have htilt := angularTilt_abs_le_quarter (b := b) (w := w) (r := r) hcA hdelta
have hcos : |cos theta| ≤ (1 : ℝ) :=
abs_le.mpr ⟨Real.neg_one_le_cos theta, Real.cos_le_one theta⟩
have hprod :
|angularTilt b cA delta w r * cos theta| ≤ (1 / 4 : ℝ) := by
rw [abs_mul]
calc
|angularTilt b cA delta w r| * |cos theta| ≤ (1 / 4) * 1 :=
mul_le_mul htilt hcos (abs_nonneg _) (by norm_num)
_ = 1 / 4 := by ring
rw [abs_le] at hprod
constructor <;> unfold angularDensityFactor <;> linarith
theorem angularDensityFactor_pos
In particular, every angular density factor is strictly positive.
Formal statement
hypotheses
b cA delta w r theta :
ℝ
hcA :
8 ≤ cA
hdelta :
0 < delta
conclusion
0 < angularDensityFactor b cA delta w r theta
Proof (Lean source)
-- @node: angularDensityFactor_pos
lemma angularDensityFactor_pos {b cA delta w r theta : ℝ}
(hcA : 8 ≤ cA) (hdelta : 0 < delta) :
0 < angularDensityFactor b cA delta w r theta := by
have h := angularDensityFactor_mem_Icc (b := b) (w := w) (r := r)
(theta := theta) hcA hdelta
exact (by norm_num : (0 : ℝ) < 3 / 4).trans_le h.1
The cosine of the polar direction around a packing center, with the value at the center fixed to zero. This coordinate formula avoids choosing a global angle on the score plane.
Definition (Lean source)
-- @node: packingDirectionCos
noncomputable def packingDirectionCos (center x : Score) : ℝ :=
if dist x center = 0 then 0 else (x 0 - center 0) / dist x center
theorem packingDirectionCos_abs_le_one
The coordinate direction cosine has absolute value at most one.
Formal statement
Proof (Lean source)
-- @node: packingDirectionCos_abs_le_one
lemma packingDirectionCos_abs_le_one (center x : Score) :
|packingDirectionCos center x| ≤ 1 := by
by_cases hdist : dist x center = 0
· simp [packingDirectionCos, hdist]
· rw [packingDirectionCos, if_neg hdist, abs_div]
have hcoord : |x 0 - center 0| ≤ dist x center := by
simpa [dist_eq_norm, Real.norm_eq_abs] using
(PiLp.norm_apply_le (x - center) (0 : Fin 2))
rw [abs_of_nonneg dist_nonneg]
exact (div_le_one (lt_of_le_of_ne dist_nonneg (Ne.symm hdist))).2 hcoord
One center's signed angular correction to the design density.
Definition (Lean source)
-- @node: packingAngularTerm
noncomputable def packingAngularTerm
(b cA delta w : ℝ) (center x : Score) : ℝ :=
angularTilt b cA delta w (dist x center) * packingDirectionCos center x
theorem packingAngularTerm_continuous
The cutoff removes the apparent directional singularity at the center, so each angular correction is continuous on the whole score plane.
Formal statement
hypotheses
conclusion
Continuous (packingAngularTerm b cA delta w center)
Proof (Lean source)
-- @node: packingAngularTerm_continuous
lemma packingAngularTerm_continuous {b cA delta w : ℝ} (hb : 0 < b)
(hscale : 0 < cA * delta) (center : Score) :
Continuous (packingAngularTerm b cA delta w center) := by
rw [continuous_iff_continuousAt]
intro x
by_cases hx : x = center
· subst x
have hR : 0 < (cA * delta) / b := div_pos hscale hb
have hevent : ∀ᶠ y in nhds center, dist y center < (cA * delta) / b :=
(continuousAt_id.dist continuousAt_const).eventually_lt continuousAt_const
(by simpa)
have heq : packingAngularTerm b cA delta w center =ᶠ[nhds center]
(fun _ => 0) := by
filter_upwards [hevent] with y hy
rw [packingAngularTerm, angularTilt, angularCutoff_eq_zero hscale]
· simp
· simpa [mul_comm] using ((lt_div_iff₀ hb).mp hy).le
exact continuousAt_const.congr_of_eventuallyEq heq
· have hdist : dist x center ≠ 0 := by
simpa [dist_eq_zero] using hx
have hevent : ∀ᶠ y in nhds x, dist y center ≠ 0 :=
(continuousAt_id.dist continuousAt_const).eventually_ne hdist
have htilt : ContinuousAt
(fun y : Score => angularTilt b cA delta w (dist y center)) x :=
(angularTilt_continuous hscale).continuousAt.comp'
(continuousAt_id.dist continuousAt_const)
have hcoord : ContinuousAt (fun y : Score => y 0 - center 0) x := by
fun_prop
have hraw : ContinuousAt
(fun y : Score => angularTilt b cA delta w (dist y center) *
((y 0 - center 0) / dist y center)) x := by
exact htilt.mul
(hcoord.div (continuousAt_id.dist continuousAt_const) hdist)
apply hraw.congr_of_eventuallyEq
filter_upwards [hevent] with y hy
simp [packingAngularTerm, packingDirectionCos, hy]
theorem packingAngularTerm_abs_le_quarter
Each active angular correction is uniformly bounded by one quarter.
Formal statement
hypotheses
conclusion
|packingAngularTerm b cA delta w center x| ≤ 1 / 4
Proof (Lean source)
-- @node: packingAngularTerm_abs_le_quarter
lemma packingAngularTerm_abs_le_quarter {b cA delta w : ℝ}
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (center x : Score) :
|packingAngularTerm b cA delta w center x| ≤ 1 / 4 := by
rw [packingAngularTerm, abs_mul]
calc
|angularTilt b cA delta w (dist x center)| * |packingDirectionCos center x| ≤
(1 / 4 : ℝ) * 1 :=
mul_le_mul (angularTilt_abs_le_quarter hcA hdelta)
(packingDirectionCos_abs_le_one center x) (abs_nonneg _) (by norm_num)
_ = 1 / 4 := by ring
theorem packingAngularTerm_eq_zero_of_bandwidth_le_dist
A center contributes no angular density correction outside its packing bandwidth.
Formal statement
hypotheses
conclusion
packingAngularTerm b cA delta w center x = 0
Proof (Lean source)
-- @node: packingAngularTerm_eq_zero_of_bandwidth_le_dist
lemma packingAngularTerm_eq_zero_of_bandwidth_le_dist {b cA delta w : ℝ}
{center x : Score} (hw : 0 < w) (hx : w ≤ dist x center) :
packingAngularTerm b cA delta w center x = 0 := by
rw [packingAngularTerm, angularTilt,
angularRadialProfile_eq_zero_of_bandwidth_le_abs hw (by simpa using hx)]
simp
The design density obtained by summing the active disjoint angular corrections over the packing grid.
Definition (Lean source)
-- @node: packingAngularDensity
noncomputable def packingAngularDensity {M : ℕ} (b cA delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) (x : Score) : ℝ :=
1 + ∑ j, if omega j then packingAngularTerm b cA delta w (centers j) x else 0
theorem packingAngularDensity_continuous
The finite angularly tilted design density is continuous.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
conclusion
Continuous (packingAngularDensity b cA delta w centers omega)
Proof (Lean source)
-- @node: packingAngularDensity_continuous
lemma packingAngularDensity_continuous {M : ℕ} {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (centers : Fin M → Score)
(omega : Fin M → Bool) :
Continuous (packingAngularDensity b cA delta w centers omega) := by
unfold packingAngularDensity
apply continuous_const.add
apply continuous_finset_sum
intro j _
by_cases hj : omega j = true
· simpa [hj] using packingAngularTerm_continuous hb hscale (centers j)
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simpa [hjf] using (continuous_const : Continuous (fun _ : Score => (0 : ℝ)))
theorem packingAngularDensity_measurable
The finite angularly tilted design density is Borel measurable.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
conclusion
Measurable (packingAngularDensity b cA delta w centers omega)
Proof (Lean source)
-- @node: packingAngularDensity_measurable
lemma packingAngularDensity_measurable {M : ℕ} {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (centers : Fin M → Score)
(omega : Fin M → Bool) :
Measurable (packingAngularDensity b cA delta w centers omega) :=
(packingAngularDensity_continuous hb hscale centers omega).measurable
theorem packingAngularDensity_sum_abs_le_quarter
Three-bandwidth separation ensures that at most one angular correction is nonzero at any score point, so summing the family does not enlarge its pointwise envelope.
Formal statement
Proof (Lean source)
-- @node: packingAngularDensity_sum_abs_le_quarter
lemma packingAngularDensity_sum_abs_le_quarter {M : ℕ} {b cA delta w : ℝ}
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (x : Score) :
|∑ j, if omega j then packingAngularTerm b cA delta w (centers j) x else 0| ≤
1 / 4 := by
by_cases hex : ∃ j, omega j = true ∧
packingAngularTerm b cA delta w (centers j) x ≠ 0
· obtain ⟨j, hjbit, hjne⟩ := hex
rw [Finset.sum_eq_single j]
· simp only [hjbit, if_true]
exact packingAngularTerm_abs_le_quarter hcA hdelta (centers j) x
· intro i _ hij
have hzero : packingAngularTerm b cA delta w (centers i) x = 0 := by
by_contra hine
have hxi : dist x (centers i) < w := by
apply lt_of_not_ge
intro hfar
exact hine (packingAngularTerm_eq_zero_of_bandwidth_le_dist hw hfar)
have hxj : dist x (centers j) < w := by
apply lt_of_not_ge
intro hfar
exact hjne (packingAngularTerm_eq_zero_of_bandwidth_le_dist hw hfar)
have htri : dist (centers i) (centers j) ≤
dist (centers i) x + dist x (centers j) := dist_triangle _ _ _
have hs := hsep i j hij
rw [dist_comm (centers i) x] at htri
linarith
simp [hzero]
· simp
· have hzero : ∀ j : Fin M,
(if omega j then packingAngularTerm b cA delta w (centers j) x else 0) = 0 := by
intro j
by_cases hj : omega j = true
· simp only [hj, if_true]
by_contra hjne
exact hex ⟨j, hj, hjne⟩
· have hjfalse : omega j = false := Bool.eq_false_of_not_eq_true hj
simp [hjfalse]
rw [Finset.sum_eq_zero fun j _ => hzero j, abs_zero]
norm_num
theorem packingAngularDensity_mem_Icc
The angularly tilted design density remains in the paper's uniform density envelope.
Formal statement
Proof (Lean source)
-- @node: packingAngularDensity_mem_Icc
lemma packingAngularDensity_mem_Icc {M : ℕ} {b cA delta w : ℝ}
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (x : Score) :
packingAngularDensity b cA delta w centers omega x ∈
Icc (3 / 4 : ℝ) (5 / 4 : ℝ) := by
have hsum := packingAngularDensity_sum_abs_le_quarter (b := b)
hcA hdelta hw hsep omega x
rw [abs_le] at hsum
unfold packingAngularDensity
constructor <;> linarith
theorem packingAngularDensity_eq_on_cell
Inside one closed packing ball, the angular density depends on the bit vector only through that ball's coordinate.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
j :
Fin M
hbit :
omega j = omega' j
x :
hx :
x ∈ closedBall (centers j) w
conclusion
packingAngularDensity b cA delta w centers omega x
= packingAngularDensity b cA delta w centers omega' x
Proof (Lean source)
-- @node: packingAngularDensity_eq_on_cell
lemma packingAngularDensity_eq_on_cell {M : ℕ} {b cA delta w : ℝ}
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
{omega omega' : Fin M → Bool} {j : Fin M} (hbit : omega j = omega' j)
{x : Score} (hx : x ∈ closedBall (centers j) w) :
packingAngularDensity b cA delta w centers omega x =
packingAngularDensity b cA delta w centers omega' x := by
unfold packingAngularDensity
congr 1
apply Finset.sum_congr rfl
intro i _
by_cases hij : i = j
· subst i
rw [hbit]
· have hfar : w ≤ dist x (centers i) := by
have htri : dist (centers i) (centers j) ≤
dist (centers i) x + dist x (centers j) := dist_triangle _ _ _
have hs := hsep i j hij
rw [Metric.mem_closedBall] at hx
rw [dist_comm (centers i) x] at htri
linarith
rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw hfar]
simp
theorem packingAngularDensity_eq_one_off_cells
Away from every closed packing ball, all angular corrections vanish and the design density is the common unit baseline.
Formal statement
hypotheses
conclusion
packingAngularDensity b cA delta w centers omega x = 1
Proof (Lean source)
-- @node: packingAngularDensity_eq_one_off_cells
lemma packingAngularDensity_eq_one_off_cells {M : ℕ} {b cA delta w : ℝ}
(hw : 0 < w) {centers : Fin M → Score} (omega : Fin M → Bool)
{x : Score} (hx : ∀ j, x ∉ closedBall (centers j) w) :
packingAngularDensity b cA delta w centers omega x = 1 := by
unfold packingAngularDensity
rw [Finset.sum_eq_zero]
· simp
· intro j _
have hfar : w ≤ dist x (centers j) := by
have hlt : w < dist x (centers j) := by
simpa [Metric.mem_closedBall, not_le] using hx j
exact hlt.le
rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw hfar]
simp
theorem angularTilt_eq_zero_of_le
Below the inner cutoff radius the angular tilt vanishes identically.
Formal statement
hypotheses
b cA delta w r :
ℝ
hscale :
0 < cA * delta
h :
b * r ≤ cA * delta
conclusion
angularTilt b cA delta w r = 0
Proof (Lean source)
-- @node: angularTilt_eq_zero_of_le
lemma angularTilt_eq_zero_of_le {b cA delta w r : ℝ}
(hscale : 0 < cA * delta) (h : b * r ≤ cA * delta) :
angularTilt b cA delta w r = 0 := by
rw [angularTilt, angularCutoff_eq_zero hscale h]
simp
theorem angularTilt_eq_formula
Beyond twice the cutoff radius the clipped tilt agrees with the paper's unclipped cancellation formula.
Formal statement
hypotheses
b cA delta w r :
ℝ
hscale :
0 < cA * delta
h :
2 * (cA * delta) ≤ b * r
conclusion
angularTilt b cA delta w r = -(2 * delta * angularRadialProfile w r) / (b * r)
Proof (Lean source)
-- @node: angularTilt_eq_formula
lemma angularTilt_eq_formula {b cA delta w r : ℝ}
(hscale : 0 < cA * delta) (h : 2 * (cA * delta) ≤ b * r) :
angularTilt b cA delta w r =
-(2 * delta * angularRadialProfile w r) / (b * r) := by
have hmax : max (b * r) (cA * delta) = b * r := by
rw [max_eq_left]
linarith
rw [angularTilt, angularCutoff_eq_one hscale h, hmax]
ring
theorem angularTilt_eq_zero_of_bandwidth_le_abs
Outside the bump bandwidth the angular density perturbation vanishes.
Formal statement
Proof (Lean source)
-- @node: angularTilt_eq_zero_of_bandwidth_le_abs
lemma angularTilt_eq_zero_of_bandwidth_le_abs {b cA delta w r : ℝ}
(hw : 0 < w) (hr : w ≤ |r|) : angularTilt b cA delta w r = 0 := by
rw [angularTilt, angularRadialProfile_eq_zero_of_bandwidth_le_abs hw hr]
simp
theorem angularDensityFactor_eq_one_of_bandwidth_le_abs
Outside the bump bandwidth the perturbed polar density factor is exactly the common baseline density.
Formal statement
hypotheses
b cA delta w r theta :
ℝ
hw :
0 < w
hr :
w ≤ |r|
conclusion
angularDensityFactor b cA delta w r theta = 1
Proof (Lean source)
-- @node: angularDensityFactor_eq_one_of_bandwidth_le_abs
lemma angularDensityFactor_eq_one_of_bandwidth_le_abs {b cA delta w r theta : ℝ}
(hw : 0 < w) (hr : w ≤ |r|) :
angularDensityFactor b cA delta w r theta = 1 := by
rw [angularDensityFactor, angularTilt_eq_zero_of_bandwidth_le_abs hw hr]
simp
theorem angularOutcomeCancellation_identity
Once the cutoff is fully active, the radial bump contribution and the affine-times-angular contribution cancel after integrating over the half-circle.
Formal statement
hypotheses
b cA delta w r :
ℝ
hscale :
0 < cA * delta
h :
2 * (cA * delta) ≤ b * r
conclusion
Proof (Lean source)
-- @node: angularOutcomeCancellation_identity
lemma angularOutcomeCancellation_identity {b cA delta w r : ℝ}
(hscale : 0 < cA * delta) (h : 2 * (cA * delta) ≤ b * r) :
pi * delta * angularRadialProfile w r +
(pi / 2) * (b * r) * angularTilt b cA delta w r = 0 := by
rw [angularTilt_eq_formula hscale h]
have hbr : b * r ≠ 0 := by
have : 0 < b * r := lt_of_lt_of_le (mul_pos (by positivity) (by positivity)) h
exact this.ne'
rcases mul_ne_zero_iff.mp hbr with ⟨hb, hr⟩
field_simp [hb, hr]
ring
theorem angularTilt_halfDisc_mass_cancellation
The cosine angular density correction has zero total mass on every upper half-disc.
Formal statement
hypotheses
b cA delta w R :
ℝ
conclusion
(∫ z : ℝ × ℝ in {z | 0 < z.2 ∧ planarRadius z ≤ R}, angularTilt b cA delta w (planarRadius z) * cos (planarAngle z))
= 0
Proof (Lean source)
-- @node: angularTilt_halfDisc_mass_cancellation
lemma angularTilt_halfDisc_mass_cancellation (b cA delta w R : ℝ) :
(∫ z : ℝ × ℝ in {z | 0 < z.2 ∧ planarRadius z ≤ R},
angularTilt b cA delta w (planarRadius z) *
cos (planarAngle z)) = 0 := by
exact halfDisc_weighted_cos_cancellation (angularTilt b cA delta w) R
theorem packingDirectionCos_eq_planarFirst_div_radius
The direction cosine used by the angular density is the Cartesian first coordinate divided by Euclidean radius after passing to centered planar coordinates.
Formal statement
hypotheses
center x :
conclusion
packingDirectionCos center x
= (scoreCoordinates x - scoreCoordinates center).1 / planarRadius (scoreCoordinates x - scoreCoordinates center)
Proof (Lean source)
-- @node: packingDirectionCos_eq_planarFirst_div_radius
lemma packingDirectionCos_eq_planarFirst_div_radius (center x : Score) :
packingDirectionCos center x =
(scoreCoordinates x - scoreCoordinates center).1 /
planarRadius (scoreCoordinates x - scoreCoordinates center) := by
rw [planarRadius_scoreCoordinates_sub]
by_cases h : dist x center = 0
· simp [packingDirectionCos, h]
· simp [packingDirectionCos, scoreCoordinates, h]
theorem packingAngularTerm_integral_gridCell
Each angular correction integrates to zero on its square-truncated grid cell. This is the normalization bridge for every tilted design vertex.
Formal statement
hypotheses
conclusion
(∫ x : Score in closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2), packingAngularTerm b cA delta w (angularGridCenter M j) x)
= 0
Proof (Lean source)
-- @node: packingAngularTerm_integral_gridCell
lemma packingAngularTerm_integral_gridCell {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hw : w ≤ 1 / 4) :
(∫ x : Score in
closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2),
packingAngularTerm b cA delta w (angularGridCenter M j) x) = 0 := by
let c := scoreCoordinates (angularGridCenter M j)
let D : Set (ℝ × ℝ) :=
{z | 0 ≤ (z - c).2 ∧ planarRadius (z - c) ≤ w}
have himage : scoreCoordinates ''
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) = D := by
ext z
constructor
· rintro ⟨x, hx, rfl⟩
exact (mem_angularGrid_packingCell_iff_closedUpperHalfDisc j hw x).mp hx
· intro hz
let x : Score := scorePoint z.1 z.2
have hcoord : scoreCoordinates x = z := by
ext <;> simp [x, scoreCoordinates, scorePoint_apply_zero,
scorePoint_apply_one]
refine ⟨x, ?_, hcoord⟩
apply (mem_angularGrid_packingCell_iff_closedUpperHalfDisc j hw x).mpr
simpa [D, c, hcoord] using hz
have hterm : packingAngularTerm b cA delta w (angularGridCenter M j) =
fun x => angularTilt b cA delta w
(planarRadius (scoreCoordinates x - scoreCoordinates (angularGridCenter M j))) *
((scoreCoordinates x - scoreCoordinates (angularGridCenter M j)).1 /
planarRadius (scoreCoordinates x - scoreCoordinates (angularGridCenter M j))) := by
funext x
rw [packingAngularTerm,
packingDirectionCos_eq_planarFirst_div_radius,
planarRadius_scoreCoordinates_sub]
rw [hterm]
rw [← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ =>
angularTilt b cA delta w
(planarRadius (z - scoreCoordinates (angularGridCenter M j))) *
((z - scoreCoordinates (angularGridCenter M j)).1 /
planarRadius (z - scoreCoordinates (angularGridCenter M j))))
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))]
rw [himage]
change (∫ z : ℝ × ℝ in D,
angularTilt b cA delta w (planarRadius (z - c)) *
((z - c).1 / planarRadius (z - c))) = 0
exact translatedClosedHalfDisc_weighted_first_div_radius_cancellation
(angularTilt b cA delta w) w c
Helpers.AngularPacking 37 declarations This file provides the low-level probability and geometry primitives for the square-support hypercube construction.
Angular hard-family packing
This file provides the low-level probability and geometry primitives for the
square-support hypercube construction. The complete certificate is stated
downstream in AngularPackingTheorem, after the faithful law constructor is
available without an import cycle.
def packingSquare
The fixed unit square supporting every law in the hard family.
The square used by the hard family is compact.
Formal statement
conclusion
Proof (Lean source)
-- @node: packingSquare_isCompact
lemma packingSquare_isCompact : IsCompact packingSquare := by
rw [Metric.isCompact_iff_isClosed_bounded]
constructor
· unfold packingSquare scoreCube
rw [show {x : Score | ∀ i, |x i| ≤ (1 / 2 : ℝ)} =
⋂ i : Fin 2, {x : Score | |x i| ≤ (1 / 2 : ℝ)} by
ext x
simp]
apply isClosed_iInter
intro i
simpa [Real.norm_eq_abs] using
(isClosed_le
((PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) i).norm)
continuous_const)
· rw [Metric.isBounded_iff_subset_closedBall 0]
refine ⟨1, ?_⟩
intro x hx
unfold packingSquare scoreCube at hx
rw [Metric.mem_closedBall, dist_zero_right]
rw [EuclideanSpace.norm_eq]
have h0 := hx (0 : Fin 2)
have h1 := hx (1 : Fin 2)
have h0sq : |x 0| ^ 2 ≤ ((1 / 2 : ℝ) ^ 2) := by
nlinarith [abs_nonneg (x 0)]
have h1sq : |x 1| ^ 2 ≤ ((1 / 2 : ℝ) ^ 2) := by
nlinarith [abs_nonneg (x 1)]
simp only [Fin.sum_univ_two, Real.norm_eq_abs]
rw [Real.sqrt_le_one]
nlinarith
Any envelope at least one half contains the packing square in its ambient coordinate cube.
Formal statement
Proof (Lean source)
-- @node: packingSquare_subset_scoreCube
lemma packingSquare_subset_scoreCube {L : ℝ} (hL : 1 / 2 ≤ L) :
packingSquare ⊆ scoreCube L := by
intro x hx i
exact (hx i).trans hL
def packingCell
The half-disc cell cut out by the square at a boundary packing point.
Definition (Lean source)
def packingCell {M : ℕ} (centers : Fin M → Score) (w : ℝ) (j : Fin M) : Set Score :=
closedBall (centers j) w ∩ packingSquare
theorem angularGridCenter_mem_packingSquare_frontier
The explicit lower-edge grid centers lie on the frontier of the packing square.
Formal statement
Proof (Lean source)
-- @node: angularGridCenter_mem_packingSquare_frontier
lemma angularGridCenter_mem_packingSquare_frontier (M : ℕ) (j : Fin M) :
angularGridCenter M j ∈ frontier packingSquare := by
simpa [packingSquare] using angularGridCenter_mem_frontier M j
theorem angularGridPackingCells_disjoint
The explicit grid yields pairwise disjoint packing cells whenever twice the cell radius is smaller than one grid spacing.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: angularGridPackingCells_disjoint
lemma angularGridPackingCells_disjoint (M : ℕ) (w : ℝ)
(hw : 2 * w < 1 / (2 * (M + 1 : ℕ) : ℝ))
(i j : Fin M) (hij : i ≠ j) :
Disjoint (packingCell (angularGridCenter M) w i)
(packingCell (angularGridCenter M) w j) := by
simpa [packingCell, packingSquare] using angularGridCells_disjoint M w hw i j hij
theorem angularPacking_geometry
Whenever the frontier-rate radius is small, the explicit grid supplies the entire geometric prefix of AngularPackingAt, with constants c₀ = 1/24 and both radius-comparison constants equal to one.
Formal statement
hypotheses
conclusion
∃ M : ℕ,
∃ w : ℝ,
(1 / 24 : ℝ) * rpow (frontierRate n) (-(1 : ℝ) / q) ≤ M ∧
((1 : ℝ) * rpow (frontierRate n) ((1 : ℝ) / q) ≤ w ∧ w ≤ (1 : ℝ) * rpow (frontierRate n) ((1 : ℝ) / q)) ∧
(∀ j, centers j ∈ frontier packingSquare) ∧
Proof (Lean source)
-- @node: angularPacking_geometry
lemma angularPacking_geometry (n q : ℕ) (hn : 2 ≤ n)
(hsmall : angularGridRadius n q ≤ 1 / 24) :
∃ M : ℕ, ∃ w : ℝ, ∃ centers : Fin M → Score,
(1 / 24 : ℝ) * rpow (frontierRate n) (-(1 : ℝ) / q) ≤ M ∧
((1 : ℝ) * rpow (frontierRate n) ((1 : ℝ) / q) ≤ w ∧
w ≤ (1 : ℝ) * rpow (frontierRate n) ((1 : ℝ) / q)) ∧
(∀ j, centers j ∈ frontier packingSquare) ∧
(∀ i j, i ≠ j →
dist (centers i) (centers j) ≥
(1 : ℝ) * rpow (frontierRate n) ((1 : ℝ) / q)) ∧
(∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j)) := by
let w := angularGridRadius n q
let M := angularGridSize w
have hw0 : 0 < w := by
exact rpow_pos_of_pos (frontierRate_pos hn) _
have hwEq : w = rpow (frontierRate n) ((1 : ℝ) / q) := rfl
have hM := angularGridSize_frontier_lower n q hn hsmall
have hgeometry := angularGridSize_geometry w hw0 hsmall
rcases hgeometry with ⟨_, hcenters, hpairs⟩
refine ⟨M, w, angularGridCenter M, hM, ?_, ?_, ?_, ?_⟩
· simpa [hwEq]
· intro j
simpa [packingSquare] using (hcenters j).1
· intro i j hij
have hsep := (hpairs i j hij).1
simp only [one_mul]
calc
rpow (frontierRate n) ((1 : ℝ) / q) = w := hwEq.symm
_ ≤ dist (angularGridCenter M i) (angularGridCenter M j) := by
nlinarith [hw0]
· intro i j hij
simpa [packingCell, packingSquare] using (hpairs i j hij).2
def onePointDistanceLaw
The one-observation unsigned radial-outcome law at a query point.
Definition (Lean source)
noncomputable def onePointDistanceLaw (P : CtyLaw) (x : Score) : Measure (ℝ × ℝ) :=
Measure.map (fun o : Observation => (o.1, dist o.2 x)) P.law
theorem onePointDistanceLaw_isProbabilityMeasure
The one-observation radial-outcome law is a probability measure.
Formal statement
Proof (Lean source)
-- @node: onePointDistanceLaw_isProbabilityMeasure
lemma onePointDistanceLaw_isProbabilityMeasure (P : CtyLaw) (x : Score) :
IsProbabilityMeasure (onePointDistanceLaw P x) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
exact Measure.isProbabilityMeasure_map (by fun_prop)
def compressedSampleLaw
The n-observation distance-compressed law at a query point.
Definition (Lean source)
noncomputable def compressedSampleLaw (P : CtyLaw) (n : ℕ) (x : Score) :
Measure (DistanceSample n) :=
Measure.map (fun w => distanceData n w x) (sampleLaw P n)
theorem compressedSampleLaw_isProbabilityMeasure
The distance-compressed i.i.d. sample law is a probability measure.
Formal statement
Proof (Lean source)
-- @node: compressedSampleLaw_isProbabilityMeasure
lemma compressedSampleLaw_isProbabilityMeasure (P : CtyLaw) (n : ℕ) (x : Score) :
IsProbabilityMeasure (compressedSampleLaw P n x) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
letI : IsProbabilityMeasure (sampleLaw P n) := by
unfold sampleLaw
infer_instance
exact Measure.isProbabilityMeasure_map (measurable_distanceData n x).aemeasurable
theorem compressedSampleLaw_eq_pi_onePointDistanceLaw
The compressed i.i.d. sample law is exactly the finite product of the one-observation radial-outcome law. This is the bridge that permits KL tensorization directly after distance compression.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: compressedSampleLaw_eq_pi_onePointDistanceLaw
lemma compressedSampleLaw_eq_pi_onePointDistanceLaw
(P : CtyLaw) (n : ℕ) (x : Score) :
compressedSampleLaw P n x =
Measure.pi (fun _ : Fin n => onePointDistanceLaw P x) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
unfold compressedSampleLaw sampleLaw onePointDistanceLaw distanceData
change Measure.map
(fun w i => (fun o : Observation => (o.1, dist o.2 x)) (w i))
(Measure.pi fun _ : Fin n => P.law) = _
exact Measure.pi_map_pi (f := fun _ : Fin n =>
fun o : Observation => (o.1, dist o.2 x)) (fun _ =>
(show Measurable (fun o : Observation => (o.1, dist o.2 x)) by
fun_prop).aemeasurable)
theorem compressedSampleLaw_klDiv_le_of_onePoint
A finite one-observation radial KL bound tensorizes to the compressed sample law. Absolute continuity and log-likelihood integrability are the standard finite-KL guards required by product tensorization.
Formal statement
hypotheses
P P' :
n :
ℕ
x :
B :
ℝ
hB :
0 ≤ B
hac :
onePointDistanceLaw P x ≪ onePointDistanceLaw P' x
hint :
hKL :
≤ ofReal B
conclusion
≤ ofReal ((n : ℝ) * B)
Proof (Lean source)
-- @node: compressedSampleLaw_klDiv_le_of_onePoint
lemma compressedSampleLaw_klDiv_le_of_onePoint
(P P' : CtyLaw) (n : ℕ) (x : Score) {B : ℝ} (hB : 0 ≤ B)
(hac : onePointDistanceLaw P x ≪ onePointDistanceLaw P' x)
(hint : Integrable
(llr (onePointDistanceLaw P x) (onePointDistanceLaw P' x))
(onePointDistanceLaw P x))
(hKL : klDiv (onePointDistanceLaw P x)
(onePointDistanceLaw P' x) ≤ ofReal B) :
klDiv (compressedSampleLaw P n x)
(compressedSampleLaw P' n x) ≤ ofReal ((n : ℝ) * B) := by
letI : IsProbabilityMeasure (onePointDistanceLaw P x) :=
onePointDistanceLaw_isProbabilityMeasure P x
letI : IsProbabilityMeasure (onePointDistanceLaw P' x) :=
onePointDistanceLaw_isProbabilityMeasure P' x
have ht := productKL_tensorization
n (onePointDistanceLaw P x) (onePointDistanceLaw P' x) hac hint
rw [compressedSampleLaw_eq_pi_onePointDistanceLaw,
compressedSampleLaw_eq_pi_onePointDistanceLaw]
rw [← ENNReal.toReal_le_toReal ht.product_ne_top ENNReal.ofReal_ne_top]
rw [ENNReal.toReal_ofReal (mul_nonneg (Nat.cast_nonneg n) hB)]
calc
_ ≤ (n : ℝ) * (klDiv (onePointDistanceLaw P x)
(onePointDistanceLaw P' x)).toReal := ht.apply
_ ≤ (n : ℝ) * B := by
gcongr
simpa [ENNReal.toReal_ofReal hB] using
ENNReal.toReal_mono (by simp) hKL
theorem compressedSampleLaw_klDiv_le
Unsigned-distance compression of an i.i.d. sample cannot increase its Kullback--Leibler divergence.
Formal statement
hypotheses
conclusion
Proof (Lean source)
lemma compressedSampleLaw_klDiv_le (P P' : CtyLaw) (n : ℕ) (x : Score) :
klDiv (compressedSampleLaw P n x) (compressedSampleLaw P' n x) ≤
klDiv (sampleLaw P n) (sampleLaw P' n) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
letI : IsProbabilityMeasure P'.law := P'.law_isProbability
letI : IsProbabilityMeasure (sampleLaw P n) := by
unfold sampleLaw
infer_instance
letI : IsProbabilityMeasure (sampleLaw P' n) := by
unfold sampleLaw
infer_instance
exact klDiv_map_le
(measurable_distanceData n x)
The common additive standard-Gaussian channel used to turn Bernoulli outcomes into the smooth conditional outcome laws of the packing.
Definition (Lean source)
-- @node: gaussianNoiseKernel
noncomputable def gaussianNoiseKernel : Kernel ℝ ℝ :=
mechanismKernel (gaussianReal 0 1)
(fun p : ℝ × ℝ => p.1 + p.2)
instance gaussianNoiseKernel_isMarkovKernel
The stated conditional distribution is a Markov kernel: it is a probability law at each input and varies measurably with that input.
Definition (Lean source)
instance gaussianNoiseKernel_isMarkovKernel : IsMarkovKernel gaussianNoiseKernel := by
unfold gaussianNoiseKernel
exact instIsMarkovKernelMechanismKernel
(gaussianReal 0 1) (by fun_prop)
theorem gaussianNoiseKernel_apply
At input b, the additive standard-Gaussian channel has law N(b,1).
Formal statement
Proof (Lean source)
-- @node: gaussianNoiseKernel_apply
lemma gaussianNoiseKernel_apply (b : ℝ) :
gaussianNoiseKernel b = gaussianReal b 1 := by
rw [gaussianNoiseKernel,
mechanismKernel_apply _ (by fun_prop)]
simpa using gaussianReal_map_const_add (μ := 0) (v := 1) b
theorem gaussianNoiseKernel_klDiv_bind_le
Convolution with the common additive Gaussian noise in the packing cannot increase the Bernoulli-stage Kullback--Leibler divergence.
Formal statement
Proof (Lean source)
-- @node: gaussianNoiseKernel_klDiv_bind_le
lemma gaussianNoiseKernel_klDiv_bind_le
(μ ν : Measure ℝ) [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] :
klDiv (μ.bind gaussianNoiseKernel)
(ν.bind gaussianNoiseKernel) ≤
klDiv μ ν := by
exact klDiv_bind_le_of_isProbabilityMeasure
μ ν gaussianNoiseKernel
The conditional outcome law obtained by adding independent standard Gaussian noise to a real-valued Bernoulli draw.
Definition (Lean source)
-- @node: bernoulliGaussianLaw
noncomputable def bernoulliGaussianLaw (p : ℝ) : Measure ℝ :=
(bernoulliLaw p).bind gaussianNoiseKernel
theorem bernoulliGaussianLaw_eq_gaussian_mixture
The Bernoulli-plus-Gaussian outcome law is the explicit mixture of the unit-variance Gaussians centered at one and zero.
Formal statement
hypotheses
p :
ℝ
conclusion
Proof (Lean source)
-- @node: bernoulliGaussianLaw_eq_gaussian_mixture
lemma bernoulliGaussianLaw_eq_gaussian_mixture (p : ℝ) :
bernoulliGaussianLaw p = ofReal p • gaussianReal 1 1 +
ofReal (1 - p) • gaussianReal 0 1 := by
ext s hs
rw [bernoulliGaussianLaw,
Measure.bind_apply hs gaussianNoiseKernel.measurable.aemeasurable]
rw [bernoulliLaw_lintegral_ofReal]
rw [gaussianNoiseKernel_apply, gaussianNoiseKernel_apply]
simp [Measure.add_apply, Measure.smul_apply]
theorem bernoulliGaussianLaw_klDiv_le_four_sq_sub
Adding the common Gaussian noise preserves the quadratic KL bound for Bernoulli parameters in the middle half of the unit interval.
Formal statement
hypotheses
p q :
ℝ
hp_lo :
(1 : ℝ) / 4 ≤ p
hp_hi :
p ≤ 3 / 4
hq_lo :
(1 : ℝ) / 4 ≤ q
hq_hi :
q ≤ 3 / 4
conclusion
≤ ofReal (4 * (p - q) ^ 2)
Proof (Lean source)
-- @node: bernoulliGaussianLaw_klDiv_le_four_sq_sub
lemma bernoulliGaussianLaw_klDiv_le_four_sq_sub {p q : ℝ}
(hp_lo : (1 : ℝ) / 4 ≤ p) (hp_hi : p ≤ 3 / 4)
(hq_lo : (1 : ℝ) / 4 ≤ q) (hq_hi : q ≤ 3 / 4) :
klDiv (bernoulliGaussianLaw p) (bernoulliGaussianLaw q) ≤
ofReal (4 * (p - q) ^ 2) := by
letI : IsProbabilityMeasure
(bernoulliLaw p) :=
bernoulliLaw_isProbabilityMeasure
(by linarith) (by linarith)
letI : IsProbabilityMeasure
(bernoulliLaw q) :=
bernoulliLaw_isProbabilityMeasure
(by linarith) (by linarith)
exact (gaussianNoiseKernel_klDiv_bind_le
(bernoulliLaw p)
(bernoulliLaw q)).trans
(bernoulliLaw_klDiv_le_four_sq_sub
hp_lo hp_hi hq_lo hq_hi)
theorem bernoulliGaussianLaw_isProbabilityMeasure
For a success probability in the unit interval, the Bernoulli-plus-Gaussian outcome law is a probability measure.
Formal statement
Proof (Lean source)
-- @node: bernoulliGaussianLaw_isProbabilityMeasure
lemma bernoulliGaussianLaw_isProbabilityMeasure {p : ℝ}
(hp0 : 0 ≤ p) (hp1 : p ≤ 1) :
IsProbabilityMeasure (bernoulliGaussianLaw p) := by
letI : IsProbabilityMeasure
(bernoulliLaw p) :=
bernoulliLaw_isProbabilityMeasure hp0 hp1
exact MeasureTheory.isProbabilityMeasure_bind
gaussianNoiseKernel.measurable.aemeasurable
(Filter.Eventually.of_forall fun _ => inferInstance)
theorem bernoulliGaussianLaw_integrable_id
The identity is integrable under every Bernoulli-plus-Gaussian outcome law, including parameter values outside the unit interval.
Formal statement
Proof (Lean source)
-- @node: bernoulliGaussianLaw_integrable_id
lemma bernoulliGaussianLaw_integrable_id (p : ℝ) :
Integrable id (bernoulliGaussianLaw p) := by
rw [bernoulliGaussianLaw_eq_gaussian_mixture]
apply Integrable.add_measure
· exact ((memLp_id_gaussianReal (μ := (1 : ℝ)) (v := 1) 1).integrable
(by norm_num)).smul_measure (by simp)
· exact ((memLp_id_gaussianReal (μ := (0 : ℝ)) (v := 1) 1).integrable
(by norm_num)).smul_measure (by simp)
theorem bernoulliGaussianLaw_memLp_id_two
The identity is square-integrable under every Bernoulli-plus-Gaussian outcome law. This supplies the CtyLaw.sq_integrable field of the eventual hard-family construction.
Formal statement
Proof (Lean source)
-- @node: bernoulliGaussianLaw_memLp_id_two
lemma bernoulliGaussianLaw_memLp_id_two (p : ℝ) :
MemLp id 2 (bernoulliGaussianLaw p) := by
rw [memLp_two_iff_integrable_sq measurable_id.aestronglyMeasurable,
bernoulliGaussianLaw_eq_gaussian_mixture]
apply Integrable.add_measure
· have h : Integrable (fun y : ℝ => y ^ 2) (gaussianReal 1 1) := by
simpa [id, Real.norm_eq_abs, sq_abs] using
(memLp_id_gaussianReal (μ := (1 : ℝ)) (v := 1) 2).integrable_norm_pow
(by norm_num : (2 : ℕ) ≠ 0)
exact h.smul_measure (by simp)
· have h : Integrable (fun y : ℝ => y ^ 2) (gaussianReal 0 1) := by
simpa [id, Real.norm_eq_abs, sq_abs] using
(memLp_id_gaussianReal (μ := (0 : ℝ)) (v := 1) 2).integrable_norm_pow
(by norm_num : (2 : ℕ) ≠ 0)
exact h.smul_measure (by simp)
theorem bernoulliGaussianLaw_integral_id
The conditional mean of a Bernoulli draw plus centered Gaussian noise is its Bernoulli success probability.
Formal statement
hypotheses
p :
ℝ
hp0 :
0 ≤ p
hp1 :
p ≤ 1
conclusion
∫ y, y ∂bernoulliGaussianLaw p = p
Proof (Lean source)
-- @node: bernoulliGaussianLaw_integral_id
lemma bernoulliGaussianLaw_integral_id {p : ℝ}
(hp0 : 0 ≤ p) (hp1 : p ≤ 1) :
∫ y, y ∂bernoulliGaussianLaw p = p := by
rw [bernoulliGaussianLaw_eq_gaussian_mixture, integral_add_measure]
· rw [integral_smul_measure, integral_smul_measure]
simp [hp0, sub_nonneg.mpr hp1]
· exact ((memLp_id_gaussianReal (μ := (1 : ℝ)) (v := 1) 1).integrable
(by norm_num)).smul_measure (by simp)
· exact ((memLp_id_gaussianReal (μ := (0 : ℝ)) (v := 1) 1).integrable
(by norm_num)).smul_measure (by simp)
The second moment about an arbitrary center under N(m,1) equals one plus the squared displacement from the Gaussian mean.
Formal statement
hypotheses
m p :
ℝ
conclusion
∫ y, (y - p) ^ 2 ∂gaussianReal m 1 = 1 + (m - p) ^ 2
Proof (Lean source)
-- @node: gaussianReal_integral_sq_sub
lemma gaussianReal_integral_sq_sub (m p : ℝ) :
∫ y, (y - p) ^ 2 ∂gaussianReal m 1 = 1 + (m - p) ^ 2 := by
have hcenterLp : MemLp (fun y : ℝ => y - m) 2 (gaussianReal m 1) := by
exact (memLp_id_gaussianReal' (μ := m) (v := 1) 2 (by simp)).sub
(memLp_const m)
have hsq : Integrable (fun y : ℝ => (y - m) ^ 2) (gaussianReal m 1) := by
simpa [Real.norm_eq_abs, sq_abs] using
hcenterLp.integrable_norm_pow (by norm_num : (2 : ℕ) ≠ 0)
have hlin : Integrable (fun y : ℝ => 2 * (m - p) * (y - m))
(gaussianReal m 1) := by
exact (hcenterLp.integrable (by norm_num)).const_mul _
have hvar : ∫ y, (y - m) ^ 2 ∂gaussianReal m 1 = 1 := by
have hv := variance_id_gaussianReal (μ := m) (v := 1)
rw [variance_eq_integral measurable_id.aemeasurable] at hv
simp only [id_eq, integral_id_gaussianReal] at hv
norm_num at hv
exact hv
have hcenterMean : ∫ y, y - m ∂gaussianReal m 1 = 0 := by
have hi := integral_sub
((memLp_id_gaussianReal (μ := m) (v := 1) 1).integrable (by norm_num))
(integrable_const m)
calc
_ = (∫ y, y ∂gaussianReal m 1) - ∫ _y, m ∂gaussianReal m 1 := by
simpa only [Pi.sub_apply, id_eq] using hi
_ = 0 := by simp
rw [show (fun y : ℝ => (y - p) ^ 2) =
fun y => (y - m) ^ 2 + 2 * (m - p) * (y - m) + (m - p) ^ 2 by
funext y
ring]
change (∫ y, ((y - m) ^ 2 + 2 * (m - p) * (y - m)) +
(m - p) ^ 2 ∂gaussianReal m 1) = _
calc
_ = (∫ y, (y - m) ^ 2 + 2 * (m - p) * (y - m) ∂gaussianReal m 1) +
∫ _y, (m - p) ^ 2 ∂gaussianReal m 1 := by
simpa only [Pi.add_apply] using
integral_add (hsq.add hlin) (by fun_prop :
Integrable (fun _y : ℝ => (m - p) ^ 2) (gaussianReal m 1))
_ = ((∫ y, (y - m) ^ 2 ∂gaussianReal m 1) +
∫ y, 2 * (m - p) * (y - m) ∂gaussianReal m 1) +
∫ _y, (m - p) ^ 2 ∂gaussianReal m 1 := by
rw [integral_add hsq hlin]
_ = _ := by
rw [hvar, integral_const_mul, hcenterMean]
simp
theorem bernoulliGaussianLaw_variance_id
The conditional variance of a Bernoulli draw plus independent standard Gaussian noise is 1 + p(1-p).
Formal statement
hypotheses
p :
ℝ
hp0 :
0 ≤ p
hp1 :
p ≤ 1
conclusion
variance id (bernoulliGaussianLaw p) = 1 + p * (1 - p)
Proof (Lean source)
-- @node: bernoulliGaussianLaw_variance_id
lemma bernoulliGaussianLaw_variance_id {p : ℝ}
(hp0 : 0 ≤ p) (hp1 : p ≤ 1) :
variance id (bernoulliGaussianLaw p) = 1 + p * (1 - p) := by
letI : IsProbabilityMeasure (bernoulliGaussianLaw p) :=
bernoulliGaussianLaw_isProbabilityMeasure hp0 hp1
rw [variance_eq_integral measurable_id.aemeasurable]
simp only [id_eq, bernoulliGaussianLaw_integral_id hp0 hp1]
rw [bernoulliGaussianLaw_eq_gaussian_mixture, integral_add_measure]
· rw [integral_smul_measure, integral_smul_measure]
rw [gaussianReal_integral_sq_sub, gaussianReal_integral_sq_sub]
simp [hp0, sub_nonneg.mpr hp1]
ring
· apply Integrable.smul_measure _ (by simp)
simpa [id] using
(((memLp_id_gaussianReal (μ := (1 : ℝ)) (v := 1) 2).sub
(memLp_const p)).integrable_norm_pow (by norm_num : (2 : ℕ) ≠ 0))
· apply Integrable.smul_measure _ (by simp)
simpa [id] using
(((memLp_id_gaussianReal (μ := (0 : ℝ)) (v := 1) 2).sub
(memLp_const p)).integrable_norm_pow (by norm_num : (2 : ℕ) ≠ 0))
The measurable Bernoulli-plus-Gaussian kernel of a regression function.
Definition (Lean source)
-- @node: bernoulliGaussianKernel
noncomputable def bernoulliGaussianKernel (p : Score → ℝ) (hp : Measurable p) :
Kernel Score ℝ where
toFun x := bernoulliGaussianLaw (p x)
measurable' := by
unfold bernoulliGaussianLaw bernoulliLaw
fun_prop
theorem bernoulliGaussianKernel_isMarkovKernel
A unit-range regression function makes the outcome kernel Markov.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: bernoulliGaussianKernel_isMarkovKernel
lemma bernoulliGaussianKernel_isMarkovKernel (p : Score → ℝ) (hp : Measurable p)
(h0 : ∀ x, 0 ≤ p x) (h1 : ∀ x, p x ≤ 1) :
IsMarkovKernel (bernoulliGaussianKernel p hp) := by
constructor
intro x
exact bernoulliGaussianLaw_isProbabilityMeasure (h0 x) (h1 x)
The joint (Y,X) law from a design and the explicit outcome kernel.
Definition (Lean source)
-- @node: jointBernoulliGaussianLaw
noncomputable def jointBernoulliGaussianLaw
(nu : Measure Score) (p : Score → ℝ) (hp : Measurable p) : Measure Observation :=
Measure.map swap (Measure.compProd nu (bernoulliGaussianKernel p hp))
theorem jointBernoulliGaussianLaw_isProbabilityMeasure
A probability design and unit-range regression give a probability law.
Formal statement
Proof (Lean source)
-- @node: jointBernoulliGaussianLaw_isProbabilityMeasure
lemma jointBernoulliGaussianLaw_isProbabilityMeasure
(nu : Measure Score) [IsProbabilityMeasure nu]
(p : Score → ℝ) (hp : Measurable p)
(h0 : ∀ x, 0 ≤ p x) (h1 : ∀ x, p x ≤ 1) :
IsProbabilityMeasure (jointBernoulliGaussianLaw nu p hp) := by
letI : IsMarkovKernel (bernoulliGaussianKernel p hp) :=
bernoulliGaussianKernel_isMarkovKernel p hp h0 h1
unfold jointBernoulliGaussianLaw
exact Measure.isProbabilityMeasure_map measurable_swap.aemeasurable
theorem jointBernoulliGaussianLaw_map_snd
The score marginal is exactly the supplied design law.
Formal statement
hypotheses
conclusion
Measure.map snd (jointBernoulliGaussianLaw nu p hp) = nu
Proof (Lean source)
-- @node: jointBernoulliGaussianLaw_map_snd
lemma jointBernoulliGaussianLaw_map_snd
(nu : Measure Score) [IsProbabilityMeasure nu]
(p : Score → ℝ) (hp : Measurable p)
(h0 : ∀ x, 0 ≤ p x) (h1 : ∀ x, p x ≤ 1) :
Measure.map snd (jointBernoulliGaussianLaw nu p hp) = nu := by
letI : IsMarkovKernel (bernoulliGaussianKernel p hp) :=
bernoulliGaussianKernel_isMarkovKernel p hp h0 h1
unfold jointBernoulliGaussianLaw
rw [Measure.map_map measurable_snd measurable_swap]
change Measure.map fst (Measure.compProd nu (bernoulliGaussianKernel p hp)) = nu
exact Measure.fst_compProd nu (bernoulliGaussianKernel p hp)
theorem jointBernoulliGaussianLaw_condDistrib
Disintegration recovers the supplied outcome kernel almost everywhere.
Formal statement
hypotheses
conclusion
(let _ : IsProbabilityMeasure (jointBernoulliGaussianLaw nu p hp) := jointBernoulliGaussianLaw_isProbabilityMeasure nu p hp h0 h1 (fun x => condDistrib fst snd (jointBernoulliGaussianLaw nu p hp) x) =ᵐ[nu] bernoulliGaussianKernel p hp)
Proof (Lean source)
-- @node: jointBernoulliGaussianLaw_condDistrib
lemma jointBernoulliGaussianLaw_condDistrib
(nu : Measure Score) [IsProbabilityMeasure nu]
(p : Score → ℝ) (hp : Measurable p)
(h0 : ∀ x, 0 ≤ p x) (h1 : ∀ x, p x ≤ 1) :
(let _ : IsProbabilityMeasure (jointBernoulliGaussianLaw nu p hp) :=
jointBernoulliGaussianLaw_isProbabilityMeasure nu p hp h0 h1
(fun x => condDistrib fst snd (jointBernoulliGaussianLaw nu p hp) x)
=ᵐ[nu] bernoulliGaussianKernel p hp) := by
letI : IsMarkovKernel (bernoulliGaussianKernel p hp) :=
bernoulliGaussianKernel_isMarkovKernel p hp h0 h1
letI : IsProbabilityMeasure (jointBernoulliGaussianLaw nu p hp) :=
jointBernoulliGaussianLaw_isProbabilityMeasure nu p hp h0 h1
have h := condDistrib_ae_eq_of_measure_eq_compProd_of_measurable
(μ := jointBernoulliGaussianLaw nu p hp) (X := snd) (Y := fst)
measurable_snd measurable_fst (κ := bernoulliGaussianKernel p hp) (by
rw [jointBernoulliGaussianLaw_map_snd nu p hp h0 h1]
unfold jointBernoulliGaussianLaw
rw [Measure.map_map (measurable_snd.prodMk measurable_fst) measurable_swap]
simp [Function.comp_def])
rwa [jointBernoulliGaussianLaw_map_snd nu p hp h0 h1] at h
theorem bernoulliGaussianLaw_integral_sq
The second moment of a Bernoulli draw plus standard Gaussian noise is 1+p.
Formal statement
hypotheses
p :
ℝ
h0 :
0 ≤ p
h1 :
p ≤ 1
conclusion
∫ y, y ^ 2 ∂bernoulliGaussianLaw p = 1 + p
Proof (Lean source)
-- @node: bernoulliGaussianLaw_integral_sq
lemma bernoulliGaussianLaw_integral_sq {p : ℝ} (h0 : 0 ≤ p) (h1 : p ≤ 1) :
∫ y, y ^ 2 ∂bernoulliGaussianLaw p = 1 + p := by
have hg1 : ∫ y, y ^ 2 ∂gaussianReal 1 1 = 1 + (1 : ℝ) ^ 2 := by
simpa only [sub_zero] using gaussianReal_integral_sq_sub (1 : ℝ) 0
have hg0 : ∫ y, y ^ 2 ∂gaussianReal 0 1 = 1 + (0 : ℝ) ^ 2 := by
simpa only [sub_zero] using gaussianReal_integral_sq_sub (0 : ℝ) 0
rw [bernoulliGaussianLaw_eq_gaussian_mixture, integral_add_measure]
· rw [integral_smul_measure, integral_smul_measure, hg1, hg0]
simp [h0, sub_nonneg.mpr h1]
ring
· simpa [Real.norm_eq_abs, sq_abs] using
((memLp_id_gaussianReal (μ := (1 : ℝ)) (v := 1) 2).integrable_norm_pow
(by norm_num : (2 : ℕ) ≠ 0)).smul_measure (by simp)
· simpa [Real.norm_eq_abs, sq_abs] using
((memLp_id_gaussianReal (μ := (0 : ℝ)) (v := 1) 2).integrable_norm_pow
(by norm_num : (2 : ℕ) ≠ 0)).smul_measure (by simp)
theorem jointBernoulliGaussianLaw_memLp_fst_two
The outcome coordinate of the explicit joint law is square-integrable.
Formal statement
Proof (Lean source)
-- @node: jointBernoulliGaussianLaw_memLp_fst_two
lemma jointBernoulliGaussianLaw_memLp_fst_two
(nu : Measure Score) [IsProbabilityMeasure nu]
(p : Score → ℝ) (hp : Measurable p)
(h0 : ∀ x, 0 ≤ p x) (h1 : ∀ x, p x ≤ 1) :
MemLp fst 2 (jointBernoulliGaussianLaw nu p hp) := by
letI : IsMarkovKernel (bernoulliGaussianKernel p hp) :=
bernoulliGaussianKernel_isMarkovKernel p hp h0 h1
have hbase : MemLp snd 2
(Measure.compProd nu (bernoulliGaussianKernel p hp)) := by
rw [memLp_two_iff_integrable_sq measurable_snd.aestronglyMeasurable]
apply (Measure.integrable_compProd_iff (by fun_prop)).2
constructor
· filter_upwards with x
simpa [bernoulliGaussianKernel, Real.norm_eq_abs, sq_abs] using
(bernoulliGaussianLaw_memLp_id_two (p x)).integrable_norm_pow
(by norm_num : (2 : ℕ) ≠ 0)
· have heq : (fun x => ∫ y, ‖y ^ 2‖ ∂bernoulliGaussianKernel p hp x) =
fun x => 1 + p x := by
funext x
simpa [bernoulliGaussianKernel, Real.norm_eq_abs, abs_sq] using
bernoulliGaussianLaw_integral_sq (h0 x) (h1 x)
rw [heq]
have hpLp : MemLp p 1 nu := MemLp.of_bound hp.aestronglyMeasurable 1
(Filter.Eventually.of_forall fun x => by
simpa [Real.norm_eq_abs, abs_of_nonneg (h0 x)] using h1 x)
exact (integrable_const (1 : ℝ)).add (hpLp.integrable (by norm_num))
have hswap : MeasurePreserving swap (jointBernoulliGaussianLaw nu p hp)
(Measure.compProd nu (bernoulliGaussianKernel p hp)) :=
{ measurable := measurable_swap
map_eq := by
unfold jointBernoulliGaussianLaw
rw [Measure.map_map measurable_swap measurable_swap]
simp [Function.comp_def] }
simpa [Function.comp_def] using hbase.comp_measurePreserving hswap
theorem jointBernoulliGaussianLaw_condMean
The conditional mean is the regression used in the construction.
Formal statement
hypotheses
conclusion
(let _ : IsProbabilityMeasure (jointBernoulliGaussianLaw nu p hp) := jointBernoulliGaussianLaw_isProbabilityMeasure nu p hp h0 h1 ∀ᵐ x ∂nu, p x = ∫ y, y ∂condDistrib fst snd (jointBernoulliGaussianLaw nu p hp) x)
Proof (Lean source)
-- @node: jointBernoulliGaussianLaw_condMean
lemma jointBernoulliGaussianLaw_condMean
(nu : Measure Score) [IsProbabilityMeasure nu]
(p : Score → ℝ) (hp : Measurable p)
(h0 : ∀ x, 0 ≤ p x) (h1 : ∀ x, p x ≤ 1) :
(let _ : IsProbabilityMeasure (jointBernoulliGaussianLaw nu p hp) :=
jointBernoulliGaussianLaw_isProbabilityMeasure nu p hp h0 h1
∀ᵐ x ∂nu, p x = ∫ y, y ∂condDistrib fst snd
(jointBernoulliGaussianLaw nu p hp) x) := by
filter_upwards [jointBernoulliGaussianLaw_condDistrib nu p hp h0 h1] with x hx
rw [hx]
exact (bernoulliGaussianLaw_integral_id (h0 x) (h1 x)).symm
theorem jointBernoulliGaussianLaw_condVar
The conditional variance is 1+p(1-p).
Formal statement
hypotheses
conclusion
(let _ : IsProbabilityMeasure (jointBernoulliGaussianLaw nu p hp) := jointBernoulliGaussianLaw_isProbabilityMeasure nu p hp h0 h1 ∀ᵐ x ∂nu, 1 + p x * (1 - p x) = variance id (condDistrib fst snd (jointBernoulliGaussianLaw nu p hp) x))
Proof (Lean source)
-- @node: jointBernoulliGaussianLaw_condVar
lemma jointBernoulliGaussianLaw_condVar
(nu : Measure Score) [IsProbabilityMeasure nu]
(p : Score → ℝ) (hp : Measurable p)
(h0 : ∀ x, 0 ≤ p x) (h1 : ∀ x, p x ≤ 1) :
(let _ : IsProbabilityMeasure (jointBernoulliGaussianLaw nu p hp) :=
jointBernoulliGaussianLaw_isProbabilityMeasure nu p hp h0 h1
∀ᵐ x ∂nu, 1 + p x * (1 - p x) = variance id
(condDistrib fst snd (jointBernoulliGaussianLaw nu p hp) x)) := by
filter_upwards [jointBernoulliGaussianLaw_condDistrib nu p hp h0 h1] with x hx
rw [hx]
exact (bernoulliGaussianLaw_variance_id (h0 x) (h1 x)).symm
Helpers.AngularPackingOnePointKL 6 declarations This module connects the common-radius KL interface to the angular packing, including its middle-half parameter clipping and short-radius mass bound.
Construction-specific one-point KL bound
This module connects the common-radius KL interface to the angular packing, including its middle-half parameter clipping and short-radius mass bound.
Pointwise clipping to the middle half of the Bernoulli parameter range.
Definition (Lean source)
-- @node: middleHalfClip
noncomputable def middleHalfClip (f : Score → ℝ) : Score → ℝ :=
fun x => max (1 / 4 : ℝ) (min (3 / 4 : ℝ) (f x))
theorem middleHalfClip_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
Proof (Lean source)
lemma middleHalfClip_measurable {f : Score → ℝ} (hf : Measurable f) :
Measurable (middleHalfClip f) := by
unfold middleHalfClip
fun_prop
theorem middleHalfClip_mem_Icc
The clipped success parameter lies in the displayed closed interval.
Formal statement
Proof (Lean source)
lemma middleHalfClip_mem_Icc (f : Score → ℝ) (x : Score) :
middleHalfClip f x ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ) := by
unfold middleHalfClip
constructor <;> simp <;> norm_num
theorem middleHalfClip_clippedPackingRegression_ae_eq
On an admissible angular design, middle-half clipping is silent almost everywhere because the design is supported on the packing square.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
=ᵐ[ angularDesignMeasure b cA delta w (angularGridCenter M) omega] clippedPackingRegression b delta w (angularGridCenter M) omega
Proof (Lean source)
-- @node: middleHalfClip_clippedPackingRegression_ae_eq
lemma middleHalfClip_clippedPackingRegression_ae_eq
{M : ℕ} {b cA delta w : ℝ}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) :
middleHalfClip (clippedPackingRegression b delta w
(angularGridCenter M) omega) =ᵐ[
angularDesignMeasure b cA delta w (angularGridCenter M) omega]
clippedPackingRegression b delta w (angularGridCenter M) omega := by
have hsupp := angularDesignMeasure_support hb hscale hcA hdelta hw hsep omega
have hmem : scoreCube (1 / 2 : ℝ) ∈ ae
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) := by
rw [← hsupp]
exact Measure.support_mem_ae
filter_upwards [hmem] with x hx
have hp := packingRegression_mem_Icc hbSmall hdelta.le hdeltaSmall hw hsep omega hx
unfold middleHalfClip
rw [clippedPackingRegression_eq_on_square hbSmall hdelta.le hdeltaSmall hw
hsep omega hx]
rw [min_eq_right hp.2, max_eq_right hp.1]
theorem angularDesignMeasure_radial_Iio_le
The radius marginal of an admissible angular design assigns at most the density envelope times the enclosing planar disk area to a short interval.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w R :
ℝ
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hR :
0 ≤ R
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
Measure.map (fun x : Score => dist x (angularGridCenter M j)) (angularDesignMeasure b cA delta w (angularGridCenter M) omega) (Iio R)
≤ ofReal (5 * R ^ 2)
Proof (Lean source)
-- @node: angularDesignMeasure_radial_Iio_le
lemma angularDesignMeasure_radial_Iio_le
{M : ℕ} (j : Fin M) {b cA delta w R : ℝ}
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw : 0 < w) (hR : 0 ≤ R)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) :
Measure.map (fun x : Score => dist x (angularGridCenter M j))
(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
(Iio R) ≤ ofReal (5 * R ^ 2) := by
rw [Measure.map_apply (by fun_prop) measurableSet_Iio,
angularDesignMeasure_eq_restrict_withDensity,
withDensity_apply _ (measurableSet_Iio.preimage (by fun_prop))]
calc
(∫⁻ x in {x | dist x (angularGridCenter M j) ∈ Iio R},
ofReal
(packingAngularDensity b cA delta w (angularGridCenter M) omega x)
∂volume.restrict (scoreCube (1 / 2))) ≤
∫⁻ _x in {x | dist x (angularGridCenter M j) ∈ Iio R},
ofReal (5 / 4 : ℝ)
∂volume.restrict (scoreCube (1 / 2)) := by
apply lintegral_mono
intro x
exact ENNReal.ofReal_le_ofReal
(packingAngularDensity_mem_Icc hcA hdelta hw hsep omega x).2
_ = ofReal (5 / 4 : ℝ) *
(volume.restrict (scoreCube (1 / 2)))
{x | dist x (angularGridCenter M j) ∈ Iio R} :=
setLIntegral_const _ _
_ ≤ ofReal (5 / 4 : ℝ) *
volume (closedBall (angularGridCenter M j) R) := by
apply mul_le_mul_right
calc
(volume.restrict (scoreCube (1 / 2)))
{x | dist x (angularGridCenter M j) ∈ Iio R} ≤
volume {x | dist x (angularGridCenter M j) ∈ Iio R} :=
Measure.restrict_apply_le _ _
_ ≤ volume (closedBall (angularGridCenter M j) R) := by
apply measure_mono
intro x hx
simpa [Metric.mem_closedBall] using hx.le
_ ≤ ofReal (5 * R ^ 2) := by
rw [EuclideanSpace.volume_closedBall_fin_two, ← ENNReal.ofReal_pow hR,
← ENNReal.ofReal_mul (sq_nonneg R),
← ENNReal.ofReal_mul (by positivity : 0 ≤ (5 / 4 : ℝ))]
apply ENNReal.ofReal_le_ofReal
nlinarith [Real.pi_pos.le, Real.pi_le_four, sq_nonneg R]
theorem angularPacking_radialOutcome_klDiv_le
For the fixed angular constants, one changed bit has one-observation radius--outcome KL at most the declared fourth-order envelope.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
delta w :
ℝ
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
let nu := angularDesignMeasure (1 / 8) 8 delta w (angularGridCenter M) omega let omega' := flipBit j omega let nu' := angularDesignMeasure (1 / 8) 8 delta w (angularGridCenter M) omega' let p := clippedPackingRegression (1 / 8) delta w (angularGridCenter M) omega let p' := clippedPackingRegression (1 / 8) delta w (angularGridCenter M) omega' klDiv (Measure.map (fun z : Score × ℝ => (z.2, dist z.1 (angularGridCenter M j))) (Measure.compProd nu (bernoulliGaussianKernel p (clippedPackingRegression_measurable (1 / 8) delta w (angularGridCenter M) omega)))) (Measure.map (fun z : Score × ℝ => (z.2, dist z.1 (angularGridCenter M j))) (Measure.compProd nu' (bernoulliGaussianKernel p' (clippedPackingRegression_measurable (1 / 8) delta w (angularGridCenter M) omega'))))
≤ ofReal (angularPackingOnePointKLConstant * delta ^ 4)
Proof (Lean source)
-- @node: angularPacking_radialOutcome_klDiv_le
lemma angularPacking_radialOutcome_klDiv_le
{M : ℕ} (j : Fin M) {delta w : ℝ}
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) :
let nu := angularDesignMeasure (1 / 8) 8 delta w
(angularGridCenter M) omega
let omega' := flipBit j omega
let nu' := angularDesignMeasure (1 / 8) 8 delta w
(angularGridCenter M) omega'
let p := clippedPackingRegression (1 / 8) delta w
(angularGridCenter M) omega
let p' := clippedPackingRegression (1 / 8) delta w
(angularGridCenter M) omega'
klDiv
(Measure.map (fun z : Score × ℝ =>
(z.2, dist z.1 (angularGridCenter M j)))
(Measure.compProd nu (bernoulliGaussianKernel p
(clippedPackingRegression_measurable (1 / 8) delta w
(angularGridCenter M) omega))))
(Measure.map (fun z : Score × ℝ =>
(z.2, dist z.1 (angularGridCenter M j)))
(Measure.compProd nu' (bernoulliGaussianKernel p'
(clippedPackingRegression_measurable (1 / 8) delta w
(angularGridCenter M) omega')))) ≤
ofReal (angularPackingOnePointKLConstant * delta ^ 4) := by
dsimp only
let omega' := flipBit j omega
let nu := angularDesignMeasure (1 / 8) 8 delta w (angularGridCenter M) omega
let nu' := angularDesignMeasure (1 / 8) 8 delta w (angularGridCenter M) omega'
let p := clippedPackingRegression (1 / 8) delta w (angularGridCenter M) omega
let p' := clippedPackingRegression (1 / 8) delta w (angularGridCenter M) omega'
let pm := middleHalfClip p
let pm' := middleHalfClip p'
let hp := clippedPackingRegression_measurable (1 / 8) delta w
(angularGridCenter M) omega
let hp' := clippedPackingRegression_measurable (1 / 8) delta w
(angularGridCenter M) omega'
let hpm : Measurable pm := middleHalfClip_measurable hp
let hpm' : Measurable pm' := middleHalfClip_measurable hp'
letI : IsProbabilityMeasure nu := angularDesignMeasure_isProbabilityMeasure
(by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta hw
hwQuarter hsep omega
letI : IsProbabilityMeasure nu' := angularDesignMeasure_isProbabilityMeasure
(by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta hw
hwQuarter hsep omega'
letI : IsMarkovKernel (bernoulliGaussianKernel p hp) :=
bernoulliGaussianKernel_isMarkovKernel p hp
(fun x => (clippedPackingRegression_mem_Icc (1 / 8) delta w
(angularGridCenter M) omega x).1)
(fun x => (clippedPackingRegression_mem_Icc (1 / 8) delta w
(angularGridCenter M) omega x).2)
letI : IsMarkovKernel (bernoulliGaussianKernel p' hp') :=
bernoulliGaussianKernel_isMarkovKernel p' hp'
(fun x => (clippedPackingRegression_mem_Icc (1 / 8) delta w
(angularGridCenter M) omega' x).1)
(fun x => (clippedPackingRegression_mem_Icc (1 / 8) delta w
(angularGridCenter M) omega' x).2)
letI : IsMarkovKernel (bernoulliGaussianKernel pm hpm) :=
bernoulliGaussianKernel_isMarkovKernel pm hpm
(fun x => by linarith [(middleHalfClip_mem_Icc p x).1])
(fun x => by linarith [(middleHalfClip_mem_Icc p x).2])
letI : IsMarkovKernel (bernoulliGaussianKernel pm' hpm') :=
bernoulliGaussianKernel_isMarkovKernel pm' hpm'
(fun x => by linarith [(middleHalfClip_mem_Icc p' x).1])
(fun x => by linarith [(middleHalfClip_mem_Icc p' x).2])
have heq : pm =ᵐ[nu] p := by
exact middleHalfClip_clippedPackingRegression_ae_eq (by norm_num)
(by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta
hdeltaSmall hw hsep omega
have heq' : pm' =ᵐ[nu'] p' := by
exact middleHalfClip_clippedPackingRegression_ae_eq (by norm_num)
(by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta
hdeltaSmall hw hsep omega'
have hk : bernoulliGaussianKernel p hp =ᵐ[nu]
bernoulliGaussianKernel pm hpm := by
filter_upwards [heq] with x hx
ext A hA
simp [bernoulliGaussianKernel, hx]
have hk' : bernoulliGaussianKernel p' hp' =ᵐ[nu']
bernoulliGaussianKernel pm' hpm' := by
filter_upwards [heq'] with x hx
ext A hA
simp [bernoulliGaussianKernel, hx]
change klDiv
(Measure.map (fun z : Score × ℝ =>
(z.2, dist z.1 (angularGridCenter M j)))
(Measure.compProd nu (bernoulliGaussianKernel p hp)))
(Measure.map (fun z : Score × ℝ =>
(z.2, dist z.1 (angularGridCenter M j)))
(Measure.compProd nu' (bernoulliGaussianKernel p' hp'))) ≤ _
rw [Measure.compProd_congr hk, Measure.compProd_congr hk']
have hmap : Measure.map (fun x : Score => dist x (angularGridCenter M j)) nu =
Measure.map (fun x : Score => dist x (angularGridCenter M j)) nu' := by
dsimp [nu, nu', omega']
exact angularDesignMeasure_map_distance_eq j (by norm_num)
(mul_pos (by norm_num) hdelta) (by norm_num) hdelta hw hwQuarter hsep
omega (flipBit j omega)
(by intro k hkj; simp [flipBit, hkj])
have hraw := radialOutcomeLaw_klDiv_le_of_localized_success_bound
nu nu' pm pm' hpm hpm'
(fun x => (middleHalfClip_mem_Icc p x).1)
(fun x => (middleHalfClip_mem_Icc p x).2)
(fun x => (middleHalfClip_mem_Icc p' x).1)
(fun x => (middleHalfClip_mem_Icc p' x).2)
(angularGridCenter M j) hmap (D := 2 * delta) (by positivity)
(E := Iio (128 * delta)) measurableSet_Iio
(by
intro A hA
rw [integral_congr_ae (ae_restrict_of_ae heq),
integral_congr_ae (ae_restrict_of_ae heq')]
dsimp [p, p', nu, nu', omega']
have hd := angularPacking_flip_success_setIntegral_abs_le
(b := (1 / 8 : ℝ)) (cA := 8) (delta := delta) (w := w) j
(by norm_num) (by norm_num) (mul_pos (by norm_num) hdelta)
(by norm_num) hdelta hdeltaSmall hw hwQuarter hsep omega hA
have hrewrite : 2 * (8 * delta) / (1 / 8 : ℝ) = 128 * delta := by ring
rw [hrewrite] at hd
exact hd.trans (by
have hm : 0 ≤ (Measure.map
(fun x : Score => dist x (angularGridCenter M j))
(angularDesignMeasure (1 / 8) 8 delta w (angularGridCenter M) omega)
(A ∩ Iio (128 * delta))).toReal := ENNReal.toReal_nonneg
nlinarith))
have hmass : Measure.map (fun x : Score => dist x (angularGridCenter M j)) nu
(Iio (128 * delta)) ≤ ofReal (5 * (128 * delta) ^ 2) := by
dsimp [nu]
exact angularDesignMeasure_radial_Iio_le j (by norm_num) hdelta hw
(by positivity) hsep omega
apply hraw.trans
calc
ofReal (4 * (2 * delta) ^ 2) *
Measure.map (fun x : Score => dist x (angularGridCenter M j)) nu
(Iio (128 * delta)) ≤
ofReal (4 * (2 * delta) ^ 2) *
ofReal (5 * (128 * delta) ^ 2) := mul_le_mul_right hmass _
_ = ofReal (angularPackingOnePointKLConstant * delta ^ 4) := by
rw [← ENNReal.ofReal_mul (by positivity : 0 ≤ 4 * (2 * delta) ^ 2)]
apply congrArg ofReal
unfold angularPackingOnePointKLConstant
ring
Helpers.AngularPackingTheorem 18 declarations This downstream module states the complete finite packing certificate and its eventual fixed-constant construction.
Angular hard-family certificate
This downstream module states the complete finite packing certificate and its
eventual fixed-constant construction. Keeping it downstream of AngularLaw
lets the assembly use the faithful CTY-law constructor without an import cycle.
def AngularPackingAt
The full finite hard-family certificate at sample size n, with constants fixed outside n.
Definition (Lean source)
def AngularPackingAt
(n q : ℕ) (L c0 c1 cwLow cwHigh cRadial alpha : ℝ) : Prop :=
∃ M : ℕ, ∃ w m : ℝ,
∃ centers : Fin M → Score,
∃ laws : (Fin M → Bool) → CtyLaw,
∃ values : Fin M → Bool → ℝ,
(c0 * rpow (frontierRate n) (-(1 : ℝ) / q) ≤ M) ∧
(cwLow * rpow (frontierRate n) ((1 : ℝ) / q) ≤ w ∧
w ≤ cwHigh * rpow (frontierRate n) ((1 : ℝ) / q)) ∧
(∀ j, centers j ∈ frontier packingSquare) ∧
(∀ i j, i ≠ j →
dist (centers i) (centers j) ≥ cwLow * rpow (frontierRate n) ((1 : ℝ) / q)) ∧
(∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j)) ∧
(∀ omega, CtyNonparametricClass q L (laws omega)) ∧
(∀ omega, (laws omega).support = packingSquare) ∧
(∀ omega j,
Measure.map snd (laws omega).law (packingCell centers w j) =
ofReal m) ∧
(∀ omega omega' j, omega j = omega' j →
(laws omega).law.restrict
{o | o.2 ∈ packingCell centers w j} =
(laws omega').law.restrict
{o | o.2 ∈ packingCell centers w j}) ∧
(∀ omega omega',
(laws omega).law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j} =
(laws omega').law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}) ∧
(∀ omega j,
(laws omega).mu (centers j) = values j (omega j)) ∧
(∀ j, |values j true - values j false| ≥ c1 * frontierRate n) ∧
(∀ omega j,
Measure.map (fun o : Observation => dist o.2 (centers j)) (laws omega).law =
Measure.map (fun o : Observation => dist o.2 (centers j))
(laws (flipBit j omega)).law) ∧
(∀ omega j,
(onePointDistanceLaw (laws omega) (centers j)).restrict
{z | cRadial * frontierRate n ≤ z.2} =
(onePointDistanceLaw (laws (flipBit j omega))
(centers j)).restrict {z | cRadial * frontierRate n ≤ z.2}) ∧
∀ omega j,
klDiv
(compressedSampleLaw (laws omega) n (centers j))
(compressedSampleLaw (laws (flipBit j omega)) n (centers j)) ≤
ofReal (alpha * log M)
theorem angularPackingCtyLaw_cell_mass_eq_volume
The score marginal of a faithful angular packing law assigns each grid cell exactly its Lebesgue volume, independently of the Boolean vertex.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
Measure.map snd (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0 hw hsep).law (packingCell (angularGridCenter M) w j)
Proof (Lean source)
-- @node: angularPackingCtyLaw_cell_mass_eq_volume
lemma angularPackingCtyLaw_cell_mass_eq_volume {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw0 : 0 < w)
(hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) :
Measure.map snd
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0
hw hsep).law
(packingCell (angularGridCenter M) w j) =
volume (packingCell (angularGridCenter M) w j) := by
rw [angularPackingCtyLaw_map_snd]
simpa [packingCell, packingSquare] using
angularDesignMeasure_gridCell_eq_volume j hb hscale hcA hdelta hw0 hw hsep omega
theorem angularGrid_packingCell_volume_eq
All lower-edge grid cells have the same Lebesgue volume. Translation along the lower edge carries one closed half-disc exactly onto any other and preserves planar Lebesgue measure.
Formal statement
hypotheses
conclusion
Proof (Lean source)
-- @node: angularGrid_packingCell_volume_eq
lemma angularGrid_packingCell_volume_eq {M : ℕ} (i j : Fin M) {w : ℝ}
(hw : w ≤ 1 / 4) :
volume (packingCell (angularGridCenter M) w i) =
volume (packingCell (angularGridCenter M) w j) := by
let d : Score := angularGridCenter M j - angularGridCenter M i
let T : Score → Score := fun x => d + x
have hT : MeasurableEmbedding T := (Homeomorph.addLeft d).measurableEmbedding
have hmp : MeasurePreserving T (volume : Measure Score) volume :=
measurePreserving_add_left volume d
have himage : T '' packingCell (angularGridCenter M) w i =
packingCell (angularGridCenter M) w j := by
ext x
constructor
· rintro ⟨y, hy, rfl⟩
apply (mem_angularGrid_packingCell_iff_closedUpperHalfDisc j hw _).mpr
have hi :=
(mem_angularGrid_packingCell_iff_closedUpperHalfDisc i hw y).mp hy
refine ⟨?_, ?_⟩
· simpa [T, d, scoreCoordinates, angularGridCenter_apply_one] using hi.1
· rw [show scoreCoordinates (T y) - scoreCoordinates (angularGridCenter M j) =
scoreCoordinates y - scoreCoordinates (angularGridCenter M i) by
ext <;> simp [T, d, scoreCoordinates] <;> ring]
exact hi.2
· intro hx
let y : Score := -d + x
have hy : y ∈ packingCell (angularGridCenter M) w i := by
apply (mem_angularGrid_packingCell_iff_closedUpperHalfDisc i hw _).mpr
have hj :=
(mem_angularGrid_packingCell_iff_closedUpperHalfDisc j hw x).mp hx
refine ⟨?_, ?_⟩
· simpa [y, d, scoreCoordinates, angularGridCenter_apply_one] using hj.1
· rw [show scoreCoordinates y - scoreCoordinates (angularGridCenter M i) =
scoreCoordinates x - scoreCoordinates (angularGridCenter M j) by
ext <;> simp [y, d, scoreCoordinates] <;> ring]
exact hj.2
refine ⟨y, hy, ?_⟩
simp [T, y]
have hC : MeasurableSet (packingCell (angularGridCenter M) w i) :=
Metric.isClosed_closedBall.measurableSet.inter (scoreCube_measurableSet _)
rw [← himage]
symm
calc
volume (T '' packingCell (angularGridCenter M) w i) =
Measure.map T volume (T '' packingCell (angularGridCenter M) w i) := by
rw [hmp.map_eq]
_ = volume (packingCell (angularGridCenter M) w i) := by
rw [Measure.map_apply hT.measurable (hT.measurableSet_image' hC),
hT.injective.preimage_image]
theorem angularPackingCtyLaw_center_value_certificate
At the selected amplitude, the faithful angular laws take their declared Boolean values at every grid center, and the two values have the exact fixed frontier-rate separation.
Formal statement
hypotheses
M n :
ℕ
hn :
2 ≤ n
b cA w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * angularPackingDelta n
hcA :
8 ≤ cA
hdelta :
0 < angularPackingDelta n
hdeltaSmall :
angularPackingDelta n ≤ 1 / 8
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
(∀ omega j, (angularPackingCtyLaw b cA (angularPackingDelta n) w omega hb hscale hcA hdelta hw0 hw hsep).mu (angularGridCenter M j) = packingCenterValue b (angularPackingDelta n) (angularGridCenter M) j (omega j)) ∧
(∀ j, |packingCenterValue b (angularPackingDelta n) (angularGridCenter M) j true - packingCenterValue b (angularPackingDelta n) (angularGridCenter M) j false| = (1 / 1024 : ℝ) * frontierRate n)
Proof (Lean source)
-- @node: angularPackingCtyLaw_center_value_certificate
lemma angularPackingCtyLaw_center_value_certificate {M n : ℕ} (hn : 2 ≤ n)
{b cA w : ℝ} (hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * angularPackingDelta n) (hcA : 8 ≤ cA)
(hdelta : 0 < angularPackingDelta n)
(hdeltaSmall : angularPackingDelta n ≤ 1 / 8)
(hw0 : 0 < w) (hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k)) :
(∀ omega j,
(angularPackingCtyLaw b cA (angularPackingDelta n) w omega hb hscale hcA
hdelta hw0 hw hsep).mu (angularGridCenter M j) =
packingCenterValue b (angularPackingDelta n) (angularGridCenter M) j (omega j)) ∧
(∀ j,
|packingCenterValue b (angularPackingDelta n) (angularGridCenter M) j true -
packingCenterValue b (angularPackingDelta n) (angularGridCenter M) j false| =
(1 / 1024 : ℝ) * frontierRate n) := by
constructor
· intro omega j
exact angularPackingCtyLaw_mu_center hb hbSmall hscale hcA hdelta
hdeltaSmall hw0 hw hsep j
· exact packingCenterValue_frontierRate_separation hn b (angularGridCenter M)
theorem angularPackingCtyLaw_locality_certificate
The faithful angular laws satisfy both exact locality clauses appearing in AngularPackingAt: a cell sees only its own bit, while the law off the union of cells is independent of the entire Boolean vertex.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
(∀ omega omega' j, omega j = omega' j → (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep).law.restrict {o | o.2 ∈ packingCell (angularGridCenter M) w j} = (angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw hwQuarter hsep).law.restrict {o | o.2 ∈ packingCell (angularGridCenter M) w j}) ∧
(∀ omega omega', (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep).law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell (angularGridCenter M) w j} = (angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw hwQuarter hsep).law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell (angularGridCenter M) w j})
Proof (Lean source)
-- @node: angularPackingCtyLaw_locality_certificate
lemma angularPackingCtyLaw_locality_certificate {M : ℕ}
{b cA delta w : ℝ}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k)) :
(∀ omega omega' j, omega j = omega' j →
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep).law.restrict
{o | o.2 ∈ packingCell (angularGridCenter M) w j} =
(angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw
hwQuarter hsep).law.restrict
{o | o.2 ∈ packingCell (angularGridCenter M) w j}) ∧
(∀ omega omega',
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep).law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j,
packingCell (angularGridCenter M) w j} =
(angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw
hwQuarter hsep).law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j,
packingCell (angularGridCenter M) w j}) := by
constructor
· intro omega omega' j hbit
exact angularPackingCtyLaw_restrict_cell_eq hb hbSmall hscale hcA hdelta
hdeltaSmall hw hwQuarter hsep hbit
· intro omega omega'
exact angularPackingCtyLaw_restrict_off_cells_eq hb hbSmall hscale hcA
hdelta hdeltaSmall hw hwQuarter hsep omega omega'
theorem angularPackingCtyLaw_map_distance_eq
Adjacent faithful angular laws have the same complete unsigned-radius law at the grid center whose bit is changed.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
hother :
∀ k
if
k ≠ j
then
omega k = omega' k
conclusion
Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j)) (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0 hw hsep).law
= Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j)) (angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw0 hw hsep).law
Proof (Lean source)
-- @node: angularPackingCtyLaw_map_distance_eq
lemma angularPackingCtyLaw_map_distance_eq {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw0 : 0 < w)
(hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega omega' : Fin M → Bool)
(hother : ∀ k, k ≠ j → omega k = omega' k) :
Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j))
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0
hw hsep).law =
Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j))
(angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw0
hw hsep).law := by
let radial : Score → ℝ := fun x => dist x (angularGridCenter M j)
have hscore := angularDesignMeasure_map_distance_eq j hb hscale hcA hdelta
hw0 hw hsep omega omega' hother
calc
Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j))
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0
hw hsep).law =
Measure.map radial (Measure.map snd
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0
hw hsep).law) := by
rw [Measure.map_map (by fun_prop) (by fun_prop)]
rfl
_ = Measure.map radial
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) := by
rw [angularPackingCtyLaw_map_snd]
_ = Measure.map radial
(angularDesignMeasure b cA delta w (angularGridCenter M) omega') := hscore
_ = Measure.map radial (Measure.map snd
(angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw0
hw hsep).law) := by
rw [angularPackingCtyLaw_map_snd]
_ = Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j))
(angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw0
hw hsep).law := by
rw [Measure.map_map (by fun_prop) (by fun_prop)]
rfl
theorem angularPackingCtyLaw_flip_map_distance_eq
Flipping one packing bit preserves the full unsigned-radius law at the corresponding grid center.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j)) (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0 hw hsep).law
= Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j)) (angularPackingCtyLaw b cA delta w (flipBit j omega) hb hscale hcA hdelta hw0 hw hsep).law
Proof (Lean source)
-- @node: angularPackingCtyLaw_flip_map_distance_eq
lemma angularPackingCtyLaw_flip_map_distance_eq {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw0 : 0 < w)
(hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) :
Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j))
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0
hw hsep).law =
Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j))
(angularPackingCtyLaw b cA delta w (flipBit j omega)
hb hscale hcA hdelta hw0 hw hsep).law := by
apply angularPackingCtyLaw_map_distance_eq j hb hscale hcA hdelta hw0 hw hsep
omega (flipBit j omega)
intro k hkj
simp [flipBit, hkj]
theorem angularPackingCtyLaw_mem_nonparametricClass_of_scaling_bounds
The derivative-scaling leaves for the normalized bump assemble into the complete CTY-class certificate for every vertex of the angular family. This is the Hölder part of the final packing construction; none of its bounds depend on the number of cells or on the Boolean vertex.
Formal statement
hypotheses
M q :
ℕ
L b cA delta w :
ℝ
hq :
1 ≤ q
hL :
4 ≤ L
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscalePos :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
C :
ℕ → ℝ
hC0 :
∀ j, 0 ≤ C j
hC :
∀ j z, ‖iteratedFDeriv ℝ j packingBump z‖ ≤ C j
hscale :
∀ j
if
j ≤ q
then
|delta| * (w⁻¹) ^ j * C j ≤ 1
conclusion
CtyNonparametricClass q L (angularPackingCtyLaw b cA delta w omega hb hscalePos hcA hdelta hw hwQuarter hsep)
Proof (Lean source)
-- @node: angularPackingCtyLaw_mem_nonparametricClass_of_scaling_bounds
lemma angularPackingCtyLaw_mem_nonparametricClass_of_scaling_bounds
{M q : ℕ} {L b cA delta w : ℝ}
(hq : 1 ≤ q) (hL : 4 ≤ L)
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscalePos : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(C : ℕ → ℝ)
(hC0 : ∀ j, 0 ≤ C j)
(hC : ∀ j z, ‖iteratedFDeriv ℝ j packingBump z‖ ≤ C j)
(hscale : ∀ j, j ≤ q → |delta| * (w⁻¹) ^ j * C j ≤ 1) :
∀ omega : Fin M → Bool,
CtyNonparametricClass q L
(angularPackingCtyLaw b cA delta w omega hb hscalePos hcA hdelta hw
hwQuarter hsep) := by
intro omega
apply angularPackingCtyLaw_mem_nonparametricClass_of_holder omega hq hL hb
hbSmall hscalePos hcA hdelta hdeltaSmall hw hwQuarter hsep
simpa [packingSquare] using
clippedPackingRegression_mem_holder_of_scaling_bounds hq hL hbSmall
hdelta.le hdeltaSmall hw hsep omega C hC0 hC hscale
theorem angularPackingCtyLaw_radial_representation_certificate
The radial-cancellation and disintegration leaves jointly give the common radius marginal and explicit radial fibre representations for both endpoints of every adjacent edge of the Boolean hypercube.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
let P := angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep let omega' := flipBit j omega let P' := angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw hwQuarter hsep Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j)) P.law
onePointDistanceLaw P (angularGridCenter M j)
= Measure.map (fun z : Score × ℝ => (z.2, dist z.1 (angularGridCenter M j))) (Measure.compProd (angularDesignMeasure b cA delta w (angularGridCenter M) omega) (bernoulliGaussianKernel (clippedPackingRegression b delta w (angularGridCenter M) omega) (clippedPackingRegression_measurable b delta w (angularGridCenter M) omega))) ∧
onePointDistanceLaw P' (angularGridCenter M j)
= Measure.map (fun z : Score × ℝ => (z.2, dist z.1 (angularGridCenter M j))) (Measure.compProd (angularDesignMeasure b cA delta w (angularGridCenter M) omega') (bernoulliGaussianKernel (clippedPackingRegression b delta w (angularGridCenter M) omega') (clippedPackingRegression_measurable b delta w (angularGridCenter M) omega')))
Proof (Lean source)
-- @node: angularPackingCtyLaw_radial_representation_certificate
lemma angularPackingCtyLaw_radial_representation_certificate
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) :
let P := angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep
let omega' := flipBit j omega
let P' := angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw
hwQuarter hsep
Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j)) P.law =
Measure.map (fun o : Observation => dist o.2 (angularGridCenter M j)) P'.law ∧
onePointDistanceLaw P (angularGridCenter M j) =
Measure.map
(fun z : Score × ℝ => (z.2, dist z.1 (angularGridCenter M j)))
(Measure.compProd
(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
(bernoulliGaussianKernel
(clippedPackingRegression b delta w (angularGridCenter M) omega)
(clippedPackingRegression_measurable b delta w
(angularGridCenter M) omega))) ∧
onePointDistanceLaw P' (angularGridCenter M j) =
Measure.map
(fun z : Score × ℝ => (z.2, dist z.1 (angularGridCenter M j)))
(Measure.compProd
(angularDesignMeasure b cA delta w (angularGridCenter M) omega')
(bernoulliGaussianKernel
(clippedPackingRegression b delta w (angularGridCenter M) omega')
(clippedPackingRegression_measurable b delta w
(angularGridCenter M) omega'))) := by
dsimp only
constructor
· exact angularPackingCtyLaw_flip_map_distance_eq j hb hscale hcA hdelta hw
hwQuarter hsep omega
constructor
· exact angularPackingCtyLaw_onePointDistanceLaw_eq_map_compProd hb hscale
hcA hdelta hw hwQuarter hsep omega (angularGridCenter M j)
· exact angularPackingCtyLaw_onePointDistanceLaw_eq_map_compProd hb hscale
hcA hdelta hw hwQuarter hsep (flipBit j omega)
(angularGridCenter M j)
theorem packingCenterValue_scaledDelta_separation
The two Boolean regression values at a packing center have exactly the smoothness-normalized frontier-rate separation.
Formal statement
hypotheses
conclusion
= (1 / (1024 * packingBumpDerivativeScale q)) * frontierRate n
Proof (Lean source)
-- @node: packingCenterValue_scaledDelta_separation
lemma packingCenterValue_scaledDelta_separation {M n q : ℕ}
(hn : 2 ≤ n) (centers : Fin M → Score) (j : Fin M) :
|packingCenterValue (1 / 8) (angularPackingScaledDelta q n) centers j true -
packingCenterValue (1 / 8) (angularPackingScaledDelta q n) centers j false| =
(1 / (1024 * packingBumpDerivativeScale q)) * frontierRate n := by
rw [packingCenterValue_true_false]
· exact angularPackingScaledDelta_eq_scale_mul_frontierRate q n
· unfold angularPackingScaledDelta
exact div_nonneg (frontierRate_pos hn).le
(mul_nonneg (by norm_num) (packingBumpDerivativeScale_pos q).le)
theorem angularPackingScaledDelta_derivative_scaling
For an admissible sample size, the normalized amplitude and frontier-rate bandwidth satisfy every derivative scaling inequality through order q.
Formal statement
hypotheses
conclusion
∀ j
if
j ≤ q
then
≤ 1
Proof (Lean source)
-- @node: angularPackingScaledDelta_derivative_scaling
lemma angularPackingScaledDelta_derivative_scaling (n q : ℕ)
(hq : 1 ≤ q) (hn : 2 ≤ n) (hrate : frontierRate n ≤ 1) :
∀ j, j ≤ q →
|angularPackingScaledDelta q n| *
((angularGridRadius n q)⁻¹) ^ j * packingBumpDerivativeBound j ≤ 1 := by
intro j hjq
let r := frontierRate n
let w := angularGridRadius n q
let K := 1024 * packingBumpDerivativeScale q
have hr0 : 0 < r := frontierRate_pos hn
have hK0 : 0 < K := by
dsimp [K]
exact mul_pos (by norm_num) (packingBumpDerivativeScale_pos q)
have hw0 : 0 < w := Real.rpow_pos_of_pos hr0 _
have hexp0 : 0 ≤ (1 : ℝ) / q := by positivity
have hw1 : w ≤ 1 := by
exact Real.rpow_le_one hr0.le hrate hexp0
have hwq : w ^ q = r := by
dsimp [w, angularGridRadius, r]
simpa [one_div] using
(Real.rpow_inv_natCast_pow hr0.le (show q ≠ 0 by omega))
have hpows : w ^ q ≤ w ^ j :=
pow_le_pow_of_le_one hw0.le hw1 hjq
have hradial : r * (w⁻¹) ^ j ≤ 1 := by
rw [inv_pow, ← hwq]
simpa [div_eq_mul_inv] using (div_le_one (pow_pos hw0 j)).2 hpows
have hfrac0 : 0 ≤ packingBumpDerivativeBound j / K :=
div_nonneg (packingBumpDerivativeBound_nonneg j) hK0.le
have hfrac1 : packingBumpDerivativeBound j / K ≤ 1 :=
(div_le_one hK0).2 (by
have hscale0 := (packingBumpDerivativeScale_pos q).le
have hj := packingBumpDerivativeBound_le_scale hjq
dsimp [K]
nlinarith)
have hmul := mul_le_one₀ hradial hfrac0 hfrac1
have hdelta : |angularPackingScaledDelta q n| = r / K := by
change |r / K| = r / K
exact abs_of_pos (div_pos hr0 hK0)
rw [hdelta]
calc
(r / K) * w⁻¹ ^ j * packingBumpDerivativeBound j =
(r * w⁻¹ ^ j) * (packingBumpDerivativeBound j / K) := by ring
_ ≤ 1 := hmul
theorem angularPackingCtyLaw_mem_class_scaledDelta
The smoothness-normalized amplitude turns the derivative/scaling leaves into the complete Hölder-class certificate for an angular packing vertex.
Formal statement
hypotheses
M n q :
ℕ
L :
ℝ
hq :
1 ≤ q
hL :
4 ≤ L
hn :
2 ≤ n
hrate :
frontierRate n ≤ 1
hdelta :
0 < angularPackingScaledDelta q n
hdeltaSmall :
angularPackingScaledDelta q n ≤ 1 / 8
hw :
0 < angularGridRadius n q
hwQuarter :
angularGridRadius n q ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
conclusion
CtyNonparametricClass q L (angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n) (angularGridRadius n q) omega (by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta hw hwQuarter hsep)
Proof (Lean source)
-- @node: angularPackingCtyLaw_mem_class_scaledDelta
lemma angularPackingCtyLaw_mem_class_scaledDelta
{M n q : ℕ} {L : ℝ} (hq : 1 ≤ q) (hL : 4 ≤ L) (hn : 2 ≤ n)
(hrate : frontierRate n ≤ 1)
(hdelta : 0 < angularPackingScaledDelta q n)
(hdeltaSmall : angularPackingScaledDelta q n ≤ 1 / 8)
(hw : 0 < angularGridRadius n q)
(hwQuarter : angularGridRadius n q ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * angularGridRadius n q ≤
dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) :
CtyNonparametricClass q L
(angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n)
(angularGridRadius n q) omega (by norm_num)
(mul_pos (by norm_num) hdelta) (by norm_num) hdelta hw hwQuarter hsep) := by
apply angularPackingCtyLaw_mem_nonparametricClass_of_scaling_bounds hq hL
(by norm_num) (by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num)
hdelta hdeltaSmall hw hwQuarter hsep packingBumpDerivativeBound
packingBumpDerivativeBound_nonneg
packingBump_iteratedFDeriv_le_derivativeBound
exact angularPackingScaledDelta_derivative_scaling n q hq hn hrate
theorem angularPackingScaledDelta_eventually_admissible
Eventually the smoothness-normalized amplitude is positive, stays inside the regression envelope, and its complete angular-cancellation radius lies inside the frontier-rate cell bandwidth.
Formal statement
hypotheses
q :
ℕ
hq :
1 ≤ q
conclusion
∀ᶠ n in atTop,
2 ≤ n ∧
frontierRate n ≤ 1 ∧
0 < angularPackingScaledDelta q n ∧
angularPackingScaledDelta q n ≤ 1 / 8 ∧
2 * (8 * angularPackingScaledDelta q n) ≤ (1 / 8 : ℝ) * angularGridRadius n q
Proof (Lean source)
-- @node: angularPackingScaledDelta_eventually_admissible
lemma angularPackingScaledDelta_eventually_admissible (q : ℕ) (hq : 1 ≤ q) :
∀ᶠ n in atTop,
2 ≤ n ∧ frontierRate n ≤ 1 ∧
0 < angularPackingScaledDelta q n ∧
angularPackingScaledDelta q n ≤ 1 / 8 ∧
2 * (8 * angularPackingScaledDelta q n) ≤
(1 / 8 : ℝ) * angularGridRadius n q := by
filter_upwards [eventually_ge_atTop (2 : ℕ), frontierRate_eventually_le_one]
with n hn hrate
have hr0 : 0 < frontierRate n := frontierRate_pos hn
have hK0 : 0 < packingBumpDerivativeScale q := packingBumpDerivativeScale_pos q
have hK1 : 1 ≤ packingBumpDerivativeScale q := by
unfold packingBumpDerivativeScale
have hsum : 0 ≤ ∑ j ∈ range (q + 1), packingBumpDerivativeBound j :=
sum_nonneg fun j _ => packingBumpDerivativeBound_nonneg j
linarith
have hrw : frontierRate n ≤ angularGridRadius n q :=
frontierRate_le_angularGridRadius n q hq hn hrate
have hdelta : angularPackingScaledDelta q n =
frontierRate n / (1024 * packingBumpDerivativeScale q) := rfl
refine ⟨hn, hrate, ?_, ?_, ?_⟩
· rw [hdelta]
positivity
· rw [hdelta]
apply (div_le_iff₀ (by positivity : 0 < 1024 * packingBumpDerivativeScale q)).2
nlinarith
· rw [hdelta]
rw [show 2 * (8 * (frontierRate n /
(1024 * packingBumpDerivativeScale q))) =
frontierRate n / (64 * packingBumpDerivativeScale q) by ring]
apply (div_le_iff₀
(by positivity : 0 < 64 * packingBumpDerivativeScale q)).2
calc
frontierRate n ≤ angularGridRadius n q := hrw
_ ≤ (1 / 8 : ℝ) * angularGridRadius n q *
(64 * packingBumpDerivativeScale q) := by
have hw0 : 0 ≤ angularGridRadius n q := (lt_of_lt_of_le hr0 hrw).le
have hmul := mul_le_mul_of_nonneg_left hK1 hw0
nlinarith
theorem angularPackingScaledDelta_cutoff_fully_active
Every radius beyond one eighth of the frontier rate lies in the region where the angular cutoff is fully active for the smoothness-normalized amplitude. This is the numerical bridge used by radial outcome cancellation.
Formal statement
hypotheses
conclusion
2 * (8 * angularPackingScaledDelta q n) ≤ (1 / 8 : ℝ) * r
Proof (Lean source)
-- @node: angularPackingScaledDelta_cutoff_fully_active
lemma angularPackingScaledDelta_cutoff_fully_active {q n : ℕ} {r : ℝ}
(hn : 2 ≤ n) (hr : (1 / 8 : ℝ) * frontierRate n ≤ r) :
2 * (8 * angularPackingScaledDelta q n) ≤ (1 / 8 : ℝ) * r := by
have hscale : 1 ≤ packingBumpDerivativeScale q := by
unfold packingBumpDerivativeScale
have hsum : 0 ≤ ∑ j ∈ range (q + 1), packingBumpDerivativeBound j :=
sum_nonneg fun j _ => packingBumpDerivativeBound_nonneg j
linarith
have hrate0 : 0 ≤ frontierRate n := (frontierRate_pos hn).le
rw [angularPackingScaledDelta]
rw [show 2 * (8 * (frontierRate n /
(1024 * packingBumpDerivativeScale q))) =
frontierRate n / (64 * packingBumpDerivativeScale q) by ring]
apply (div_le_iff₀
(by positivity : 0 < 64 * packingBumpDerivativeScale q)).2
have hr0 : 0 ≤ r := by nlinarith
have hrs : r ≤ r * packingBumpDerivativeScale q := by
simpa using mul_le_mul_of_nonneg_left hscale hr0
nlinarith [hr, hrs]
theorem angularPackingScaledDelta_cutoff_active_on_tail
On every measurable tail beginning at one eighth of the frontier rate, the scaled angular cutoff is fully active. This is the exact quantified form needed by the radial-slice cancellation argument.
Formal statement
hypotheses
conclusion
∀ r ∈ A, 2 * (8 * angularPackingScaledDelta q n) ≤ (1 / 8 : ℝ) * r
Proof (Lean source)
-- @node: angularPackingScaledDelta_cutoff_active_on_tail
lemma angularPackingScaledDelta_cutoff_active_on_tail {q n : ℕ} (hn : 2 ≤ n)
{A : Set ℝ} (hA : A ⊆ Ici ((1 / 8 : ℝ) * frontierRate n)) :
∀ r ∈ A,
2 * (8 * angularPackingScaledDelta q n) ≤ (1 / 8 : ℝ) * r := by
intro r hr
exact angularPackingScaledDelta_cutoff_fully_active hn (hA hr)
theorem angularPackingAt_of_certificates
Assembly interface for the final angular certificate. It isolates the three genuinely radial obligations (common cell mass, equality off the active radius, and compressed KL) from the already-closed geometry, class, locality, and center-value parts of the construction.
Formal statement
hypotheses
n q M :
ℕ
L c0 c1 cwLow cwHigh cRadial alpha w m :
ℝ
hM :
c0 * rpow (frontierRate n) (-(1 : ℝ) / q) ≤ M
hw :
cwLow * rpow (frontierRate n) ((1 : ℝ) / q) ≤ w ∧
w ≤ cwHigh * rpow (frontierRate n) ((1 : ℝ) / q)
hcenters :
∀ j, centers j ∈ frontier packingSquare
hsep :
∀ i j
if
i ≠ j
then
hdisjoint :
∀ i j
if
i ≠ j
then
hclass :
∀ omega, CtyNonparametricClass q L (laws omega)
hsupport :
∀ omega, (laws omega).support = packingSquare
hmass :
∀ omega j,
hcell :
∀ omega omega' j
if
omega j = omega' j
then
(laws omega).law.restrict {o | o.2 ∈ packingCell centers w j}
= (laws omega').law.restrict {o | o.2 ∈ packingCell centers w j}
hoff :
∀ omega omega',
(laws omega).law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
= (laws omega').law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
hvalue :
∀ omega j, (laws omega).mu (centers j) = values j (omega j)
hvalueSep :
hradius :
∀ omega j,
Measure.map (fun o : Observation => dist o.2 (centers j)) (laws omega).law
houtside :
∀ omega j,
= (onePointDistanceLaw (laws (flipBit j omega)) (centers j)).restrict {z | cRadial * frontierRate n ≤ z.2}
hkl :
∀ omega j,
klDiv (compressedSampleLaw (laws omega) n (centers j)) (compressedSampleLaw (laws (flipBit j omega)) n (centers j))
conclusion
AngularPackingAt n q L c0 c1 cwLow cwHigh cRadial alpha
Proof (Lean source)
-- @node: angularPackingAt_of_certificates
lemma angularPackingAt_of_certificates
{n q M : ℕ} {L c0 c1 cwLow cwHigh cRadial alpha w m : ℝ}
{centers : Fin M → Score} {laws : (Fin M → Bool) → CtyLaw}
{values : Fin M → Bool → ℝ}
(hM : c0 * rpow (frontierRate n) (-(1 : ℝ) / q) ≤ M)
(hw : cwLow * rpow (frontierRate n) ((1 : ℝ) / q) ≤ w ∧
w ≤ cwHigh * rpow (frontierRate n) ((1 : ℝ) / q))
(hcenters : ∀ j, centers j ∈ frontier packingSquare)
(hsep : ∀ i j, i ≠ j →
dist (centers i) (centers j) ≥
cwLow * rpow (frontierRate n) ((1 : ℝ) / q))
(hdisjoint : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(hclass : ∀ omega, CtyNonparametricClass q L (laws omega))
(hsupport : ∀ omega, (laws omega).support = packingSquare)
(hmass : ∀ omega j,
Measure.map snd (laws omega).law (packingCell centers w j) =
ofReal m)
(hcell : ∀ omega omega' j, omega j = omega' j →
(laws omega).law.restrict {o | o.2 ∈ packingCell centers w j} =
(laws omega').law.restrict {o | o.2 ∈ packingCell centers w j})
(hoff : ∀ omega omega',
(laws omega).law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j} =
(laws omega').law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j})
(hvalue : ∀ omega j, (laws omega).mu (centers j) = values j (omega j))
(hvalueSep : ∀ j,
|values j true - values j false| ≥ c1 * frontierRate n)
(hradius : ∀ omega j,
Measure.map (fun o : Observation => dist o.2 (centers j)) (laws omega).law =
Measure.map (fun o : Observation => dist o.2 (centers j))
(laws (flipBit j omega)).law)
(houtside : ∀ omega j,
(onePointDistanceLaw (laws omega) (centers j)).restrict
{z | cRadial * frontierRate n ≤ z.2} =
(onePointDistanceLaw (laws (flipBit j omega))
(centers j)).restrict {z | cRadial * frontierRate n ≤ z.2})
(hkl : ∀ omega j,
klDiv
(compressedSampleLaw (laws omega) n (centers j))
(compressedSampleLaw (laws (flipBit j omega)) n
(centers j)) ≤ ofReal (alpha * log M)) :
AngularPackingAt n q L c0 c1 cwLow cwHigh cRadial alpha := by
exact ⟨M, w, m, centers, laws, values, hM, hw, hcenters, hsep, hdisjoint,
hclass, hsupport, hmass, hcell, hoff, hvalue, hvalueSep, hradius, houtside,
hkl⟩
theorem angularPackingAt_scaledDelta_of_radial_certificates
At the smoothness-normalized amplitude, the already-proved geometric, Hölder, locality, support, center-value, and radial-marginal leaves reduce the full angular packing certificate to its three remaining radial estimates.
Formal statement
hypotheses
n q :
ℕ
L cRadial alpha :
ℝ
hq :
1 ≤ q
hL :
4 ≤ L
hn :
2 ≤ n
hrate :
frontierRate n ≤ 1
hsmall :
angularGridRadius n q ≤ 1 / 24
hdelta :
0 < angularPackingScaledDelta q n
hdeltaSmall :
angularPackingScaledDelta q n ≤ 1 / 8
houtside :
∀ omega j,
(onePointDistanceLaw (angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n) (angularGridRadius n q) omega (by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta (rpow_pos_of_pos (frontierRate_pos hn) _) (by linarith) (fun i k hik => (angularGridSize_geometry (angularGridRadius n q) (rpow_pos_of_pos (frontierRate_pos hn) _) hsmall).2.2 i k hik |>.1)) (angularGridCenter (angularGridSize (angularGridRadius n q)) j)).restrict {z | cRadial * frontierRate n ≤ z.2}
= (onePointDistanceLaw (angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n) (angularGridRadius n q) (flipBit j omega) (by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta (rpow_pos_of_pos (frontierRate_pos hn) _) (by linarith) (fun i k hik => (angularGridSize_geometry (angularGridRadius n q) (rpow_pos_of_pos (frontierRate_pos hn) _) hsmall).2.2 i k hik |>.1)) (angularGridCenter (angularGridSize (angularGridRadius n q)) j)).restrict {z | cRadial * frontierRate n ≤ z.2}
hkl :
∀ omega j,
klDiv (compressedSampleLaw (angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n) (angularGridRadius n q) omega (by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta (rpow_pos_of_pos (frontierRate_pos hn) _) (by linarith) (fun i k hik => (angularGridSize_geometry (angularGridRadius n q) (rpow_pos_of_pos (frontierRate_pos hn) _) hsmall).2.2 i k hik |>.1)) n (angularGridCenter (angularGridSize (angularGridRadius n q)) j)) (compressedSampleLaw (angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n) (angularGridRadius n q) (flipBit j omega) (by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta (rpow_pos_of_pos (frontierRate_pos hn) _) (by linarith) (fun i k hik => (angularGridSize_geometry (angularGridRadius n q) (rpow_pos_of_pos (frontierRate_pos hn) _) hsmall).2.2 i k hik |>.1)) n (angularGridCenter (angularGridSize (angularGridRadius n q)) j))
conclusion
AngularPackingAt n q L (1 / 24) (1 / (1024 * packingBumpDerivativeScale q)) 1 1 cRadial alpha
Proof (Lean source)
-- @node: angularPackingAt_scaledDelta_of_radial_certificates
lemma angularPackingAt_scaledDelta_of_radial_certificates
{n q : ℕ} {L cRadial alpha : ℝ}
(hq : 1 ≤ q) (hL : 4 ≤ L) (hn : 2 ≤ n)
(hrate : frontierRate n ≤ 1)
(hsmall : angularGridRadius n q ≤ 1 / 24)
(hdelta : 0 < angularPackingScaledDelta q n)
(hdeltaSmall : angularPackingScaledDelta q n ≤ 1 / 8)
(houtside : ∀ omega j,
(onePointDistanceLaw
(angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n)
(angularGridRadius n q) omega (by norm_num)
(mul_pos (by norm_num) hdelta) (by norm_num) hdelta
(rpow_pos_of_pos (frontierRate_pos hn) _)
(by linarith) (fun i k hik =>
(angularGridSize_geometry (angularGridRadius n q)
(rpow_pos_of_pos (frontierRate_pos hn) _) hsmall).2.2 i k hik |>.1))
(angularGridCenter (angularGridSize (angularGridRadius n q)) j)).restrict
{z | cRadial * frontierRate n ≤ z.2} =
(onePointDistanceLaw
(angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n)
(angularGridRadius n q) (flipBit j omega) (by norm_num)
(mul_pos (by norm_num) hdelta) (by norm_num) hdelta
(rpow_pos_of_pos (frontierRate_pos hn) _)
(by linarith) (fun i k hik =>
(angularGridSize_geometry (angularGridRadius n q)
(rpow_pos_of_pos (frontierRate_pos hn) _) hsmall).2.2 i k hik |>.1))
(angularGridCenter (angularGridSize (angularGridRadius n q)) j)).restrict
{z | cRadial * frontierRate n ≤ z.2})
(hkl : ∀ omega j,
klDiv
(compressedSampleLaw
(angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n)
(angularGridRadius n q) omega (by norm_num)
(mul_pos (by norm_num) hdelta) (by norm_num) hdelta
(rpow_pos_of_pos (frontierRate_pos hn) _)
(by linarith) (fun i k hik =>
(angularGridSize_geometry (angularGridRadius n q)
(rpow_pos_of_pos (frontierRate_pos hn) _) hsmall).2.2 i k hik |>.1))
n (angularGridCenter (angularGridSize (angularGridRadius n q)) j))
(compressedSampleLaw
(angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n)
(angularGridRadius n q) (flipBit j omega) (by norm_num)
(mul_pos (by norm_num) hdelta) (by norm_num) hdelta
(rpow_pos_of_pos (frontierRate_pos hn) _)
(by linarith) (fun i k hik =>
(angularGridSize_geometry (angularGridRadius n q)
(rpow_pos_of_pos (frontierRate_pos hn) _) hsmall).2.2 i k hik |>.1))
n (angularGridCenter (angularGridSize (angularGridRadius n q)) j)) ≤
ofReal
(alpha * log (angularGridSize (angularGridRadius n q)))) :
AngularPackingAt n q L (1 / 24)
(1 / (1024 * packingBumpDerivativeScale q)) 1 1 cRadial alpha := by
let w := angularGridRadius n q
let M := angularGridSize w
have hw0 : 0 < w := rpow_pos_of_pos (frontierRate_pos hn) _
have hgeometry := angularGridSize_geometry w hw0 hsmall
have hsep3 : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k) :=
fun i k hik => (hgeometry.2.2 i k hik).1
have hMpos : 0 < M := by
have hleft : 0 < (1 / (24 * w) : ℝ) := by positivity
have hcast : (0 : ℝ) < M := lt_of_lt_of_le hleft hgeometry.1
exact_mod_cast hcast
let j0 : Fin M := ⟨0, hMpos⟩
let m : ℝ :=
(volume (packingCell (angularGridCenter M) w j0)).toReal
let laws : (Fin M → Bool) → CtyLaw := fun omega =>
angularPackingCtyLaw (1 / 8) 8 (angularPackingScaledDelta q n) w omega
(by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta hw0
(by linarith) hsep3
let values : Fin M → Bool → ℝ :=
packingCenterValue (1 / 8) (angularPackingScaledDelta q n)
(angularGridCenter M)
apply angularPackingAt_of_certificates (M := M) (w := w) (m := m)
(centers := angularGridCenter M) (laws := laws) (values := values)
· simpa [w, M] using angularGridSize_frontier_lower n q hn hsmall
· simp [w, angularGridRadius]
· exact fun j => angularGridCenter_mem_packingSquare_frontier M j
· intro i j hij
have hij' := hsep3 i j hij
rw [one_mul]
change angularGridRadius n q ≤
dist (angularGridCenter M i) (angularGridCenter M j)
change 3 * angularGridRadius n q ≤
dist (angularGridCenter M i) (angularGridCenter M j) at hij'
have hw0' : 0 < angularGridRadius n q := by simpa [w] using hw0
linarith
· exact fun i j hij => hgeometry.2.2 i j hij |>.2
· intro omega
exact angularPackingCtyLaw_mem_class_scaledDelta hq hL hn hrate hdelta
hdeltaSmall hw0 (by linarith) hsep3 omega
· intro omega
dsimp [laws]
exact angularPackingCtyLaw_support (1 / 8) 8
(angularPackingScaledDelta q n) w omega (by norm_num)
(mul_pos (by norm_num) hdelta) (by norm_num) hdelta hw0 (by linarith)
hsep3
· intro omega j
dsimp [laws]
rw [angularPackingCtyLaw_cell_mass_eq_volume j (by norm_num)
(mul_pos (by norm_num) hdelta) (by norm_num) hdelta hw0 (by linarith)
hsep3 omega]
rw [angularGrid_packingCell_volume_eq j j0 (by linarith)]
exact (ENNReal.ofReal_toReal
(((isCompact_closedBall (angularGridCenter M j0) w).inter_right
packingScoreCube_isCompact.isClosed).measure_lt_top.ne)).symm
· exact (angularPackingCtyLaw_locality_certificate (M := M)
(by norm_num) (by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num)
hdelta hdeltaSmall hw0 (by linarith) hsep3).1
· exact (angularPackingCtyLaw_locality_certificate (M := M)
(by norm_num) (by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num)
hdelta hdeltaSmall hw0 (by linarith) hsep3).2
· intro omega j
exact angularPackingCtyLaw_mu_center (by norm_num) (by norm_num)
(mul_pos (by norm_num) hdelta) (by norm_num) hdelta hdeltaSmall hw0
(by linarith) hsep3 j
· intro j
rw [packingCenterValue_scaledDelta_separation hn (angularGridCenter M) j]
· exact fun omega j => angularPackingCtyLaw_flip_map_distance_eq j
(by norm_num) (mul_pos (by norm_num) hdelta) (by norm_num) hdelta hw0
(by linarith) hsep3 omega
· simpa [laws, w, M] using houtside
· simpa [laws, w, M] using hkl
For every admissible smoothness order and envelope, fixed positive constants and a fixed α < 1/8 yield the CTY square-support angular hard family for all sufficiently large sample sizes.
Formal statement
conclusion
∀ q : ℕ,
∀ L : ℝ,
1
≤ q → 4 ≤ L → ∃ c0 c1 cwLow cwHigh cRadial alpha : ℝ, 0 < c0 ∧ 0 < c1 ∧ 0 < cwLow ∧ 0 < cwHigh ∧ 0 < cRadial ∧ 0 < alpha ∧ alpha < 1 / 8 ∧ ∃ N : ℕ, ∀ n ≥ N, AngularPackingAt n q L c0 c1 cwLow cwHigh cRadial alpha
Proof (Lean source)
lemma cty_support_boundary_angular_packing :
∀ q : ℕ, ∀ L : ℝ, 1 ≤ q → 4 ≤ L →
∃ c0 c1 cwLow cwHigh cRadial alpha : ℝ,
0 < c0 ∧ 0 < c1 ∧ 0 < cwLow ∧ 0 < cwHigh ∧ 0 < cRadial ∧
0 < alpha ∧ alpha < 1 / 8 ∧
∃ N : ℕ, ∀ n ≥ N,
AngularPackingAt n q L c0 c1 cwLow cwHigh cRadial alpha := by
intro q L hq hL
refine ⟨1 / 24, 1 / (1024 * packingBumpDerivativeScale q), 1, 1,
1 / 8, 1 / 16, by norm_num, ?_, by norm_num, by norm_num, by norm_num,
by norm_num, by norm_num, ?_⟩
· exact div_pos (by norm_num)
(mul_pos (by norm_num) (packingBumpDerivativeScale_pos q))
have hsum : 0 ≤ ∑ j ∈ range (q + 1), packingBumpDerivativeBound j :=
sum_nonneg fun j _ => packingBumpDerivativeBound_nonneg j
have hq0 : (0 : ℝ) ≤ q := by positivity
have hqle : (q : ℝ) ≤ packingBumpDerivativeScale q := by
unfold packingBumpDerivativeScale
linarith
have hCle : angularPackingOnePointKLConstant ≤ packingBumpDerivativeScale q := by
unfold angularPackingOnePointKLConstant packingBumpDerivativeScale
linarith
have hS0 : 0 ≤ packingBumpDerivativeScale q :=
(packingBumpDerivativeScale_pos q).le
have hprod : (q : ℝ) * angularPackingOnePointKLConstant ≤
packingBumpDerivativeScale q ^ 2 := by
rw [pow_two]
exact mul_le_mul hqle hCle
(by unfold angularPackingOnePointKLConstant; norm_num) hS0
have hS1 : 1 ≤ packingBumpDerivativeScale q := by
unfold packingBumpDerivativeScale
linarith
have hSsq1 : 1 ≤ packingBumpDerivativeScale q ^ 2 := by nlinarith
have hCbudget : 256 * (q : ℝ) * angularPackingOnePointKLConstant ≤
(1024 * packingBumpDerivativeScale q) ^ 4 := by
calc
256 * (q : ℝ) * angularPackingOnePointKLConstant ≤
256 * packingBumpDerivativeScale q ^ 2 := by nlinarith
_ ≤ (1024 * packingBumpDerivativeScale q) ^ 4 := by
nlinarith [sq_nonneg (packingBumpDerivativeScale q ^ 2 - 1)]
have hcert : ∀ᶠ n in atTop,
AngularPackingAt n q L (1 / 24)
(1 / (1024 * packingBumpDerivativeScale q)) 1 1 (1 / 8) (1 / 16) := by
filter_upwards [angularGridRadius_eventually_small q hq,
angularPackingScaledDelta_eventually_admissible q hq,
angularPackingScaledDelta_eventually_klBudget q hq
angularPackingOnePointKLConstant hCbudget] with n hgrid hadm hbudget
apply angularPackingAt_scaledDelta_of_radial_certificates hq hL hadm.1
hadm.2.1 hgrid.2 hadm.2.2.1 hadm.2.2.2.1
· intro omega j
apply angularPackingCtyLaw_flip_restrict_Ici_eq_of_active j
(by norm_num) (by norm_num) (mul_pos (by norm_num) hadm.2.2.1)
(by norm_num) hadm.2.2.1 hadm.2.2.2.1
hgrid.1 (by linarith)
(fun i k hik =>
(angularGridSize_geometry (angularGridRadius n q) hgrid.1 hgrid.2).2.2
i k hik |>.1)
intro r hr
exact angularPackingScaledDelta_cutoff_fully_active hadm.1 hr
· intro omega j
let M := angularGridSize (angularGridRadius n q)
let delta := angularPackingScaledDelta q n
let w := angularGridRadius n q
let P := angularPackingCtyLaw (1 / 8) 8 delta w omega (by norm_num)
(mul_pos (by norm_num) hadm.2.2.1) (by norm_num) hadm.2.2.1
hgrid.1 (by linarith)
(fun i k hik =>
(angularGridSize_geometry w hgrid.1 hgrid.2).2.2 i k hik |>.1)
let P' := angularPackingCtyLaw (1 / 8) 8 delta w
(flipBit j omega) (by norm_num)
(mul_pos (by norm_num) hadm.2.2.1) (by norm_num) hadm.2.2.1
hgrid.1 (by linarith)
(fun i k hik =>
(angularGridSize_geometry w hgrid.1 hgrid.2).2.2 i k hik |>.1)
have hrepr := angularPackingCtyLaw_radial_representation_certificate
(M := M) (b := (1 / 8 : ℝ)) (cA := 8) (delta := delta) (w := w) j
(by norm_num) (mul_pos (by norm_num) hadm.2.2.1) (by norm_num)
hadm.2.2.1 hgrid.1 (by linarith)
(fun i k hik =>
(angularGridSize_geometry w hgrid.1 hgrid.2).2.2 i k hik |>.1) omega
have hone : klDiv
(onePointDistanceLaw P (angularGridCenter M j))
(onePointDistanceLaw P' (angularGridCenter M j)) ≤
ofReal (angularPackingOnePointKLConstant * delta ^ 4) := by
dsimp [P, P', M, delta, w]
rw [hrepr.2.1, hrepr.2.2]
exact angularPacking_radialOutcome_klDiv_le j hadm.2.2.1
hadm.2.2.2.1 hgrid.1 (by linarith)
(fun i k hik =>
(angularGridSize_geometry (angularGridRadius n q) hgrid.1
hgrid.2).2.2 i k hik |>.1) omega
have htensor := compressedSampleLaw_klDiv_le_of_onePoint_finite_bound
P P' n (angularGridCenter M j)
(B := angularPackingOnePointKLConstant * delta ^ 4)
(mul_nonneg (by unfold angularPackingOnePointKLConstant; norm_num)
(by positivity)) hone
exact htensor.trans (ENNReal.ofReal_le_ofReal (by
dsimp [delta, M]
exact hbudget hgrid.2))
exact Filter.eventually_atTop.1 hcert
Helpers.AngularRadial 12 declarations This module strengthens the polar cancellation identities to measurable radial subsets and transports them to the square-truncated cells used by the angular packing.
Radial cancellation for angular packing cells
This module strengthens the polar cancellation identities to measurable radial subsets and transports them to the square-truncated cells used by the angular packing. These setwise identities are the leaf input for equality of adjacent radius pushforwards.
theorem halfDisc_radialSet_weighted_first_div_radius_cancellation
Cartesian direction-cosine cancellation continues to hold after restricting an open upper half-disc to any measurable set of radii.
Formal statement
hypotheses
conclusion
(∫ z : ℝ × ℝ in {z | 0 < z.2 ∧ planarRadius z ≤ r} ∩ planarRadius ⁻¹' A, g (planarRadius z) * (z.1 / planarRadius z))
= 0
Proof (Lean source)
-- @node: halfDisc_radialSet_weighted_first_div_radius_cancellation
lemma halfDisc_radialSet_weighted_first_div_radius_cancellation
(g : ℝ → ℝ) (r : ℝ) {A : Set ℝ} (hA : MeasurableSet A) :
(∫ z : ℝ × ℝ in
{z | 0 < z.2 ∧ planarRadius z ≤ r} ∩ planarRadius ⁻¹' A,
g (planarRadius z) * (z.1 / planarRadius z)) = 0 := by
have hD : MeasurableSet
({z : ℝ × ℝ | 0 < z.2 ∧ planarRadius z ≤ r} ∩ planarRadius ⁻¹' A) := by
exact ((measurableSet_lt measurable_const measurable_snd).inter
(measurableSet_le planarRadius_measurable measurable_const)).inter
(hA.preimage planarRadius_measurable)
calc
_ = ∫ z : ℝ × ℝ in
{z | 0 < z.2 ∧ planarRadius z ≤ r} ∩ planarRadius ⁻¹' A,
g (planarRadius z) * cos (planarAngle z) := by
apply integral_congr_ae
exact ae_restrict_of_forall_mem hD fun z hz => by
change g (planarRadius z) * (z.1 / planarRadius z) =
g (planarRadius z) * cos (planarAngle z)
rw [planarFirst_div_radius_eq_cos z hz.1.1]
_ = 0 := halfDisc_radialSet_weighted_cos_cancellation g r hA
theorem closedHalfDisc_radialSet_weighted_first_div_radius_cancellation
Closing the diameter of the half-disc does not alter setwise radial Cartesian direction-cosine cancellation.
Formal statement
hypotheses
conclusion
(∫ z : ℝ × ℝ in {z | 0 ≤ z.2 ∧ planarRadius z ≤ r} ∩ planarRadius ⁻¹' A, g (planarRadius z) * (z.1 / planarRadius z))
= 0
Proof (Lean source)
-- @node: closedHalfDisc_radialSet_weighted_first_div_radius_cancellation
lemma closedHalfDisc_radialSet_weighted_first_div_radius_cancellation
(g : ℝ → ℝ) (r : ℝ) {A : Set ℝ} (hA : MeasurableSet A) :
(∫ z : ℝ × ℝ in
{z | 0 ≤ z.2 ∧ planarRadius z ≤ r} ∩ planarRadius ⁻¹' A,
g (planarRadius z) * (z.1 / planarRadius z)) = 0 := by
let Dc : Set (ℝ × ℝ) :=
{z | 0 ≤ z.2 ∧ planarRadius z ≤ r} ∩ planarRadius ⁻¹' A
let Do : Set (ℝ × ℝ) :=
{z | 0 < z.2 ∧ planarRadius z ≤ r} ∩ planarRadius ⁻¹' A
change (∫ z : ℝ × ℝ in Dc,
g (planarRadius z) * (z.1 / planarRadius z)) = 0
rw [setIntegral_congr_set (show Dc =ᵐ[volume] Do by
simp only [EventuallyEq]
rw [ae_iff]
apply measure_mono_null (t := {z : ℝ × ℝ | z.2 = 0})
· intro z hz
simp only [mem_setOf_eq]
by_contra hy
apply hz
apply propext
constructor
· rintro ⟨⟨hy0, hr⟩, hrad⟩
exact ⟨⟨lt_of_le_of_ne hy0 (Ne.symm hy), hr⟩, hrad⟩
· rintro ⟨⟨hy0, hr⟩, hrad⟩
exact ⟨⟨hy0.le, hr⟩, hrad⟩
· rw [Measure.volume_eq_prod]
rw [show {z : ℝ × ℝ | z.2 = 0} = univ ×ˢ ({0} : Set ℝ) by
ext z
simp]
rw [Measure.prod_prod]
simp)]
simpa [Do] using
halfDisc_radialSet_weighted_first_div_radius_cancellation g r hA
theorem translatedClosedHalfDisc_radialSet_weighted_first_div_radius_cancellation
Translation preserves closed-half-disc cancellation on every measurable radial subset.
Formal statement
hypotheses
conclusion
(∫ z : ℝ × ℝ in {z | 0 ≤ (z - c).2 ∧ planarRadius (z - c) ≤ r} ∩ {z | planarRadius (z - c) ∈ A}, g (planarRadius (z - c)) * ((z - c).1 / planarRadius (z - c)))
= 0
Proof (Lean source)
-- @node: translatedClosedHalfDisc_radialSet_weighted_first_div_radius_cancellation
lemma translatedClosedHalfDisc_radialSet_weighted_first_div_radius_cancellation
(g : ℝ → ℝ) (r : ℝ) (c : ℝ × ℝ)
{A : Set ℝ} (hA : MeasurableSet A) :
(∫ z : ℝ × ℝ in
{z | 0 ≤ (z - c).2 ∧ planarRadius (z - c) ≤ r} ∩
{z | planarRadius (z - c) ∈ A},
g (planarRadius (z - c)) * ((z - c).1 / planarRadius (z - c))) = 0 := by
let D : Set (ℝ × ℝ) :=
({u | 0 ≤ u.2 ∧ planarRadius u ≤ r} ∩ planarRadius ⁻¹' A)
let T : (ℝ × ℝ) → (ℝ × ℝ) := fun u => c + u
have hT : MeasurableEmbedding T :=
(Homeomorph.addLeft c).measurableEmbedding
have hmp : MeasurePreserving T (volume : Measure (ℝ × ℝ)) volume :=
measurePreserving_add_left volume c
have hset :
({z : ℝ × ℝ | 0 ≤ (z - c).2 ∧ planarRadius (z - c) ≤ r} ∩
{z | planarRadius (z - c) ∈ A}) = T '' D := by
ext z
constructor
· rintro ⟨hz, hA'⟩
refine ⟨z - c, ?_, by simp [T]⟩
exact ⟨hz, hA'⟩
· rintro ⟨u, ⟨hu, hAu⟩, rfl⟩
simpa [T] using intro hu hAu
rw [hset, hmp.setIntegral_image_emb hT]
have hfun : (fun u : ℝ × ℝ =>
g (planarRadius (T u - c)) * ((T u - c).1 / planarRadius (T u - c))) =
fun u => g (planarRadius u) * (u.1 / planarRadius u) := by
funext u
simp [T]
rw [hfun]
exact closedHalfDisc_radialSet_weighted_first_div_radius_cancellation g r hA
theorem angularGridCenter_closedRadialSet_weighted_direction_cancellation
At a lower-edge angular grid center, every radial weight times the horizontal direction cosine integrates to zero on each measurable radial slice of the square-truncated cell.
Formal statement
hypotheses
conclusion
let c := angularGridCenter M j let D : Set Score := {x | 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A} (∫ x in D, g (dist x c) * ((scoreCoordinates x - scoreCoordinates c).1 / dist x c))
= 0
Proof (Lean source)
-- @node: angularGridCenter_closedRadialSet_weighted_direction_cancellation
lemma angularGridCenter_closedRadialSet_weighted_direction_cancellation
{M : ℕ} (j : Fin M) (g : ℝ → ℝ) (w : ℝ)
{A : Set ℝ} (hA : MeasurableSet A) :
let c := angularGridCenter M j
let D : Set Score :=
{x | 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
(∫ x in D, g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) = 0 := by
dsimp only
let c : Score := angularGridCenter M j
let cp : ℝ × ℝ := scoreCoordinates c
let D : Set Score :=
{x | 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let E : Set (ℝ × ℝ) :=
{z | 0 ≤ (z - cp).2 ∧ planarRadius (z - cp) ≤ w} ∩
{z | planarRadius (z - cp) ∈ A}
have himage : scoreCoordinates '' D = E := by
ext z
constructor
· rintro ⟨x, hx, rfl⟩
simpa [D, E, cp, c, planarRadius_scoreCoordinates_sub] using hx
· intro hz
let x : Score := scorePoint z.1 z.2
have hcoord : scoreCoordinates x = z := by
ext <;> simp [x, scoreCoordinates, scorePoint_apply_zero,
scorePoint_apply_one]
have hdist : dist x c = planarRadius (z - scoreCoordinates c) := by
rw [← planarRadius_scoreCoordinates_sub, hcoord]
refine ⟨x, ?_, hcoord⟩
simpa [D, E, cp, c, hcoord, hdist] using hz
change (∫ x in D, g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) = 0
have hfun : (fun x : Score => g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) =
fun x => g (planarRadius (scoreCoordinates x - scoreCoordinates c)) *
((scoreCoordinates x - scoreCoordinates c).1 /
planarRadius (scoreCoordinates x - scoreCoordinates c)) := by
funext x
rw [planarRadius_scoreCoordinates_sub]
rw [hfun]
rw [← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ => g (planarRadius (z - scoreCoordinates c)) *
((z - scoreCoordinates c).1 /
planarRadius (z - scoreCoordinates c))) D]
rw [himage]
simpa [E, cp, c] using
translatedClosedHalfDisc_radialSet_weighted_first_div_radius_cancellation
g w (scoreCoordinates (angularGridCenter M j)) hA
theorem packingAngularTerm_integral_gridCell_radialSet
An angular correction integrates to zero on every measurable radial slice of its square-truncated packing cell.
Formal statement
hypotheses
conclusion
(∫ x : Score in (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩ {x | dist x (angularGridCenter M j) ∈ A}, packingAngularTerm b cA delta w (angularGridCenter M j) x)
= 0
Proof (Lean source)
-- @node: packingAngularTerm_integral_gridCell_radialSet
lemma packingAngularTerm_integral_gridCell_radialSet {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hw : w ≤ 1 / 4) {A : Set ℝ}
(hA : MeasurableSet A) :
(∫ x : Score in
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩
{x | dist x (angularGridCenter M j) ∈ A},
packingAngularTerm b cA delta w (angularGridCenter M j) x) = 0 := by
let c := scoreCoordinates (angularGridCenter M j)
let D : Set (ℝ × ℝ) :=
({z | 0 ≤ (z - c).2 ∧ planarRadius (z - c) ≤ w} ∩
{z | planarRadius (z - c) ∈ A})
have himage : scoreCoordinates ''
((closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩
{x | dist x (angularGridCenter M j) ∈ A}) = D := by
ext z
constructor
· rintro ⟨x, ⟨hx, hr⟩, rfl⟩
refine ⟨(mem_angularGrid_packingCell_iff_closedUpperHalfDisc j hw x).mp hx, ?_⟩
simpa [c, planarRadius_scoreCoordinates_sub] using hr
· rintro ⟨hz, hr⟩
let x : Score := scorePoint z.1 z.2
have hcoord : scoreCoordinates x = z := by
ext <;> simp [x, scoreCoordinates, scorePoint_apply_zero,
scorePoint_apply_one]
refine ⟨x, ⟨?_, ?_⟩, hcoord⟩
· apply (mem_angularGrid_packingCell_iff_closedUpperHalfDisc j hw x).mpr
simpa [D, c, hcoord] using hz
· change dist x (angularGridCenter M j) ∈ A
rw [← planarRadius_scoreCoordinates_sub]
simpa [c, hcoord] using hr
have hterm : packingAngularTerm b cA delta w (angularGridCenter M j) =
fun x => angularTilt b cA delta w
(planarRadius (scoreCoordinates x - scoreCoordinates (angularGridCenter M j))) *
((scoreCoordinates x - scoreCoordinates (angularGridCenter M j)).1 /
planarRadius (scoreCoordinates x - scoreCoordinates (angularGridCenter M j))) := by
funext x
rw [packingAngularTerm,
packingDirectionCos_eq_planarFirst_div_radius,
planarRadius_scoreCoordinates_sub]
rw [hterm]
rw [← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ =>
angularTilt b cA delta w
(planarRadius (z - scoreCoordinates (angularGridCenter M j))) *
((z - scoreCoordinates (angularGridCenter M j)).1 /
planarRadius (z - scoreCoordinates (angularGridCenter M j))))
((closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩
{x | dist x (angularGridCenter M j) ∈ A})]
rw [himage]
change (∫ z : ℝ × ℝ in D,
angularTilt b cA delta w (planarRadius (z - c)) *
((z - c).1 / planarRadius (z - c))) = 0
exact translatedClosedHalfDisc_radialSet_weighted_first_div_radius_cancellation
(angularTilt b cA delta w) w c hA
theorem packingAngularDensity_integral_gridCell_radialSet
Every measurable radial slice of a grid cell has its unperturbed Lebesgue mass under the angular density, independently of the active bit.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
A :
Set ℝ
hA :
conclusion
(∫ x : Score in (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩ {x | dist x (angularGridCenter M j) ∈ A}, packingAngularDensity b cA delta w (angularGridCenter M) omega x)
= (volume ((closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩ {x | dist x (angularGridCenter M j) ∈ A})).toReal
Proof (Lean source)
-- @node: packingAngularDensity_integral_gridCell_radialSet
lemma packingAngularDensity_integral_gridCell_radialSet {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hw0 : 0 < w) (hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) {A : Set ℝ} (hA : MeasurableSet A) :
(∫ x : Score in
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩
{x | dist x (angularGridCenter M j) ∈ A},
packingAngularDensity b cA delta w (angularGridCenter M) omega x) =
(volume ((closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩
{x | dist x (angularGridCenter M j) ∈ A})).toReal := by
let C := closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)
let R : Set Score := {x | dist x (angularGridCenter M j) ∈ A}
let omega' : Fin M → Bool := fun k => if k = j then omega j else false
have hR : MeasurableSet R := hA.preimage (by fun_prop)
have hCR : MeasurableSet (C ∩ R) :=
(Metric.isClosed_closedBall.measurableSet.inter
(scoreCube_measurableSet _)).inter hR
have hpoint : ∀ x ∈ C ∩ R,
packingAngularDensity b cA delta w (angularGridCenter M) omega x =
1 + if omega j then
packingAngularTerm b cA delta w (angularGridCenter M j) x else 0 := by
intro x hx
rw [packingAngularDensity_eq_on_cell hw0 hsep
(omega' := omega') (j := j) (by simp [omega']) hx.1.1]
simp only [packingAngularDensity, omega']
rw [Finset.sum_eq_single j]
· simp
· intro k _ hkj
simp [hkj]
· simp
rw [setIntegral_congr_fun hCR hpoint]
have hcompact : IsCompact C :=
(isCompact_closedBall (angularGridCenter M j) w).inter_right
packingScoreCube_isCompact.isClosed
have hconst : IntegrableOn (fun _ : Score => (1 : ℝ)) (C ∩ R) :=
(continuous_const.continuousOn.integrableOn_compact hcompact).mono_set inter_subset_left
have hterm : IntegrableOn
(fun x : Score => if omega j then
packingAngularTerm b cA delta w (angularGridCenter M j) x else 0) (C ∩ R) := by
by_cases hj : omega j = true
· simpa [hj] using
(((packingAngularTerm_continuous hb hscale
(angularGridCenter M j)).continuousOn.integrableOn_compact hcompact).mono_set
inter_subset_left : IntegrableOn
(packingAngularTerm b cA delta w (angularGridCenter M j)) (C ∩ R))
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simpa [hjf] using hconst.const_mul 0
rw [integral_add hconst hterm, integral_const]
simp only [Measure.real, Measure.restrict_apply_univ]
have hz : (∫ x : Score in C ∩ R,
if omega j then
packingAngularTerm b cA delta w (angularGridCenter M j) x else 0) = 0 := by
by_cases hj : omega j = true
· simpa [C, R, hj] using
(packingAngularTerm_integral_gridCell_radialSet (b := b) (cA := cA)
(delta := delta) j hw hA)
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
simp [hjf]
rw [hz]
simp [C, R]
theorem angularDesignMeasure_gridCell_radialSet_eq_volume
The score design assigns every measurable radial slice of a grid cell exactly its Lebesgue volume, uniformly over packing vertices.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
A :
Set ℝ
hA :
conclusion
angularDesignMeasure b cA delta w (angularGridCenter M) omega ((closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩ {x | dist x (angularGridCenter M j) ∈ A})
= volume ((closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩ {x | dist x (angularGridCenter M j) ∈ A})
Proof (Lean source)
-- @node: angularDesignMeasure_gridCell_radialSet_eq_volume
lemma angularDesignMeasure_gridCell_radialSet_eq_volume {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw0 : 0 < w)
(hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) {A : Set ℝ} (hA : MeasurableSet A) :
angularDesignMeasure b cA delta w (angularGridCenter M) omega
((closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩
{x | dist x (angularGridCenter M j) ∈ A}) =
volume ((closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩
{x | dist x (angularGridCenter M j) ∈ A}) := by
let C := (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) ∩
{x | dist x (angularGridCenter M j) ∈ A}
have hC : MeasurableSet C :=
(Metric.isClosed_closedBall.measurableSet.inter
(scoreCube_measurableSet _)).inter (hA.preimage (by fun_prop))
rw [angularDesignMeasure, withDensity_apply _ hC]
have hcompact : IsCompact
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) :=
(isCompact_closedBall (angularGridCenter M j) w).inter_right
packingScoreCube_isCompact.isClosed
have hint : IntegrableOn
(packingAngularDensity b cA delta w (angularGridCenter M) omega) C volume :=
((packingAngularDensity_continuous hb hscale
(angularGridCenter M) omega).continuousOn.integrableOn_compact hcompact).mono_set
(by intro x hx; exact hx.1)
have hnonneg : 0 ≤ᵐ[volume.restrict C]
packingAngularDensity b cA delta w (angularGridCenter M) omega := by
filter_upwards with x
exact (packingAngularDensity_mem_Icc hcA hdelta hw0 hsep omega x).1.trans'
(by norm_num)
have heq : (fun x => ofReal
(angularDesignDensity b cA delta w (angularGridCenter M) omega x)) =ᵐ[volume.restrict C]
fun x => ofReal
(packingAngularDensity b cA delta w (angularGridCenter M) omega x) := by
filter_upwards [ae_restrict_mem hC] with x hx
rw [angularDesignDensity_eq_on_square hx.1.2]
rw [lintegral_congr_ae heq]
rw [← ofReal_integral_eq_lintegral_ofReal hint hnonneg]
rw [show (∫ x : Score in C,
packingAngularDensity b cA delta w (angularGridCenter M) omega x) =
(volume C).toReal by
exact packingAngularDensity_integral_gridCell_radialSet j hb hscale hw0 hw
hsep omega hA]
apply ENNReal.ofReal_toReal
exact ne_of_lt ((measure_mono (by
intro x hx
exact hx.1)).trans_lt hcompact.measure_lt_top)
theorem angularDesignDensity_eq_off_gridCell
Outside one grid cell, two angular design densities agree whenever all Boolean coordinates other than that cell's coordinate agree.
Formal statement
hypotheses
conclusion
angularDesignDensity b cA delta w (angularGridCenter M) omega x
= angularDesignDensity b cA delta w (angularGridCenter M) omega' x
Proof (Lean source)
-- @node: angularDesignDensity_eq_off_gridCell
lemma angularDesignDensity_eq_off_gridCell {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hw0 : 0 < w)
(omega omega' : Fin M → Bool)
(hother : ∀ k, k ≠ j → omega k = omega' k)
{x : Score}
(hx : x ∉ closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)) :
angularDesignDensity b cA delta w (angularGridCenter M) omega x =
angularDesignDensity b cA delta w (angularGridCenter M) omega' x := by
by_cases hxSquare : x ∈ scoreCube (1 / 2 : ℝ)
· rw [angularDesignDensity_eq_on_square hxSquare,
angularDesignDensity_eq_on_square hxSquare]
unfold packingAngularDensity
congr 1
apply Finset.sum_congr rfl
intro k _
by_cases hkj : k = j
· subst k
have hxBall : x ∉ closedBall (angularGridCenter M j) w :=
fun h => hx ⟨h, hxSquare⟩
have hfar : w ≤ dist x (angularGridCenter M j) := by
exact le_of_lt (by simpa [Metric.mem_closedBall, not_le] using
(show w < dist x (angularGridCenter M j) by
simpa [Metric.mem_closedBall, not_le] using hxBall))
rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw0 hfar]
simp
· rw [hother k hkj]
· rw [angularDesignDensity_eq_zero_off_square hxSquare,
angularDesignDensity_eq_zero_off_square hxSquare]
theorem angularDesignMeasure_restrict_compl_gridCell_eq
The restrictions of two adjacent angular score designs to the complement of the changed grid cell are identical.
Formal statement
hypotheses
conclusion
(angularDesignMeasure b cA delta w (angularGridCenter M) omega).restrict (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))ᶜ
= (angularDesignMeasure b cA delta w (angularGridCenter M) omega').restrict (closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))ᶜ
Proof (Lean source)
-- @node: angularDesignMeasure_restrict_compl_gridCell_eq
lemma angularDesignMeasure_restrict_compl_gridCell_eq {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hw0 : 0 < w)
(omega omega' : Fin M → Bool)
(hother : ∀ k, k ≠ j → omega k = omega' k) :
(angularDesignMeasure b cA delta w (angularGridCenter M) omega).restrict
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))ᶜ =
(angularDesignMeasure b cA delta w (angularGridCenter M) omega').restrict
(closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2))ᶜ := by
let C := closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)
have hC : MeasurableSet C :=
Metric.isClosed_closedBall.measurableSet.inter (scoreCube_measurableSet _)
ext s hs
rw [Measure.restrict_apply hs, Measure.restrict_apply hs]
unfold angularDesignMeasure
rw [withDensity_apply _ (hs.inter hC.compl),
withDensity_apply _ (hs.inter hC.compl)]
apply lintegral_congr_ae
filter_upwards [ae_restrict_mem (hs.inter hC.compl)] with x hx
apply congrArg ofReal
exact angularDesignDensity_eq_off_gridCell j hw0 omega omega' hother hx.2
theorem angularDesignMeasure_map_distance_eq
The radius pushforwards of two angular score designs agree whenever the vertices differ, if at all, only at the queried grid cell.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
hother :
∀ k
if
k ≠ j
then
omega k = omega' k
conclusion
Measure.map (fun x : Score => dist x (angularGridCenter M j)) (angularDesignMeasure b cA delta w (angularGridCenter M) omega)
= Measure.map (fun x : Score => dist x (angularGridCenter M j)) (angularDesignMeasure b cA delta w (angularGridCenter M) omega')
Proof (Lean source)
-- @node: angularDesignMeasure_map_distance_eq
lemma angularDesignMeasure_map_distance_eq {M : ℕ} (j : Fin M)
{b cA delta w : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hcA : 8 ≤ cA) (hdelta : 0 < delta) (hw0 : 0 < w)
(hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega omega' : Fin M → Bool)
(hother : ∀ k, k ≠ j → omega k = omega' k) :
Measure.map (fun x : Score => dist x (angularGridCenter M j))
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) =
Measure.map (fun x : Score => dist x (angularGridCenter M j))
(angularDesignMeasure b cA delta w (angularGridCenter M) omega') := by
let C := closedBall (angularGridCenter M j) w ∩ scoreCube (1 / 2)
let radial : Score → ℝ := fun x => dist x (angularGridCenter M j)
have hC : MeasurableSet C :=
Metric.isClosed_closedBall.measurableSet.inter (scoreCube_measurableSet _)
have hradial : Measurable radial := by fun_prop
have hcell : Measure.map radial
((angularDesignMeasure b cA delta w (angularGridCenter M) omega).restrict C) =
Measure.map radial
((angularDesignMeasure b cA delta w (angularGridCenter M) omega').restrict C) := by
ext A hA
rw [Measure.map_apply hradial hA, Measure.map_apply hradial hA,
Measure.restrict_apply (hA.preimage hradial),
Measure.restrict_apply (hA.preimage hradial)]
have hset : radial ⁻¹' A ∩ C = C ∩ {x | dist x (angularGridCenter M j) ∈ A} := by
ext x
simp [radial, and_comm]
rw [hset,
angularDesignMeasure_gridCell_radialSet_eq_volume j hb hscale hcA hdelta
hw0 hw hsep omega hA,
angularDesignMeasure_gridCell_radialSet_eq_volume j hb hscale hcA hdelta
hw0 hw hsep omega' hA]
have hcompl :
(angularDesignMeasure b cA delta w (angularGridCenter M) omega).restrict Cᶜ =
(angularDesignMeasure b cA delta w (angularGridCenter M) omega').restrict Cᶜ := by
exact angularDesignMeasure_restrict_compl_gridCell_eq j hw0 omega omega' hother
calc
Measure.map radial
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) =
Measure.map radial
((angularDesignMeasure b cA delta w (angularGridCenter M) omega).restrict C +
(angularDesignMeasure b cA delta w
(angularGridCenter M) omega).restrict Cᶜ) := by
rw [Measure.restrict_add_restrict_compl hC]
_ = Measure.map radial
((angularDesignMeasure b cA delta w (angularGridCenter M) omega).restrict C) +
Measure.map radial
((angularDesignMeasure b cA delta w (angularGridCenter M) omega).restrict Cᶜ) :=
Measure.map_add _ _ hradial
_ = Measure.map radial
((angularDesignMeasure b cA delta w (angularGridCenter M) omega').restrict C) +
Measure.map radial
((angularDesignMeasure b cA delta w (angularGridCenter M) omega').restrict Cᶜ) := by
rw [hcell, hcompl]
_ = Measure.map radial
(angularDesignMeasure b cA delta w (angularGridCenter M) omega') := by
rw [← Measure.map_add _ _ hradial, Measure.restrict_add_restrict_compl hC]
theorem halfDisc_radialSet_angular_outcome_cancellation
On every measurable set of radii where the angular cutoff is fully active, the radial bump contribution is exactly cancelled by the affine-times-angular contribution after integration over the upper half-disc.
Formal statement
hypotheses
b cA delta w R :
ℝ
hscale :
0 < cA * delta
A :
Set ℝ
hA :
hactive :
∀ r ∈ A, 2 * (cA * delta) ≤ b * r
conclusion
(∫ z : ℝ × ℝ in {z | 0 < z.2 ∧ planarRadius z ≤ R} ∩ planarRadius ⁻¹' A, delta * angularRadialProfile w (planarRadius z))
+ (∫ z : ℝ × ℝ in {z | 0 < z.2 ∧ planarRadius z ≤ R} ∩ planarRadius ⁻¹' A, b * z.1 * angularTilt b cA delta w (planarRadius z) * (z.1 / planarRadius z))
= 0
Proof (Lean source)
-- @node: halfDisc_radialSet_angular_outcome_cancellation
lemma halfDisc_radialSet_angular_outcome_cancellation
{b cA delta w R : ℝ} (hscale : 0 < cA * delta)
{A : Set ℝ} (hA : MeasurableSet A)
(hactive : ∀ r ∈ A, 2 * (cA * delta) ≤ b * r) :
(∫ z : ℝ × ℝ in
{z | 0 < z.2 ∧ planarRadius z ≤ R} ∩ planarRadius ⁻¹' A,
delta * angularRadialProfile w (planarRadius z)) +
(∫ z : ℝ × ℝ in
{z | 0 < z.2 ∧ planarRadius z ≤ R} ∩ planarRadius ⁻¹' A,
b * z.1 * angularTilt b cA delta w (planarRadius z) *
(z.1 / planarRadius z)) = 0 := by
let D : Set (ℝ × ℝ) := {z | 0 < z.2 ∧ planarRadius z ≤ R}
let E : Set (ℝ × ℝ) := planarRadius ⁻¹' A
have hD : MeasurableSet D :=
(measurableSet_lt measurable_const measurable_snd).inter
(measurableSet_le planarRadius_measurable measurable_const)
have hE : MeasurableSet E := hA.preimage planarRadius_measurable
have hfirst := halfDisc_radial_integral
(fun r => A.indicator (fun s => delta * angularRadialProfile w s) r) R
have hsecond := halfDisc_weighted_cos_sq
(fun r => A.indicator (fun s => b * r * angularTilt b cA delta w r) r) R
change (∫ z : ℝ × ℝ in D ∩ E,
delta * angularRadialProfile w (planarRadius z)) +
(∫ z : ℝ × ℝ in D ∩ E,
b * z.1 * angularTilt b cA delta w (planarRadius z) *
(z.1 / planarRadius z)) = 0
have hfirst' :
(∫ z : ℝ × ℝ in D ∩ E,
delta * angularRadialProfile w (planarRadius z)) =
∫ r : ℝ in Ioc 0 R,
pi * r * A.indicator
(fun s => delta * angularRadialProfile w s) r := by
rw [inter_comm, ← Measure.restrict_restrict hE, ← integral_indicator hE]
calc
(∫ z : ℝ × ℝ in D,
E.indicator (fun z => delta * angularRadialProfile w (planarRadius z)) z) =
∫ z : ℝ × ℝ in D,
A.indicator (fun s => delta * angularRadialProfile w s)
(planarRadius z) := by
apply integral_congr_ae
filter_upwards with z
by_cases hz : planarRadius z ∈ A <;> simp [E, hz]
_ = _ := by simpa [D] using hfirst
have hsecond' :
(∫ z : ℝ × ℝ in D ∩ E,
b * z.1 * angularTilt b cA delta w (planarRadius z) *
(z.1 / planarRadius z)) =
(∫ r : ℝ in Ioc 0 R,
r * A.indicator
(fun s => b * s * angularTilt b cA delta w s) r) *
(pi / 2) := by
rw [inter_comm, ← Measure.restrict_restrict hE, ← integral_indicator hE]
calc
(∫ z : ℝ × ℝ in D,
E.indicator (fun z => b * z.1 * angularTilt b cA delta w
(planarRadius z) * (z.1 / planarRadius z)) z) =
∫ z : ℝ × ℝ in D,
A.indicator (fun s => b * planarRadius z *
angularTilt b cA delta w (planarRadius z)) (planarRadius z) *
cos (planarAngle z) ^ 2 := by
apply integral_congr_ae
filter_upwards [ae_restrict_mem hD] with z hzD
by_cases hz : planarRadius z ∈ A
· rw [Set.indicator_of_mem (show z ∈ E by exact hz),
Set.indicator_of_mem hz]
have hr := planarFirst_div_radius_eq_cos z hzD.1
have hr0 : planarRadius z ≠ 0 := by
intro hzero
have hs : z.1 ^ 2 + z.2 ^ 2 ≤ 0 := by
exact Real.sqrt_eq_zero'.mp (by simpa [planarRadius] using hzero)
nlinarith [hzD.1, sq_nonneg z.1, sq_nonneg z.2]
field_simp [hr0] at hr
field_simp [hr0]
rw [hr]
ring
· rw [Set.indicator_of_notMem (show z ∉ E by exact hz),
Set.indicator_of_notMem hz]
simp
_ = _ := hsecond
rw [hfirst', hsecond']
have hfint : IntegrableOn
(fun r : ℝ => pi * r * A.indicator
(fun s => delta * angularRadialProfile w s) r) (Ioc 0 R) := by
have hbase : IntegrableOn
(fun r : ℝ => pi * r * (delta * angularRadialProfile w r))
(Ioc 0 R) := by
have hcont : Continuous (fun r : ℝ =>
pi * r * (delta * angularRadialProfile w r)) :=
(continuous_const.mul continuous_id).mul
(continuous_const.mul (angularRadialProfile_continuous w))
exact (hcont.continuousOn.integrableOn_compact isCompact_Icc).mono_set
Ioc_subset_Icc_self
exact (hbase.indicator hA).congr
(Filter.Eventually.of_forall fun r => by
by_cases hr : r ∈ A <;> simp [indicator, hr])
have hgint : IntegrableOn
(fun r : ℝ => r * A.indicator
(fun s => b * s * angularTilt b cA delta w s) r) (Ioc 0 R) := by
have hbase : IntegrableOn
(fun r : ℝ => r * (b * r * angularTilt b cA delta w r))
(Ioc 0 R) := by
exact ((continuous_id.mul
((continuous_const.mul continuous_id).mul
(angularTilt_continuous hscale))).continuousOn.integrableOn_compact
isCompact_Icc).mono_set Ioc_subset_Icc_self
exact (hbase.indicator hA).congr
(Filter.Eventually.of_forall fun r => by
by_cases hr : r ∈ A <;> simp [indicator, hr])
rw [← integral_mul_const,
← integral_add hfint (hgint.mul_const (pi / 2))]
apply integral_eq_zero_of_ae
filter_upwards with r
by_cases hrA : r ∈ A
· simp only [Set.indicator_of_mem hrA]
have hc := angularOutcomeCancellation_identity (w := w) hscale (hactive r hrA)
calc
pi * r * (delta * angularRadialProfile w r) +
r * (b * r * angularTilt b cA delta w r) * (pi / 2) =
r * (pi * delta * angularRadialProfile w r +
(pi / 2) * (b * r) * angularTilt b cA delta w r) := by ring
_ = 0 := by rw [hc, mul_zero]
· simp [Set.indicator_of_notMem hrA]
theorem translatedHalfDisc_radialSet_angular_outcome_cancellation
Translation of the fully-active radial outcome cancellation to a packing center. This is the form used when the lower-edge half-disc is written in the ambient score coordinates.
Formal statement
hypotheses
b cA delta w R :
ℝ
hscale :
0 < cA * delta
c :
ℝ × ℝ
A :
Set ℝ
hA :
hactive :
∀ r ∈ A, 2 * (cA * delta) ≤ b * r
conclusion
(∫ z : ℝ × ℝ in {z | 0 < (z - c).2 ∧ planarRadius (z - c) ≤ R} ∩ {z | planarRadius (z - c) ∈ A}, delta * angularRadialProfile w (planarRadius (z - c)))
+ (∫ z : ℝ × ℝ in {z | 0 < (z - c).2 ∧ planarRadius (z - c) ≤ R} ∩ {z | planarRadius (z - c) ∈ A}, b * (z - c).1 * angularTilt b cA delta w (planarRadius (z - c)) * ((z - c).1 / planarRadius (z - c)))
= 0
Proof (Lean source)
-- @node: translatedHalfDisc_radialSet_angular_outcome_cancellation
lemma translatedHalfDisc_radialSet_angular_outcome_cancellation
{b cA delta w R : ℝ} (hscale : 0 < cA * delta)
(c : ℝ × ℝ) {A : Set ℝ} (hA : MeasurableSet A)
(hactive : ∀ r ∈ A, 2 * (cA * delta) ≤ b * r) :
(∫ z : ℝ × ℝ in
{z | 0 < (z - c).2 ∧ planarRadius (z - c) ≤ R} ∩
{z | planarRadius (z - c) ∈ A},
delta * angularRadialProfile w (planarRadius (z - c))) +
(∫ z : ℝ × ℝ in
{z | 0 < (z - c).2 ∧ planarRadius (z - c) ≤ R} ∩
{z | planarRadius (z - c) ∈ A},
b * (z - c).1 * angularTilt b cA delta w (planarRadius (z - c)) *
((z - c).1 / planarRadius (z - c))) = 0 := by
let D : Set (ℝ × ℝ) :=
{u | 0 < u.2 ∧ planarRadius u ≤ R} ∩ {u | planarRadius u ∈ A}
let T : (ℝ × ℝ) → (ℝ × ℝ) := fun u => c + u
have hT : MeasurableEmbedding T :=
(Homeomorph.addLeft c).measurableEmbedding
have hmp : MeasurePreserving T (volume : Measure (ℝ × ℝ)) volume :=
measurePreserving_add_left volume c
have hset :
({z : ℝ × ℝ | 0 < (z - c).2 ∧ planarRadius (z - c) ≤ R} ∩
{z | planarRadius (z - c) ∈ A}) = T '' D := by
ext z
constructor
· rintro ⟨hz, hAz⟩
refine ⟨z - c, ⟨?_, ?_⟩, by simp [T]⟩
· exact hz
· exact hAz
· rintro ⟨u, ⟨hu, hAu⟩, rfl⟩
simpa [T] using intro hu hAu
rw [hset, hmp.setIntegral_image_emb hT,
hmp.setIntegral_image_emb hT]
have hfirst : (fun u : ℝ × ℝ =>
delta * angularRadialProfile w (planarRadius (T u - c))) =
fun u => delta * angularRadialProfile w (planarRadius u) := by
funext u
simp [T]
have hsecond : (fun u : ℝ × ℝ =>
b * (T u - c).1 * angularTilt b cA delta w (planarRadius (T u - c)) *
((T u - c).1 / planarRadius (T u - c))) =
fun u => b * u.1 * angularTilt b cA delta w (planarRadius u) *
(u.1 / planarRadius u) := by
funext u
simp [T]
rw [hfirst, hsecond]
exact halfDisc_radialSet_angular_outcome_cancellation
(w := w) (R := R) hscale hA hactive
Helpers.AngularRadialAlgebra 4 declarations This module isolates the pointwise product identity behind the radial-outcome cancellation.
Pointwise algebra for angular radial fibres
This module isolates the pointwise product identity behind the radial-outcome cancellation. It evaluates the regression and design density in the changed cell before the later integral argument discards the purely angular terms.
theorem angularRadialSuccessIncrement_identity
Before the cutoff is fully active, the uncancelled radial success-mass increment is exactly the bump amplitude times the complementary cutoff.
Formal statement
hypotheses
b cA delta w r :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
conclusion
delta * angularRadialProfile w r + (b * r * angularTilt b cA delta w r) / 2
= delta * angularRadialProfile w r * (1 - angularCutoff b cA delta r)
Proof (Lean source)
-- @node: angularRadialSuccessIncrement_identity
lemma angularRadialSuccessIncrement_identity
{b cA delta w r : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
:
delta * angularRadialProfile w r +
(b * r * angularTilt b cA delta w r) / 2 =
delta * angularRadialProfile w r *
(1 - angularCutoff b cA delta r) := by
by_cases hcut : angularCutoff b cA delta r = 0
· rw [angularTilt, hcut]
simp
· have hbr : cA * delta < b * r := by
by_contra h
have hle : b * r ≤ cA * delta := le_of_not_gt h
exact hcut (angularCutoff_eq_zero hscale hle)
have hmax : max (b * r) (cA * delta) = b * r := max_eq_left hbr.le
have hbr0 : b * r ≠ 0 := ne_of_gt (hscale.trans hbr)
have hr0 : r ≠ 0 := by
intro hrzero
exact hbr0 (by simp [hrzero])
rw [angularTilt, hmax]
field_simp [hbr0, hr0]
ring
theorem angularRadialSuccessIncrement_abs_le
The uncancelled radial success-mass increment has absolute value at most the bump amplitude. This is the pointwise input to the exceptional-radius Bernoulli KL estimate.
Formal statement
hypotheses
b cA delta w r :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hdelta :
0 ≤ delta
conclusion
|delta * angularRadialProfile w r + (b * r * angularTilt b cA delta w r) / 2| ≤ delta
Proof (Lean source)
-- @node: angularRadialSuccessIncrement_abs_le
lemma angularRadialSuccessIncrement_abs_le
{b cA delta w r : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hdelta : 0 ≤ delta) :
|delta * angularRadialProfile w r +
(b * r * angularTilt b cA delta w r) / 2| ≤ delta := by
rw [angularRadialSuccessIncrement_identity hb hscale]
have hp := angularRadialProfile_mem_Icc w r
have hc := angularCutoff_mem_Icc b cA delta r
have hcomp : 0 ≤ 1 - angularCutoff b cA delta r := sub_nonneg.mpr hc.2
have hcomp1 : 1 - angularCutoff b cA delta r ≤ 1 := by linarith [hc.1]
have hprod :
angularRadialProfile w r * (1 - angularCutoff b cA delta r) ≤ 1 := by
exact mul_le_one₀ hp.2 hcomp hcomp1
rw [show delta * angularRadialProfile w r *
(1 - angularCutoff b cA delta r) =
delta * (angularRadialProfile w r *
(1 - angularCutoff b cA delta r)) by ring,
abs_of_nonneg (mul_nonneg hdelta (mul_nonneg hp.1 hcomp))]
nlinarith [mul_nonneg hdelta
(show 0 ≤ angularRadialProfile w r *
(1 - angularCutoff b cA delta r) from mul_nonneg hp.1 hcomp)]
theorem packingRegression_mul_density_flip_cell_identity
Inside the changed cell, a true packing bit contributes exactly its radial bump, while its flipped false bit contributes only the affine baseline.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hw :
0 < w
hsep :
∀ i k : Fin M
if
i ≠ k
then
hj :
omega j = true
x :
hx :
x ∈ closedBall (angularGridCenter M j) w
conclusion
packingRegression b delta w (angularGridCenter M) omega x * packingAngularDensity b cA delta w (angularGridCenter M) omega x
- packingRegression b delta w (angularGridCenter M) (flipBit j omega) x * packingAngularDensity b cA delta w (angularGridCenter M) (flipBit j omega) x
= localizedPackingBump delta w (angularGridCenter M j) x
+ (packingAffineBaseline b x + localizedPackingBump delta w (angularGridCenter M j) x) * packingAngularTerm b cA delta w (angularGridCenter M j) x
Proof (Lean source)
-- @node: packingRegression_mul_density_flip_cell_identity
lemma packingRegression_mul_density_flip_cell_identity
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hw : 0 < w)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) (hj : omega j = true) {x : Score}
(hx : x ∈ closedBall (angularGridCenter M j) w) :
packingRegression b delta w (angularGridCenter M) omega x *
packingAngularDensity b cA delta w (angularGridCenter M) omega x -
packingRegression b delta w (angularGridCenter M)
(flipBit j omega) x *
packingAngularDensity b cA delta w (angularGridCenter M)
(flipBit j omega) x =
localizedPackingBump delta w (angularGridCenter M j) x +
(packingAffineBaseline b x +
localizedPackingBump delta w (angularGridCenter M j) x) *
packingAngularTerm b cA delta w (angularGridCenter M j) x := by
have hfar : ∀ i : Fin M, i ≠ j →
w ≤ dist x (angularGridCenter M i) := by
intro i hij
have htri : dist (angularGridCenter M i) (angularGridCenter M j) ≤
dist (angularGridCenter M i) x +
dist x (angularGridCenter M j) := dist_triangle _ _ _
have hs := hsep i j hij
rw [Metric.mem_closedBall] at hx
rw [dist_comm (angularGridCenter M i) x] at htri
linarith
have hreg : packingRegression b delta w (angularGridCenter M) omega x =
packingAffineBaseline b x +
localizedPackingBump delta w (angularGridCenter M j) x := by
unfold packingRegression
rw [Finset.sum_eq_single j]
· simp [hj]
· intro i _ hij
rw [localizedPackingBump_eq_zero_of_bandwidth_le_dist hw (hfar i hij)]
simp
· simp
have hregFlip : packingRegression b delta w (angularGridCenter M)
(flipBit j omega) x = packingAffineBaseline b x := by
unfold packingRegression
rw [Finset.sum_eq_zero]
· simp
· intro i _
by_cases hij : i = j
· subst i
simp [flipBit, hj]
· rw [localizedPackingBump_eq_zero_of_bandwidth_le_dist hw (hfar i hij)]
simp
have hdens : packingAngularDensity b cA delta w (angularGridCenter M) omega x =
1 + packingAngularTerm b cA delta w (angularGridCenter M j) x := by
unfold packingAngularDensity
rw [Finset.sum_eq_single j]
· simp [hj]
· intro i _ hij
rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw (hfar i hij)]
simp
· simp
have hdensFlip : packingAngularDensity b cA delta w (angularGridCenter M)
(flipBit j omega) x = 1 := by
unfold packingAngularDensity
rw [Finset.sum_eq_zero]
· simp
· intro i _
by_cases hij : i = j
· subst i
simp [flipBit, hj]
· rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw (hfar i hij)]
simp
rw [hreg, hregFlip, hdens, hdensFlip]
ring
theorem packingRegression_mul_density_flip_cell_radial_identity
The cell product identity in the radial-profile and direction-cosine coordinates consumed by the polar cancellation lemmas.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hw :
0 < w
hsep :
∀ i k : Fin M
if
i ≠ k
then
hj :
omega j = true
x :
hx :
x ∈ closedBall (angularGridCenter M j) w
conclusion
packingRegression b delta w (angularGridCenter M) omega x * packingAngularDensity b cA delta w (angularGridCenter M) omega x
- packingRegression b delta w (angularGridCenter M) (flipBit j omega) x * packingAngularDensity b cA delta w (angularGridCenter M) (flipBit j omega) x
+ (packingAffineBaseline b x + delta * angularRadialProfile w (dist x (angularGridCenter M j))) * angularTilt b cA delta w (dist x (angularGridCenter M j)) * ((scoreCoordinates x - scoreCoordinates (angularGridCenter M j)).1 / dist x (angularGridCenter M j))
Proof (Lean source)
-- @node: packingRegression_mul_density_flip_cell_radial_identity
lemma packingRegression_mul_density_flip_cell_radial_identity
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hw : 0 < w)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) (hj : omega j = true) {x : Score}
(hx : x ∈ closedBall (angularGridCenter M j) w) :
packingRegression b delta w (angularGridCenter M) omega x *
packingAngularDensity b cA delta w (angularGridCenter M) omega x -
packingRegression b delta w (angularGridCenter M)
(flipBit j omega) x *
packingAngularDensity b cA delta w (angularGridCenter M)
(flipBit j omega) x =
delta * angularRadialProfile w (dist x (angularGridCenter M j)) +
(packingAffineBaseline b x +
delta * angularRadialProfile w (dist x (angularGridCenter M j))) *
angularTilt b cA delta w (dist x (angularGridCenter M j)) *
((scoreCoordinates x - scoreCoordinates (angularGridCenter M j)).1 /
dist x (angularGridCenter M j)) := by
rw [packingRegression_mul_density_flip_cell_identity j hw hsep omega hj hx,
localizedPackingBump_eq_delta_mul_angularRadialProfile]
rw [packingAngularTerm, packingDirectionCos_eq_planarFirst_div_radius]
rw [planarRadius_scoreCoordinates_sub]
ring
Helpers.AngularRadialAssembly 2 declarations This module turns the polar cancellation identity for the changed half-disc into equality of the complete radius--outcome laws beyond an active cutoff.
Assembly of angular radial-fibre cancellation
This module turns the polar cancellation identity for the changed half-disc into equality of the complete radius--outcome laws beyond an active cutoff.
theorem angularPacking_flip_setIntegral_eq_of_active
For a true changed bit, the conditional-mean mass of every fully active radial slice is unchanged by flipping that bit.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
hj :
omega j = true
A :
Set ℝ
hA :
hactive :
∀ r ∈ A, 2 * (cA * delta) ≤ b * r
conclusion
(∫ x in {x | dist x (angularGridCenter M j) ∈ A}, clippedPackingRegression b delta w (angularGridCenter M) omega x ∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega))
= ∫ x in {x | dist x (angularGridCenter M j) ∈ A}, clippedPackingRegression b delta w (angularGridCenter M) (flipBit j omega) x ∂(angularDesignMeasure b cA delta w (angularGridCenter M) (flipBit j omega))
Proof (Lean source)
-- @node: angularPacking_flip_setIntegral_eq_of_active
lemma angularPacking_flip_setIntegral_eq_of_active
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) (hj : omega j = true)
{A : Set ℝ} (hA : MeasurableSet A)
(hactive : ∀ r ∈ A, 2 * (cA * delta) ≤ b * r) :
(∫ x in {x | dist x (angularGridCenter M j) ∈ A},
clippedPackingRegression b delta w (angularGridCenter M) omega x
∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega)) =
∫ x in {x | dist x (angularGridCenter M j) ∈ A},
clippedPackingRegression b delta w (angularGridCenter M)
(flipBit j omega) x
∂(angularDesignMeasure b cA delta w (angularGridCenter M)
(flipBit j omega)) := by
let c := angularGridCenter M j
let S : Set Score := {x | dist x c ∈ A}
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ S
let f : Score → ℝ := fun x =>
packingRegression b delta w (angularGridCenter M) omega x *
packingAngularDensity b cA delta w (angularGridCenter M) omega x
let f' : Score → ℝ := fun x =>
packingRegression b delta w (angularGridCenter M)
(flipBit j omega) x *
packingAngularDensity b cA delta w (angularGridCenter M)
(flipBit j omega) x
have hS : MeasurableSet S := hA.preimage (by fun_prop)
rw [clippedPackingRegression_setIntegral_angularDesignMeasure hb hbSmall hcA
hscale hdelta hdeltaSmall hw hsep omega hS,
clippedPackingRegression_setIntegral_angularDesignMeasure hb hbSmall hcA
hscale hdelta hdeltaSmall hw hsep (flipBit j omega) hS]
change (∫ x in S ∩ scoreCube (1 / 2 : ℝ), f x) =
∫ x in S ∩ scoreCube (1 / 2 : ℝ), f' x
have hf : IntegrableOn f (S ∩ scoreCube (1 / 2 : ℝ)) := by
exact (((packingRegression_contDiff b delta w (angularGridCenter M) omega).continuous.mul
(packingAngularDensity_continuous hb hscale
(angularGridCenter M) omega)).continuousOn.integrableOn_compact
packingScoreCube_isCompact).mono_set inter_subset_right
have hf' : IntegrableOn f' (S ∩ scoreCube (1 / 2 : ℝ)) := by
exact (((packingRegression_contDiff b delta w (angularGridCenter M)
(flipBit j omega)).continuous.mul
(packingAngularDensity_continuous hb hscale (angularGridCenter M)
(flipBit j omega))).continuousOn.integrableOn_compact
packingScoreCube_isCompact).mono_set inter_subset_right
rw [← sub_eq_zero, ← integral_sub hf hf']
have hboundary : (volume : Measure Score)
{x | (scoreCoordinates x - scoreCoordinates c).2 = 0} = 0 := by
have hpre : {x : Score | (scoreCoordinates x - scoreCoordinates c).2 = 0} =
scoreCoordinates ⁻¹'
{z : ℝ × ℝ | z.2 = (scoreCoordinates c).2} := by
ext x
change (scoreCoordinates x).2 - (scoreCoordinates c).2 = 0 ↔
(scoreCoordinates x).2 = (scoreCoordinates c).2
constructor <;> intro h <;> linarith
rw [hpre, scoreCoordinates_measurePreserving.measure_preimage_emb
scoreCoordinates_measurableEmbedding]
have hset : {z : ℝ × ℝ | z.2 = (scoreCoordinates c).2} =
univ ×ˢ {(scoreCoordinates c).2} := by
ext z
simp
rw [hset, Measure.volume_eq_prod,
Measure.prod_apply (MeasurableSet.univ.prod
(measurableSet_singleton (scoreCoordinates c).2))]
simp
have hae : ∀ᵐ x ∂(volume : Measure Score),
(S ∩ scoreCube (1 / 2 : ℝ)).indicator (fun x => f x - f' x) x =
D.indicator (fun x => f x - f' x) x := by
filter_upwards [compl_mem_ae_iff.mpr hboundary] with x hxboundary
by_cases hxD : x ∈ D
· have hxCell : x ∈ closedBall c w ∩ scoreCube (1 / 2 : ℝ) := by
apply (mem_angularGrid_packingCell_iff_closedUpperHalfDisc j hwQuarter x).mpr
exact ⟨le_of_lt hxD.1.1, by
simpa [c, planarRadius_scoreCoordinates_sub] using hxD.1.2⟩
have hxS : x ∈ S := hxD.2
rw [Set.indicator_of_mem hxD,
Set.indicator_of_mem (show x ∈ S ∩ scoreCube (1 / 2 : ℝ) from
⟨hxS, hxCell.2⟩)]
· rw [Set.indicator_of_notMem hxD]
by_cases hxSS : x ∈ S ∩ scoreCube (1 / 2 : ℝ)
· rw [Set.indicator_of_mem hxSS]
have hxOutside : x ∉ closedBall c w := by
intro hxBall
have hxLower := hxSS.2 (1 : Fin 2)
have hcLower : c 1 = -(1 / 2 : ℝ) := by
dsimp [c]
simpa [div_eq_mul_inv] using angularGridCenter_apply_one M j
have hnonneg : 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 := by
dsimp [scoreCube] at hxLower
simp only [scoreCoordinates, Prod.snd_sub]
rw [hcLower]
have hlower := neg_le_of_abs_le hxLower
linarith
have hpos : 0 < (scoreCoordinates x - scoreCoordinates c).2 :=
lt_of_le_of_ne hnonneg (Ne.symm hxboundary)
exact hxD ⟨⟨hpos, by simpa [c, Metric.mem_closedBall] using hxBall⟩, hxSS.1⟩
have hfar : w ≤ dist x c := by
exact le_of_lt (by simpa [Metric.mem_closedBall, not_le] using hxOutside)
have hreg : packingRegression b delta w (angularGridCenter M) omega x =
packingRegression b delta w (angularGridCenter M)
(flipBit j omega) x := by
unfold packingRegression
congr 1
apply Finset.sum_congr rfl
intro k _
by_cases hkj : k = j
· subst k
rw [localizedPackingBump_eq_zero_of_bandwidth_le_dist hw hfar]
simp
· simp [flipBit, hkj]
have hdens : packingAngularDensity b cA delta w (angularGridCenter M) omega x =
packingAngularDensity b cA delta w (angularGridCenter M)
(flipBit j omega) x := by
unfold packingAngularDensity
congr 1
apply Finset.sum_congr rfl
intro k _
by_cases hkj : k = j
· subst k
rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw hfar]
simp
· simp [flipBit, hkj]
simp [f, f', hreg, hdens]
· rw [Set.indicator_of_notMem hxSS]
rw [← integral_indicator (hS.inter (scoreCube_measurableSet _)),
integral_congr_ae hae]
have hD : MeasurableSet D := by
dsimp [D]
have hv : Measurable (fun x : Score =>
(scoreCoordinates x - scoreCoordinates c).2) := by fun_prop
have hr : Measurable (fun x : Score => dist x c) := by fun_prop
exact ((measurableSet_lt measurable_const hv).inter
(measurableSet_le hr measurable_const)).inter hS
rw [integral_indicator hD]
change (∫ x in D, f x - f' x) = 0
simpa [D, S, c, f, f'] using
packingRegression_density_flip_integral_eq_zero_of_active j hb hscale hw
hsep omega hj hA hactive
theorem angularPackingCtyLaw_flip_restrict_Ici_eq_of_active
If the angular cutoff is fully active beyond R, flipping a bit leaves the complete radius--outcome law unchanged on that tail.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w R :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
hactive :
∀ r ∈ Ici R, 2 * (cA * delta) ≤ b * r
conclusion
(onePointDistanceLaw (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw hwQuarter hsep) (angularGridCenter M j)).restrict {z | R ≤ z.2}
= (onePointDistanceLaw (angularPackingCtyLaw b cA delta w (flipBit j omega) hb hscale hcA hdelta hw hwQuarter hsep) (angularGridCenter M j)).restrict {z | R ≤ z.2}
Proof (Lean source)
-- @node: angularPackingCtyLaw_flip_restrict_Ici_eq_of_active
lemma angularPackingCtyLaw_flip_restrict_Ici_eq_of_active
{M : ℕ} (j : Fin M) {b cA delta w R : ℝ}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool)
(hactive : ∀ r ∈ Ici R, 2 * (cA * delta) ≤ b * r) :
(onePointDistanceLaw
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw
hwQuarter hsep) (angularGridCenter M j)).restrict {z | R ≤ z.2} =
(onePointDistanceLaw
(angularPackingCtyLaw b cA delta w (flipBit j omega)
hb hscale hcA hdelta hw hwQuarter hsep)
(angularGridCenter M j)).restrict {z | R ≤ z.2} := by
apply angularPackingCtyLaw_restrict_Ici_eq_of_radial_slices hb hscale hcA
hdelta hw hwQuarter hsep omega (flipBit j omega) j
intro A B hA hB
let S : Set Score :=
{x | dist x (angularGridCenter M j) ∈ B ∩ Ici R}
have hS : MeasurableSet S := (hB.inter measurableSet_Ici).preimage (by fun_prop)
have hmap := angularDesignMeasure_map_distance_eq j hb hscale hcA hdelta hw
hwQuarter hsep omega (flipBit j omega)
(by intro k hkj; simp [flipBit, hkj])
letI : IsProbabilityMeasure
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw
hwQuarter hsep omega
letI : IsProbabilityMeasure
(angularDesignMeasure b cA delta w (angularGridCenter M)
(flipBit j omega)) :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw
hwQuarter hsep (flipBit j omega)
have hmass := radialSlice_mass_eq_of_map_distance_eq
(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
(angularDesignMeasure b cA delta w (angularGridCenter M)
(flipBit j omega))
(angularGridCenter M j) hmap (A := B ∩ Ici R)
(hB.inter measurableSet_Ici)
apply bernoulliGaussianKernel_setLIntegral_eq_of_mass_and_mean
(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
(angularDesignMeasure b cA delta w (angularGridCenter M)
(flipBit j omega))
(clippedPackingRegression b delta w (angularGridCenter M) omega)
(clippedPackingRegression b delta w (angularGridCenter M)
(flipBit j omega))
(clippedPackingRegression_measurable b delta w (angularGridCenter M) omega)
(clippedPackingRegression_measurable b delta w (angularGridCenter M)
(flipBit j omega))
(fun x => (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega x).1)
(fun x => (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega x).2)
(fun x => (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) (flipBit j omega) x).1)
(fun x => (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) (flipBit j omega) x).2)
(D := S) hmass
by_cases hj : omega j = true
· exact angularPacking_flip_setIntegral_eq_of_active j hb hbSmall hscale hcA
hdelta hdeltaSmall hw hwQuarter hsep omega hj (hB.inter measurableSet_Ici)
(fun r hr => hactive r hr.2)
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
have htrue : (flipBit j omega) j = true := by
simp [flipBit, hjf]
symm
simpa [S, flipBit_involutive j omega] using
angularPacking_flip_setIntegral_eq_of_active j hb hbSmall hscale hcA
hdelta hdeltaSmall hw hwQuarter hsep
(flipBit j omega) htrue (hB.inter measurableSet_Ici)
(fun r hr => hactive r hr.2)
Helpers.AngularRadialFibre 3 declarations This module assembles the pointwise product identity and polar cancellation leaves needed by the eventual equality of radial outcome fibres.
Radial fibre cancellation for adjacent angular packing laws
This module assembles the pointwise product identity and polar cancellation leaves needed by the eventual equality of radial outcome fibres.
theorem clippedPackingRegression_setIntegral_angularDesignMeasure
Integrating the clipped regression under an angular design is exactly Lebesgue integration of the untruncated regression times its design density on the part of the set lying in the packing square. This is the bookkeeping bridge between the faithful score law and the polar cancellation identities.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hcA :
8 ≤ cA
hscale :
0 < cA * delta
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k : Fin M
if
i ≠ k
then
hD :
conclusion
(∫ x in D, clippedPackingRegression b delta w (angularGridCenter M) omega x ∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega))
= ∫ x in D ∩ scoreCube (1 / 2 : ℝ), packingRegression b delta w (angularGridCenter M) omega x * packingAngularDensity b cA delta w (angularGridCenter M) omega x
Proof (Lean source)
-- @node: clippedPackingRegression_setIntegral_angularDesignMeasure
lemma clippedPackingRegression_setIntegral_angularDesignMeasure
{M : ℕ} {b cA delta w : ℝ}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4) (hcA : 8 ≤ cA)
(hscale : 0 < cA * delta)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) {D : Set Score} (hD : MeasurableSet D) :
(∫ x in D,
clippedPackingRegression b delta w (angularGridCenter M) omega x
∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega)) =
∫ x in D ∩ scoreCube (1 / 2 : ℝ),
packingRegression b delta w (angularGridCenter M) omega x *
packingAngularDensity b cA delta w (angularGridCenter M) omega x := by
rw [angularDesignMeasure_eq_restrict_withDensity]
rw [setIntegral_withDensity_eq_setIntegral_toReal_smul₀
((packingAngularDensity_measurable hb hscale
(angularGridCenter M) omega).ennreal_ofReal.aemeasurable)
(by simp) _ hD]
rw [Measure.restrict_restrict hD, inter_comm]
apply integral_congr_ae
filter_upwards [ae_restrict_mem ((scoreCube_measurableSet _).inter hD)]
with x hx
rw [clippedPackingRegression_eq_on_square hbSmall hdelta.le hdeltaSmall hw
hsep omega hx.1]
have hdens0 : 0 ≤ packingAngularDensity b cA delta w
(angularGridCenter M) omega x := by
have hlo := (packingAngularDensity_mem_Icc (b := b) hcA hdelta hw
hsep omega x).1
linarith
simp [ENNReal.toReal_ofReal hdens0, mul_comm]
theorem angularGridCenter_openRadialSet_weighted_direction_cancellation
At a lower-edge grid center, a radial weight times the horizontal direction cosine integrates to zero on every open-half-disc radial slice.
Formal statement
hypotheses
conclusion
let c := angularGridCenter M j let D : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A} (∫ x in D, g (dist x c) * ((scoreCoordinates x - scoreCoordinates c).1 / dist x c))
= 0
Proof (Lean source)
-- @node: angularGridCenter_openRadialSet_weighted_direction_cancellation
lemma angularGridCenter_openRadialSet_weighted_direction_cancellation
{M : ℕ} (j : Fin M) (g : ℝ → ℝ) (w : ℝ)
{A : Set ℝ} (hA : MeasurableSet A) :
let c := angularGridCenter M j
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
(∫ x in D, g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) = 0 := by
dsimp only
let c : Score := angularGridCenter M j
let cp : ℝ × ℝ := scoreCoordinates c
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let E : Set (ℝ × ℝ) :=
{z | 0 < (z - cp).2 ∧ planarRadius (z - cp) ≤ w} ∩
{z | planarRadius (z - cp) ∈ A}
have himage : scoreCoordinates '' D = E := by
ext z
constructor
· rintro ⟨x, hx, rfl⟩
simpa [D, E, cp, c, planarRadius_scoreCoordinates_sub] using hx
· intro hz
let x : Score := scorePoint z.1 z.2
have hcoord : scoreCoordinates x = z := by
ext <;> simp [x, scoreCoordinates, scorePoint_apply_zero,
scorePoint_apply_one]
refine ⟨x, ?_, hcoord⟩
simpa [D, E, cp, c, hcoord, ← planarRadius_scoreCoordinates_sub] using hz
have hfun : (fun x : Score => g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) =
fun x => g (planarRadius (scoreCoordinates x - scoreCoordinates c)) *
((scoreCoordinates x - scoreCoordinates c).1 /
planarRadius (scoreCoordinates x - scoreCoordinates c)) := by
funext x
rw [planarRadius_scoreCoordinates_sub]
rw [hfun]
rw [← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ => g (planarRadius (z - scoreCoordinates c)) *
((z - scoreCoordinates c).1 / planarRadius (z - scoreCoordinates c))) D,
himage]
let T : (ℝ × ℝ) → (ℝ × ℝ) := fun u => cp + u
let E0 : Set (ℝ × ℝ) :=
{u | 0 < u.2 ∧ planarRadius u ≤ w} ∩ planarRadius ⁻¹' A
have hT : MeasurableEmbedding T := (Homeomorph.addLeft cp).measurableEmbedding
have hmp : MeasurePreserving T (volume : Measure (ℝ × ℝ)) volume :=
measurePreserving_add_left volume cp
have hE : E = T '' E0 := by
ext z
constructor
· rintro ⟨hz, hAz⟩
refine ⟨z - cp, ⟨?_, ?_⟩, by simp [T]⟩
· simpa [E, E0] using hz
· simpa [E, E0] using hAz
· rintro ⟨u, ⟨hu, hAu⟩, rfl⟩
simpa [E, E0, T] using intro hu hAu
rw [hE, hmp.setIntegral_image_emb hT]
have heq : (fun u : ℝ × ℝ =>
g (planarRadius (T u - scoreCoordinates c)) *
((T u - scoreCoordinates c).1 /
planarRadius (T u - scoreCoordinates c))) =
fun u => g (planarRadius u) * (u.1 / planarRadius u) := by
funext u
simp [T, cp]
rw [heq]
simpa [E0] using
halfDisc_radialSet_weighted_first_div_radius_cancellation g w hA
theorem packingRegression_density_flip_integral_eq_zero_of_active
For a true bit, the outcome-weighted design-density difference integrates to zero on every fully active radial slice of its cell.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hw :
0 < w
hj :
omega j = true
A :
Set ℝ
hA :
hactive :
∀ r ∈ A, 2 * (cA * delta) ≤ b * r
conclusion
let c := angularGridCenter M j let D : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A} (∫ x in D, packingRegression b delta w (angularGridCenter M) omega x * packingAngularDensity b cA delta w (angularGridCenter M) omega x - packingRegression b delta w (angularGridCenter M) (flipBit j omega) x * packingAngularDensity b cA delta w (angularGridCenter M) (flipBit j omega) x)
= 0
Proof (Lean source)
-- @node: packingRegression_density_flip_integral_eq_zero_of_active
lemma packingRegression_density_flip_integral_eq_zero_of_active
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (hw : 0 < w)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) (hj : omega j = true)
{A : Set ℝ} (hA : MeasurableSet A)
(hactive : ∀ r ∈ A, 2 * (cA * delta) ≤ b * r) :
let c := angularGridCenter M j
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
(∫ x in D,
packingRegression b delta w (angularGridCenter M) omega x *
packingAngularDensity b cA delta w (angularGridCenter M) omega x -
packingRegression b delta w (angularGridCenter M)
(flipBit j omega) x *
packingAngularDensity b cA delta w (angularGridCenter M)
(flipBit j omega) x) = 0 := by
dsimp only
let c := angularGridCenter M j
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
have hDsub : D ⊆ closedBall c w := by
intro x hx
simpa [D, Metric.mem_closedBall] using hx.1.2
have hfirst : IntegrableOn
(fun x : Score => delta * angularRadialProfile w (dist x c)) D :=
(((continuous_const.mul
((angularRadialProfile_continuous w).comp
(continuous_id.dist continuous_const))).continuousOn.integrableOn_compact
(isCompact_closedBall c w)).mono_set hDsub)
have hbase : Continuous (packingAffineBaseline b) := by
unfold packingAffineBaseline
fun_prop
have hsecond : IntegrableOn
(fun x : Score =>
(packingAffineBaseline b x +
delta * angularRadialProfile w (dist x c)) *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) D := by
have hcont : Continuous (fun x : Score =>
(packingAffineBaseline b x + localizedPackingBump delta w c x) *
packingAngularTerm b cA delta w c x) :=
(hbase.add (localizedPackingBump_contDiff delta w c).continuous).mul
(packingAngularTerm_continuous hb hscale c)
have hintClosed : IntegrableOn
(fun x : Score =>
(packingAffineBaseline b x + localizedPackingBump delta w c x) *
packingAngularTerm b cA delta w c x)
(closedBall c w) volume :=
hcont.continuousOn.integrableOn_compact (isCompact_closedBall c w)
have hint := hintClosed.mono_set hDsub
convert hint using 1
ext x
rw [localizedPackingBump_eq_delta_mul_angularRadialProfile,
packingAngularTerm, packingDirectionCos_eq_planarFirst_div_radius,
planarRadius_scoreCoordinates_sub]
ring
have hD : MeasurableSet D := by
dsimp [D]
have hv : Measurable (fun x : Score =>
(scoreCoordinates x - scoreCoordinates c).2) := by fun_prop
have hr : Measurable (fun x : Score => dist x c) := by fun_prop
exact ((measurableSet_lt measurable_const hv).inter
(measurableSet_le hr measurable_const)).inter (hA.preimage hr)
rw [integral_congr_ae (ae_restrict_of_forall_mem hD fun x hx =>
packingRegression_mul_density_flip_cell_radial_identity j hw hsep omega hj
(hDsub hx))]
rw [integral_add hfirst hsecond]
have hsplit : (∫ x in D,
(packingAffineBaseline b x +
delta * angularRadialProfile w (dist x c)) *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) =
(∫ x in D,
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) := by
let g : ℝ → ℝ := fun r =>
(1 / 2 + b * (angularGridCenter M j) 0 +
delta * angularRadialProfile w r) * angularTilt b cA delta w r
have hz := angularGridCenter_openRadialSet_weighted_direction_cancellation
j g w hA
dsimp only at hz
have hz' : (∫ x in D, g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) = 0 := by
simpa [D, c] using hz
have hright : IntegrableOn
(fun x : Score =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) D := by
have hc : Continuous (fun x : Score =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
packingAngularTerm b cA delta w c x) := by
apply Continuous.mul
· fun_prop
· exact packingAngularTerm_continuous hb hscale c
have hiClosed : IntegrableOn (fun x : Score =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
packingAngularTerm b cA delta w c x)
(closedBall c w) volume :=
hc.continuousOn.integrableOn_compact (isCompact_closedBall c w)
have hi := hiClosed.mono_set hDsub
convert hi using 1
ext x
rw [packingAngularTerm, packingDirectionCos_eq_planarFirst_div_radius,
planarRadius_scoreCoordinates_sub]
ring
have hzeroInt : IntegrableOn
(fun x : Score => g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) D := by
have hc : Continuous (fun x : Score =>
(1 / 2 + b * c 0 + delta * angularRadialProfile w (dist x c)) *
packingAngularTerm b cA delta w c x) := by
apply Continuous.mul
· exact continuous_const.add
(continuous_const.mul ((angularRadialProfile_continuous w).comp
(continuous_id.dist continuous_const)))
· exact packingAngularTerm_continuous hb hscale c
have hiClosed : IntegrableOn (fun x : Score =>
(1 / 2 + b * c 0 + delta * angularRadialProfile w (dist x c)) *
packingAngularTerm b cA delta w c x)
(closedBall c w) volume :=
hc.continuousOn.integrableOn_compact (isCompact_closedBall c w)
have hi := hiClosed.mono_set hDsub
convert hi using 1
ext x
dsimp [g]
rw [packingAngularTerm, packingDirectionCos_eq_planarFirst_div_radius,
planarRadius_scoreCoordinates_sub]
simp only [Prod.fst_sub]
ring
rw [show (fun x : Score =>
(packingAffineBaseline b x +
delta * angularRadialProfile w (dist x c)) *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) =
(fun x =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c) +
g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) by
funext x
dsimp [g, packingAffineBaseline, c, scoreCoordinates]
ring]
rw [integral_add hright hzeroInt, hz', add_zero]
rw [hsplit]
exact angularGridCenter_radialSet_angular_outcome_cancellation
(w := w) j hscale hA hactive
Helpers.AngularRadialKL 1 declarations This module packages the finite-KL bookkeeping needed to tensorize a one-observation radial-outcome estimate.
KL assembly for angular radial laws
This module packages the finite-KL bookkeeping needed to tensorize a one-observation radial-outcome estimate. In particular, absolute continuity and log-likelihood integrability are consequences of a finite real KL bound; they need not be proved separately by the angular construction.
theorem compressedSampleLaw_klDiv_le_of_onePoint_finite_bound
A finite real bound on one-observation radial KL supplies the absolute continuity and log-likelihood integrability guards required by product tensorization.
Formal statement
Proof (Lean source)
-- @node: compressedSampleLaw_klDiv_le_of_onePoint_finite_bound
lemma compressedSampleLaw_klDiv_le_of_onePoint_finite_bound
(P P' : CtyLaw) (n : ℕ) (x : Score) {B : ℝ} (hB : 0 ≤ B)
(hKL : klDiv (onePointDistanceLaw P x)
(onePointDistanceLaw P' x) ≤ ofReal B) :
klDiv (compressedSampleLaw P n x)
(compressedSampleLaw P' n x) ≤ ofReal ((n : ℝ) * B) := by
have hfinite : klDiv (onePointDistanceLaw P x)
(onePointDistanceLaw P' x) ≠ ⊤ :=
ne_top_of_le_ne_top ENNReal.ofReal_ne_top hKL
have hguards := InformationTheory.klDiv_ne_top_iff.mp hfinite
exact compressedSampleLaw_klDiv_le_of_onePoint P P' n x hB
hguards.1 hguards.2 hKL
Helpers.AngularRadialOnePointKL 15 declarations This module supplies the paper-local common-radius kernel representation and the quantitative exceptional-radius estimate used by the angular packing.
One-point KL bound for the angular radial construction
This module supplies the paper-local common-radius kernel representation and the quantitative exceptional-radius estimate used by the angular packing.
The success-weighted radius measure associated with a score law and a Bernoulli regression.
Definition (Lean source)
-- @node: radialSuccessMeasure
noncomputable def radialSuccessMeasure
(nu : Measure Score) (p : Score → ℝ) (center : Score) : Measure ℝ :=
Measure.map (fun x : Score => dist x center)
(nu.withDensity fun x => ofReal (p x))
The measurable radial Bernoulli parameter obtained as the density of the success-weighted radius measure with respect to the radius marginal.
Definition (Lean source)
-- @node: radialSuccessParameter
noncomputable def radialSuccessParameter
(nu : Measure Score) (p : Score → ℝ) (center : Score) : ℝ → ℝ :=
fun r => ((radialSuccessMeasure nu p center).rnDeriv
(Measure.map (fun x : Score => dist x center) nu) r).toReal
theorem radialSuccessMeasure_absolutelyContinuous
The success-weighted radius measure is absolutely continuous with respect to the radius marginal whenever the regression is at most one.
Formal statement
Proof (Lean source)
-- @node: radialSuccessMeasure_absolutelyContinuous
lemma radialSuccessMeasure_absolutelyContinuous
(nu : Measure Score) [IsFiniteMeasure nu] (p : Score → ℝ)
(hp : Measurable p) (hp1 : ∀ x, p x ≤ 1) (center : Score) :
radialSuccessMeasure nu p center ≪
Measure.map (fun x : Score => dist x center) nu := by
apply Measure.absolutelyContinuous_of_le
apply Measure.map_mono
· calc
nu.withDensity (fun x => ofReal (p x)) ≤
nu.withDensity 1 := by
apply withDensity_mono
filter_upwards with x
simpa using ENNReal.ofReal_le_one.mpr (hp1 x)
_ = nu := withDensity_one
· fun_prop
theorem radialSuccessParameter_setIntegral
Integrating the radial success parameter over a measurable radial set recovers the success-weighted score integral on its preimage.
Formal statement
Proof (Lean source)
-- @node: radialSuccessParameter_setIntegral
lemma radialSuccessParameter_setIntegral
(nu : Measure Score) [IsFiniteMeasure nu] (p : Score → ℝ)
(hp : Measurable p) (hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1)
(center : Score) (A : Set ℝ) (hA : MeasurableSet A) :
(∫ r in A, radialSuccessParameter nu p center r
∂(Measure.map (fun x : Score => dist x center) nu)) =
∫ x in {x | dist x center ∈ A}, p x ∂nu := by
let rho : Score → ℝ := fun x => dist x center
let m : Measure ℝ := Measure.map rho nu
let s : Measure ℝ := radialSuccessMeasure nu p center
have hle : s ≤ m := by
dsimp [s, m, rho]
apply Measure.map_mono
· calc
nu.withDensity (fun x => ofReal (p x)) ≤
nu.withDensity 1 := by
apply withDensity_mono
filter_upwards with x
simpa using ENNReal.ofReal_le_one.mpr (hp1 x)
_ = nu := withDensity_one
· fun_prop
have hac : s ≪ m := Measure.absolutelyContinuous_of_le hle
letI : IsFiniteMeasure m := Measure.isFiniteMeasure_map nu rho
letI : IsFiniteMeasure s := isFiniteMeasure_of_le m hle
have hleft := Measure.setIntegral_toReal_rnDeriv hac A
have hsA : s A = ofReal (∫ x in {x | rho x ∈ A}, p x ∂nu) := by
change (Measure.map rho
(nu.withDensity fun x => ofReal (p x))) A = _
rw [Measure.map_apply (by fun_prop) hA,
withDensity_apply _ (hA.preimage (by fun_prop))]
rw [← ofReal_integral_eq_lintegral_ofReal]
· rfl
· apply Measure.integrableOn_of_bounded (measure_ne_top _ _)
hp.aestronglyMeasurable
filter_upwards with x
rw [Real.norm_eq_abs, abs_of_nonneg (hp0 x)]
exact hp1 x
· exact Filter.Eventually.of_forall hp0
change (∫ r in A, ((s.rnDeriv m) r).toReal ∂m) = _
rw [hleft]
rw [Measure.real_def, hsA, ENNReal.toReal_ofReal]
exact integral_nonneg_of_ae (Filter.Eventually.of_forall fun x => hp0 x)
theorem radialSuccessParameter_mem_Icc_ae
A scorewise middle-half bound passes to the Radon--Nikodym radial success parameter.
Formal statement
hypotheses
conclusion
radialSuccessParameter nu p center r ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ)
Proof (Lean source)
-- @node: radialSuccessParameter_mem_Icc_ae
lemma radialSuccessParameter_mem_Icc_ae
(nu : Measure Score) [IsFiniteMeasure nu] (p : Score → ℝ)
(hp : Measurable p) (hp0 : ∀ x, 1 / 4 ≤ p x)
(hp1 : ∀ x, p x ≤ 3 / 4) (center : Score) :
∀ᵐ r ∂(Measure.map (fun x : Score => dist x center) nu),
radialSuccessParameter nu p center r ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ) := by
let rho : Score → ℝ := fun x => dist x center
let m : Measure ℝ := Measure.map rho nu
let g : ℝ → ℝ := radialSuccessParameter nu p center
letI : IsFiniteMeasure m := Measure.isFiniteMeasure_map nu rho
let s : Measure ℝ := radialSuccessMeasure nu p center
have hsle : s ≤ m := by
dsimp [s, m, rho]
apply Measure.map_mono
· calc
nu.withDensity (fun x => ofReal (p x)) ≤
nu.withDensity 1 := by
apply withDensity_mono
filter_upwards with x
simpa using ENNReal.ofReal_le_one.mpr (by linarith [hp1 x])
_ = nu := withDensity_one
· fun_prop
letI : IsFiniteMeasure s := isFiniteMeasure_of_le m hsle
have hg : Integrable g m := by
dsimp [g, radialSuccessParameter, m, rho]
exact Measure.integrable_toReal_rnDeriv
have hcLo : Integrable (fun _ : ℝ => (1 / 4 : ℝ)) m := integrable_const _
have hcHi : Integrable (fun _ : ℝ => (3 / 4 : ℝ)) m := integrable_const _
have hlo : (fun _ : ℝ => (1 / 4 : ℝ)) ≤ᵐ[m] g := by
apply ae_le_of_forall_setIntegral_le hcLo hg
intro A hA _
rw [radialSuccessParameter_setIntegral nu p hp
(fun x => by linarith [hp0 x]) (fun x => by linarith [hp1 x]) center A hA]
rw [integral_const]
change (m.restrict A).real univ * (1 / 4 : ℝ) ≤ _
rw [Measure.real_def, Measure.restrict_apply_univ]
have hmap : m A = nu {x | rho x ∈ A} := by
rw [Measure.map_apply (by fun_prop) hA]
rfl
rw [hmap]
have hmono : (∫ x in {x | rho x ∈ A}, (1 / 4 : ℝ) ∂nu) ≤
∫ x in {x | rho x ∈ A}, p x ∂nu := by
apply integral_mono_ae
· exact integrableOn_const
· apply Measure.integrableOn_of_bounded (M := 1) (measure_ne_top _ _)
hp.aestronglyMeasurable
filter_upwards with x
rw [Real.norm_eq_abs]
exact abs_le.mpr ⟨by linarith [hp0 x], by linarith [hp1 x]⟩
· exact ae_restrict_of_forall_mem (hA.preimage (by fun_prop))
(fun x _ => hp0 x)
simpa [Measure.real_def] using hmono
have hhi : g ≤ᵐ[m] (fun _ : ℝ => (3 / 4 : ℝ)) := by
apply ae_le_of_forall_setIntegral_le hg hcHi
intro A hA _
rw [radialSuccessParameter_setIntegral nu p hp
(fun x => by linarith [hp0 x]) (fun x => by linarith [hp1 x]) center A hA]
rw [integral_const]
change _ ≤ (m.restrict A).real univ * (3 / 4 : ℝ)
rw [Measure.real_def, Measure.restrict_apply_univ]
have hmap : m A = nu {x | rho x ∈ A} := by
rw [Measure.map_apply (by fun_prop) hA]
rfl
rw [hmap]
have hmono : (∫ x in {x | rho x ∈ A}, p x ∂nu) ≤
∫ x in {x | rho x ∈ A}, (3 / 4 : ℝ) ∂nu := by
apply integral_mono_ae
· apply Measure.integrableOn_of_bounded (M := 1) (measure_ne_top _ _)
hp.aestronglyMeasurable
filter_upwards with x
rw [Real.norm_eq_abs]
exact abs_le.mpr ⟨by linarith [hp0 x], by linarith [hp1 x]⟩
· exact integrableOn_const
· exact ae_restrict_of_forall_mem (hA.preimage (by fun_prop))
(fun x _ => hp1 x)
simpa [Measure.real_def] using hmono
filter_upwards [hlo, hhi] with r hr0 hr1
exact ⟨hr0, hr1⟩
A globally clipped version of the radial success parameter. Clipping is silent almost everywhere under the radius marginal but makes the associated Bernoulli--Gaussian kernel a Markov kernel without exceptional values.
Definition (Lean source)
-- @node: clippedRadialSuccessParameter
noncomputable def clippedRadialSuccessParameter
(nu : Measure Score) (p : Score → ℝ) (center : Score) : ℝ → ℝ :=
fun r => max (1 / 4 : ℝ) (min (3 / 4 : ℝ)
(radialSuccessParameter nu p center r))
theorem clippedRadialSuccessParameter_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (clippedRadialSuccessParameter nu p center)
Proof (Lean source)
lemma clippedRadialSuccessParameter_measurable
(nu : Measure Score) (p : Score → ℝ) (center : Score) :
Measurable (clippedRadialSuccessParameter nu p center) := by
unfold clippedRadialSuccessParameter radialSuccessParameter
fun_prop
theorem clippedRadialSuccessParameter_mem_Icc
The clipped success parameter lies in the displayed closed interval.
Formal statement
hypotheses
conclusion
clippedRadialSuccessParameter nu p center r ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ)
Proof (Lean source)
lemma clippedRadialSuccessParameter_mem_Icc
(nu : Measure Score) (p : Score → ℝ) (center : Score) (r : ℝ) :
clippedRadialSuccessParameter nu p center r ∈
Icc (1 / 4 : ℝ) (3 / 4 : ℝ) := by
unfold clippedRadialSuccessParameter
constructor <;> simp <;> norm_num
theorem clippedRadialSuccessParameter_ae_eq
The two stated constructions agree under the theorem's assumptions.
Formal statement
hypotheses
conclusion
clippedRadialSuccessParameter nu p center
Proof (Lean source)
lemma clippedRadialSuccessParameter_ae_eq
(nu : Measure Score) [IsFiniteMeasure nu] (p : Score → ℝ)
(hp : Measurable p) (hp0 : ∀ x, 1 / 4 ≤ p x)
(hp1 : ∀ x, p x ≤ 3 / 4) (center : Score) :
clippedRadialSuccessParameter nu p center =ᵐ[
Measure.map (fun x : Score => dist x center) nu]
radialSuccessParameter nu p center := by
filter_upwards [radialSuccessParameter_mem_Icc_ae nu p hp hp0 hp1 center]
with r hr
unfold clippedRadialSuccessParameter
rw [min_eq_right hr.2, max_eq_right hr.1]
The Bernoulli--Gaussian kernel over an arbitrary measurable base type.
Definition (Lean source)
-- @node: bernoulliGaussianKernelOn
noncomputable def bernoulliGaussianKernelOn
{A : Type*} [MeasurableSpace A] (p : A → ℝ) (hp : Measurable p) :
Kernel A ℝ where
toFun x := bernoulliGaussianLaw (p x)
measurable' := by
unfold bernoulliGaussianLaw bernoulliLaw
fun_prop
theorem bernoulliGaussianKernelOn_isMarkovKernel
The stated conditional distribution is a Markov kernel: it is a probability law at each input and varies measurably with that input.
Formal statement
hypotheses
conclusion
Proof (Lean source)
lemma bernoulliGaussianKernelOn_isMarkovKernel
{A : Type*} [MeasurableSpace A] (p : A → ℝ) (hp : Measurable p)
(h0 : ∀ x, 0 ≤ p x) (h1 : ∀ x, p x ≤ 1) :
IsMarkovKernel (bernoulliGaussianKernelOn p hp) := by
constructor
intro x
exact bernoulliGaussianLaw_isProbabilityMeasure (h0 x) (h1 x)
theorem bernoulliGaussianKernel_setLIntegral_eq_of_mass_and_mean_general
Two Bernoulli--Gaussian mixtures over possibly different base spaces have the same outcome mass when the base masses and integrated success parameters agree.
Formal statement
hypotheses
A B :
nu :
nu' :
Measure B
IsFiniteMeasure nu'
p :
A → ℝ
p' :
B → ℝ
hp :
hp' :
Measurable p'
hp0 :
∀ x, 0 ≤ p x
hp1 :
∀ x, p x ≤ 1
hp0' :
∀ x, 0 ≤ p' x
hp1' :
∀ x, p' x ≤ 1
D :
Set A
D' :
Set B
hmass :
nu D = nu' D'
hmean :
∫ x in D, p x ∂nu = ∫ x in D', p' x ∂nu'
E :
Set ℝ
conclusion
(∫⁻ x in D, bernoulliGaussianKernelOn p hp x E ∂nu)
= ∫⁻ x in D', bernoulliGaussianKernelOn p' hp' x E ∂nu'
Proof (Lean source)
-- @node: bernoulliGaussianKernel_setLIntegral_eq_of_mass_and_mean_general
lemma bernoulliGaussianKernel_setLIntegral_eq_of_mass_and_mean_general
{A B : Type*} [MeasurableSpace A] [MeasurableSpace B]
(nu : Measure A) [IsFiniteMeasure nu]
(nu' : Measure B) [IsFiniteMeasure nu']
(p : A → ℝ) (p' : B → ℝ) (hp : Measurable p) (hp' : Measurable p')
(hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1)
(hp0' : ∀ x, 0 ≤ p' x) (hp1' : ∀ x, p' x ≤ 1)
{D : Set A} {D' : Set B} (hmass : nu D = nu' D')
(hmean : ∫ x in D, p x ∂nu = ∫ x in D', p' x ∂nu')
(E : Set ℝ) :
(∫⁻ x in D, bernoulliGaussianKernelOn p hp x E ∂nu) =
∫⁻ x in D', bernoulliGaussianKernelOn p' hp' x E ∂nu' := by
have hpInt : IntegrableOn p D nu := by
apply Measure.integrableOn_of_bounded (M := 1) (measure_ne_top nu D)
hp.aestronglyMeasurable
filter_upwards with x
rw [Real.norm_eq_abs, abs_of_nonneg (hp0 x)]
exact hp1 x
have hpInt' : IntegrableOn p' D' nu' := by
apply Measure.integrableOn_of_bounded (M := 1) (measure_ne_top nu' D')
hp'.aestronglyMeasurable
filter_upwards with x
rw [Real.norm_eq_abs, abs_of_nonneg (hp0' x)]
exact hp1' x
have hqInt : IntegrableOn (fun x => 1 - p x) D nu :=
(integrableOn_const (s := D) (C := (1 : ℝ))).sub hpInt
have hqInt' : IntegrableOn (fun x => 1 - p' x) D' nu' :=
(integrableOn_const (s := D') (C := (1 : ℝ))).sub hpInt'
have hpL : (∫⁻ x in D, ofReal (p x) ∂nu) =
∫⁻ x in D', ofReal (p' x) ∂nu' := by
rw [← ofReal_integral_eq_lintegral_ofReal hpInt
(Filter.Eventually.of_forall hp0),
← ofReal_integral_eq_lintegral_ofReal hpInt'
(Filter.Eventually.of_forall hp0'), hmean]
have hqmean : ∫ x in D, (1 - p x) ∂nu =
∫ x in D', (1 - p' x) ∂nu' := by
rw [integral_sub (integrableOn_const (s := D) (C := (1 : ℝ))) hpInt,
integral_sub (integrableOn_const (s := D') (C := (1 : ℝ))) hpInt']
simp only [integral_const, Measure.real_def]
rw [Measure.restrict_apply_univ, Measure.restrict_apply_univ, hmass, hmean]
have hqL : (∫⁻ x in D, ofReal (1 - p x) ∂nu) =
∫⁻ x in D', ofReal (1 - p' x) ∂nu' := by
rw [← ofReal_integral_eq_lintegral_ofReal hqInt
(Filter.Eventually.of_forall fun x => sub_nonneg.mpr (hp1 x)),
← ofReal_integral_eq_lintegral_ofReal hqInt'
(Filter.Eventually.of_forall fun x => sub_nonneg.mpr (hp1' x)), hqmean]
simp only [bernoulliGaussianKernelOn, Kernel.coe_mk,
bernoulliGaussianLaw_eq_gaussian_mixture, Measure.add_apply,
Measure.smul_apply, smul_eq_mul]
change (∫⁻ x, ofReal (p x) * (gaussianReal 1 1) E +
ofReal (1 - p x) * (gaussianReal 0 1) E ∂(nu.restrict D)) =
∫⁻ x, ofReal (p' x) * (gaussianReal 1 1) E +
ofReal (1 - p' x) * (gaussianReal 0 1) E ∂(nu'.restrict D')
rw [lintegral_add_left (by fun_prop) _, lintegral_add_left (by fun_prop) _]
simp_rw [mul_comm (ofReal (p _)), mul_comm (ofReal (1 - p _)),
mul_comm (ofReal (p' _)), mul_comm (ofReal (1 - p' _))]
have hmulP : (∫⁻ x in D, (gaussianReal 1 1) E * ofReal (p x) ∂nu) =
(gaussianReal 1 1) E * ∫⁻ x in D, ofReal (p x) ∂nu := by
exact lintegral_const_mul _ (by fun_prop)
have hmulQ : (∫⁻ x in D, (gaussianReal 0 1) E * ofReal (1 - p x) ∂nu) =
(gaussianReal 0 1) E * ∫⁻ x in D, ofReal (1 - p x) ∂nu := by
exact lintegral_const_mul _ (by fun_prop)
have hmulP' : (∫⁻ x in D', (gaussianReal 1 1) E * ofReal (p' x) ∂nu') =
(gaussianReal 1 1) E * ∫⁻ x in D', ofReal (p' x) ∂nu' := by
exact lintegral_const_mul _ (by fun_prop)
have hmulQ' : (∫⁻ x in D', (gaussianReal 0 1) E * ofReal (1 - p' x) ∂nu') =
(gaussianReal 0 1) E * ∫⁻ x in D', ofReal (1 - p' x) ∂nu' := by
exact lintegral_const_mul _ (by fun_prop)
rw [hmulP, hmulQ, hmulP', hmulQ', hpL, hqL]
theorem radialOutcomeLaw_eq_map_swap_compProd
After forgetting score direction, a Bernoulli--Gaussian score mixture is a composition product over the radius marginal with the clipped radial success parameter, followed by swapping radius and outcome coordinates.
Formal statement
hypotheses
conclusion
Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center)) (Measure.compProd nu (bernoulliGaussianKernel p hp))
= Measure.map swap (Measure.compProd (Measure.map (fun x : Score => dist x center) nu) (bernoulliGaussianKernelOn (clippedRadialSuccessParameter nu p center) (clippedRadialSuccessParameter_measurable nu p center)))
Proof (Lean source)
-- @node: radialOutcomeLaw_eq_map_swap_compProd
lemma radialOutcomeLaw_eq_map_swap_compProd
(nu : Measure Score) [IsFiniteMeasure nu] (p : Score → ℝ)
(hp : Measurable p) (hp0 : ∀ x, 1 / 4 ≤ p x)
(hp1 : ∀ x, p x ≤ 3 / 4) (center : Score) :
Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center))
(Measure.compProd nu (bernoulliGaussianKernel p hp)) =
Measure.map swap
(Measure.compProd (Measure.map (fun x : Score => dist x center) nu)
(bernoulliGaussianKernelOn
(clippedRadialSuccessParameter nu p center)
(clippedRadialSuccessParameter_measurable nu p center))) := by
let rho : Score → ℝ := fun x => dist x center
let m : Measure ℝ := Measure.map rho nu
let g : ℝ → ℝ := clippedRadialSuccessParameter nu p center
let hg : Measurable g := clippedRadialSuccessParameter_measurable nu p center
letI : IsMarkovKernel
(bernoulliGaussianKernel p hp) :=
bernoulliGaussianKernel_isMarkovKernel p hp
(fun x => by linarith [hp0 x]) (fun x => by linarith [hp1 x])
letI : IsFiniteMeasure m := Measure.isFiniteMeasure_map nu rho
letI : IsMarkovKernel (bernoulliGaussianKernelOn g hg) :=
bernoulliGaussianKernelOn_isMarkovKernel g hg
(fun r => by
dsimp [g]
exact (by linarith [
(clippedRadialSuccessParameter_mem_Icc nu p center r).1]))
(fun r => by
dsimp [g]
exact (by linarith [
(clippedRadialSuccessParameter_mem_Icc nu p center r).2]))
apply Measure.ext_prod
intro A B hA hB
rw [map_radiusOutcome_compProd_apply_prod nu
(bernoulliGaussianKernel p hp) center hA hB]
have hright : (Measure.map swap
(Measure.compProd m (bernoulliGaussianKernelOn g hg))) (A ×ˢ B) =
∫⁻ r in B, bernoulliGaussianKernelOn g hg r A ∂m := by
rw [Measure.map_apply measurable_swap (hA.prod hB), Measure.compProd_apply]
· rw [← lintegral_indicator hB]
congr 1
funext r
by_cases hr : r ∈ B
· simp [hr]
· simp [hr]
· exact (hA.prod hB).preimage measurable_swap
rw [hright]
apply bernoulliGaussianKernel_setLIntegral_eq_of_mass_and_mean_general
(D := {x | rho x ∈ B}) (D' := B) nu m p g hp hg
(fun x => by linarith [hp0 x]) (fun x => by linarith [hp1 x])
(fun r => by
dsimp [g]
linarith [(clippedRadialSuccessParameter_mem_Icc nu p center r).1])
(fun r => by
dsimp [g]
linarith [(clippedRadialSuccessParameter_mem_Icc nu p center r).2])
· rw [Measure.map_apply (by fun_prop) hB]
rfl
· have heq := clippedRadialSuccessParameter_ae_eq nu p hp hp0 hp1 center
rw [integral_congr_ae (ae_restrict_of_ae heq)]
exact (radialSuccessParameter_setIntegral nu p hp
(fun x => by linarith [hp0 x]) (fun x => by linarith [hp1 x])
center B hB).symm
theorem clippedRadialSuccessParameter_abs_sub_le_ae
A setwise bound on success-weighted radial masses gives the corresponding almost-everywhere bound on the two radial Bernoulli parameters.
Formal statement
hypotheses
nu nu' :
p p' :
Score → ℝ
hp :
hp' :
Measurable p'
hp0 :
∀ x, 1 / 4 ≤ p x
hp1 :
∀ x, p x ≤ 3 / 4
hp0' :
∀ x, 1 / 4 ≤ p' x
hp1' :
∀ x, p' x ≤ 3 / 4
center :
hmap :
D :
ℝ
hD :
0 ≤ D
E :
Set ℝ
hE :
conclusion
|clippedRadialSuccessParameter nu p center r
- clippedRadialSuccessParameter nu' p' center r|
≤ E.indicator (fun _ => D) r
Proof (Lean source)
-- @node: clippedRadialSuccessParameter_abs_sub_le_ae
lemma clippedRadialSuccessParameter_abs_sub_le_ae
(nu nu' : Measure Score) [IsFiniteMeasure nu] [IsFiniteMeasure nu']
(p p' : Score → ℝ) (hp : Measurable p) (hp' : Measurable p')
(hp0 : ∀ x, 1 / 4 ≤ p x) (hp1 : ∀ x, p x ≤ 3 / 4)
(hp0' : ∀ x, 1 / 4 ≤ p' x) (hp1' : ∀ x, p' x ≤ 3 / 4)
(center : Score)
(hmap : Measure.map (fun x : Score => dist x center) nu =
Measure.map (fun x : Score => dist x center) nu')
{D : ℝ} (hD : 0 ≤ D) {E : Set ℝ} (hE : MeasurableSet E)
(hdiff : ∀ A : Set ℝ, MeasurableSet A →
|(∫ x in {x | dist x center ∈ A}, p x ∂nu) -
∫ x in {x | dist x center ∈ A}, p' x ∂nu'| ≤
D * (Measure.map (fun x : Score => dist x center) nu (A ∩ E)).toReal) :
∀ᵐ r ∂(Measure.map (fun x : Score => dist x center) nu),
|clippedRadialSuccessParameter nu p center r -
clippedRadialSuccessParameter nu' p' center r| ≤
E.indicator (fun _ => D) r := by
let rho : Score → ℝ := fun x => dist x center
let m : Measure ℝ := Measure.map rho nu
let g : ℝ → ℝ := radialSuccessParameter nu p center
let g' : ℝ → ℝ := radialSuccessParameter nu' p' center
letI : IsFiniteMeasure m := Measure.isFiniteMeasure_map nu rho
let s : Measure ℝ := radialSuccessMeasure nu p center
let s' : Measure ℝ := radialSuccessMeasure nu' p' center
have hsle : s ≤ m := by
dsimp [s, m, rho]
apply Measure.map_mono
· calc
nu.withDensity (fun x => ofReal (p x)) ≤ nu.withDensity 1 := by
apply withDensity_mono
filter_upwards with x
simpa using ENNReal.ofReal_le_one.mpr (by linarith [hp1 x])
_ = nu := withDensity_one
· fun_prop
have hs'le : s' ≤ m := by
have hm' : Measure.map rho nu' = m := by simpa [m, rho] using hmap.symm
rw [← hm']
dsimp [s', rho]
apply Measure.map_mono
· calc
nu'.withDensity (fun x => ofReal (p' x)) ≤ nu'.withDensity 1 := by
apply withDensity_mono
filter_upwards with x
simpa using ENNReal.ofReal_le_one.mpr (by linarith [hp1' x])
_ = nu' := withDensity_one
· fun_prop
letI : IsFiniteMeasure s := isFiniteMeasure_of_le m hsle
letI : IsFiniteMeasure s' := isFiniteMeasure_of_le m hs'le
have hg : Integrable g m := by
dsimp [g, radialSuccessParameter, m, rho]
exact Measure.integrable_toReal_rnDeriv
have hg' : Integrable g' m := by
have hm' : Measure.map rho nu' = m := by simpa [m, rho] using hmap.symm
rw [← hm']
dsimp [g', radialSuccessParameter, rho]
exact Measure.integrable_toReal_rnDeriv
have hc : Integrable (E.indicator (fun _ : ℝ => D)) m :=
(integrable_const _).indicator hE
have hconst (A : Set ℝ) (hA : MeasurableSet A) :
(∫ r in A, E.indicator (fun _ : ℝ => D) r ∂m) =
D * (m (A ∩ E)).toReal := by
rw [integral_indicator hE, integral_const]
simp [Measure.real_def, Measure.restrict_apply, hA, hE, inter_comm, mul_comm]
have hup : (fun r => g r - g' r) ≤ᵐ[m]
E.indicator (fun _ => D) := by
apply ae_le_of_forall_setIntegral_le (hg.sub hg') hc
intro A hA _
change (∫ r in A, g r - g' r ∂m) ≤ _
rw [integral_sub hg.integrableOn hg'.integrableOn]
rw [radialSuccessParameter_setIntegral nu p hp
(fun x => by linarith [hp0 x]) (fun x => by linarith [hp1 x]) center A hA]
have hp'Int := radialSuccessParameter_setIntegral nu' p' hp'
(fun x => by linarith [hp0' x]) (fun x => by linarith [hp1' x]) center A hA
have hm' : Measure.map rho nu' = m := by simpa [m, rho] using hmap.symm
change (∫ r in A, g' r ∂Measure.map rho nu') = _ at hp'Int
rw [hm'] at hp'Int
rw [hp'Int]
rw [hconst A hA]
have hh := (abs_le.mp (hdiff A hA)).2
simpa [m, rho, mul_comm] using hh
have hdown : (fun r => g' r - g r) ≤ᵐ[m]
E.indicator (fun _ => D) := by
apply ae_le_of_forall_setIntegral_le (hg'.sub hg) hc
intro A hA _
change (∫ r in A, g' r - g r ∂m) ≤ _
rw [integral_sub hg'.integrableOn hg.integrableOn]
have hp'Int := radialSuccessParameter_setIntegral nu' p' hp'
(fun x => by linarith [hp0' x]) (fun x => by linarith [hp1' x]) center A hA
have hm' : Measure.map rho nu' = m := by simpa [m, rho] using hmap.symm
change (∫ r in A, g' r ∂Measure.map rho nu') = _ at hp'Int
rw [hm'] at hp'Int
rw [hp'Int]
rw [radialSuccessParameter_setIntegral nu p hp
(fun x => by linarith [hp0 x]) (fun x => by linarith [hp1 x]) center A hA]
rw [hconst A hA]
have hh := (abs_le.mp (hdiff A hA)).1
simpa [m, rho, mul_comm, sub_eq_add_neg] using hh
have heq := clippedRadialSuccessParameter_ae_eq nu p hp hp0 hp1 center
have heq' := clippedRadialSuccessParameter_ae_eq nu' p' hp' hp0' hp1' center
rw [← hmap] at heq'
filter_upwards [hup, hdown, heq, heq'] with r hrup hrdown hr hr'
rw [hr, hr']
exact abs_le.mpr ⟨by linarith, by linarith⟩
theorem radialOutcomeLaw_klDiv_le_of_localized_success_bound
The common-radius disintegration and a localized radial-parameter bound give a one-observation KL estimate proportional to the exceptional radial mass.
Formal statement
hypotheses
nu nu' :
p p' :
Score → ℝ
hp :
hp' :
Measurable p'
hp0 :
∀ x, 1 / 4 ≤ p x
hp1 :
∀ x, p x ≤ 3 / 4
hp0' :
∀ x, 1 / 4 ≤ p' x
hp1' :
∀ x, p' x ≤ 3 / 4
center :
hmap :
D :
ℝ
hD :
0 ≤ D
E :
Set ℝ
hE :
conclusion
klDiv (Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center)) (Measure.compProd nu (bernoulliGaussianKernel p hp))) (Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center)) (Measure.compProd nu' (bernoulliGaussianKernel p' hp')))
Proof (Lean source)
-- @node: radialOutcomeLaw_klDiv_le_of_localized_success_bound
lemma radialOutcomeLaw_klDiv_le_of_localized_success_bound
(nu nu' : Measure Score) [IsFiniteMeasure nu] [IsFiniteMeasure nu']
(p p' : Score → ℝ) (hp : Measurable p) (hp' : Measurable p')
(hp0 : ∀ x, 1 / 4 ≤ p x) (hp1 : ∀ x, p x ≤ 3 / 4)
(hp0' : ∀ x, 1 / 4 ≤ p' x) (hp1' : ∀ x, p' x ≤ 3 / 4)
(center : Score)
(hmap : Measure.map (fun x : Score => dist x center) nu =
Measure.map (fun x : Score => dist x center) nu')
{D : ℝ} (hD : 0 ≤ D) {E : Set ℝ} (hE : MeasurableSet E)
(hdiff : ∀ A : Set ℝ, MeasurableSet A →
|(∫ x in {x | dist x center ∈ A}, p x ∂nu) -
∫ x in {x | dist x center ∈ A}, p' x ∂nu'| ≤
D * (Measure.map (fun x : Score => dist x center) nu (A ∩ E)).toReal) :
klDiv
(Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center))
(Measure.compProd nu (bernoulliGaussianKernel p hp)))
(Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center))
(Measure.compProd nu' (bernoulliGaussianKernel p' hp'))) ≤
ofReal (4 * D ^ 2) *
Measure.map (fun x : Score => dist x center) nu E := by
let rho : Score → ℝ := fun x => dist x center
let m : Measure ℝ := Measure.map rho nu
let g : ℝ → ℝ := clippedRadialSuccessParameter nu p center
let g' : ℝ → ℝ := clippedRadialSuccessParameter nu' p' center
let hg : Measurable g := clippedRadialSuccessParameter_measurable nu p center
let hg' : Measurable g' := clippedRadialSuccessParameter_measurable nu' p' center
let k : Kernel ℝ ℝ := bernoulliGaussianKernelOn g hg
let k' : Kernel ℝ ℝ := bernoulliGaussianKernelOn g' hg'
letI : IsFiniteMeasure m := Measure.isFiniteMeasure_map nu rho
letI : IsMarkovKernel k := bernoulliGaussianKernelOn_isMarkovKernel g hg
(fun r => by
dsimp [g]
linarith [(clippedRadialSuccessParameter_mem_Icc nu p center r).1])
(fun r => by
dsimp [g]
linarith [(clippedRadialSuccessParameter_mem_Icc nu p center r).2])
letI : IsMarkovKernel k' := bernoulliGaussianKernelOn_isMarkovKernel g' hg'
(fun r => by
dsimp [g']
linarith [(clippedRadialSuccessParameter_mem_Icc nu' p' center r).1])
(fun r => by
dsimp [g']
linarith [(clippedRadialSuccessParameter_mem_Icc nu' p' center r).2])
rw [radialOutcomeLaw_eq_map_swap_compProd nu p hp hp0 hp1 center,
radialOutcomeLaw_eq_map_swap_compProd nu' p' hp' hp0' hp1' center]
have hm' : Measure.map rho nu' = m := by simpa [m, rho] using hmap.symm
rw [show Measure.map (fun x : Score => dist x center) nu = m by rfl,
show Measure.map (fun x : Score => dist x center) nu' = m by exact hm']
rw [show (Prod.swap : ℝ × ℝ → ℝ × ℝ) =
⇑(MeasurableEquiv.prodComm (α := ℝ) (β := ℝ)) by rfl]
rw [klDiv_map_measurableEmbedding
(MeasurableEquiv.prodComm (α := ℝ) (β := ℝ)).measurableEmbedding]
rw [klDiv_compProd_right_of_forall_ac]
· have hpar := clippedRadialSuccessParameter_abs_sub_le_ae nu nu' p p' hp hp'
hp0 hp1 hp0' hp1' center hmap hD hE hdiff
calc
(∫⁻ r, klDiv (k r) (k' r) ∂m) ≤
∫⁻ r, E.indicator (fun _ => ofReal (4 * D ^ 2)) r ∂m := by
apply lintegral_mono_ae
filter_upwards [hpar] with r hr
have hk := bernoulliGaussianLaw_klDiv_le_four_sq_sub
(clippedRadialSuccessParameter_mem_Icc nu p center r).1
(clippedRadialSuccessParameter_mem_Icc nu p center r).2
(clippedRadialSuccessParameter_mem_Icc nu' p' center r).1
(clippedRadialSuccessParameter_mem_Icc nu' p' center r).2
change klDiv (k r) (k' r) ≤ _ at hk
by_cases hrE : r ∈ E
· rw [Set.indicator_of_mem hrE]
exact hk.trans (ENNReal.ofReal_le_ofReal (by
have habs : |g r - g' r| ≤ D := by simpa [hrE] using hr
have hsq := (sq_le_sq₀ (abs_nonneg (g r - g' r)) hD).2 habs
rw [← sq_abs (g r - g' r)]
nlinarith))
· rw [Set.indicator_of_notMem hrE]
have hz : g r = g' r := by
have : |g r - g' r| ≤ 0 := by simpa [hrE] using hr
exact sub_eq_zero.mp (abs_eq_zero.mp (le_antisymm this (abs_nonneg _)))
have hkk : k r = k' r := by
ext A hA
simp [k, k', bernoulliGaussianKernelOn, hz]
rw [hkk, InformationTheory.klDiv_self]
_ = ∫⁻ _r in E, ofReal (4 * D ^ 2) ∂m :=
lintegral_indicator hE _
_ = ofReal (4 * D ^ 2) * m E :=
setLIntegral_const E (ofReal (4 * D ^ 2))
· filter_upwards with r
have hk := bernoulliGaussianLaw_klDiv_le_four_sq_sub
(clippedRadialSuccessParameter_mem_Icc nu p center r).1
(clippedRadialSuccessParameter_mem_Icc nu p center r).2
(clippedRadialSuccessParameter_mem_Icc nu' p' center r).1
(clippedRadialSuccessParameter_mem_Icc nu' p' center r).2
have hfinite : klDiv (k r) (k' r) ≠ ⊤ := by
change klDiv (k r) (k' r) ≤ _ at hk
exact ne_top_of_le_ne_top ENNReal.ofReal_ne_top hk
exact (InformationTheory.klDiv_ne_top_iff.mp hfinite).1
Helpers.AngularRadialOutcome 8 declarations This module rewrites the one-observation distance-compressed law of an angular packing vertex directly as the pushforward of its score-first disintegration.
Radial outcome representation for the angular packing
This module rewrites the one-observation distance-compressed law of an angular packing vertex directly as the pushforward of its score-first disintegration. The representation is the bridge from radial cancellation to the exceptional- radius equality and one-point KL estimates used by the final certificate.
theorem radialSlice_mass_eq_of_map_distance_eq Lemma radialSlice_mass_eq_of_map_distance_eq in the paper ↗
Equality of radius pushforwards gives equality of the base mass on every measurable radial slice. This is the mass half of the Bernoulli--Gaussian radial-fibre comparison.
Formal statement
Proof (Lean source)
-- @node: radialSlice_mass_eq_of_map_distance_eq
lemma radialSlice_mass_eq_of_map_distance_eq
(nu nu' : Measure Score) (center : Score)
(hmap : Measure.map (fun x : Score => dist x center) nu =
Measure.map (fun x : Score => dist x center) nu')
{A : Set ℝ} (hA : MeasurableSet A) :
nu {x | dist x center ∈ A} = nu' {x | dist x center ∈ A} := by
have hradial : Measurable (fun x : Score => dist x center) := by fun_prop
change nu ((fun x : Score => dist x center) ⁻¹' A) =
nu' ((fun x : Score => dist x center) ⁻¹' A)
rw [← Measure.map_apply hradial hA, ← Measure.map_apply hradial hA, hmap]
theorem map_radiusOutcome_compProd_apply_prod Lemma map_radiusOutcome_compProd_apply_prod in the paper ↗
A rectangle under a radius--outcome pushforward of a composition product is the fibre probability integrated over the corresponding radial slice of the base measure. This is the rectangle-level disintegration identity used to turn the setwise polar cancellation lemmas into equality of radial-outcome measures.
Formal statement
hypotheses
Proof (Lean source)
-- @node: map_radiusOutcome_compProd_apply_prod
lemma map_radiusOutcome_compProd_apply_prod
(nu : Measure Score) [SFinite nu] (k : Kernel Score ℝ)
[IsSFiniteKernel k] (center : Score) {A B : Set ℝ}
(hA : MeasurableSet A) (hB : MeasurableSet B) :
(Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center))
(Measure.compProd nu k)) (A ×ˢ B) =
∫⁻ x in {x | dist x center ∈ B}, k x A ∂nu := by
rw [Measure.map_apply (by fun_prop) (hA.prod hB),
Measure.compProd_apply ((hA.prod hB).preimage (by fun_prop))]
rw [← lintegral_indicator (show MeasurableSet
{x : Score | dist x center ∈ B} from hB.preimage (by fun_prop))]
congr 1
funext x
by_cases hx : dist x center ∈ B
· have hx' : x ∈ {x : Score | dist x center ∈ B} := hx
rw [Set.indicator_of_mem hx']
congr 1
ext y
simp [hx]
· have hx' : x ∉ {x : Score | dist x center ∈ B} := hx
rw [Set.indicator_of_notMem hx']
have hset : Prod.mk x ⁻¹'
((fun z : Score × ℝ => (z.2, dist z.1 center)) ⁻¹' (A ×ˢ B)) = ∅ := by
ext y
simp [hx]
rw [hset]
simp
theorem map_radiusOutcome_compProd_restrict_Ici_eq Lemma map_radiusOutcome_compProd_restrict_Ici_eq in the paper ↗
Equality of all outcome probabilities on all radial slices beyond R assembles into equality of the two restricted radius--outcome laws. The hypothesis is deliberately rectangle-level, matching the output of the polar integral calculations.
Formal statement
hypotheses
Proof (Lean source)
-- @node: map_radiusOutcome_compProd_restrict_Ici_eq
lemma map_radiusOutcome_compProd_restrict_Ici_eq
(nu nu' : Measure Score) [IsFiniteMeasure nu] [IsFiniteMeasure nu']
(k k' : Kernel Score ℝ) [IsFiniteKernel k] [IsFiniteKernel k']
(center : Score) (R : ℝ)
(hslices : ∀ (A B : Set ℝ), MeasurableSet A → MeasurableSet B →
(∫⁻ x in {x | dist x center ∈ B ∩ Ici R}, k x A ∂nu) =
∫⁻ x in {x | dist x center ∈ B ∩ Ici R}, k' x A ∂nu') :
(Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center))
(Measure.compProd nu k)).restrict {z | R ≤ z.2} =
(Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center))
(Measure.compProd nu' k')).restrict {z | R ≤ z.2} := by
apply Measure.ext_prod
intro A B hA hB
rw [Measure.restrict_apply (hA.prod hB),
Measure.restrict_apply (hA.prod hB)]
have hset : (A ×ˢ B) ∩ {z : ℝ × ℝ | R ≤ z.2} = A ×ˢ (B ∩ Ici R) := by
ext z
simp [and_left_comm, and_comm]
rw [hset,
map_radiusOutcome_compProd_apply_prod nu k center hA
(hB.inter measurableSet_Ici),
map_radiusOutcome_compProd_apply_prod nu' k' center hA
(hB.inter measurableSet_Ici)]
exact hslices A B hA hB
theorem angularPackingCtyLaw_onePointDistanceLaw_eq_map_compProd
The one-point radial-outcome law of an angular packing vertex is the pushforward of the explicit score design and Bernoulli--Gaussian fibre kernel. This keeps the score first until the final map, exposing the radial fibres used by the cancellation argument.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
center :
conclusion
onePointDistanceLaw (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0 hw hsep) center
= Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center)) (Measure.compProd (angularDesignMeasure b cA delta w (angularGridCenter M) omega) (bernoulliGaussianKernel (clippedPackingRegression b delta w (angularGridCenter M) omega) (clippedPackingRegression_measurable b delta w (angularGridCenter M) omega)))
Proof (Lean source)
-- @node: angularPackingCtyLaw_onePointDistanceLaw_eq_map_compProd
lemma angularPackingCtyLaw_onePointDistanceLaw_eq_map_compProd
{M : ℕ} {b cA delta w : ℝ} (hb : 0 < b)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA) (hdelta : 0 < delta)
(hw0 : 0 < w) (hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) (center : Score) :
onePointDistanceLaw
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0 hw hsep)
center =
Measure.map (fun z : Score × ℝ => (z.2, dist z.1 center))
(Measure.compProd
(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
(bernoulliGaussianKernel
(clippedPackingRegression b delta w (angularGridCenter M) omega)
(clippedPackingRegression_measurable b delta w
(angularGridCenter M) omega))) := by
let nu := angularDesignMeasure b cA delta w (angularGridCenter M) omega
let p := clippedPackingRegression b delta w (angularGridCenter M) omega
letI : IsProbabilityMeasure nu :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw0 hw hsep omega
have h0 : ∀ x, 0 ≤ p x := fun x =>
(clippedPackingRegression_mem_Icc b delta w (angularGridCenter M) omega x).1
have h1 : ∀ x, p x ≤ 1 := fun x =>
(clippedPackingRegression_mem_Icc b delta w (angularGridCenter M) omega x).2
unfold onePointDistanceLaw angularPackingCtyLaw bernoulliGaussianCtyLaw
dsimp only
unfold jointBernoulliGaussianLaw
rw [Measure.map_map (by fun_prop) measurable_swap]
rfl
theorem angularPackingCtyLaw_onePointDistanceLaw_apply_prod
Rectangle probabilities of the angular radial-outcome law are obtained by integrating its explicit Bernoulli--Gaussian fibre over a radial slice of the angular score design.
Formal statement
hypotheses
M :
ℕ
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
center :
A B :
Set ℝ
hA :
hB :
conclusion
onePointDistanceLaw (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0 hw hsep) center (A ×ˢ B)
= ∫⁻ x in {x | dist x center ∈ B}, bernoulliGaussianKernel (clippedPackingRegression b delta w (angularGridCenter M) omega) (clippedPackingRegression_measurable b delta w (angularGridCenter M) omega) x A ∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
Proof (Lean source)
-- @node: angularPackingCtyLaw_onePointDistanceLaw_apply_prod
lemma angularPackingCtyLaw_onePointDistanceLaw_apply_prod
{M : ℕ} {b cA delta w : ℝ} (hb : 0 < b)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA) (hdelta : 0 < delta)
(hw0 : 0 < w) (hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) (center : Score) {A B : Set ℝ}
(hA : MeasurableSet A) (hB : MeasurableSet B) :
onePointDistanceLaw
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0 hw hsep)
center (A ×ˢ B) =
∫⁻ x in {x | dist x center ∈ B},
bernoulliGaussianKernel
(clippedPackingRegression b delta w (angularGridCenter M) omega)
(clippedPackingRegression_measurable b delta w
(angularGridCenter M) omega) x A
∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega) := by
letI : IsProbabilityMeasure
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw0 hw
hsep omega
letI : IsMarkovKernel
(bernoulliGaussianKernel
(clippedPackingRegression b delta w (angularGridCenter M) omega)
(clippedPackingRegression_measurable b delta w
(angularGridCenter M) omega)) :=
bernoulliGaussianKernel_isMarkovKernel _ _
(fun x => (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega x).1)
(fun x => (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega x).2)
rw [angularPackingCtyLaw_onePointDistanceLaw_eq_map_compProd hb hscale hcA
hdelta hw0 hw hsep omega center]
exact map_radiusOutcome_compProd_apply_prod _ _ center hA hB
theorem angularGridCenter_radialSet_angular_outcome_cancellation
The fully-active angular outcome cancellation, transported from planar coordinates to the Euclidean score space at a lower-edge grid center. This is the score-space form consumed by the radial fibre-law comparison.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hscale :
0 < cA * delta
A :
Set ℝ
hA :
hactive :
∀ r ∈ A, 2 * (cA * delta) ≤ b * r
conclusion
let c := angularGridCenter M j let D : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A} (∫ x in D, delta * angularRadialProfile w (dist x c))
+ (∫ x in D, b * (scoreCoordinates x - scoreCoordinates c).1 * angularTilt b cA delta w (dist x c) * ((scoreCoordinates x - scoreCoordinates c).1 / dist x c))
= 0
Proof (Lean source)
-- @node: angularGridCenter_radialSet_angular_outcome_cancellation
lemma angularGridCenter_radialSet_angular_outcome_cancellation
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hscale : 0 < cA * delta) {A : Set ℝ} (hA : MeasurableSet A)
(hactive : ∀ r ∈ A, 2 * (cA * delta) ≤ b * r) :
let c := angularGridCenter M j
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
(∫ x in D, delta * angularRadialProfile w (dist x c)) +
(∫ x in D,
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) = 0 := by
dsimp only
let c : Score := angularGridCenter M j
let cp : ℝ × ℝ := scoreCoordinates c
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let E : Set (ℝ × ℝ) :=
{z | 0 < (z - cp).2 ∧ planarRadius (z - cp) ≤ w} ∩
{z | planarRadius (z - cp) ∈ A}
have himage : scoreCoordinates '' D = E := by
ext z
constructor
· rintro ⟨x, hx, rfl⟩
simpa [D, E, cp, c, planarRadius_scoreCoordinates_sub] using hx
· intro hz
let x : Score := scorePoint z.1 z.2
have hcoord : scoreCoordinates x = z := by
ext <;> simp [x, scoreCoordinates, scorePoint_apply_zero,
scorePoint_apply_one]
have hdist : dist x c = planarRadius (z - scoreCoordinates c) := by
rw [← planarRadius_scoreCoordinates_sub]
rw [hcoord]
refine ⟨x, ?_, hcoord⟩
simpa [D, E, cp, c, hcoord, hdist] using hz
have hfirst : (fun x : Score =>
delta * angularRadialProfile w (dist x c)) =
fun x => delta * angularRadialProfile w
(planarRadius (scoreCoordinates x - scoreCoordinates c)) := by
funext x
rw [planarRadius_scoreCoordinates_sub]
have hsecond : (fun x : Score =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) =
fun x =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w
(planarRadius (scoreCoordinates x - scoreCoordinates c)) *
((scoreCoordinates x - scoreCoordinates c).1 /
planarRadius (scoreCoordinates x - scoreCoordinates c)) := by
funext x
rw [planarRadius_scoreCoordinates_sub]
rw [hfirst, hsecond]
rw [← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ =>
delta * angularRadialProfile w (planarRadius (z - scoreCoordinates c))) D,
← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ =>
b * (z - scoreCoordinates c).1 *
angularTilt b cA delta w (planarRadius (z - scoreCoordinates c)) *
((z - scoreCoordinates c).1 / planarRadius (z - scoreCoordinates c))) D]
rw [himage]
simpa [E, cp, c] using
translatedHalfDisc_radialSet_angular_outcome_cancellation
(w := w) (R := w) hscale (scoreCoordinates (angularGridCenter M j)) hA hactive
theorem bernoulliGaussianKernel_setLIntegral_eq_of_mass_and_mean
On a fixed score slice, a Bernoulli--Gaussian mixture is determined by the slice mass and the slice integral of its Bernoulli parameter. This is the measure-theoretic bridge from the two polar cancellation identities to equality of radial outcome fibres.
Formal statement
hypotheses
nu nu' :
p p' :
Score → ℝ
hp :
hp' :
Measurable p'
hp0 :
∀ x, 0 ≤ p x
hp1 :
∀ x, p x ≤ 1
hp0' :
∀ x, 0 ≤ p' x
hp1' :
∀ x, p' x ≤ 1
hmass :
nu D = nu' D
hmean :
∫ x in D, p x ∂nu = ∫ x in D, p' x ∂nu'
A :
Set ℝ
conclusion
(∫⁻ x in D, bernoulliGaussianKernel p hp x A ∂nu)
= ∫⁻ x in D, bernoulliGaussianKernel p' hp' x A ∂nu'
Proof (Lean source)
-- @node: bernoulliGaussianKernel_setLIntegral_eq_of_mass_and_mean
lemma bernoulliGaussianKernel_setLIntegral_eq_of_mass_and_mean
(nu nu' : Measure Score) [IsFiniteMeasure nu] [IsFiniteMeasure nu']
(p p' : Score → ℝ) (hp : Measurable p) (hp' : Measurable p')
(hp0 : ∀ x, 0 ≤ p x) (hp1 : ∀ x, p x ≤ 1)
(hp0' : ∀ x, 0 ≤ p' x) (hp1' : ∀ x, p' x ≤ 1)
{D : Set Score} (hmass : nu D = nu' D)
(hmean : ∫ x in D, p x ∂nu = ∫ x in D, p' x ∂nu')
(A : Set ℝ) :
(∫⁻ x in D, bernoulliGaussianKernel p hp x A ∂nu) =
∫⁻ x in D, bernoulliGaussianKernel p' hp' x A ∂nu' := by
have hpInt : IntegrableOn p D nu := by
apply Measure.integrableOn_of_bounded (measure_ne_top nu D) hp.aestronglyMeasurable
filter_upwards with x
rw [Real.norm_eq_abs, abs_le]
exact ⟨by linarith [hp0 x], hp1 x⟩
have hpInt' : IntegrableOn p' D nu' := by
apply Measure.integrableOn_of_bounded (measure_ne_top nu' D) hp'.aestronglyMeasurable
filter_upwards with x
rw [Real.norm_eq_abs, abs_le]
exact ⟨by linarith [hp0' x], hp1' x⟩
have hqInt : IntegrableOn (fun x => 1 - p x) D nu :=
(integrableOn_const (s := D) (C := (1 : ℝ))).sub hpInt
have hqInt' : IntegrableOn (fun x => 1 - p' x) D nu' :=
(integrableOn_const (s := D) (C := (1 : ℝ))).sub hpInt'
have hpL : (∫⁻ x in D, ofReal (p x) ∂nu) =
∫⁻ x in D, ofReal (p' x) ∂nu' := by
rw [← ofReal_integral_eq_lintegral_ofReal hpInt
(Filter.Eventually.of_forall fun x => hp0 x),
← ofReal_integral_eq_lintegral_ofReal hpInt'
(Filter.Eventually.of_forall fun x => hp0' x), hmean]
have hqmean : ∫ x in D, (1 - p x) ∂nu =
∫ x in D, (1 - p' x) ∂nu' := by
rw [integral_sub (integrableOn_const (s := D) (C := (1 : ℝ))) hpInt,
integral_sub (integrableOn_const (s := D) (C := (1 : ℝ))) hpInt']
simp only [integral_const, Measure.real_def]
rw [Measure.restrict_apply_univ, Measure.restrict_apply_univ]
rw [hmass, hmean]
have hqL : (∫⁻ x in D, ofReal (1 - p x) ∂nu) =
∫⁻ x in D, ofReal (1 - p' x) ∂nu' := by
rw [← ofReal_integral_eq_lintegral_ofReal hqInt
(Filter.Eventually.of_forall fun x => sub_nonneg.mpr (hp1 x)),
← ofReal_integral_eq_lintegral_ofReal hqInt'
(Filter.Eventually.of_forall fun x => sub_nonneg.mpr (hp1' x)), hqmean]
simp only [bernoulliGaussianKernel, Kernel.coe_mk,
bernoulliGaussianLaw_eq_gaussian_mixture, Measure.add_apply,
Measure.smul_apply, smul_eq_mul]
change (∫⁻ x, ofReal (p x) * (gaussianReal 1 1) A +
ofReal (1 - p x) * (gaussianReal 0 1) A ∂( nu.restrict D)) =
∫⁻ x, ofReal (p' x) * (gaussianReal 1 1) A +
ofReal (1 - p' x) * (gaussianReal 0 1) A ∂(nu'.restrict D)
rw [lintegral_add_left
(show Measurable (fun x => ofReal (p x) *
(gaussianReal 1 1) A) by fun_prop) _,
lintegral_add_left
(show Measurable (fun x => ofReal (p' x) *
(gaussianReal 1 1) A) by fun_prop) _]
simp_rw [mul_comm (ofReal (p _)), mul_comm (ofReal (1 - p _)),
mul_comm (ofReal (p' _)), mul_comm (ofReal (1 - p' _))]
have hmulP : (∫⁻ x in D, (gaussianReal 1 1) A * ofReal (p x) ∂nu) =
(gaussianReal 1 1) A * ∫⁻ x in D, ofReal (p x) ∂nu := by
exact lintegral_const_mul _ (by fun_prop)
have hmulQ : (∫⁻ x in D, (gaussianReal 0 1) A * ofReal (1 - p x) ∂nu) =
(gaussianReal 0 1) A * ∫⁻ x in D, ofReal (1 - p x) ∂nu := by
exact lintegral_const_mul _ (by fun_prop)
have hmulP' : (∫⁻ x in D, (gaussianReal 1 1) A * ofReal (p' x) ∂nu') =
(gaussianReal 1 1) A * ∫⁻ x in D, ofReal (p' x) ∂nu' := by
exact lintegral_const_mul _ (by fun_prop)
have hmulQ' : (∫⁻ x in D, (gaussianReal 0 1) A * ofReal (1 - p' x) ∂nu') =
(gaussianReal 0 1) A * ∫⁻ x in D, ofReal (1 - p' x) ∂nu' := by
exact lintegral_const_mul _ (by fun_prop)
rw [hmulP, hmulQ, hmulP', hmulQ', hpL, hqL]
theorem angularPackingCtyLaw_restrict_Ici_eq_of_radial_slices
Rectangle-level radial fibre identities for two angular vertices imply equality of their complete radius--outcome laws beyond the stated cutoff. This packages the explicit score-first disintegrations with the product-set extension argument, so the packing theorem only has to supply the polar slice calculation.
Formal statement
hypotheses
M :
ℕ
b cA delta w R :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hw0 :
0 < w
hw :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
j :
Fin M
hslices :
∀ (A B : Set ℝ)
if
and
then
(∫⁻ x in {x | dist x (angularGridCenter M j) ∈ B ∩ Ici R}, bernoulliGaussianKernel (clippedPackingRegression b delta w (angularGridCenter M) omega) (clippedPackingRegression_measurable b delta w (angularGridCenter M) omega) x A ∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega))
= ∫⁻ x in {x | dist x (angularGridCenter M j) ∈ B ∩ Ici R}, bernoulliGaussianKernel (clippedPackingRegression b delta w (angularGridCenter M) omega') (clippedPackingRegression_measurable b delta w (angularGridCenter M) omega') x A ∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega')
conclusion
(onePointDistanceLaw (angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0 hw hsep) (angularGridCenter M j)).restrict {z | R ≤ z.2}
= (onePointDistanceLaw (angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw0 hw hsep) (angularGridCenter M j)).restrict {z | R ≤ z.2}
Proof (Lean source)
-- @node: angularPackingCtyLaw_restrict_Ici_eq_of_radial_slices
lemma angularPackingCtyLaw_restrict_Ici_eq_of_radial_slices
{M : ℕ} {b cA delta w R : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hw0 : 0 < w) (hw : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega omega' : Fin M → Bool) (j : Fin M)
(hslices : ∀ (A B : Set ℝ), MeasurableSet A → MeasurableSet B →
(∫⁻ x in {x | dist x (angularGridCenter M j) ∈ B ∩ Ici R},
bernoulliGaussianKernel
(clippedPackingRegression b delta w (angularGridCenter M) omega)
(clippedPackingRegression_measurable b delta w
(angularGridCenter M) omega) x A
∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega)) =
∫⁻ x in {x | dist x (angularGridCenter M j) ∈ B ∩ Ici R},
bernoulliGaussianKernel
(clippedPackingRegression b delta w (angularGridCenter M) omega')
(clippedPackingRegression_measurable b delta w
(angularGridCenter M) omega') x A
∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega')) :
(onePointDistanceLaw
(angularPackingCtyLaw b cA delta w omega hb hscale hcA hdelta hw0 hw hsep)
(angularGridCenter M j)).restrict {z | R ≤ z.2} =
(onePointDistanceLaw
(angularPackingCtyLaw b cA delta w omega' hb hscale hcA hdelta hw0 hw hsep)
(angularGridCenter M j)).restrict {z | R ≤ z.2} := by
let nu := angularDesignMeasure b cA delta w (angularGridCenter M) omega
let nu' := angularDesignMeasure b cA delta w (angularGridCenter M) omega'
let p := clippedPackingRegression b delta w (angularGridCenter M) omega
let p' := clippedPackingRegression b delta w (angularGridCenter M) omega'
let hp := clippedPackingRegression_measurable b delta w
(angularGridCenter M) omega
let hp' := clippedPackingRegression_measurable b delta w
(angularGridCenter M) omega'
let k := bernoulliGaussianKernel p hp
let k' := bernoulliGaussianKernel p' hp'
letI : IsProbabilityMeasure nu :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw0 hw hsep omega
letI : IsProbabilityMeasure nu' :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw0 hw hsep omega'
letI : IsMarkovKernel k := bernoulliGaussianKernel_isMarkovKernel p hp
(fun x => (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega x).1)
(fun x => (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega x).2)
letI : IsMarkovKernel k' := bernoulliGaussianKernel_isMarkovKernel p' hp'
(fun x => (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega' x).1)
(fun x => (clippedPackingRegression_mem_Icc b delta w
(angularGridCenter M) omega' x).2)
rw [angularPackingCtyLaw_onePointDistanceLaw_eq_map_compProd hb hscale hcA
hdelta hw0 hw hsep omega (angularGridCenter M j),
angularPackingCtyLaw_onePointDistanceLaw_eq_map_compProd hb hscale hcA
hdelta hw0 hw hsep omega' (angularGridCenter M j)]
apply map_radiusOutcome_compProd_restrict_Ici_eq nu nu' k k'
(angularGridCenter M j) R
simpa [nu, nu', p, p', hp, hp', k, k'] using hslices
Helpers.AngularRadialQuantitative 6 declarations This module strengthens the exact active-tail cancellation with the localized absolute bound needed for the one-point KL estimate.
Quantitative angular radial cancellation
This module strengthens the exact active-tail cancellation with the localized absolute bound needed for the one-point KL estimate.
theorem angularRadialSuccessIncrement_setIntegral_abs_le
The one-dimensional polar success increment is bounded by the bump amplitude after multiplication by the nonnegative half-circle Jacobian.
Formal statement
hypotheses
conclusion
|∫ r in Ioc 0 R, pi * r * A.indicator (fun s => delta * angularRadialProfile w s + (b * s * angularTilt b cA delta w s) / 2) r|
Proof (Lean source)
-- @node: angularRadialSuccessIncrement_setIntegral_abs_le
lemma angularRadialSuccessIncrement_setIntegral_abs_le
{b cA delta w R : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hdelta : 0 ≤ delta) {A : Set ℝ} (hA : MeasurableSet A) :
|∫ r in Ioc 0 R, pi * r * A.indicator
(fun s => delta * angularRadialProfile w s +
(b * s * angularTilt b cA delta w s) / 2) r| ≤
delta * ∫ r in Ioc 0 R, pi * r *
(A ∩ Iio (2 * (cA * delta) / b)).indicator (fun _ => (1 : ℝ)) r := by
let inc : ℝ → ℝ := fun r => delta * angularRadialProfile w r +
(b * r * angularTilt b cA delta w r) / 2
let jac : ℝ → ℝ := fun r => pi * r
have hinc : Continuous inc := by
dsimp [inc]
exact (continuous_const.mul (angularRadialProfile_continuous w)).add
((((continuous_const.mul continuous_id).mul
(angularTilt_continuous hscale)).div_const 2))
have hjac : Continuous jac := by
dsimp [jac]
fun_prop
have hf : IntegrableOn (fun r => jac r * A.indicator inc r) (Ioc 0 R) := by
have hbase : IntegrableOn (fun r => jac r * inc r) (Ioc 0 R) :=
((hjac.mul hinc).continuousOn.integrableOn_compact isCompact_Icc).mono_set
Ioc_subset_Icc_self
exact (hbase.indicator hA).congr
(Filter.Eventually.of_forall fun r => by
by_cases hr : r ∈ A <;> simp [indicator, hr])
have hg : IntegrableOn
(fun r => delta * (jac r *
(A ∩ Iio (2 * (cA * delta) / b)).indicator (fun _ => (1 : ℝ)) r))
(Ioc 0 R) := by
have hbase : IntegrableOn (fun r => delta * jac r) (Ioc 0 R) :=
((continuous_const.mul hjac).continuousOn.integrableOn_compact
isCompact_Icc).mono_set Ioc_subset_Icc_self
exact (hbase.indicator
(hA.inter (measurableSet_Iio (a := 2 * (cA * delta) / b)))).congr
(Filter.Eventually.of_forall fun r => by
by_cases hr : r ∈ A ∩ Iio (2 * (cA * delta) / b)
· simp only [Set.indicator_of_mem hr]
ring
· simp only [Set.indicator_of_notMem hr]
ring)
calc
|∫ r in Ioc 0 R, jac r * A.indicator inc r| ≤
∫ r in Ioc 0 R, |jac r * A.indicator inc r| :=
abs_integral_le_integral_abs
_ ≤ ∫ r in Ioc 0 R,
delta * (jac r *
(A ∩ Iio (2 * (cA * delta) / b)).indicator (fun _ => (1 : ℝ)) r) := by
apply integral_mono_ae hf.abs hg
exact ae_restrict_of_forall_mem measurableSet_Ioc (fun r hr => by
have hj0 : 0 ≤ jac r := mul_nonneg Real.pi_pos.le hr.1.le
by_cases hrA : r ∈ A
· by_cases hrE : r ∈ Iio (2 * (cA * delta) / b)
· simp only [Set.indicator_of_mem hrA,
Set.indicator_of_mem (show r ∈ A ∩ Iio _ from ⟨hrA, hrE⟩), mul_one]
rw [abs_mul, abs_of_nonneg hj0]
simpa [inc, mul_comm] using mul_le_mul_of_nonneg_left
(angularRadialSuccessIncrement_abs_le (w := w) (r := r)
hb hscale hdelta) hj0
· have hactive : 2 * (cA * delta) ≤ b * r := by
have hrge : 2 * (cA * delta) / b ≤ r := le_of_not_gt hrE
apply (div_le_iff₀ hb).mp at hrge
nlinarith
have hzero : inc r = 0 := by
dsimp [inc]
rw [angularRadialSuccessIncrement_identity hb hscale,
angularCutoff_eq_one hscale hactive]
ring
simp [Set.indicator_of_mem hrA,
Set.indicator_of_notMem (show r ∉ A ∩ Iio _ from fun h => hrE h.2),
hzero]
· have hrnot : r ∉ A ∩ Iio (2 * (cA * delta) / b) :=
fun h => hrA h.1
simp [Set.indicator_of_notMem hrA, Set.indicator_of_notMem hrnot])
_ = delta * ∫ r in Ioc 0 R,
jac r * (A ∩ Iio (2 * (cA * delta) / b)).indicator
(fun _ => (1 : ℝ)) r := by
rw [integral_const_mul]
theorem halfDisc_radialSet_angular_outcome_abs_le
On any measurable radial slice of an upper half-disc, the combined bump and cosine-squared success-mass increment is bounded by the bump amplitude times the slice area.
Formal statement
hypotheses
conclusion
let D : Set (ℝ × ℝ) := {z | 0 < z.2 ∧ planarRadius z ≤ R} ∩ planarRadius ⁻¹' A |(∫ z in D, delta * angularRadialProfile w (planarRadius z))
≤ delta * (volume ({z | 0 < z.2 ∧ planarRadius z ≤ R} ∩ planarRadius ⁻¹' (A ∩ Iio (2 * (cA * delta) / b)))).toReal
Proof (Lean source)
-- @node: halfDisc_radialSet_angular_outcome_abs_le
lemma halfDisc_radialSet_angular_outcome_abs_le
{b cA delta w R : ℝ} (hb : 0 < b) (hscale : 0 < cA * delta)
(hdelta : 0 ≤ delta) {A : Set ℝ} (hA : MeasurableSet A) :
let D : Set (ℝ × ℝ) :=
{z | 0 < z.2 ∧ planarRadius z ≤ R} ∩ planarRadius ⁻¹' A
|(∫ z in D, delta * angularRadialProfile w (planarRadius z)) +
(∫ z in D, b * z.1 * angularTilt b cA delta w (planarRadius z) *
(z.1 / planarRadius z))| ≤ delta *
(volume ({z | 0 < z.2 ∧ planarRadius z ≤ R} ∩
planarRadius ⁻¹' (A ∩ Iio (2 * (cA * delta) / b)))).toReal := by
classical
dsimp only
let D0 : Set (ℝ × ℝ) := {z | 0 < z.2 ∧ planarRadius z ≤ R}
let E : Set (ℝ × ℝ) := planarRadius ⁻¹' A
let Eloc : Set (ℝ × ℝ) :=
planarRadius ⁻¹' (A ∩ Iio (2 * (cA * delta) / b))
have hD0 : MeasurableSet D0 :=
(measurableSet_lt measurable_const measurable_snd).inter
(measurableSet_le planarRadius_measurable measurable_const)
have hE : MeasurableSet E := hA.preimage planarRadius_measurable
have hEloc : MeasurableSet Eloc :=
(hA.inter measurableSet_Iio).preimage planarRadius_measurable
have hfirst := halfDisc_radial_integral
(fun r => A.indicator (fun s => delta * angularRadialProfile w s) r) R
have hsecond := halfDisc_weighted_cos_sq
(fun r => A.indicator (fun s => b * r * angularTilt b cA delta w r) r) R
have harea := halfDisc_radial_integral
(fun r => (A ∩ Iio (2 * (cA * delta) / b)).indicator
(fun _ => (1 : ℝ)) r) R
have hfirst' :
(∫ z : ℝ × ℝ in D0 ∩ E,
delta * angularRadialProfile w (planarRadius z)) =
∫ r : ℝ in Ioc 0 R, pi * r * A.indicator
(fun s => delta * angularRadialProfile w s) r := by
rw [inter_comm, ← Measure.restrict_restrict hE, ← integral_indicator hE]
calc
_ = ∫ z : ℝ × ℝ in D0,
A.indicator (fun s => delta * angularRadialProfile w s)
(planarRadius z) := by
apply integral_congr_ae
filter_upwards with z
by_cases hz : planarRadius z ∈ A <;> simp [E, hz]
_ = _ := by simpa [D0] using hfirst
have hsecond' :
(∫ z : ℝ × ℝ in D0 ∩ E,
b * z.1 * angularTilt b cA delta w (planarRadius z) *
(z.1 / planarRadius z)) =
(∫ r : ℝ in Ioc 0 R,
r * A.indicator
(fun s => b * s * angularTilt b cA delta w s) r) *
(pi / 2) := by
rw [inter_comm, ← Measure.restrict_restrict hE, ← integral_indicator hE]
calc
_ = ∫ z : ℝ × ℝ in D0,
A.indicator (fun s => b * planarRadius z *
angularTilt b cA delta w (planarRadius z)) (planarRadius z) *
cos (planarAngle z) ^ 2 := by
apply integral_congr_ae
filter_upwards [ae_restrict_mem hD0] with z hzD
by_cases hz : planarRadius z ∈ A
· rw [Set.indicator_of_mem (show z ∈ E from hz),
Set.indicator_of_mem hz]
have hr := planarFirst_div_radius_eq_cos z hzD.1
have hr0 : planarRadius z ≠ 0 := by
intro hzero
have hs : z.1 ^ 2 + z.2 ^ 2 ≤ 0 :=
Real.sqrt_eq_zero'.mp (by simpa [planarRadius] using hzero)
nlinarith [hzD.1, sq_nonneg z.1, sq_nonneg z.2]
field_simp [hr0] at hr ⊢
rw [hr]
ring
· simp [Set.indicator_of_notMem (show z ∉ E from hz), hz]
_ = _ := hsecond
have harea' : (volume (D0 ∩ Eloc)).toReal =
∫ r : ℝ in Ioc 0 R,
pi * r * (A ∩ Iio (2 * (cA * delta) / b)).indicator
(fun _ => (1 : ℝ)) r := by
have hone : (∫ z : ℝ × ℝ in D0 ∩ Eloc, (1 : ℝ)) =
∫ r : ℝ in Ioc 0 R,
pi * r * (A ∩ Iio (2 * (cA * delta) / b)).indicator
(fun _ => (1 : ℝ)) r := by
rw [inter_comm, ← Measure.restrict_restrict hEloc,
← integral_indicator hEloc]
calc
_ = ∫ z : ℝ × ℝ in D0,
(A ∩ Iio (2 * (cA * delta) / b)).indicator
(fun _ => (1 : ℝ)) (planarRadius z) := by
apply integral_congr_ae
filter_upwards with z
by_cases hz : planarRadius z ∈ A ∩ Iio (2 * (cA * delta) / b)
· have hz' : z ∈ Eloc := hz
rw [Set.indicator_of_mem hz', Set.indicator_of_mem hz]
· have hz' : z ∉ Eloc := hz
rw [Set.indicator_of_notMem hz', Set.indicator_of_notMem hz]
_ = _ := by simpa [D0] using harea
simpa [integral_const, Measure.real_def] using hone
change _ ≤ delta * (volume (D0 ∩ Eloc)).toReal
rw [hfirst', hsecond', harea']
have hfint : IntegrableOn
(fun r : ℝ => pi * r * A.indicator
(fun s => delta * angularRadialProfile w s) r) (Ioc 0 R) := by
have hc : Continuous (fun r : ℝ =>
pi * r * (delta * angularRadialProfile w r)) :=
(continuous_const.mul continuous_id).mul
(continuous_const.mul (angularRadialProfile_continuous w))
exact ((((hc.continuousOn.integrableOn_compact isCompact_Icc).mono_set
Ioc_subset_Icc_self).indicator hA)).congr
(Filter.Eventually.of_forall fun r => by
by_cases hr : r ∈ A <;> simp [indicator, hr])
have hgint : IntegrableOn
(fun r : ℝ => r * A.indicator
(fun s => b * s * angularTilt b cA delta w s) r) (Ioc 0 R) := by
have hc : Continuous (fun r : ℝ =>
r * (b * r * angularTilt b cA delta w r)) :=
continuous_id.mul ((continuous_const.mul continuous_id).mul
(angularTilt_continuous hscale))
exact ((((hc.continuousOn.integrableOn_compact isCompact_Icc).mono_set
Ioc_subset_Icc_self).indicator hA)).congr
(Filter.Eventually.of_forall fun r => by
by_cases hr : r ∈ A <;> simp [indicator, hr])
rw [← integral_mul_const, ← integral_add hfint
(hgint.mul_const (pi / 2))]
have hcombine :
(∫ r in Ioc 0 R,
pi * r * A.indicator
(fun s => delta * angularRadialProfile w s) r +
r * A.indicator
(fun s => b * s * angularTilt b cA delta w s) r *
(pi / 2)) =
∫ r in Ioc 0 R, pi * r * A.indicator
(fun s => delta * angularRadialProfile w s +
(b * s * angularTilt b cA delta w s) / 2) r := by
apply integral_congr_ae
filter_upwards with r
by_cases hrA : r ∈ A <;> simp [hrA] <;> ring
rw [hcombine]
exact angularRadialSuccessIncrement_setIntegral_abs_le
(w := w) (R := R) hb hscale hdelta hA
theorem angularGridCenter_radialSet_angular_outcome_abs_le
Translation of the quantitative half-disc bound to a lower-edge angular grid center in score coordinates.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hscale :
0 < cA * delta
hdelta :
0 ≤ delta
A :
Set ℝ
hA :
conclusion
let c := angularGridCenter M j let D : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A} let Dloc : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)} |(∫ x in D, delta * angularRadialProfile w (dist x c))
+ (∫ x in D, b * (scoreCoordinates x - scoreCoordinates c).1 * angularTilt b cA delta w (dist x c) * ((scoreCoordinates x - scoreCoordinates c).1 / dist x c))|
≤ delta * (volume Dloc).toReal
Proof (Lean source)
-- @node: angularGridCenter_radialSet_angular_outcome_abs_le
lemma angularGridCenter_radialSet_angular_outcome_abs_le
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hb : 0 < b) (hscale : 0 < cA * delta) (hdelta : 0 ≤ delta)
{A : Set ℝ} (hA : MeasurableSet A) :
let c := angularGridCenter M j
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let Dloc : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)}
|(∫ x in D, delta * angularRadialProfile w (dist x c)) +
(∫ x in D,
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c))| ≤
delta * (volume Dloc).toReal := by
dsimp only
let c : Score := angularGridCenter M j
let cp : ℝ × ℝ := scoreCoordinates c
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let Dloc : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)}
let E : Set (ℝ × ℝ) :=
{z | 0 < (z - cp).2 ∧ planarRadius (z - cp) ≤ w} ∩
{z | planarRadius (z - cp) ∈ A}
let Eloc : Set (ℝ × ℝ) :=
{z | 0 < (z - cp).2 ∧ planarRadius (z - cp) ≤ w} ∩
{z | planarRadius (z - cp) ∈ A ∩ Iio (2 * (cA * delta) / b)}
have himage : scoreCoordinates '' D = E := by
ext z
constructor
· rintro ⟨x, hx, rfl⟩
simpa [D, E, cp, c, planarRadius_scoreCoordinates_sub] using hx
· intro hz
let x : Score := scorePoint z.1 z.2
have hcoord : scoreCoordinates x = z := by
ext <;> simp [x, scoreCoordinates, scorePoint_apply_zero,
scorePoint_apply_one]
refine ⟨x, ?_, hcoord⟩
simpa [D, E, cp, c, hcoord, ← planarRadius_scoreCoordinates_sub] using hz
have himageLoc : scoreCoordinates '' Dloc = Eloc := by
ext z
constructor
· rintro ⟨x, hx, rfl⟩
simpa [Dloc, Eloc, cp, c, planarRadius_scoreCoordinates_sub] using hx
· intro hz
let x : Score := scorePoint z.1 z.2
have hcoord : scoreCoordinates x = z := by
ext <;> simp [x, scoreCoordinates, scorePoint_apply_zero,
scorePoint_apply_one]
refine ⟨x, ?_, hcoord⟩
simpa [Dloc, Eloc, cp, c, hcoord,
← planarRadius_scoreCoordinates_sub] using hz
change |(∫ x in D, delta * angularRadialProfile w (dist x c)) +
(∫ x in D, b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c))| ≤
delta * (volume Dloc).toReal
have hfirst : (fun x : Score => delta * angularRadialProfile w (dist x c)) =
fun x => delta * angularRadialProfile w
(planarRadius (scoreCoordinates x - scoreCoordinates c)) := by
funext x
rw [planarRadius_scoreCoordinates_sub]
have hsecond : (fun x : Score =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) =
fun x => b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w
(planarRadius (scoreCoordinates x - scoreCoordinates c)) *
((scoreCoordinates x - scoreCoordinates c).1 /
planarRadius (scoreCoordinates x - scoreCoordinates c)) := by
funext x
rw [planarRadius_scoreCoordinates_sub]
rw [hfirst, hsecond]
change |(∫ x in D, (fun z : ℝ × ℝ =>
delta * angularRadialProfile w (planarRadius (z - scoreCoordinates c)))
(scoreCoordinates x)) +
(∫ x in D, (fun z : ℝ × ℝ =>
b * (z - scoreCoordinates c).1 *
angularTilt b cA delta w (planarRadius (z - scoreCoordinates c)) *
((z - scoreCoordinates c).1 / planarRadius (z - scoreCoordinates c)))
(scoreCoordinates x))| ≤ delta * (volume Dloc).toReal
rw [← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ => delta * angularRadialProfile w
(planarRadius (z - scoreCoordinates c))) D,
← scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding
(fun z : ℝ × ℝ => b * (z - scoreCoordinates c).1 *
angularTilt b cA delta w (planarRadius (z - scoreCoordinates c)) *
((z - scoreCoordinates c).1 / planarRadius (z - scoreCoordinates c))) D]
have hvolScore : (volume Dloc).toReal =
(volume (scoreCoordinates '' Dloc)).toReal := by
have h := scoreCoordinates_measurePreserving.setIntegral_image_emb
scoreCoordinates_measurableEmbedding (fun _ : ℝ × ℝ => (1 : ℝ)) Dloc
simpa [integral_const, Measure.real_def] using h.symm
rw [hvolScore]
rw [himage, himageLoc]
let T : (ℝ × ℝ) → (ℝ × ℝ) := fun u => cp + u
let E0 : Set (ℝ × ℝ) :=
{u | 0 < u.2 ∧ planarRadius u ≤ w} ∩ planarRadius ⁻¹' A
let E0loc : Set (ℝ × ℝ) :=
{u | 0 < u.2 ∧ planarRadius u ≤ w} ∩
planarRadius ⁻¹' (A ∩ Iio (2 * (cA * delta) / b))
have hT : MeasurableEmbedding T := (Homeomorph.addLeft cp).measurableEmbedding
have hmp : MeasurePreserving T (volume : Measure (ℝ × ℝ)) volume :=
measurePreserving_add_left volume cp
have hE : E = T '' E0 := by
ext z
constructor
· rintro ⟨hz, hAz⟩
refine ⟨z - cp, ⟨?_, ?_⟩, by simp [T]⟩
· simpa [E0] using hz
· simpa [E0] using hAz
· rintro ⟨u, ⟨hu, hAu⟩, rfl⟩
simpa [E, E0, T] using And.intro hu hAu
have hEloc : Eloc = T '' E0loc := by
ext z
constructor
· rintro ⟨hz, hAz⟩
refine ⟨z - cp, ⟨?_, ?_⟩, by simp [T]⟩
· simpa [E0loc] using hz
· simpa [E0loc] using hAz
· rintro ⟨u, ⟨hu, hAu⟩, rfl⟩
simpa [Eloc, E0loc, T] using And.intro hu hAu
rw [hE, hmp.setIntegral_image_emb hT, hmp.setIntegral_image_emb hT]
rw [hEloc]
have hvol : (volume (T '' E0loc)).toReal = (volume E0loc).toReal := by
have h := hmp.setIntegral_image_emb hT (fun _ : ℝ × ℝ => (1 : ℝ)) E0loc
simpa [integral_const, Measure.real_def] using h
rw [hvol]
simpa [T, cp, c, E0, E0loc] using
halfDisc_radialSet_angular_outcome_abs_le
(w := w) (R := w) hb hscale hdelta hA
theorem angularPacking_flip_setIntegral_abs_le_cellArea
For a true changed bit, the success-weighted mass difference on any radial slice is bounded by the amplitude times the area of that slice inside the changed half-disc.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hj :
omega j = true
A :
Set ℝ
hA :
conclusion
let c := angularGridCenter M j let D : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A} let Dloc : Set Score := {x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ {x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)} |(∫ x in {x | dist x c ∈ A}, clippedPackingRegression b delta w (angularGridCenter M) omega x ∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega))
- ∫ x in {x | dist x c ∈ A}, clippedPackingRegression b delta w (angularGridCenter M) (flipBit j omega) x ∂(angularDesignMeasure b cA delta w (angularGridCenter M) (flipBit j omega))|
≤ delta * (volume Dloc).toReal
Proof (Lean source)
-- @node: angularPacking_flip_setIntegral_abs_le_cellArea
lemma angularPacking_flip_setIntegral_abs_le_cellArea
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) (hj : omega j = true)
{A : Set ℝ} (hA : MeasurableSet A) :
let c := angularGridCenter M j
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A}
let Dloc : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)}
|(∫ x in {x | dist x c ∈ A},
clippedPackingRegression b delta w (angularGridCenter M) omega x
∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega)) -
∫ x in {x | dist x c ∈ A},
clippedPackingRegression b delta w (angularGridCenter M)
(flipBit j omega) x
∂(angularDesignMeasure b cA delta w (angularGridCenter M)
(flipBit j omega))| ≤
delta * (volume Dloc).toReal := by
dsimp only
let c := angularGridCenter M j
let S : Set Score := {x | dist x c ∈ A}
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩ S
let Dloc : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ A ∩ Iio (2 * (cA * delta) / b)}
let f : Score → ℝ := fun x =>
packingRegression b delta w (angularGridCenter M) omega x *
packingAngularDensity b cA delta w (angularGridCenter M) omega x
let f' : Score → ℝ := fun x =>
packingRegression b delta w (angularGridCenter M)
(flipBit j omega) x *
packingAngularDensity b cA delta w (angularGridCenter M)
(flipBit j omega) x
have hS : MeasurableSet S := hA.preimage (by fun_prop)
rw [clippedPackingRegression_setIntegral_angularDesignMeasure hb hbSmall hcA
hscale hdelta hdeltaSmall hw hsep omega hS,
clippedPackingRegression_setIntegral_angularDesignMeasure hb hbSmall hcA
hscale hdelta hdeltaSmall hw hsep (flipBit j omega) hS]
change |(∫ x in S ∩ scoreCube (1 / 2 : ℝ), f x) -
∫ x in S ∩ scoreCube (1 / 2 : ℝ), f' x| ≤ delta * (volume Dloc).toReal
have hf : IntegrableOn f (S ∩ scoreCube (1 / 2 : ℝ)) :=
(((packingRegression_contDiff b delta w (angularGridCenter M) omega).continuous.mul
(packingAngularDensity_continuous hb hscale
(angularGridCenter M) omega)).continuousOn.integrableOn_compact
packingScoreCube_isCompact).mono_set inter_subset_right
have hf' : IntegrableOn f' (S ∩ scoreCube (1 / 2 : ℝ)) :=
(((packingRegression_contDiff b delta w (angularGridCenter M)
(flipBit j omega)).continuous.mul
(packingAngularDensity_continuous hb hscale (angularGridCenter M)
(flipBit j omega))).continuousOn.integrableOn_compact
packingScoreCube_isCompact).mono_set inter_subset_right
rw [← integral_sub hf hf']
have hboundary : (volume : Measure Score)
{x | (scoreCoordinates x - scoreCoordinates c).2 = 0} = 0 := by
have hpre : {x : Score | (scoreCoordinates x - scoreCoordinates c).2 = 0} =
scoreCoordinates ⁻¹' {z : ℝ × ℝ | z.2 = (scoreCoordinates c).2} := by
ext x
change (scoreCoordinates x).2 - (scoreCoordinates c).2 = 0 ↔
(scoreCoordinates x).2 = (scoreCoordinates c).2
constructor <;> intro h <;> linarith
rw [hpre, scoreCoordinates_measurePreserving.measure_preimage_emb
scoreCoordinates_measurableEmbedding]
have hset : {z : ℝ × ℝ | z.2 = (scoreCoordinates c).2} =
univ ×ˢ {(scoreCoordinates c).2} := by ext z; simp
rw [hset, Measure.volume_eq_prod,
Measure.prod_apply (MeasurableSet.univ.prod
(measurableSet_singleton (scoreCoordinates c).2))]
simp
have hae : ∀ᵐ x ∂(volume : Measure Score),
(S ∩ scoreCube (1 / 2 : ℝ)).indicator (fun x => f x - f' x) x =
D.indicator (fun x => f x - f' x) x := by
filter_upwards [compl_mem_ae_iff.mpr hboundary] with x hxboundary
by_cases hxD : x ∈ D
· have hxCell : x ∈ closedBall c w ∩ scoreCube (1 / 2 : ℝ) := by
apply (mem_angularGrid_packingCell_iff_closedUpperHalfDisc j hwQuarter x).mpr
exact ⟨le_of_lt hxD.1.1, by
simpa [c, planarRadius_scoreCoordinates_sub] using hxD.1.2⟩
rw [Set.indicator_of_mem hxD,
Set.indicator_of_mem (show x ∈ S ∩ scoreCube (1 / 2 : ℝ) from
⟨hxD.2, hxCell.2⟩)]
· rw [Set.indicator_of_notMem hxD]
by_cases hxSS : x ∈ S ∩ scoreCube (1 / 2 : ℝ)
· rw [Set.indicator_of_mem hxSS]
have hxOutside : x ∉ closedBall c w := by
intro hxBall
have hxLower := hxSS.2 (1 : Fin 2)
have hcLower : c 1 = -(1 / 2 : ℝ) := by
dsimp [c]
simpa [div_eq_mul_inv] using angularGridCenter_apply_one M j
have hnonneg : 0 ≤ (scoreCoordinates x - scoreCoordinates c).2 := by
dsimp [scoreCube] at hxLower
simp only [scoreCoordinates, Prod.snd_sub]
rw [hcLower]
have hlower := neg_le_of_abs_le hxLower
linarith
exact hxD ⟨⟨lt_of_le_of_ne hnonneg (Ne.symm hxboundary),
by simpa [c, Metric.mem_closedBall] using hxBall⟩, hxSS.1⟩
have hfar : w ≤ dist x c :=
le_of_lt (by simpa [Metric.mem_closedBall, not_le] using hxOutside)
have hreg : packingRegression b delta w (angularGridCenter M) omega x =
packingRegression b delta w (angularGridCenter M)
(flipBit j omega) x := by
unfold packingRegression
congr 1
apply Finset.sum_congr rfl
intro k _
by_cases hkj : k = j
· subst k
rw [localizedPackingBump_eq_zero_of_bandwidth_le_dist hw hfar]
simp
· simp [flipBit, hkj]
have hdens : packingAngularDensity b cA delta w (angularGridCenter M) omega x =
packingAngularDensity b cA delta w (angularGridCenter M)
(flipBit j omega) x := by
unfold packingAngularDensity
congr 1
apply Finset.sum_congr rfl
intro k _
by_cases hkj : k = j
· subst k
rw [packingAngularTerm_eq_zero_of_bandwidth_le_dist hw hfar]
simp
· simp [flipBit, hkj]
simp [f, f', hreg, hdens]
· rw [Set.indicator_of_notMem hxSS]
have hD : MeasurableSet D := by
have hv : Measurable (fun x : Score =>
(scoreCoordinates x - scoreCoordinates c).2) := by fun_prop
have hr : Measurable (fun x : Score => dist x c) := by fun_prop
exact ((measurableSet_lt measurable_const hv).inter
(measurableSet_le hr measurable_const)).inter hS
rw [← integral_indicator (hS.inter (scoreCube_measurableSet _)),
integral_congr_ae hae, integral_indicator hD]
change |∫ x in D, f x - f' x| ≤ delta * (volume Dloc).toReal
have hDsub : D ⊆ closedBall c w := by
intro x hx
simpa [D, Metric.mem_closedBall] using hx.1.2
have hpoint : ∀ x ∈ D, f x - f' x =
delta * angularRadialProfile w (dist x c) +
(packingAffineBaseline b x + delta * angularRadialProfile w (dist x c)) *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c) := by
intro x hx
simpa [c, f, f'] using
packingRegression_mul_density_flip_cell_radial_identity j hw hsep omega hj
(hDsub hx)
rw [integral_congr_ae (ae_restrict_of_forall_mem hD hpoint)]
let g : ℝ → ℝ := fun r =>
(1 / 2 + b * c 0 + delta * angularRadialProfile w r) *
angularTilt b cA delta w r
have hz := angularGridCenter_openRadialSet_weighted_direction_cancellation
j g w hA
dsimp only at hz
have hz' : (∫ x in D, g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) = 0 := by
simpa [D, c] using hz
have hfirst : IntegrableOn
(fun x : Score => delta * angularRadialProfile w (dist x c)) D :=
((((continuous_const.mul ((angularRadialProfile_continuous w).comp
(continuous_id.dist continuous_const))).continuousOn.integrableOn_compact
(isCompact_closedBall c w)).mono_set hDsub))
have hright : IntegrableOn (fun x : Score =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) D := by
have hc : Continuous (fun x : Score =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
packingAngularTerm b cA delta w c x) := by
apply Continuous.mul
· fun_prop
· exact packingAngularTerm_continuous hb hscale c
have hiClosed : IntegrableOn (fun x : Score =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
packingAngularTerm b cA delta w c x)
(closedBall c w) volume :=
hc.continuousOn.integrableOn_compact (isCompact_closedBall c w)
have hi := hiClosed.mono_set hDsub
convert hi using 1
ext x
rw [packingAngularTerm, packingDirectionCos_eq_planarFirst_div_radius,
planarRadius_scoreCoordinates_sub]
ring
have hzeroInt : IntegrableOn (fun x : Score => g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) D := by
have hc : Continuous (fun x : Score =>
(1 / 2 + b * c 0 + delta * angularRadialProfile w (dist x c)) *
packingAngularTerm b cA delta w c x) :=
(continuous_const.add (continuous_const.mul
((angularRadialProfile_continuous w).comp
(continuous_id.dist continuous_const)))).mul
(packingAngularTerm_continuous hb hscale c)
have hiClosed : IntegrableOn (fun x : Score =>
(1 / 2 + b * c 0 + delta * angularRadialProfile w (dist x c)) *
packingAngularTerm b cA delta w c x)
(closedBall c w) volume :=
hc.continuousOn.integrableOn_compact (isCompact_closedBall c w)
have hi := hiClosed.mono_set hDsub
convert hi using 1
ext x
dsimp [g]
rw [packingAngularTerm, packingDirectionCos_eq_planarFirst_div_radius,
planarRadius_scoreCoordinates_sub]
simp only [Prod.fst_sub]
ring
have hdecomp : (fun x : Score =>
delta * angularRadialProfile w (dist x c) +
(packingAffineBaseline b x + delta * angularRadialProfile w (dist x c)) *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) = fun x =>
delta * angularRadialProfile w (dist x c) +
(b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c) +
g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) := by
funext x
dsimp [g, packingAffineBaseline, c, scoreCoordinates]
ring
rw [hdecomp]
have hsum : (∫ x in D,
delta * angularRadialProfile w (dist x c) +
(b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c) +
g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c))) =
(∫ x in D, delta * angularRadialProfile w (dist x c)) +
((∫ x in D, b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) +
∫ x in D, g (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)) := by
let u : Score → ℝ := fun x =>
b * (scoreCoordinates x - scoreCoordinates c).1 *
angularTilt b cA delta w (dist x c) *
((scoreCoordinates x - scoreCoordinates c).1 / dist x c)
let v : Score → ℝ := fun x => g (dist x c) *
-- … truncated; follow the source link for the rest …
theorem angularPacking_flip_setIntegral_abs_le_radialMass
The cell-area bound is dominated by the common radius marginal on the same measurable radial set.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
hj :
omega j = true
A :
Set ℝ
hA :
conclusion
|(∫ x in {x | dist x (angularGridCenter M j) ∈ A}, clippedPackingRegression b delta w (angularGridCenter M) omega x ∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega))
- ∫ x in {x | dist x (angularGridCenter M j) ∈ A}, clippedPackingRegression b delta w (angularGridCenter M) (flipBit j omega) x ∂(angularDesignMeasure b cA delta w (angularGridCenter M) (flipBit j omega))|
≤ delta * (Measure.map (fun x : Score => dist x (angularGridCenter M j)) (angularDesignMeasure b cA delta w (angularGridCenter M) omega) (A ∩ Iio (2 * (cA * delta) / b))).toReal
Proof (Lean source)
-- @node: angularPacking_flip_setIntegral_abs_le_radialMass
lemma angularPacking_flip_setIntegral_abs_le_radialMass
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) (hj : omega j = true)
{A : Set ℝ} (hA : MeasurableSet A) :
|(∫ x in {x | dist x (angularGridCenter M j) ∈ A},
clippedPackingRegression b delta w (angularGridCenter M) omega x
∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega)) -
∫ x in {x | dist x (angularGridCenter M j) ∈ A},
clippedPackingRegression b delta w (angularGridCenter M)
(flipBit j omega) x
∂(angularDesignMeasure b cA delta w (angularGridCenter M)
(flipBit j omega))| ≤
delta * (Measure.map (fun x : Score => dist x (angularGridCenter M j))
(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
(A ∩ Iio (2 * (cA * delta) / b))).toReal := by
let c := angularGridCenter M j
let Aloc : Set ℝ := A ∩ Iio (2 * (cA * delta) / b)
let D : Set Score :=
{x | 0 < (scoreCoordinates x - scoreCoordinates c).2 ∧ dist x c ≤ w} ∩
{x | dist x c ∈ Aloc}
have hbase := angularPacking_flip_setIntegral_abs_le_cellArea j hb hbSmall
hscale hcA hdelta hdeltaSmall hw hwQuarter hsep omega hj hA
dsimp only at hbase
apply hbase.trans
apply mul_le_mul_of_nonneg_left _ hdelta.le
change (volume D).toReal ≤ _
have hDsub : D ⊆
(closedBall c w ∩ scoreCube (1 / 2)) ∩ {x | dist x c ∈ Aloc} := by
intro x hx
refine ⟨?_, hx.2⟩
apply (mem_angularGrid_packingCell_iff_closedUpperHalfDisc j hwQuarter x).mpr
exact ⟨hx.1.1.le, by simpa [c, planarRadius_scoreCoordinates_sub] using hx.1.2⟩
have hcell := angularDesignMeasure_gridCell_radialSet_eq_volume j hb hscale hcA
hdelta hw hwQuarter hsep omega (A := Aloc) (by
dsimp [Aloc]
exact hA.inter measurableSet_Iio)
letI : IsProbabilityMeasure
(angularDesignMeasure b cA delta w (angularGridCenter M) omega) :=
angularDesignMeasure_isProbabilityMeasure hb hscale hcA hdelta hw
hwQuarter hsep omega
have hmeas : MeasurableSet Aloc := by
dsimp [Aloc]
exact hA.inter measurableSet_Iio
rw [Measure.map_apply (by fun_prop) hmeas]
have hDfinite : volume D ≠ ⊤ := ne_of_lt
((measure_mono hDsub).trans (measure_mono inter_subset_left) |>.trans_lt
((isCompact_closedBall c w).inter_right
packingScoreCube_isCompact.isClosed |>.measure_lt_top))
apply (ENNReal.toReal_le_toReal hDfinite (measure_ne_top _ _)).2
exact calc
volume D ≤ volume ((closedBall c w ∩ scoreCube (1 / 2)) ∩
{x | dist x c ∈ Aloc}) := measure_mono hDsub
_ = angularDesignMeasure b cA delta w (angularGridCenter M) omega
((closedBall c w ∩ scoreCube (1 / 2)) ∩
{x | dist x c ∈ Aloc}) := hcell.symm
_ ≤ angularDesignMeasure b cA delta w (angularGridCenter M) omega
{x | dist x c ∈ Aloc} := measure_mono inter_subset_right
theorem angularPacking_flip_success_setIntegral_abs_le
The localized success-mass estimate holds in either orientation of the changed packing bit.
Formal statement
hypotheses
M :
ℕ
j :
Fin M
b cA delta w :
ℝ
hb :
0 < b
hbSmall :
|b| ≤ 1 / 4
hscale :
0 < cA * delta
hcA :
8 ≤ cA
hdelta :
0 < delta
hdeltaSmall :
delta ≤ 1 / 8
hw :
0 < w
hwQuarter :
w ≤ 1 / 4
hsep :
∀ i k : Fin M
if
i ≠ k
then
A :
Set ℝ
hA :
conclusion
|(∫ x in {x | dist x (angularGridCenter M j) ∈ A}, clippedPackingRegression b delta w (angularGridCenter M) omega x ∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega))
- ∫ x in {x | dist x (angularGridCenter M j) ∈ A}, clippedPackingRegression b delta w (angularGridCenter M) (flipBit j omega) x ∂(angularDesignMeasure b cA delta w (angularGridCenter M) (flipBit j omega))|
≤ delta * (Measure.map (fun x : Score => dist x (angularGridCenter M j)) (angularDesignMeasure b cA delta w (angularGridCenter M) omega) (A ∩ Iio (2 * (cA * delta) / b))).toReal
Proof (Lean source)
-- @node: angularPacking_flip_success_setIntegral_abs_le
lemma angularPacking_flip_success_setIntegral_abs_le
{M : ℕ} (j : Fin M) {b cA delta w : ℝ}
(hb : 0 < b) (hbSmall : |b| ≤ 1 / 4)
(hscale : 0 < cA * delta) (hcA : 8 ≤ cA)
(hdelta : 0 < delta) (hdeltaSmall : delta ≤ 1 / 8)
(hw : 0 < w) (hwQuarter : w ≤ 1 / 4)
(hsep : ∀ i k : Fin M, i ≠ k →
3 * w ≤ dist (angularGridCenter M i) (angularGridCenter M k))
(omega : Fin M → Bool) {A : Set ℝ} (hA : MeasurableSet A) :
|(∫ x in {x | dist x (angularGridCenter M j) ∈ A},
clippedPackingRegression b delta w (angularGridCenter M) omega x
∂(angularDesignMeasure b cA delta w (angularGridCenter M) omega)) -
∫ x in {x | dist x (angularGridCenter M j) ∈ A},
clippedPackingRegression b delta w (angularGridCenter M)
(flipBit j omega) x
∂(angularDesignMeasure b cA delta w (angularGridCenter M)
(flipBit j omega))| ≤
delta * (Measure.map (fun x : Score => dist x (angularGridCenter M j))
(angularDesignMeasure b cA delta w (angularGridCenter M) omega)
(A ∩ Iio (2 * (cA * delta) / b))).toReal := by
by_cases hj : omega j = true
· exact angularPacking_flip_setIntegral_abs_le_radialMass j hb hbSmall
hscale hcA hdelta hdeltaSmall hw hwQuarter hsep omega hj hA
· have hjf : omega j = false := Bool.eq_false_of_not_eq_true hj
have htrue : (flipBit j omega) j = true := by
simp [flipBit, hjf]
have hbound := angularPacking_flip_setIntegral_abs_le_radialMass j hb hbSmall
hscale hcA hdelta hdeltaSmall hw hwQuarter hsep
(flipBit j omega) htrue hA
have hmap := angularDesignMeasure_map_distance_eq j hb hscale hcA hdelta hw
hwQuarter hsep omega (flipBit j omega)
(by intro k hkj; simp [flipBit, hkj])
rw [← hmap] at hbound
simpa [flipBit_involutive j omega, abs_sub_comm] using hbound
Helpers.AngularScaledDelta 11 declarations This module fixes the derivative scale used by the angular hard family and records both its exact fourth-power budget and the eventual comparison with the logarithm of the boundary-grid size.
Smoothness-normalized angular amplitude
This module fixes the derivative scale used by the angular hard family and records both its exact fourth-power budget and the eventual comparison with the logarithm of the boundary-grid size.
A fixed choice of a uniform bound for the jth derivative of the normalized packing bump.
Definition (Lean source)
-- @node: packingBumpDerivativeBound
noncomputable def packingBumpDerivativeBound (j : ℕ) : ℝ :=
choose (packingBump_iteratedFDeriv_bound j)
theorem packingBumpDerivativeBound_nonneg
The chosen normalized-bump derivative bound is nonnegative.
Formal statement
Proof (Lean source)
-- @node: packingBumpDerivativeBound_nonneg
lemma packingBumpDerivativeBound_nonneg (j : ℕ) :
0 ≤ packingBumpDerivativeBound j :=
(Classical.choose_spec (packingBump_iteratedFDeriv_bound j)).1
theorem packingBump_iteratedFDeriv_le_derivativeBound
The chosen constant bounds the corresponding normalized-bump derivative at every score.
Formal statement
Proof (Lean source)
-- @node: packingBump_iteratedFDeriv_le_derivativeBound
lemma packingBump_iteratedFDeriv_le_derivativeBound (j : ℕ) (z : Score) :
‖iteratedFDeriv ℝ j packingBump z‖ ≤ packingBumpDerivativeBound j :=
(Classical.choose_spec (packingBump_iteratedFDeriv_bound j)).2 z
A fixed numerical envelope for the construction-specific one-observation radial KL estimate.
Definition (Lean source)
-- @node: angularPackingOnePointKLConstant
def angularPackingOnePointKLConstant : ℝ := 1310720
A positive, smoothness-dependent scale dominating all derivative bounds needed through order q, while explicitly absorbing the smoothness order and the construction-specific one-observation KL envelope.
Definition (Lean source)
-- @node: packingBumpDerivativeScale
noncomputable def packingBumpDerivativeScale (q : ℕ) : ℝ :=
1 + (q : ℝ) + 1310720 +
∑ j ∈ range (q + 1), packingBumpDerivativeBound j
theorem packingBumpDerivativeScale_pos
The derivative scale is positive.
Formal statement
Proof (Lean source)
-- @node: packingBumpDerivativeScale_pos
lemma packingBumpDerivativeScale_pos (q : ℕ) :
0 < packingBumpDerivativeScale q := by
unfold packingBumpDerivativeScale
have hsum : 0 ≤ ∑ j ∈ range (q + 1), packingBumpDerivativeBound j :=
sum_nonneg fun j _ => packingBumpDerivativeBound_nonneg j
linarith
theorem packingBumpDerivativeBound_le_scale
Every derivative bound through order q is dominated by the common smoothness-dependent scale.
Formal statement
hypotheses
j q :
ℕ
hjq :
j ≤ q
conclusion
Proof (Lean source)
-- @node: packingBumpDerivativeBound_le_scale
lemma packingBumpDerivativeBound_le_scale {j q : ℕ} (hjq : j ≤ q) :
packingBumpDerivativeBound j ≤ packingBumpDerivativeScale q := by
have hjmem : j ∈ range (q + 1) := Finset.mem_range.mpr (by omega)
have hjle : packingBumpDerivativeBound j ≤
∑ k ∈ range (q + 1), packingBumpDerivativeBound k :=
Finset.single_le_sum
(fun k _ => packingBumpDerivativeBound_nonneg k) hjmem
unfold packingBumpDerivativeScale
linarith
The bump amplitude with its smoothness-dependent derivative normalization. It remains a fixed positive multiple of the paper's frontier rate.
Definition (Lean source)
-- @node: angularPackingScaledDelta
noncomputable def angularPackingScaledDelta (q n : ℕ) : ℝ :=
frontierRate n / (1024 * packingBumpDerivativeScale q)
theorem angularPackingScaledDelta_eq_scale_mul_frontierRate
The smoothness-normalized amplitude is an exact fixed positive multiple of the frontier rate.
Formal statement
Proof (Lean source)
-- @node: angularPackingScaledDelta_eq_scale_mul_frontierRate
lemma angularPackingScaledDelta_eq_scale_mul_frontierRate (q n : ℕ) :
angularPackingScaledDelta q n =
(1 / (1024 * packingBumpDerivativeScale q)) * frontierRate n := by
unfold angularPackingScaledDelta
ring
theorem angularPackingScaledDelta_fourth_power
The smoothness-normalized amplitude has the exact fourth-power budget needed by the one-point radial KL estimate.
Formal statement
hypotheses
q n :
ℕ
hn :
2 ≤ n
conclusion
(n : ℝ) * angularPackingScaledDelta q n ^ 4
= log n / (1024 * packingBumpDerivativeScale q) ^ 4
Proof (Lean source)
-- @node: angularPackingScaledDelta_fourth_power
lemma angularPackingScaledDelta_fourth_power (q n : ℕ) (hn : 2 ≤ n) :
(n : ℝ) * angularPackingScaledDelta q n ^ 4 =
log n / (1024 * packingBumpDerivativeScale q) ^ 4 := by
unfold angularPackingScaledDelta
rw [div_pow]
calc
(n : ℝ) * (frontierRate n ^ 4 /
(1024 * packingBumpDerivativeScale q) ^ 4) =
((n : ℝ) * frontierRate n ^ 4) /
(1024 * packingBumpDerivativeScale q) ^ 4 := by ring
_ = _ := by rw [frontierRate_fourth_power n hn]
theorem angularPackingScaledDelta_eventually_klBudget
Any construction-specific one-point KL constant small enough for the fixed derivative normalization eventually fits under one sixteenth of the logarithmic grid budget.
Formal statement
hypotheses
conclusion
∀ᶠ n in atTop
if
angularGridRadius n q ≤ 1 / 24
then
(n : ℝ) * (C * angularPackingScaledDelta q n ^ 4)
Proof (Lean source)
-- @node: angularPackingScaledDelta_eventually_klBudget
lemma angularPackingScaledDelta_eventually_klBudget
(q : ℕ) (hq : 1 ≤ q) (C : ℝ)
(hC : 256 * (q : ℝ) * C ≤
(1024 * packingBumpDerivativeScale q) ^ 4) :
∀ᶠ n in atTop,
angularGridRadius n q ≤ 1 / 24 →
(n : ℝ) * (C * angularPackingScaledDelta q n ^ 4) ≤
(1 / 16 : ℝ) * log (angularGridSize (angularGridRadius n q)) := by
have hlog_atTop : Tendsto (fun n : ℕ => log (n : ℝ)) atTop atTop :=
Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop
have hlog_pos : ∀ᶠ n : ℕ in atTop, 0 < log (n : ℝ) :=
hlog_atTop.eventually_gt_atTop 0
have hloglog_bound : ∀ᶠ n : ℕ in atTop,
log (log (n : ℝ)) ≤ (1 / 2 : ℝ) * log (n : ℝ) := by
filter_upwards [hlog_atTop.eventually_ge_atTop 16, hlog_pos] with n hnlog hnlogpos
have hnlog0 : 0 ≤ log (n : ℝ) := le_trans (by norm_num) hnlog
have hbase := Real.log_le_rpow_div hnlog0
(show (0 : ℝ) < 1 / 2 by norm_num)
have hsqrt : log (log (n : ℝ)) ≤
2 * sqrt (log (n : ℝ)) := by
simpa [Real.sqrt_eq_rpow, div_eq_mul_inv, mul_comm] using hbase
have hfour : 4 ≤ sqrt (log (n : ℝ)) := by
rw [← Real.sqrt_sq (by norm_num : (0 : ℝ) ≤ 4)]
apply Real.sqrt_le_sqrt
norm_num
exact hnlog
nlinarith [Real.sq_sqrt hnlog0]
have hconst : ∀ᶠ n : ℕ in atTop,
2 * log 24 ≤
(1 / (256 * (q : ℝ))) * log (n : ℝ) := by
have hcoef : 0 < (1 / (256 * (q : ℝ)) : ℝ) := by positivity
exact (hlog_atTop.const_mul_atTop hcoef).eventually_ge_atTop _
filter_upwards [eventually_ge_atTop (2 : ℕ), hloglog_bound, hconst]
with n hn hloglog hconstn
intro hsmall
have hnreal : (0 : ℝ) < n := by positivity
have hrate : 0 < frontierRate n := frontierRate_pos hn
have hqreal : (0 : ℝ) < q := by positivity
have hMlow := angularGridSize_frontier_lower n q hn hsmall
have hlowpos : 0 < (1 / 24 : ℝ) *
rpow (frontierRate n) (-(1 : ℝ) / q) :=
mul_pos (by norm_num) (rpow_pos_of_pos hrate _)
have hlogM := Real.log_le_log hlowpos hMlow
rw [show log ((1 / 24 : ℝ) *
rpow (frontierRate n) (-(1 : ℝ) / q)) =
log (1 / 24 : ℝ) +
log (rpow (frontierRate n) (-(1 : ℝ) / q)) by
exact Real.log_mul (by norm_num)
(ne_of_gt (rpow_pos_of_pos hrate _))] at hlogM
rw [show log (rpow (frontierRate n) (-(1 : ℝ) / q)) =
(-(1 : ℝ) / q) * log (frontierRate n) by
exact Real.log_rpow hrate _] at hlogM
have hlograte : log (frontierRate n) =
(1 / 4 : ℝ) * (log (log n) - log n) := by
unfold frontierRate
have hn1r : (1 : ℝ) < n := by exact_mod_cast (show 1 < n by omega)
have hlogn : 0 < log (n : ℝ) := Real.log_pos hn1r
rw [show log (rpow (log n / n) (1 / 4 : ℝ)) =
(1 / 4 : ℝ) * log (log n / n) by
exact Real.log_rpow (div_pos hlogn hnreal) _]
rw [Real.log_div hlogn.ne' hnreal.ne']
rw [hlograte] at hlogM
have hlog24 : log (1 / 24 : ℝ) = -log 24 := by
rw [one_div, Real.log_inv]
rw [hlog24] at hlogM
rw [show (n : ℝ) * (C * angularPackingScaledDelta q n ^ 4) =
C * ((n : ℝ) * angularPackingScaledDelta q n ^ 4) by ring,
angularPackingScaledDelta_fourth_power q n hn]
have htarget :
C * (log n / (1024 * packingBumpDerivativeScale q) ^ 4) ≤
(1 / 16 : ℝ) *
(-log 24 + (1 / (8 * (q : ℝ))) * log n) := by
have hKpos : 0 < (1024 * packingBumpDerivativeScale q) ^ 4 :=
pow_pos (mul_pos (by norm_num) (packingBumpDerivativeScale_pos q)) _
have hcoef : C / (1024 * packingBumpDerivativeScale q) ^ 4 ≤
1 / (256 * (q : ℝ)) := by
apply (div_le_iff₀ hKpos).2
rw [one_div, inv_mul_eq_div]
apply (le_div_iff₀ (mul_pos (by norm_num) hqreal)).2
calc
C * (256 * (q : ℝ)) = 256 * (q : ℝ) * C := by ring
_ ≤ _ := hC
have hlogn0 : 0 ≤ log (n : ℝ) := Real.log_natCast_nonneg n
rw [show C * (log n / (1024 * packingBumpDerivativeScale q) ^ 4) =
(C / (1024 * packingBumpDerivativeScale q) ^ 4) * log n by ring]
have hp := mul_le_mul_of_nonneg_right hcoef hlogn0
calc
_ ≤ (1 / (256 * (q : ℝ))) * log n := hp
_ ≤ (1 / 16 : ℝ) *
(-log 24 + (1 / (8 * (q : ℝ))) * log n) := by
have hid : (1 / (8 * (q : ℝ))) * log n =
32 * ((1 / (256 * (q : ℝ))) * log n) := by field_simp; ring
rw [hid]
nlinarith [Real.log_pos (by norm_num : (1 : ℝ) < 24)]
have hlogM' : -log 24 + (1 / (8 * (q : ℝ))) * log n ≤
log (angularGridSize (angularGridRadius n q)) := by
have hterm : (1 / (8 * (q : ℝ))) * log n ≤
(-1 / (q : ℝ)) *
((1 / 4 : ℝ) * (log (log n) - log n)) := by
rw [show (1 / (8 * (q : ℝ))) * log n =
((1 / 8 : ℝ) * log n) / q by ring,
show (-1 / (q : ℝ)) * ((1 / 4 : ℝ) *
(log (log n) - log n)) =
(-(1 / 4 : ℝ) * (log (log n) - log n)) / q by ring]
exact (div_le_div_iff_of_pos_right hqreal).2 (by linarith)
have hadd := add_le_add_left hterm (-log 24)
have hadd' : -log 24 + (1 / (8 * (q : ℝ))) * log n ≤
-log 24 + (-1 / (q : ℝ)) *
((1 / 4 : ℝ) * (log (log n) - log n)) := by
simpa [add_comm] using hadd
exact hadd'.trans hlogM
exact htarget.trans (mul_le_mul_of_nonneg_left hlogM' (by norm_num))
Helpers.BumpHolder 43 declarations This file isolates the compactly supported Euclidean bump used in the packing regressions.
Smooth radial bumps for the angular packing
This file isolates the compactly supported Euclidean bump used in the packing regressions. It records its range, support, smoothness, and the corresponding facts after translation and rescaling.
A fixed smooth Euclidean bump, equal to one on the ball of radius 1/2 and supported in the open unit ball.
Definition (Lean source)
-- @node: packingContDiffBump
noncomputable def packingContDiffBump : ContDiffBump (0 : Score) :=
⟨(1 / 2 : ℝ), 1, by norm_num, by norm_num⟩
The normalized radial bump used by the packing construction.
Definition (Lean source)
-- @node: packingBump
noncomputable def packingBump (z : Score) : ℝ :=
(ContDiffBumpBase.ofInnerProductSpace Score).toFun 2 ((2 : ℝ) • z)
theorem packingBump_zero
The normalized bump equals one at its center.
Formal statement
conclusion
packingBump 0 = 1
Proof (Lean source)
-- @node: packingBump_zero
lemma packingBump_zero : packingBump 0 = 1 := by
unfold packingBump
apply ContDiffBumpBase.eq_one
· norm_num
· simp
theorem packingBump_mem_Icc
The normalized bump takes values in [0,1].
Formal statement
Proof (Lean source)
-- @node: packingBump_mem_Icc
lemma packingBump_mem_Icc (z : Score) : packingBump z ∈ Icc (0 : ℝ) 1 := by
exact ContDiffBumpBase.mem_Icc _ _ _
theorem packingBump_eq_zero_of_one_le_norm
The normalized bump vanishes outside the open unit ball.
Formal statement
Proof (Lean source)
-- @node: packingBump_eq_zero_of_one_le_norm
lemma packingBump_eq_zero_of_one_le_norm {z : Score} (hz : 1 ≤ ‖z‖) :
packingBump z = 0 := by
unfold packingBump
rw [← not_ne_iff, ← Function.mem_support]
rw [ContDiffBumpBase.support _ _ (by norm_num)]
simp only [Metric.mem_ball, dist_zero_right]
rw [norm_smul, Real.norm_eq_abs, abs_of_pos (by norm_num : (0 : ℝ) < 2)]
nlinarith
theorem packingBump_contDiff
The normalized radial bump is smooth to every finite order.
Formal statement
conclusion
Proof (Lean source)
-- @node: packingBump_contDiff
lemma packingBump_contDiff :
ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) packingBump := by
have hs := (ContDiffBumpBase.ofInnerProductSpace Score).smooth
have hg : ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)
(fun z : Score => ((2 : ℝ), (2 : ℝ) • z)) := by fun_prop
rw [← contDiffOn_univ]
have hc := hs.comp (s := univ) hg.contDiffOn (fun z _ => by simp)
exact hc
theorem packingBump_eq_of_norm_eq
The normalized packing bump depends only on Euclidean radius.
Formal statement
Proof (Lean source)
-- @node: packingBump_eq_of_norm_eq
lemma packingBump_eq_of_norm_eq {x y : Score} (hxy : ‖x‖ = ‖y‖) :
packingBump x = packingBump y := by
unfold packingBump ContDiffBumpBase.ofInnerProductSpace
change Real.smoothTransition ((2 - ‖(2 : ℝ) • x‖) / (2 - 1)) =
Real.smoothTransition ((2 - ‖(2 : ℝ) • y‖) / (2 - 1))
rw [norm_smul, norm_smul, hxy]
theorem packingBump_iteratedFDeriv_bound
Every iterated Fréchet derivative of the normalized packing bump is uniformly bounded.
Formal statement
Proof (Lean source)
-- @node: packingBump_iteratedFDeriv_bound
lemma packingBump_iteratedFDeriv_bound (j : ℕ) :
∃ C : ℝ, 0 ≤ C ∧ ∀ z : Score,
‖iteratedFDeriv ℝ j packingBump z‖ ≤ C := by
have hcont : Continuous (iteratedFDeriv ℝ j packingBump) :=
ContDiff.continuous_iteratedFDeriv (WithTop.coe_le_coe.mpr le_top)
packingBump_contDiff
have hsupp : HasCompactSupport (iteratedFDeriv ℝ j packingBump) := by
have hbump : HasCompactSupport packingBump := by
change IsCompact (closure (support
((ContDiffBumpBase.ofInnerProductSpace Score).toFun 2 ∘
fun z : Score => (2 : ℝ) • z)))
rw [Function.support_comp_eq_preimage,
ContDiffBumpBase.support _ _ (by norm_num)]
have heq : (fun z : Score => (2 : ℝ) • z) ⁻¹' ball 0 2 =
ball 0 1 := by
ext z
simp only [Set.mem_preimage, Metric.mem_ball, dist_zero_right]
rw [norm_smul]
norm_num
rw [heq, closure_ball _ one_ne_zero]
exact isCompact_closedBall 0 1
exact hbump.iteratedFDeriv j
rcases hcont.bounded_above_of_compact_support hsupp with ⟨C, hC⟩
refine ⟨max C 0, le_max_right _ _, fun z => ?_⟩
exact (hC z).trans (le_max_left _ _)
theorem packingBump_iteratedFDeriv_holder
The last derivative required by an arbitrary positive Hölder order has a global Hölder modulus.
Formal statement
hypotheses
s :
ℝ
hs :
0 < s
conclusion
Proof (Lean source)
-- @node: packingBump_iteratedFDeriv_holder
lemma packingBump_iteratedFDeriv_holder (s : ℝ) (hs : 0 < s) :
let k := ⌈s⌉₊ - 1
∃ C : ℝ, 0 ≤ C ∧ ∀ u v : Score,
‖iteratedFDeriv ℝ k packingBump u -
iteratedFDeriv ℝ k packingBump v‖ ≤
C * ‖u - v‖ ^ (s - (k : ℝ)) := by
classical
let k := ⌈s⌉₊ - 1
have hceil : k + 1 = ⌈s⌉₊ := by
dsimp [k]
have : 0 < ⌈s⌉₊ := Nat.ceil_pos.mpr hs
omega
have hk_lt : (k : ℝ) < s := by
rw [← Nat.lt_ceil]
omega
have hs_le : s ≤ (k : ℝ) + 1 := by
calc
s ≤ (⌈s⌉₊ : ℝ) := Nat.le_ceil s
_ = (k : ℝ) + 1 := by rw [← hceil]; norm_num
have hq0 : 0 ≤ s - (k : ℝ) := by linarith
have hq1 : s - (k : ℝ) ≤ 1 := by linarith
rcases packingBump_iteratedFDeriv_bound k with ⟨B0, hB0, h0⟩
rcases packingBump_iteratedFDeriv_bound (k + 1) with ⟨B1, hB1, h1⟩
let C := max B1 (2 * B0)
refine ⟨C, hB1.trans (le_max_left _ _), ?_⟩
intro u v
have hlip : ‖iteratedFDeriv ℝ k packingBump u -
iteratedFDeriv ℝ k packingBump v‖ ≤ B1 * ‖u - v‖ := by
have hd : ∀ z ∈ (Set.univ : Set Score),
DifferentiableAt ℝ (iteratedFDeriv ℝ k packingBump) z := by
intro z _
have hk0 : (k : ℕ∞) < (⊤ : ℕ∞) := WithTop.coe_lt_top k
have hk : ((k : ℕ∞) : WithTop ℕ∞) <
((⊤ : ℕ∞) : WithTop ℕ∞) := WithTop.coe_lt_coe.mpr hk0
exact (ContDiff.differentiable_iteratedFDeriv hk packingBump_contDiff) z
have hb : ∀ z ∈ (Set.univ : Set Score),
‖fderiv ℝ (iteratedFDeriv ℝ k packingBump) z‖ ≤ B1 := by
intro z _
rw [norm_fderiv_iteratedFDeriv]
exact h1 z
simpa [norm_sub_rev] using
(convex_univ.norm_image_sub_le_of_norm_fderiv_le hd hb
(Set.mem_univ v) (Set.mem_univ u))
by_cases huv : ‖u - v‖ ≤ 1
· calc
‖iteratedFDeriv ℝ k packingBump u - iteratedFDeriv ℝ k packingBump v‖
≤ B1 * ‖u - v‖ := hlip
_ ≤ B1 * ‖u - v‖ ^ (s - (k : ℝ)) := by
gcongr
exact Real.self_le_rpow_of_le_one (norm_nonneg _) huv hq1
_ ≤ C * ‖u - v‖ ^ (s - (k : ℝ)) := by
gcongr
exact le_max_left _ _
· have huv1 : 1 ≤ ‖u - v‖ := le_of_not_ge huv
calc
‖iteratedFDeriv ℝ k packingBump u - iteratedFDeriv ℝ k packingBump v‖
≤ 2 * B0 := by
calc
_ ≤ ‖iteratedFDeriv ℝ k packingBump u‖ +
‖iteratedFDeriv ℝ k packingBump v‖ := norm_sub_le _ _
_ ≤ B0 + B0 := add_le_add (h0 u) (h0 v)
_ = 2 * B0 := by ring
_ ≤ C := le_max_right _ _
_ ≤ C * ‖u - v‖ ^ (s - (k : ℝ)) := by
have hp := Real.one_le_rpow huv1 hq0
nlinarith [hB1.trans (le_max_left B1 (2 * B0))]
A translated bump of amplitude delta and bandwidth w.
Definition (Lean source)
-- @node: localizedPackingBump
noncomputable def localizedPackingBump (delta w : ℝ) (center x : Score) : ℝ :=
delta * packingBump (w⁻¹ • (x - center))
theorem localizedPackingBump_eq_delta_mul_radial
A localized packing bump is the normalized radial profile evaluated at its distance from the center.
Formal statement
Proof (Lean source)
-- @node: localizedPackingBump_eq_delta_mul_radial
lemma localizedPackingBump_eq_delta_mul_radial
{delta w : ℝ} (center x : Score) :
localizedPackingBump delta w center x =
delta * packingBump (w⁻¹ • scorePoint (dist x center) 0) := by
unfold localizedPackingBump
congr 1
apply packingBump_eq_of_norm_eq
rw [norm_smul, norm_smul]
congr 1
rw [dist_eq_norm]
simp [scorePoint, EuclideanSpace.norm_eq, Fin.sum_univ_two,
Real.norm_eq_abs, sq_abs]
theorem localizedPackingBump_center
A localized bump takes its prescribed amplitude at its center.
Formal statement
Proof (Lean source)
-- @node: localizedPackingBump_center
lemma localizedPackingBump_center (delta w : ℝ) (center : Score) :
localizedPackingBump delta w center center = delta := by
simp [localizedPackingBump, packingBump_zero]
theorem localizedPackingBump_mem_Icc
A nonnegative localized bump is bounded by its amplitude.
Formal statement
hypotheses
conclusion
localizedPackingBump delta w center x ∈ Icc 0 delta
Proof (Lean source)
-- @node: localizedPackingBump_mem_Icc
lemma localizedPackingBump_mem_Icc {delta w : ℝ} (hdelta : 0 ≤ delta)
(center x : Score) : localizedPackingBump delta w center x ∈ Icc 0 delta := by
have hb := packingBump_mem_Icc (w⁻¹ • (x - center))
exact ⟨mul_nonneg hdelta hb.1, (mul_le_mul_of_nonneg_left hb.2 hdelta).trans_eq
(mul_one delta)⟩
theorem localizedPackingBump_eq_zero_of_bandwidth_le_dist
A positive-bandwidth localized bump vanishes at distance at least w from its center.
Formal statement
hypotheses
conclusion
localizedPackingBump delta w center x = 0
Proof (Lean source)
-- @node: localizedPackingBump_eq_zero_of_bandwidth_le_dist
lemma localizedPackingBump_eq_zero_of_bandwidth_le_dist {delta w : ℝ}
{center x : Score} (hw : 0 < w) (hx : w ≤ dist x center) :
localizedPackingBump delta w center x = 0 := by
have hnorm : 1 ≤ ‖w⁻¹ • (x - center)‖ := by
rw [norm_smul, Real.norm_eq_abs, abs_inv, abs_of_pos hw]
rw [inv_mul_eq_div, one_le_div hw]
simpa [dist_eq_norm] using hx
rw [localizedPackingBump, packingBump_eq_zero_of_one_le_norm hnorm, mul_zero]
theorem localizedPackingBump_contDiff
Translation and nonzero rescaling preserve smoothness of the radial bump.
Formal statement
hypotheses
delta w :
ℝ
center :
conclusion
Proof (Lean source)
-- @node: localizedPackingBump_contDiff
lemma localizedPackingBump_contDiff (delta w : ℝ) (center : Score) :
ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)
(localizedPackingBump delta w center) := by
unfold localizedPackingBump
have hi : ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)
(fun x : Score => w⁻¹ • (x - center)) :=
ContDiff.const_smul w⁻¹ (contDiff_id.sub contDiff_const)
have hb := packingBump_contDiff.comp hi
simpa [Function.comp_def] using ContDiff.const_smul delta hb
The small affine baseline used in every member of the hard family.
Definition (Lean source)
-- @node: packingAffineBaseline
noncomputable def packingAffineBaseline (b : ℝ) (x : Score) : ℝ :=
1 / 2 + b * x 0
theorem packingAffineBaseline_mem_Icc
A slope of absolute value at most 1/2 keeps the affine baseline in [1/4,3/4] throughout the unit square.
Formal statement
hypotheses
conclusion
packingAffineBaseline b x ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ)
Proof (Lean source)
-- @node: packingAffineBaseline_mem_Icc
lemma packingAffineBaseline_mem_Icc {b : ℝ} (hb : |b| ≤ 1 / 2)
{x : Score} (hx : x ∈ scoreCube (1 / 2)) :
packingAffineBaseline b x ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ) := by
have hprod : |b * x 0| ≤ 1 / 4 := by
rw [abs_mul]
nlinarith [abs_nonneg b, abs_nonneg (x 0), hx 0]
rw [abs_le] at hprod
constructor <;> unfold packingAffineBaseline <;> linarith
theorem packingAffineBaseline_contDiff
The affine baseline is smooth to every finite order.
Formal statement
Proof (Lean source)
-- @node: packingAffineBaseline_contDiff
lemma packingAffineBaseline_contDiff (b : ℝ) :
ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) (packingAffineBaseline b) := by
unfold packingAffineBaseline
fun_prop
The regression profile obtained by adding the active disjoint radial bumps to the common affine baseline.
Definition (Lean source)
-- @node: packingRegression
noncomputable def packingRegression {M : ℕ} (b delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) (x : Score) : ℝ :=
packingAffineBaseline b x +
∑ j, if omega j then localizedPackingBump delta w (centers j) x else 0
theorem packingRegression_contDiff
Every finite packing regression is smooth to every finite order.
Formal statement
Proof (Lean source)
-- @node: packingRegression_contDiff
lemma packingRegression_contDiff {M : ℕ} (b delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) :
ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)
(packingRegression b delta w centers omega) := by
unfold packingRegression
apply (packingAffineBaseline_contDiff b).add
apply ContDiff.sum
intro j _
split
· exact localizedPackingBump_contDiff delta w (centers j)
· exact contDiff_const
theorem packingRegression_measurable
Every finite packing regression is Borel measurable.
Formal statement
hypotheses
conclusion
Measurable (packingRegression b delta w centers omega)
Proof (Lean source)
-- @node: packingRegression_measurable
lemma packingRegression_measurable {M : ℕ} (b delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) :
Measurable (packingRegression b delta w centers omega) :=
(packingRegression_contDiff b delta w centers omega).continuous.measurable
theorem packingRegression_eq_on_cell
Inside one closed packing ball, the regression depends on the bit vector only through that ball's coordinate.
Formal statement
hypotheses
M :
ℕ
b delta w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
j :
Fin M
hbit :
omega j = omega' j
x :
hx :
x ∈ closedBall (centers j) w
conclusion
packingRegression b delta w centers omega x = packingRegression b delta w centers omega' x
Proof (Lean source)
-- @node: packingRegression_eq_on_cell
lemma packingRegression_eq_on_cell {M : ℕ} {b delta w : ℝ} (hw : 0 < w)
{centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
{omega omega' : Fin M → Bool} {j : Fin M} (hbit : omega j = omega' j)
{x : Score} (hx : x ∈ closedBall (centers j) w) :
packingRegression b delta w centers omega x =
packingRegression b delta w centers omega' x := by
unfold packingRegression
congr 1
apply Finset.sum_congr rfl
intro i _
by_cases hij : i = j
· subst i
rw [hbit]
· have hfar : w ≤ dist x (centers i) := by
have htri : dist (centers i) (centers j) ≤
dist (centers i) x + dist x (centers j) := dist_triangle _ _ _
have hs := hsep i j hij
rw [Metric.mem_closedBall] at hx
rw [dist_comm (centers i) x] at htri
linarith
rw [localizedPackingBump_eq_zero_of_bandwidth_le_dist hw hfar]
simp
theorem packingRegression_eq_off_cells
Away from every closed packing ball, all radial bumps vanish and the regression equals the common affine baseline.
Formal statement
hypotheses
conclusion
packingRegression b delta w centers omega x = packingAffineBaseline b x
Proof (Lean source)
-- @node: packingRegression_eq_off_cells
lemma packingRegression_eq_off_cells {M : ℕ} {b delta w : ℝ} (hw : 0 < w)
{centers : Fin M → Score} (omega : Fin M → Bool)
{x : Score} (hx : ∀ j, x ∉ closedBall (centers j) w) :
packingRegression b delta w centers omega x = packingAffineBaseline b x := by
unfold packingRegression
rw [Finset.sum_eq_zero]
· simp
· intro j _
have hfar : w ≤ dist x (centers j) := by
have hlt : w < dist x (centers j) := by
simpa [Metric.mem_closedBall, not_le] using hx j
exact hlt.le
rw [localizedPackingBump_eq_zero_of_bandwidth_le_dist hw hfar]
simp
theorem packingRegression_center
At a separated grid center all other radial bumps vanish, so the regression value depends only on that center's bit.
Formal statement
hypotheses
M :
ℕ
b delta w :
ℝ
j :
Fin M
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
conclusion
packingRegression b delta w centers omega (centers j)
= packingAffineBaseline b (centers j) + if omega j then delta else 0
Proof (Lean source)
-- @node: packingRegression_center
lemma packingRegression_center {M : ℕ} {b delta w : ℝ}
{centers : Fin M → Score} (omega : Fin M → Bool) (j : Fin M)
(hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k)) :
packingRegression b delta w centers omega (centers j) =
packingAffineBaseline b (centers j) + if omega j then delta else 0 := by
unfold packingRegression
congr 1
rw [Finset.sum_eq_single j]
· simp [localizedPackingBump_center]
· intro i _ hij
have hfar : w ≤ dist (centers j) (centers i) := by
have hs := hsep j i (Ne.symm hij)
linarith
rw [localizedPackingBump_eq_zero_of_bandwidth_le_dist hw hfar]
split <;> simp
· simp
theorem packingRegression_center_separation
The two possible regression values at a packing center are separated by exactly the bump amplitude.
Formal statement
hypotheses
conclusion
|(packingAffineBaseline b (centers j) + delta) - packingAffineBaseline b (centers j)|
= |delta|
Proof (Lean source)
-- @node: packingRegression_center_separation
lemma packingRegression_center_separation {M : ℕ} (b delta : ℝ)
(centers : Fin M → Score) (j : Fin M) :
|(packingAffineBaseline b (centers j) + delta) -
packingAffineBaseline b (centers j)| = |delta| := by
ring_nf
The two declared regression values at a packing center, indexed by its Boolean coordinate.
Definition (Lean source)
-- @node: packingCenterValue
noncomputable def packingCenterValue {M : ℕ} (b delta : ℝ)
(centers : Fin M → Score) (j : Fin M) (bit : Bool) : ℝ :=
packingAffineBaseline b (centers j) + if bit then delta else 0
theorem packingRegression_eq_packingCenterValue
A separated packing regression takes exactly its declared Boolean value at every grid center.
Formal statement
hypotheses
M :
ℕ
b delta w :
ℝ
j :
Fin M
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
conclusion
packingRegression b delta w centers omega (centers j)
= packingCenterValue b delta centers j (omega j)
Proof (Lean source)
-- @node: packingRegression_eq_packingCenterValue
lemma packingRegression_eq_packingCenterValue {M : ℕ} {b delta w : ℝ}
{centers : Fin M → Score} (omega : Fin M → Bool) (j : Fin M)
(hw : 0 < w)
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k)) :
packingRegression b delta w centers omega (centers j) =
packingCenterValue b delta centers j (omega j) := by
rw [packingRegression_center omega j hw hsep]
rfl
theorem packingCenterValue_true_false
For a nonnegative bump amplitude, the two declared center values are separated by exactly that amplitude.
Formal statement
hypotheses
conclusion
= delta
Proof (Lean source)
-- @node: packingCenterValue_true_false
lemma packingCenterValue_true_false {M : ℕ} {b delta : ℝ}
(hdelta : 0 ≤ delta) (centers : Fin M → Score) (j : Fin M) :
|packingCenterValue b delta centers j true -
packingCenterValue b delta centers j false| = delta := by
simpa [packingCenterValue, abs_of_nonneg hdelta] using
packingRegression_center_separation b delta centers j
theorem packingCenterValue_frontierRate_separation
At the selected packing amplitude, the two center values have the exact fixed-constant frontier-rate separation used by AngularPackingAt.
Formal statement
hypotheses
conclusion
= (1 / 1024 : ℝ) * frontierRate n
Proof (Lean source)
-- @node: packingCenterValue_frontierRate_separation
lemma packingCenterValue_frontierRate_separation {M n : ℕ} (hn : 2 ≤ n)
(b : ℝ) (centers : Fin M → Score) (j : Fin M) :
|packingCenterValue b (angularPackingDelta n) centers j true -
packingCenterValue b (angularPackingDelta n) centers j false| =
(1 / 1024 : ℝ) * frontierRate n := by
rw [packingCenterValue_true_false
(show 0 ≤ angularPackingDelta n by
unfold angularPackingDelta
exact div_nonneg (frontierRate_pos hn).le (by norm_num))]
unfold angularPackingDelta
ring
theorem packingRegression_bump_sum_mem_Icc
At any point, a three-bandwidth-separated family of localized bumps has total active amplitude between zero and the amplitude of one bump.
Formal statement
Proof (Lean source)
-- @node: packingRegression_bump_sum_mem_Icc
lemma packingRegression_bump_sum_mem_Icc {M : ℕ} {delta w : ℝ}
(hdelta : 0 ≤ delta) (hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) (x : Score) :
(∑ j, if omega j then localizedPackingBump delta w (centers j) x else 0)
∈ Icc 0 delta := by
have hnonneg : ∀ j : Fin M,
0 ≤ if omega j then localizedPackingBump delta w (centers j) x else 0 := by
intro j
split
· exact (localizedPackingBump_mem_Icc hdelta (centers j) x).1
· exact le_rfl
constructor
· exact sum_nonneg fun j _ => hnonneg j
· by_cases hex : ∃ j, omega j = true ∧
localizedPackingBump delta w (centers j) x ≠ 0
· obtain ⟨j, hjbit, hjne⟩ := hex
rw [Finset.sum_eq_single j]
· simp [hjbit]
exact (localizedPackingBump_mem_Icc hdelta (centers j) x).2
· intro i _ hij
have hzero : localizedPackingBump delta w (centers i) x = 0 := by
by_contra hine
have hxi : dist x (centers i) < w := by
apply lt_of_not_ge
intro hfar
exact hine (localizedPackingBump_eq_zero_of_bandwidth_le_dist hw hfar)
have hxj : dist x (centers j) < w := by
apply lt_of_not_ge
intro hfar
exact hjne (localizedPackingBump_eq_zero_of_bandwidth_le_dist hw hfar)
have htri : dist (centers i) (centers j) ≤
dist (centers i) x + dist x (centers j) := dist_triangle _ _ _
have hs := hsep i j hij
rw [dist_comm (centers i) x] at htri
linarith
simp [hzero]
· simp
· have hzero : ∀ j : Fin M,
(if omega j then localizedPackingBump delta w (centers j) x else 0) = 0 := by
intro j
by_cases hj : omega j = true
· simp only [hj, if_true]
by_contra hjne
exact hex ⟨j, hj, hjne⟩
· have hjfalse : omega j = false := Bool.eq_false_of_not_eq_true hj
simp [hjfalse]
rw [Finset.sum_eq_zero fun j _ => hzero j]
exact hdelta
theorem packingRegression_mem_Icc
With the paper's small affine slope and bump amplitude, every packing regression stays in [1/4,3/4] on the unit square.
Formal statement
hypotheses
M :
ℕ
b delta w :
ℝ
hb :
|b| ≤ 1 / 4
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
hx :
x ∈ scoreCube (1 / 2)
conclusion
packingRegression b delta w centers omega x ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ)
Proof (Lean source)
-- @node: packingRegression_mem_Icc
lemma packingRegression_mem_Icc {M : ℕ} {b delta w : ℝ}
(hb : |b| ≤ 1 / 4) (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 8)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {x : Score} (hx : x ∈ scoreCube (1 / 2)) :
packingRegression b delta w centers omega x ∈ Icc (1 / 4 : ℝ) (3 / 4 : ℝ) := by
have hx0 := hx (0 : Fin 2)
have hprod : |b * x 0| ≤ 1 / 8 := by
rw [abs_mul]
nlinarith [abs_nonneg b, abs_nonneg (x 0)]
have hbase : packingAffineBaseline b x ∈ Icc (3 / 8 : ℝ) (5 / 8 : ℝ) := by
rw [abs_le] at hprod
constructor <;> unfold packingAffineBaseline <;> linarith
have hsum := packingRegression_bump_sum_mem_Icc hdelta0 hw hsep omega x
unfold packingRegression
constructor
· calc
(1 / 4 : ℝ) ≤ 3 / 8 := by norm_num
_ ≤ packingAffineBaseline b x := hbase.1
_ ≤ packingAffineBaseline b x +
∑ j, if omega j then localizedPackingBump delta w (centers j) x else 0 :=
le_add_of_nonneg_right hsum.1
· calc
packingAffineBaseline b x +
(∑ j, if omega j then localizedPackingBump delta w (centers j) x else 0) ≤
5 / 8 + delta := add_le_add hbase.2 hsum.2
_ ≤ (3 / 4 : ℝ) := by linarith
The globally bounded version of the packing regression used to define a Markov outcome kernel. It agrees with the paper regression everywhere on the supporting square, where the latter already lies in the middle half of the unit interval.
Definition (Lean source)
-- @node: clippedPackingRegression
noncomputable def clippedPackingRegression {M : ℕ} (b delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) (x : Score) : ℝ :=
max 0 (min 1 (packingRegression b delta w centers omega x))
theorem clippedPackingRegression_mem_Icc
The clipped packing regression takes values in the unit interval on the whole ambient score space.
Formal statement
Proof (Lean source)
-- @node: clippedPackingRegression_mem_Icc
lemma clippedPackingRegression_mem_Icc {M : ℕ} (b delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) (x : Score) :
clippedPackingRegression b delta w centers omega x ∈ Icc (0 : ℝ) 1 := by
unfold clippedPackingRegression
constructor
· exact le_max_left _ _
· exact max_le (by norm_num) (min_le_left _ _)
theorem clippedPackingRegression_eq_of_mem_Icc
Clipping does not alter a packing regression value that is already in the unit interval.
Formal statement
hypotheses
conclusion
clippedPackingRegression b delta w centers omega x
= packingRegression b delta w centers omega x
Proof (Lean source)
-- @node: clippedPackingRegression_eq_of_mem_Icc
lemma clippedPackingRegression_eq_of_mem_Icc {M : ℕ} {b delta w : ℝ}
{centers : Fin M → Score} {omega : Fin M → Bool} {x : Score}
(hx : packingRegression b delta w centers omega x ∈ Icc (0 : ℝ) 1) :
clippedPackingRegression b delta w centers omega x =
packingRegression b delta w centers omega x := by
unfold clippedPackingRegression
rw [min_eq_right hx.2, max_eq_right hx.1]
theorem clippedPackingRegression_eq_on_square
On the supporting square, the globally clipped kernel regression agrees with the paper's smooth packing regression.
Formal statement
hypotheses
M :
ℕ
b delta w :
ℝ
hb :
|b| ≤ 1 / 4
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
hx :
x ∈ scoreCube (1 / 2)
conclusion
clippedPackingRegression b delta w centers omega x
= packingRegression b delta w centers omega x
Proof (Lean source)
-- @node: clippedPackingRegression_eq_on_square
lemma clippedPackingRegression_eq_on_square {M : ℕ} {b delta w : ℝ}
(hb : |b| ≤ 1 / 4) (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 8)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {x : Score} (hx : x ∈ scoreCube (1 / 2)) :
clippedPackingRegression b delta w centers omega x =
packingRegression b delta w centers omega x := by
apply clippedPackingRegression_eq_of_mem_Icc
have hp := packingRegression_mem_Icc hb hdelta0 hdelta hw hsep omega hx
constructor <;> linarith [hp.1, hp.2]
theorem clippedPackingRegression_eq_on_cell
Within one square-truncated packing cell, the globally clipped regression depends on a packing vertex only through that cell's Boolean coordinate.
Formal statement
hypotheses
M :
ℕ
b delta w :
ℝ
hb :
|b| ≤ 1 / 4
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
j :
Fin M
hbit :
omega j = omega' j
x :
hx :
x ∈ closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ)
conclusion
clippedPackingRegression b delta w centers omega x
= clippedPackingRegression b delta w centers omega' x
Proof (Lean source)
-- @node: clippedPackingRegression_eq_on_cell
lemma clippedPackingRegression_eq_on_cell {M : ℕ} {b delta w : ℝ}
(hb : |b| ≤ 1 / 4) (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 8)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
{omega omega' : Fin M → Bool} {j : Fin M} (hbit : omega j = omega' j)
{x : Score}
(hx : x ∈ closedBall (centers j) w ∩ scoreCube (1 / 2 : ℝ)) :
clippedPackingRegression b delta w centers omega x =
clippedPackingRegression b delta w centers omega' x := by
rw [clippedPackingRegression_eq_on_square hb hdelta0 hdelta hw hsep omega hx.2,
clippedPackingRegression_eq_on_square hb hdelta0 hdelta hw hsep omega' hx.2]
exact packingRegression_eq_on_cell hw hsep hbit hx.1
theorem clippedPackingRegression_measurable
The globally clipped packing regression is Borel measurable.
Formal statement
hypotheses
conclusion
Measurable (clippedPackingRegression b delta w centers omega)
Proof (Lean source)
-- @node: clippedPackingRegression_measurable
lemma clippedPackingRegression_measurable {M : ℕ} (b delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) :
Measurable (clippedPackingRegression b delta w centers omega) := by
unfold clippedPackingRegression
exact measurable_const.max
(measurable_const.min (packingRegression_measurable b delta w centers omega))
theorem clippedPackingRegression_continuous
The globally clipped packing regression is continuous.
Formal statement
hypotheses
conclusion
Continuous (clippedPackingRegression b delta w centers omega)
Proof (Lean source)
-- @node: clippedPackingRegression_continuous
lemma clippedPackingRegression_continuous {M : ℕ} (b delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) :
Continuous (clippedPackingRegression b delta w centers omega) := by
unfold clippedPackingRegression
exact continuous_const.max
(continuous_const.min (packingRegression_contDiff b delta w centers omega).continuous)
The conditional variance profile generated by a Bernoulli regression and independent unit Gaussian noise.
Definition (Lean source)
-- @node: packingConditionalVariance
noncomputable def packingConditionalVariance {M : ℕ} (b delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) (x : Score) : ℝ :=
let p := packingRegression b delta w centers omega x
1 + p * (1 - p)
theorem packingConditionalVariance_eq_on_cell
Within a packing cell, the conditional variance depends only on the same single bit as the regression.
Formal statement
hypotheses
M :
ℕ
b delta w :
ℝ
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
j :
Fin M
hbit :
omega j = omega' j
x :
hx :
x ∈ closedBall (centers j) w
conclusion
packingConditionalVariance b delta w centers omega x
= packingConditionalVariance b delta w centers omega' x
Proof (Lean source)
-- @node: packingConditionalVariance_eq_on_cell
lemma packingConditionalVariance_eq_on_cell {M : ℕ} {b delta w : ℝ}
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
{omega omega' : Fin M → Bool} {j : Fin M} (hbit : omega j = omega' j)
{x : Score} (hx : x ∈ closedBall (centers j) w) :
packingConditionalVariance b delta w centers omega x =
packingConditionalVariance b delta w centers omega' x := by
unfold packingConditionalVariance
rw [packingRegression_eq_on_cell hw hsep hbit hx]
theorem packingConditionalVariance_continuous
The conditional variance profile is continuous (indeed smooth).
Formal statement
hypotheses
conclusion
Continuous (packingConditionalVariance b delta w centers omega)
Proof (Lean source)
-- @node: packingConditionalVariance_continuous
lemma packingConditionalVariance_continuous {M : ℕ} (b delta w : ℝ)
(centers : Fin M → Score) (omega : Fin M → Bool) :
Continuous (packingConditionalVariance b delta w centers omega) := by
have hp := (packingRegression_contDiff b delta w centers omega).continuous
unfold packingConditionalVariance
fun_prop
theorem packingConditionalVariance_mem_Icc
Under the bump envelope hypotheses, the entire conditional variance profile lies in [1,5/4] on the packing square.
Formal statement
hypotheses
M :
ℕ
b delta w :
ℝ
hb :
|b| ≤ 1 / 4
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
hx :
x ∈ scoreCube (1 / 2)
conclusion
packingConditionalVariance b delta w centers omega x ∈ Icc (1 : ℝ) (5 / 4 : ℝ)
Proof (Lean source)
-- @node: packingConditionalVariance_mem_Icc
lemma packingConditionalVariance_mem_Icc {M : ℕ} {b delta w : ℝ}
(hb : |b| ≤ 1 / 4) (hdelta0 : 0 ≤ delta) (hdelta : delta ≤ 1 / 8)
(hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {x : Score} (hx : x ∈ scoreCube (1 / 2)) :
packingConditionalVariance b delta w centers omega x ∈
Icc (1 : ℝ) (5 / 4 : ℝ) := by
exact one_add_mul_one_sub_mem_Icc
(packingRegression_mem_Icc hb hdelta0 hdelta hw hsep omega hx)
theorem packingConditionalVariance_envelope
For every paper envelope L ≥ 4, the preceding variance interval is contained in [L⁻¹,L].
Formal statement
hypotheses
M :
ℕ
L b delta w :
ℝ
hL :
4 ≤ L
hb :
|b| ≤ 1 / 4
hdelta0 :
0 ≤ delta
hdelta :
delta ≤ 1 / 8
hw :
0 < w
hsep :
∀ i k
if
i ≠ k
then
3 * w ≤ dist (centers i) (centers k)
x :
hx :
x ∈ scoreCube (1 / 2)
conclusion
L⁻¹ ≤ packingConditionalVariance b delta w centers omega x ∧
packingConditionalVariance b delta w centers omega x ≤ L
Proof (Lean source)
-- @node: packingConditionalVariance_envelope
lemma packingConditionalVariance_envelope {M : ℕ} {L b delta w : ℝ}
(hL : 4 ≤ L) (hb : |b| ≤ 1 / 4) (hdelta0 : 0 ≤ delta)
(hdelta : delta ≤ 1 / 8) (hw : 0 < w) {centers : Fin M → Score}
(hsep : ∀ i k, i ≠ k → 3 * w ≤ dist (centers i) (centers k))
(omega : Fin M → Bool) {x : Score} (hx : x ∈ scoreCube (1 / 2)) :
L⁻¹ ≤ packingConditionalVariance b delta w centers omega x ∧
packingConditionalVariance b delta w centers omega x ≤ L := by
have hvar := packingConditionalVariance_mem_Icc hb hdelta0 hdelta hw hsep omega hx
have hL0 : 0 < L := lt_of_lt_of_le (by norm_num) hL
constructor
· exact ((inv_le_one₀ hL0).2 (by linarith)).trans hvar.1
· exact hvar.2.trans (by linarith)
Helpers.BumpHolderScaling 3 declarations This module records the exact iterated-Fréchet derivative formula for the translated and rescaled bump used by the angular packing.
Derivative scaling for localized packing bumps
This module records the exact iterated-Fréchet derivative formula for the
translated and rescaled bump used by the angular packing. It is kept separate
from BumpHolder so the core bump module remains focused and short.
theorem localizedPackingBump_iteratedFDeriv
Every iterated derivative of a localized packing bump has the expected amplitude and inverse-bandwidth scaling.
Formal statement
hypotheses
conclusion
iteratedFDeriv ℝ j (localizedPackingBump delta w center) x
= delta • ((w⁻¹) ^ j • iteratedFDeriv ℝ j packingBump (w⁻¹ • (x - center)))
Proof (Lean source)
-- @node: localizedPackingBump_iteratedFDeriv
lemma localizedPackingBump_iteratedFDeriv (j : ℕ) (delta w : ℝ)
(center x : Score) :
iteratedFDeriv ℝ j (localizedPackingBump delta w center) x =
delta • ((w⁻¹) ^ j •
iteratedFDeriv ℝ j packingBump (w⁻¹ • (x - center))) := by
let g : Score → ℝ := fun z => packingBump (w⁻¹ • z)
have hg : ContDiff ℝ (j : WithTop ℕ∞) g :=
packingBump_contDiff.of_le (WithTop.coe_le_coe.mpr le_top) |>.comp
(by fun_prop)
have hfun : localizedPackingBump delta w center =
fun x => delta • g (x - center) := by
funext y
simp only [localizedPackingBump, g, smul_eq_mul]
rw [hfun]
have hgt : ContDiff ℝ (j : WithTop ℕ∞) (fun z => g (z - center)) :=
hg.comp (by fun_prop)
rw [iteratedFDeriv_const_smul_apply' hgt.contDiffAt]
rw [iteratedFDeriv_comp_sub j center x]
rw [show iteratedFDeriv ℝ j g = fun z => (w⁻¹) ^ j •
iteratedFDeriv ℝ j packingBump (w⁻¹ • z) by
exact iteratedFDeriv_comp_const_smul w⁻¹
(packingBump_contDiff.of_le (WithTop.coe_le_coe.mpr le_top))]
theorem localizedPackingBump_iteratedFDeriv_bound
The derivative scaling formula transfers every global normalized-bump bound to a localized bump with the exact amplitude and bandwidth factors.
Formal statement
hypotheses
conclusion
∃ C : ℝ,
0 ≤ C ∧
‖iteratedFDeriv ℝ j (localizedPackingBump delta w center) x‖ ≤ |delta| * (w⁻¹) ^ j * C
Proof (Lean source)
-- @node: localizedPackingBump_iteratedFDeriv_bound
lemma localizedPackingBump_iteratedFDeriv_bound (j : ℕ) (delta : ℝ)
{w : ℝ} (hw : 0 < w) (center x : Score) :
∃ C : ℝ, 0 ≤ C ∧
‖iteratedFDeriv ℝ j (localizedPackingBump delta w center) x‖ ≤
|delta| * (w⁻¹) ^ j * C := by
rcases packingBump_iteratedFDeriv_bound j with ⟨C, hC0, hC⟩
refine ⟨C, hC0, ?_⟩
rw [localizedPackingBump_iteratedFDeriv, norm_smul, norm_smul,
Real.norm_eq_abs, Real.norm_eq_abs, abs_pow, abs_inv, abs_of_pos hw]
simpa only [mul_assoc] using
mul_le_mul_of_nonneg_left (hC (w⁻¹ • (x - center)))
(mul_nonneg (abs_nonneg delta) (pow_nonneg (inv_nonneg.mpr hw.le) j))
theorem localizedPackingBump_iteratedFDeriv_holder
The top derivative of a localized bump inherits the normalized bump's Hölder modulus after translating and rescaling both arguments.
Formal statement
hypotheses
conclusion
let k := ⌈s⌉₊ - 1 ∃ C : ℝ, 0
≤ C ∧
‖iteratedFDeriv ℝ k (localizedPackingBump delta w center) x - iteratedFDeriv ℝ k (localizedPackingBump delta w center) y‖
≤ |delta| * (w⁻¹) ^ k * (C * (‖x - y‖ / w) ^ (s - (k : ℝ)))
Proof (Lean source)
-- @node: localizedPackingBump_iteratedFDeriv_holder
lemma localizedPackingBump_iteratedFDeriv_holder (s delta : ℝ) (hs : 0 < s)
{w : ℝ} (hw : 0 < w) (center x y : Score) :
let k := ⌈s⌉₊ - 1
∃ C : ℝ, 0 ≤ C ∧
‖iteratedFDeriv ℝ k (localizedPackingBump delta w center) x -
iteratedFDeriv ℝ k (localizedPackingBump delta w center) y‖ ≤
|delta| * (w⁻¹) ^ k *
(C * (‖x - y‖ / w) ^ (s - (k : ℝ))) := by
let k := ⌈s⌉₊ - 1
rcases packingBump_iteratedFDeriv_holder s hs with ⟨C, hC0, hC⟩
refine ⟨C, hC0, ?_⟩
rw [localizedPackingBump_iteratedFDeriv,
localizedPackingBump_iteratedFDeriv, ← smul_sub, ← smul_sub,
norm_smul, norm_smul, Real.norm_eq_abs, Real.norm_eq_abs,
abs_pow, abs_inv, abs_of_pos hw]
have hscaled :
‖w⁻¹ • (x - center) - w⁻¹ • (y - center)‖ = ‖x - y‖ / w := by
have hvec : w⁻¹ • (x - center) - w⁻¹ • (y - center) =
w⁻¹ • (x - y) := by
rw [← smul_sub]
congr 1
abel
rw [hvec, norm_smul, Real.norm_eq_abs, abs_inv, abs_of_pos hw,
inv_mul_eq_div]
have htop := hC (w⁻¹ • (x - center)) (w⁻¹ • (y - center))
rw [hscaled] at htop
simpa only [mul_assoc] using
mul_le_mul_of_nonneg_left htop
(mul_nonneg (abs_nonneg delta) (pow_nonneg (inv_nonneg.mpr hw.le) k))
Helpers.ClassInclusion 4 declarations The common-map class embeds in the point-indexed class by taking every section equal to the common map.
Strict inclusion of distance decision classes
The common-map class embeds in the point-indexed class by taking every section equal to the common map. Strictness is witnessed by a coordinate-valued rule on the square-support product law.
theorem ctyClass_subset_piClass
Every common-map rule is a point-indexed rule with constant sections.
Formal statement
hypotheses
n q :
ℕ
L :
ℝ
conclusion
CtyDistanceDecisionClass n q L ⊆ PointIndexedDecisionClass n q L
Proof (Lean source)
lemma ctyClass_subset_piClass (n q : ℕ) (L : ℝ) :
CtyDistanceDecisionClass n q L ⊆ PointIndexedDecisionClass n q L := by
rintro rho ⟨T, hT⟩
refine ⟨{ map := fun _x => T.map, section_measurable := fun _x => T.measurable }, ?_⟩
intro P hP w x hx
exact hT P hP w x hx
def coordinateWitnessRule
The point-indexed witness that returns the first coordinate of the query point, independently of the data.
Definition (Lean source)
def coordinateWitnessRule (n : ℕ) : RuleFun n :=
fun _w x => x 0
theorem piClass_not_subset_ctyClass
For an admissible square-support law, the coordinate witness has measurable fixed sections but cannot be represented by one common distance map.
Formal statement
hypotheses
n q :
ℕ
L :
ℝ
hn :
1 ≤ n
hq :
1 ≤ q
hL :
4 ≤ L
conclusion
coordinateWitnessRule n ∈ PointIndexedDecisionClass n q L ∧
Proof (Lean source)
lemma piClass_not_subset_ctyClass
(n q : ℕ) (L : ℝ) (hn : 1 ≤ n) (hq : 1 ≤ q) (hL : 4 ≤ L) :
coordinateWitnessRule n ∈ PointIndexedDecisionClass n q L ∧
coordinateWitnessRule n ∉ CtyDistanceDecisionClass n q L := by
constructor
· let T : PIRule n :=
{ map := fun x _w => x 0
section_measurable := fun _x => measurable_const }
refine ⟨T, ?_⟩
intro P hP w x hx
rfl
· rintro ⟨T, hT⟩
obtain ⟨c0, c1, cwLow, cwHigh, cRadial, alpha, hc0, hc1, hcwLow,
hcwHigh, hcRadial, halpha, halpha8, N, hpack⟩ :=
cty_support_boundary_angular_packing q L hq hL
obtain ⟨M, width, mass, centers, laws, values, hM, hwidth,
hcenters, hsep, hdisjoint, hlaws, hsupports, hmass, hlocal,
hoff, hvalues, hvalueSep, hradial, houtside, hkl⟩ :=
hpack (max N 2) (le_max_left _ _)
let omega : Fin M → Bool := fun _ => false
let P := laws omega
let x₀ : Score := scorePoint (-1 / 4) (-1 / 2)
let x₁ : Score := scorePoint (1 / 4) (-1 / 2)
let z : Score := scorePoint 0 (-1 / 2)
let w : Sample n := fun _ => (0, z)
have hx₀ : x₀ ∈ frontier P.support := by
rw [hsupports omega]
exact lowerEdgePoint_mem_frontier _ (by norm_num)
have hx₁ : x₁ ∈ frontier P.support := by
rw [hsupports omega]
exact lowerEdgePoint_mem_frontier _ (by norm_num)
have heq : distanceData n w x₀ = distanceData n w x₁ := by
funext i
apply Prod.ext
· rfl
· dsimp [distanceData, w, z, x₀, x₁]
rw [dist_scorePoint_same_second, dist_scorePoint_same_second]
norm_num
have h0 := hT P (hlaws omega) w x₀ hx₀
have h1 := hT P (hlaws omega) w x₁ hx₁
rw [heq] at h0
have : x₀ 0 = x₁ 0 := by
simpa [coordinateWitnessRule] using h0.trans h1.symm
norm_num [x₀, x₁, scorePoint_apply_zero] at this
For every positive sample size in the stated CTY regime, the inherited common-map distance class is a proper subset of the sectionwise-Borel point-indexed class.
Formal statement
hypotheses
n q :
ℕ
L :
ℝ
hn :
1 ≤ n
hq :
1 ≤ q
hL :
4 ≤ L
conclusion
CtyDistanceDecisionClass n q L ⊂ PointIndexedDecisionClass n q L
Proof (Lean source)
lemma common_map_strict_in_point_indexed
(n q : ℕ) (L : ℝ) (hn : 1 ≤ n) (hq : 1 ≤ q) (hL : 4 ≤ L) :
CtyDistanceDecisionClass n q L ⊂ PointIndexedDecisionClass n q L := by
refine ⟨ctyClass_subset_piClass n q L, ?_⟩
intro hreverse
exact (piClass_not_subset_ctyClass n q L hn hq hL).2
(hreverse (piClass_not_subset_ctyClass n q L hn hq hL).1)
Helpers.CoordinateEnvelope 1 declarations This file converts uniform Fréchet-derivative bounds into the scalar coordinate-partial suprema used by the paper's Euclidean extension class.
Coordinate-partial envelope assembly
This file converts uniform Fréchet-derivative bounds into the scalar coordinate-partial suprema used by the paper's Euclidean extension class.
theorem euclideanCExtEnvelope_of_iteratedFDeriv_bounds
Uniform bounds on all required Fréchet derivatives and their Lipschitz increments imply the exact scalar coordinate-partial extension envelope.
Formal statement
hypotheses
f g :
Score → ℝ
p :
ℕ
L B D :
ℝ
hS :
S.Nonempty
hSpair :
∃ x ∈ S, ∃ z ∈ S, x ≠ z
hg :
ContDiff ℝ (p + 1 : ℕ) g
hgf :
EqOn g f S
hBD :
B + D ≤ L
hbound :
∀ alpha : Fin 2 → ℕ
if
coordinateMultiOrder alpha ≤ p
then
∀ x ∈ S, ‖iteratedFDeriv ℝ (coordinateMultiOrder alpha) g x‖ ≤ B
hlip :
∀ alpha : Fin 2 → ℕ
if
coordinateMultiOrder alpha ≤ p
then
∀ x ∈ S,
∀ z ∈ S,
‖iteratedFDeriv ℝ (coordinateMultiOrder alpha) g x - iteratedFDeriv ℝ (coordinateMultiOrder alpha) g z‖
≤ D * ‖x - z‖
conclusion
EuclideanCExtEnvelope f p L S
Proof (Lean source)
-- @node: euclideanCExtEnvelope_of_iteratedFDeriv_bounds
lemma euclideanCExtEnvelope_of_iteratedFDeriv_bounds
(f g : Score → ℝ) (p : ℕ) (L B D : ℝ) (S : Set Score)
(hS : S.Nonempty) (hSpair : ∃ x ∈ S, ∃ z ∈ S, x ≠ z)
(hg : ContDiff ℝ (p + 1 : ℕ) g) (hgf : EqOn g f S)
(hBD : B + D ≤ L)
(hbound : ∀ alpha : Fin 2 → ℕ, coordinateMultiOrder alpha ≤ p →
∀ x ∈ S, ‖iteratedFDeriv ℝ (coordinateMultiOrder alpha) g x‖ ≤ B)
(hlip : ∀ alpha : Fin 2 → ℕ, coordinateMultiOrder alpha ≤ p →
∀ x ∈ S, ∀ z ∈ S,
‖iteratedFDeriv ℝ (coordinateMultiOrder alpha) g x -
iteratedFDeriv ℝ (coordinateMultiOrder alpha) g z‖ ≤ D * ‖x - z‖) :
EuclideanCExtEnvelope f p L S := by
refine ⟨Set.univ, isOpen_univ, subset_univ _, g, hg.contDiffOn,
hgf, ?_, ?_, ?_⟩
· refine ⟨B, ?_⟩
rintro r ⟨alpha, ha, x, hx, rfl⟩
exact (coordinatePartial_abs_le_iteratedFDeriv_norm g alpha x).trans
(hbound alpha ha x hx)
· refine ⟨D, ?_⟩
rintro r ⟨alpha, ha, x, hx, z, hz, hxz, rfl⟩
have hnorm : 0 < ‖x - z‖ := norm_pos_iff.mpr (sub_ne_zero.mpr hxz)
apply (div_le_iff₀ hnorm).2
exact (coordinatePartial_sub_abs_le_iteratedFDeriv_sub_norm
g alpha x z).trans (hlip alpha ha x hx z hz)
· have hpartial : sSup (coordinatePartialValues g p S) ≤ B := by
apply csSup_le
· rcases hS with ⟨x, hx⟩
exact ⟨|coordinatePartial g (fun _ ↦ 0) x|, fun _ ↦ 0,
by simp [coordinateMultiOrder], x, hx, rfl⟩
· rintro r ⟨alpha, ha, x, hx, rfl⟩
exact (coordinatePartial_abs_le_iteratedFDeriv_norm g alpha x).trans
(hbound alpha ha x hx)
have hlipsup : sSup (coordinatePartialLipschitzValues g p S) ≤ D := by
apply csSup_le
· rcases hSpair with ⟨x, hx, z, hz, hxz⟩
exact ⟨|coordinatePartial g (fun _ ↦ 0) x -
coordinatePartial g (fun _ ↦ 0) z| / ‖x - z‖,
fun _ ↦ 0, by simp [coordinateMultiOrder], x, hx, z, hz, hxz, rfl⟩
· rintro r ⟨alpha, ha, x, hx, z, hz, hxz, rfl⟩
have hnorm : 0 < ‖x - z‖ := norm_pos_iff.mpr (sub_ne_zero.mpr hxz)
apply (div_le_iff₀ hnorm).2
exact (coordinatePartial_sub_abs_le_iteratedFDeriv_sub_norm
g alpha x z).trans (hlip alpha ha x hx z hz)
linarith
Helpers.FiniteMaxCore 32 declarations The angular packing, marked Poisson experiment, coordinatewise direct-product bound, midpoint decoding, and de-Poissonization are assembled once here for an arbitrary point-indexed rule.
Finite-packing Poisson experiment core
The angular packing, marked Poisson experiment, coordinatewise direct-product bound, midpoint decoding, and de-Poissonization are assembled once here for an arbitrary point-indexed rule.
def packingIndexMeasurableSpace
Equip the packing index set with the discrete measurable structure.
Definition (Lean source)
The continuous uniform mark law on (0,1] used to put every finite Poisson configuration into a canonical order.
instance packingMarkLaw_isProbabilityMeasure
The stated experiment law has total mass one and therefore defines a probability distribution.
Definition (Lean source)
instance packingMarkLaw_isProbabilityMeasure :
IsProbabilityMeasure packingMarkLaw := by
rw [isProbabilityMeasure_iff]
simp [packingMarkLaw]
instance packingMarkLaw_noAtoms
The packing-mark distribution assigns zero probability to every individual mark.
Definition (Lean source)
instance packingMarkLaw_noAtoms : NullSingletonClass packingMarkLaw := by
unfold packingMarkLaw
infer_instance
The packing cells together with their common complement form the finite partition used to split the marked Poisson experiment.
Definition (Lean source)
-- @node: packingPartitionSet
def packingPartitionSet {M : ℕ} (centers : Fin M → Score) (w : ℝ) :
Unit ⊕ Fin M → Set Observation
| .inr j => {o | o.2 ∈ packingCell centers w j}
| .inl _ => {o | o.2 ∉ ⋃ j, packingCell centers w j}
theorem packingPartitionSet_measurable
Every packing-partition cell is measurable.
Formal statement
hypotheses
conclusion
MeasurableSet (packingPartitionSet centers w j)
Proof (Lean source)
-- @node: packingPartitionSet_measurable
lemma packingPartitionSet_measurable {M : ℕ} (centers : Fin M → Score) (w : ℝ)
(j : Unit ⊕ Fin M) : MeasurableSet (packingPartitionSet centers w j) := by
have hcell (k : Fin M) :
MeasurableSet {o : Observation | o.2 ∈ packingCell centers w k} := by
unfold packingCell
exact (Metric.isClosed_closedBall.measurableSet.inter
packingSquare_isCompact.isClosed.measurableSet).preimage measurable_snd
cases j with
| inl u =>
rw [show packingPartitionSet centers w (.inl u) =
(⋃ k : Fin M, {o : Observation | o.2 ∈ packingCell centers w k})ᶜ by
ext o
simp [packingPartitionSet]]
exact (MeasurableSet.iUnion hcell).compl
| inr j =>
simpa [packingPartitionSet] using hcell j
theorem packingPartitionSet_pairwiseDisjoint
Distinct packing-partition cells are disjoint.
Formal statement
hypotheses
M :
ℕ
w :
ℝ
hdis :
∀ i j
if
i ≠ j
then
conclusion
Pairwise (fun i j : Unit ⊕ Fin M => Disjoint (packingPartitionSet centers w i) (packingPartitionSet centers w j))
Proof (Lean source)
-- @node: packingPartitionSet_pairwiseDisjoint
lemma packingPartitionSet_pairwiseDisjoint {M : ℕ} (centers : Fin M → Score)
(w : ℝ) (hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j)) :
Pairwise (fun i j : Unit ⊕ Fin M =>
Disjoint (packingPartitionSet centers w i) (packingPartitionSet centers w j)) := by
intro i j hij
cases i with
| inl u =>
cases j with
| inl v => exact (hij (by cases u; cases v; rfl)).elim
| inr j =>
apply Set.disjoint_left.2
intro o ho hj
exact ho (Set.mem_iUnion.2 ⟨j, hj⟩)
| inr i =>
cases j with
| inl u =>
apply Set.disjoint_left.2
intro o hi ho
exact ho (Set.mem_iUnion.2 ⟨i, hi⟩)
| inr j =>
apply Set.disjoint_left.2
intro o hi hj
exact Set.disjoint_left.1
(hdis i j (fun h => hij (congrArg inr h))) hi hj
theorem packingPartitionSet_iUnion
The packing-partition cells cover the observation space.
Formal statement
Proof (Lean source)
-- @node: packingPartitionSet_iUnion
lemma packingPartitionSet_iUnion {M : ℕ} (centers : Fin M → Score) (w : ℝ) :
⋃ j : Unit ⊕ Fin M, packingPartitionSet centers w j = univ := by
ext o
simp only [Set.mem_iUnion, Set.mem_univ, iff_true]
by_cases h : o.2 ∈ ⋃ j, packingCell centers w j
· obtain ⟨j, hj⟩ := Set.mem_iUnion.1 h
exact ⟨.inr j, hj⟩
· exact ⟨.inl (), h⟩
The classifier partition associated with the packing cells.
Definition (Lean source)
-- @node: packingFinitePartition
noncomputable def packingFinitePartition {M : ℕ} (centers : Fin M → Score) (w : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j)) :
FiniteMeasurablePartition Observation (Unit ⊕ Fin M) :=
FiniteMeasurablePartition.ofSets (packingPartitionSet centers w)
(packingPartitionSet_measurable centers w)
(packingPartitionSet_pairwiseDisjoint centers w hdis)
(packingPartitionSet_iUnion centers w)
theorem packingFinitePartition_cellSet
The abstract classifier has exactly the intended packing cells.
Formal statement
hypotheses
M :
ℕ
w :
ℝ
hdis :
∀ i j
if
i ≠ j
then
conclusion
Proof (Lean source)
-- @node: packingFinitePartition_cellSet
lemma packingFinitePartition_cellSet {M : ℕ} (centers : Fin M → Score) (w : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(j : Unit ⊕ Fin M) :
(packingFinitePartition centers w hdis).cellSet j =
packingPartitionSet centers w j := by
exact FiniteMeasurablePartition.ofSets_cellSet _ _ _ _ j
theorem packingFinitePartition_cell_measure_eq_map_snd
The mass of a packing cell can be read from the score marginal.
Formal statement
hypotheses
conclusion
P.law ((packingFinitePartition centers w hdis).cellSet (.inr j))
= Measure.map snd P.law (packingCell centers w j)
Proof (Lean source)
-- @node: packingFinitePartition_cell_measure_eq_map_snd
lemma packingFinitePartition_cell_measure_eq_map_snd {M : ℕ}
(centers : Fin M → Score) (w : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(P : CtyLaw) (j : Fin M) :
P.law ((packingFinitePartition centers w hdis).cellSet (.inr j)) =
Measure.map snd P.law (packingCell centers w j) := by
rw [packingFinitePartition_cellSet, packingPartitionSet]
have hs : MeasurableSet (packingCell centers w j) := by
unfold packingCell
exact Metric.isClosed_closedBall.measurableSet.inter
packingSquare_isCompact.isClosed.measurableSet
change P.law (snd ⁻¹' packingCell centers w j) =
Measure.map snd P.law (packingCell centers w j)
exact (Measure.map_apply measurable_snd hs).symm
theorem packingCellObservationLaw_eq_of_bit_eq
Equal positive packing-cell mass and the angular locality certificate identify the normalized within-cell observation laws.
Formal statement
hypotheses
M :
ℕ
w m :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hm :
0 < m
hmass :
∀ omega j,
hlocal :
∀ omega omega' j
if
omega j = omega' j
then
(laws omega).law.restrict {o | o.2 ∈ packingCell centers w j}
= (laws omega').law.restrict {o | o.2 ∈ packingCell centers w j}
j :
Fin M
hbit :
omega j = omega' j
conclusion
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability (packingFinitePartition centers w hdis).cellObservationLaw (laws omega).law (.inr j) = (packingFinitePartition centers w hdis).cellObservationLaw (laws omega').law (.inr j))
Proof (Lean source)
-- @node: packingCellObservationLaw_eq_of_bit_eq
lemma packingCellObservationLaw_eq_of_bit_eq {M : ℕ}
(centers : Fin M → Score) (w m : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(laws : (Fin M → Bool) → CtyLaw)
(hm : 0 < m)
(hmass : ∀ omega j,
Measure.map snd (laws omega).law (packingCell centers w j) =
ofReal m)
(hlocal : ∀ omega omega' j, omega j = omega' j →
(laws omega).law.restrict {o | o.2 ∈ packingCell centers w j} =
(laws omega').law.restrict {o | o.2 ∈ packingCell centers w j})
(omega omega' : Fin M → Bool) (j : Fin M) (hbit : omega j = omega' j) :
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability
(packingFinitePartition centers w hdis).cellObservationLaw
(laws omega).law (.inr j) =
(packingFinitePartition centers w hdis).cellObservationLaw
(laws omega').law (.inr j)) := by
letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability
let p := packingFinitePartition centers w hdis
have hω : (laws omega).law (p.cellSet (.inr j)) = ofReal m := by
rw [show p = packingFinitePartition centers w hdis by rfl,
packingFinitePartition_cell_measure_eq_map_snd]
exact hmass omega j
have hω' : (laws omega').law (p.cellSet (.inr j)) = ofReal m := by
rw [show p = packingFinitePartition centers w hdis by rfl,
packingFinitePartition_cell_measure_eq_map_snd]
exact hmass omega' j
apply cellObservationLaw_eq_of_restrict_eq p (laws omega).law
(laws omega').law (.inr j)
· rw [hω]
exact (ENNReal.ofReal_pos.mpr hm).ne'
· rw [hω, hω']
· simpa [p, packingFinitePartition_cellSet, packingPartitionSet] using
hlocal omega omega' j hbit
theorem packingCanonicalCellLaw_eq_of_bit_eq
The complete canonical marked-Poisson experiment in a packing cell is a function only of that cell's Boolean coordinate.
Formal statement
hypotheses
M :
ℕ
w m :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hm :
0 < m
hmass :
∀ omega j,
hlocal :
∀ omega omega' j
if
omega j = omega' j
then
(laws omega).law.restrict {o | o.2 ∈ packingCell centers w j}
= (laws omega').law.restrict {o | o.2 ∈ packingCell centers w j}
R :
lam :
ℝ≥0
j :
Fin M
hbit :
omega j = omega' j
conclusion
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability let p := packingFinitePartition centers w hdis canonicalMarkedPoissonSampleLaw (p.cellObservationLaw (laws omega).law (.inr j)) R (lam * p.cellMass (laws omega).law (.inr j)) = canonicalMarkedPoissonSampleLaw (p.cellObservationLaw (laws omega').law (.inr j)) R (lam * p.cellMass (laws omega').law (.inr j)))
Proof (Lean source)
-- @node: packingCanonicalCellLaw_eq_of_bit_eq
lemma packingCanonicalCellLaw_eq_of_bit_eq {M : ℕ}
(centers : Fin M → Score) (w m : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(laws : (Fin M → Bool) → CtyLaw)
(hm : 0 < m)
(hmass : ∀ omega j,
Measure.map snd (laws omega).law (packingCell centers w j) =
ofReal m)
(hlocal : ∀ omega omega' j, omega j = omega' j →
(laws omega).law.restrict {o | o.2 ∈ packingCell centers w j} =
(laws omega').law.restrict {o | o.2 ∈ packingCell centers w j})
(R : Measure ℝ) [IsProbabilityMeasure R] (lam : ℝ≥0)
(omega omega' : Fin M → Bool) (j : Fin M) (hbit : omega j = omega' j) :
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability
let p := packingFinitePartition centers w hdis
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega).law (.inr j)) R
(lam * p.cellMass (laws omega).law (.inr j)) =
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega').law (.inr j)) R
(lam * p.cellMass (laws omega').law (.inr j))) := by
letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability
let p := packingFinitePartition centers w hdis
have hobs := packingCellObservationLaw_eq_of_bit_eq centers w m hdis laws hm
hmass hlocal omega omega' j hbit
have hmeasure :
(laws omega).law (p.cellSet (.inr j)) =
(laws omega').law (p.cellSet (.inr j)) := by
rw [show p = packingFinitePartition centers w hdis by rfl,
packingFinitePartition_cell_measure_eq_map_snd,
packingFinitePartition_cell_measure_eq_map_snd,
hmass omega j, hmass omega' j]
have hcellMass : p.cellMass (laws omega).law (.inr j) =
p.cellMass (laws omega').law (.inr j) := by
unfold FiniteMeasurablePartition.cellMass
rw [hmeasure]
change canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega).law (.inr j)) R
(lam * p.cellMass (laws omega).law (.inr j)) =
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega').law (.inr j)) R
(lam * p.cellMass (laws omega').law (.inr j))
change p.cellObservationLaw (laws omega).law (.inr j) =
p.cellObservationLaw (laws omega').law (.inr j) at hobs
unfold canonicalMarkedPoissonSampleLaw
simp only [hobs, hcellMass]
theorem packingComplement_restrict_eq
On laws supported by the common packing square, the abstract complement cell restriction is exactly the construction's common off-cell restriction.
Formal statement
hypotheses
M :
ℕ
w :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hsupport :
∀ omega, (laws omega).support = packingSquare
hoff :
∀ omega omega',
(laws omega).law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
= (laws omega').law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
conclusion
(laws omega).law.restrict ((packingFinitePartition centers w hdis).cellSet (.inl ()))
= (laws omega').law.restrict ((packingFinitePartition centers w hdis).cellSet (.inl ()))
Proof (Lean source)
-- @node: packingComplement_restrict_eq
lemma packingComplement_restrict_eq {M : ℕ}
(centers : Fin M → Score) (w : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(laws : (Fin M → Bool) → CtyLaw)
(hsupport : ∀ omega, (laws omega).support = packingSquare)
(hoff : ∀ omega omega',
(laws omega).law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j} =
(laws omega').law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j})
(omega omega' : Fin M → Bool) :
(laws omega).law.restrict
((packingFinitePartition centers w hdis).cellSet (.inl ())) =
(laws omega').law.restrict
((packingFinitePartition centers w hdis).cellSet (.inl ())) := by
let C : Set Observation := {o | o.2 ∉ ⋃ j, packingCell centers w j}
let C' : Set Observation :=
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
have hsupp (eta : Fin M → Bool) :
∀ᵐ o ∂(laws eta).law, o.2 ∈ packingSquare := by
apply ae_of_ae_map measurable_snd.aemeasurable
simpa [← hsupport eta, (laws eta).support_eq_marginal_support] using
(Measure.map snd (laws eta).law).support_mem_ae
have hC (eta : Fin M → Bool) : C =ᵐ[(laws eta).law] C' := by
filter_upwards [hsupp eta] with o ho
change (o.2 ∉ ⋃ j, packingCell centers w j) =
(o.2 ∈ packingSquare ∧ o.2 ∉ ⋃ j, packingCell centers w j)
simp [ho]
rw [packingFinitePartition_cellSet, packingPartitionSet]
exact ((laws omega).law.restrict_congr_set (hC omega)).trans
((hoff omega omega').trans
((laws omega').law.restrict_congr_set (hC omega')).symm)
theorem canonicalMarkedPoissonSampleLaw_zero Lemma canonicalMarkedPoissonSampleLaw_zero in the paper ↗
A zero-intensity canonical marked-Poisson law is independent of its observation law.
Formal statement
hypotheses
X :
Type*
P Q :
R :
conclusion
Proof (Lean source)
-- @node: canonicalMarkedPoissonSampleLaw_zero
lemma canonicalMarkedPoissonSampleLaw_zero
{X : Type*} [MeasurableSpace X]
(P Q : Measure X) [IsProbabilityMeasure P] [IsProbabilityMeasure Q]
(R : Measure ℝ) [IsProbabilityMeasure R] :
canonicalMarkedPoissonSampleLaw P R 0 =
canonicalMarkedPoissonSampleLaw Q R 0 := by
have hpois : poissonMeasure 0 = Measure.dirac 0 := by
ext s hs
rw [poissonMeasure, Measure.sum_apply _ hs,
tsum_eq_single 0 (fun n hn => by
simp [Measure.smul_apply, zero_pow hn])]
simp [Measure.smul_apply]
have hfinite : finiteMarkedPoissonSampleLaw P R 0 =
finiteMarkedPoissonSampleLaw Q R 0 := by
let K (S : Measure (X × ℝ)) [IsProbabilityMeasure S] :
Kernel ℕ (FiniteSample (X × ℝ)) :=
{ toFun := fun n => Measure.map (fixedSizeEmbed n)
(Measure.pi fun _ : Fin n => S)
measurable' := Measurable.of_discrete }
letI Kmarkov (S : Measure (X × ℝ)) [IsProbabilityMeasure S] :
IsMarkovKernel (K S) :=
{ isProbabilityMeasure := fun n => by
dsimp [K]
exact Measure.isProbabilityMeasure_map
(measurable_fixedSizeEmbed n).aemeasurable }
have hbind (S : Measure (X × ℝ)) [IsProbabilityMeasure S] :
finitePoissonSampleLaw S 0 =
(poissonMeasure 0).bind (K S) := by
ext s hs
rw [Measure.bind_apply hs (Kernel.aemeasurable _), lintegral_countable']
symm
calc
∑' n : ℕ, (K S n) s * poissonMeasure 0 {n} =
∑' n : ℕ, ((finitePoissonSampleLaw S 0).restrict
(FiniteSample.count ⁻¹' ({n} : Set ℕ))) s := by
congr 1
funext n
rw [finitePoissonSampleLaw_restrict_count_eq, Measure.smul_apply]
rw [smul_eq_mul]
exact mul_comm ((K S n) s) (poissonMeasure 0 {n})
_ = finitePoissonSampleLaw S 0 s := by
rw [← Measure.sum_apply _ hs, ← Measure.restrict_iUnion]
· rw [show (⋃ n : ℕ, FiniteSample.count ⁻¹' ({n} : Set ℕ)) =
univ by
ext x
simp only [Set.mem_iUnion, Set.mem_preimage,
Set.mem_singleton_iff, Set.mem_univ, iff_true]
exact ⟨x.count, rfl⟩,
Measure.restrict_univ]
· intro i j hij
exact (Set.disjoint_singleton.mpr hij).preimage FiniteSample.count
· intro n
exact measurable_finiteSample_count (MeasurableSet.singleton n)
unfold finiteMarkedPoissonSampleLaw
rw [hbind, hbind, hpois]
ext s hs
rw [Measure.bind_apply hs (Kernel.aemeasurable _),
Measure.bind_apply hs (Kernel.aemeasurable _)]
simp only [lintegral_dirac' _ (Kernel.measurable_coe _ hs)]
have heq : (Measure.pi fun _ : Fin 0 => P.prod R) =
(Measure.pi fun _ : Fin 0 => Q.prod R) := by
apply Measure.pi_eq
intro u hu
simp
change (Measure.map (fixedSizeEmbed 0)
(Measure.pi fun _ : Fin 0 => P.prod R)) s =
(Measure.map (fixedSizeEmbed 0)
(Measure.pi fun _ : Fin 0 => Q.prod R)) s
rw [heq]
unfold canonicalMarkedPoissonSampleLaw
rw [hfinite]
theorem packingCanonicalComplementLaw_eq
The canonical marked-Poisson complement experiment is common to all vertices, including when the common complement has zero mass.
Formal statement
hypotheses
M :
ℕ
w :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hsupport :
∀ omega, (laws omega).support = packingSquare
hoff :
∀ omega omega',
(laws omega).law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
= (laws omega').law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
R :
lam :
ℝ≥0
conclusion
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability let p := packingFinitePartition centers w hdis canonicalMarkedPoissonSampleLaw (p.cellObservationLaw (laws omega).law (.inl ())) R (lam * p.cellMass (laws omega).law (.inl ())) = canonicalMarkedPoissonSampleLaw (p.cellObservationLaw (laws omega').law (.inl ())) R (lam * p.cellMass (laws omega').law (.inl ())))
Proof (Lean source)
-- @node: packingCanonicalComplementLaw_eq
lemma packingCanonicalComplementLaw_eq {M : ℕ}
(centers : Fin M → Score) (w : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(laws : (Fin M → Bool) → CtyLaw)
(hsupport : ∀ omega, (laws omega).support = packingSquare)
(hoff : ∀ omega omega',
(laws omega).law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j} =
(laws omega').law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j})
(R : Measure ℝ) [IsProbabilityMeasure R] (lam : ℝ≥0)
(omega omega' : Fin M → Bool) :
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability
let p := packingFinitePartition centers w hdis
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega).law (.inl ())) R
(lam * p.cellMass (laws omega).law (.inl ())) =
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega').law (.inl ())) R
(lam * p.cellMass (laws omega').law (.inl ()))) := by
letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega').law := (laws omega').law_isProbability
let p := packingFinitePartition centers w hdis
have hrest := packingComplement_restrict_eq centers w hdis laws hsupport hoff
omega omega'
have hmass : (laws omega).law (p.cellSet (.inl ())) =
(laws omega').law (p.cellSet (.inl ())) := by
have := congrArg (fun μ : Measure Observation => μ univ) hrest
simpa [Measure.restrict_apply_univ] using this
have hcellMass : p.cellMass (laws omega).law (.inl ()) =
p.cellMass (laws omega').law (.inl ()) := by
unfold FiniteMeasurablePartition.cellMass
rw [hmass]
change canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega).law (.inl ())) R
(lam * p.cellMass (laws omega).law (.inl ())) =
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega').law (.inl ())) R
(lam * p.cellMass (laws omega').law (.inl ()))
by_cases hpos : (laws omega).law (p.cellSet (.inl ())) = 0
· have hpos' : (laws omega').law (p.cellSet (.inl ())) = 0 := by
rw [← hmass, hpos]
have hzero : p.cellMass (laws omega).law (.inl ()) = 0 := by
unfold FiniteMeasurablePartition.cellMass
rw [hpos]
simp
have hzero' : p.cellMass (laws omega').law (.inl ()) = 0 := by
unfold FiniteMeasurablePartition.cellMass
rw [hpos']
simp
rw [hzero, hzero']
simp only [mul_zero]
exact canonicalMarkedPoissonSampleLaw_zero
(p.cellObservationLaw (laws omega).law (.inl ()))
(p.cellObservationLaw (laws omega').law (.inl ())) R
· have hobs := cellObservationLaw_eq_of_restrict_eq p (laws omega).law
(laws omega').law (.inl ()) hpos hmass hrest
unfold canonicalMarkedPoissonSampleLaw
simp only [hobs, hcellMass]
Replace the score of a marked observation by its distance from one packing center, retaining the outcome and the ordering mark.
Definition (Lean source)
-- @node: packingMarkedDistance
noncomputable def packingMarkedDistance (x : Score) : Observation × ℝ → (ℝ × ℝ) × ℝ :=
fun z => ((z.1.1, dist z.1.2 x), z.2)
theorem packingMarkedDistance_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
Proof (Lean source)
lemma packingMarkedDistance_measurable (x : Score) :
Measurable (packingMarkedDistance x) := by
unfold packingMarkedDistance
fun_prop
The distance-compressed marked configuration in one packing cell.
Definition (Lean source)
-- @node: compressPackingCell
noncomputable def compressPackingCell {M : ℕ}
(centers : Fin M → Score) (j : Fin M)
(s : FiniteSample (Observation × ℝ)) : FiniteSample ((ℝ × ℝ) × ℝ) :=
finiteSampleMap (packingMarkedDistance (centers j)) s
theorem compressPackingCell_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (compressPackingCell centers j)
Proof (Lean source)
lemma compressPackingCell_measurable {M : ℕ}
(centers : Fin M → Score) (j : Fin M) :
Measurable (compressPackingCell centers j) := by
exact measurable_finiteSampleMap _ (packingMarkedDistance_measurable _)
Reassemble, for decoder j, the marked distance configuration from its compressed own cell, the raw off-cell blocks, and the common complement.
Definition (Lean source)
-- @node: assemblePackingDistanceBlocks
noncomputable def assemblePackingDistanceBlocks {M : ℕ}
(centers : Fin M → Score) (j : Fin M)
(own : FiniteSample ((ℝ × ℝ) × ℝ))
(cells : Fin M → FiniteSample (Observation × ℝ))
(common : Unit → FiniteSample (Observation × ℝ)) :
FiniteSample ((ℝ × ℝ) × ℝ) :=
superposeByMarks (fun k : Unit ⊕ Fin M => match k with
| .inl u => finiteSampleMap (packingMarkedDistance (centers j)) (common u)
| .inr k => if k = j then own
else finiteSampleMap (packingMarkedDistance (centers j)) (cells k))
theorem assemblePackingDistanceBlocks_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (fun z : FiniteSample ((ℝ × ℝ) × ℝ) × (Fin M → FiniteSample (Observation × ℝ)) × (Unit → FiniteSample (Observation × ℝ)) => assemblePackingDistanceBlocks centers j z.1 z.2.1 z.2.2)
Proof (Lean source)
lemma assemblePackingDistanceBlocks_measurable {M : ℕ}
(centers : Fin M → Score) (j : Fin M) :
Measurable (fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (Observation × ℝ)) ×
(Unit → FiniteSample (Observation × ℝ)) =>
assemblePackingDistanceBlocks centers j z.1 z.2.1 z.2.2) := by
apply measurable_superposeByMarks.comp
apply measurable_pi_lambda
intro k
cases k with
| inl u =>
exact (measurable_finiteSampleMap _ (packingMarkedDistance_measurable _)).comp
((measurable_pi_apply u).comp measurable_snd.snd)
| inr k =>
by_cases h : k = j
· simp only [assemblePackingDistanceBlocks, h, if_pos]
exact measurable_fst
· simp only [assemblePackingDistanceBlocks, h, if_neg]
exact (measurable_finiteSampleMap _ (packingMarkedDistance_measurable _)).comp
((measurable_pi_apply k).comp measurable_snd.fst)
def packingPoissonValue
The Poissonized point estimate computed from the compressed own cell and raw off-cell blocks, with zero fallback when fewer than n atoms arrive.
Definition (Lean source)
-- @node: packingPoissonValue
noncomputable def packingPoissonValue {n M : ℕ}
(T : PIRule n) (centers : Fin M → Score) (j : Fin M)
(own : FiniteSample ((ℝ × ℝ) × ℝ))
(cells : Fin M → FiniteSample (Observation × ℝ))
(common : Unit → FiniteSample (Observation × ℝ)) : ℝ :=
let s := assemblePackingDistanceBlocks centers j own cells common
if n ≤ s.count then
T.map (centers j) (canonicalPrefixObservations (0, 0) n s)
else 0
theorem packingPoissonValue_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (fun z : FiniteSample ((ℝ × ℝ) × ℝ) × (Fin M → FiniteSample (Observation × ℝ)) × (Unit → FiniteSample (Observation × ℝ)) => packingPoissonValue T centers j z.1 z.2.1 z.2.2)
Proof (Lean source)
lemma packingPoissonValue_measurable {n M : ℕ}
(T : PIRule n) (centers : Fin M → Score) (j : Fin M) :
Measurable (fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (Observation × ℝ)) ×
(Unit → FiniteSample (Observation × ℝ)) =>
packingPoissonValue T centers j z.1 z.2.1 z.2.2) := by
let f := fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (Observation × ℝ)) ×
(Unit → FiniteSample (Observation × ℝ)) =>
assemblePackingDistanceBlocks centers j z.1 z.2.1 z.2.2
have hf : Measurable f := assemblePackingDistanceBlocks_measurable centers j
apply Measurable.ite
· exact (measurable_finiteSample_count measurableSet_Ici).preimage hf
· exact (T.section_measurable (centers j)).comp
((measurable_canonicalPrefixObservations (0, 0) n).comp hf)
· exact measurable_const
def packingPoissonDecoder
The midpoint decoder induced by a point-indexed Borel section, with zero output on the failed Poisson-count event.
Definition (Lean source)
-- @node: packingPoissonDecoder
noncomputable def packingPoissonDecoder {n M : ℕ}
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (j : Fin M)
(own : FiniteSample ((ℝ × ℝ) × ℝ))
(cells : Fin M → FiniteSample (Observation × ℝ))
(common : Unit → FiniteSample (Observation × ℝ)) : Bool :=
let t := packingPoissonValue T centers j own cells common
decide (|t - values j true| ≤ |t - values j false|)
theorem packingPoissonDecoder_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (fun z : FiniteSample ((ℝ × ℝ) × ℝ) × (Fin M → FiniteSample (Observation × ℝ)) × (Unit → FiniteSample (Observation × ℝ)) => packingPoissonDecoder T centers values j z.1 z.2.1 z.2.2)
Proof (Lean source)
lemma packingPoissonDecoder_measurable {n M : ℕ}
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (j : Fin M) :
Measurable (fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (Observation × ℝ)) ×
(Unit → FiniteSample (Observation × ℝ)) =>
packingPoissonDecoder T centers values j z.1 z.2.1 z.2.2) := by
let t := fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (Observation × ℝ)) ×
(Unit → FiniteSample (Observation × ℝ)) =>
packingPoissonValue T centers j z.1 z.2.1 z.2.2
have ht : Measurable t := packingPoissonValue_measurable T centers j
apply measurable_to_bool
change MeasurableSet {z | decide
(|t z - values j true| ≤ |t z - values j false|) = true}
have hm := measurableSet_le
(ht.sub (measurable_const : Measurable (fun _ => values j true))).abs
(ht.sub (measurable_const : Measurable (fun _ => values j false))).abs
convert hm using 1 <;> ext z <;> simp
theorem packingPoissonDecoder_local
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
hypotheses
n M :
ℕ
T :
PIRule n
j :
Fin M
own :
FiniteSample ((ℝ × ℝ) × ℝ)
cells cells' :
common :
h :
∀ k
if
k ≠ j
then
cells k = cells' k
conclusion
packingPoissonDecoder T centers values j own cells common
= packingPoissonDecoder T centers values j own cells' common
Proof (Lean source)
lemma packingPoissonDecoder_local {n M : ℕ}
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (j : Fin M)
(own : FiniteSample ((ℝ × ℝ) × ℝ))
(cells cells' : Fin M → FiniteSample (Observation × ℝ))
(common : Unit → FiniteSample (Observation × ℝ))
(h : ∀ k, k ≠ j → cells k = cells' k) :
packingPoissonDecoder T centers values j own cells common =
packingPoissonDecoder T centers values j own cells' common := by
have hblocks :
(fun k : Unit ⊕ Fin M => match k with
| .inl u => finiteSampleMap (packingMarkedDistance (centers j)) (common u)
| .inr k => if k = j then own
else finiteSampleMap (packingMarkedDistance (centers j)) (cells k)) =
(fun k : Unit ⊕ Fin M => match k with
| .inl u => finiteSampleMap (packingMarkedDistance (centers j)) (common u)
| .inr k => if k = j then own
else finiteSampleMap (packingMarkedDistance (centers j)) (cells' k)) := by
funext k
cases k with
| inl u => rfl
| inr k =>
by_cases hkj : k = j
· simp [hkj]
· simp [hkj, h k hkj]
unfold packingPoissonDecoder packingPoissonValue assemblePackingDistanceBlocks
rw [hblocks]
def finitePackingLoss
The measurable maximum of the losses at finitely many packing points.
theorem finitePackingLoss_measurable_of_pointIndexed
A point-indexed rule has a measurable finite packing loss whenever its fixed sections are represented by the measurable maps in its certificate.
Formal statement
hypotheses
n M q :
ℕ
L :
ℝ
rho :
RuleFun n
hrho :
rho ∈ PointIndexedDecisionClass n q L
P :
hP :
CtyNonparametricClass q L P
hcenters :
∀ j, centers j ∈ frontier P.support
conclusion
Measurable (finitePackingLoss rho P centers)
Proof (Lean source)
-- @node: finitePackingLoss_measurable_of_pointIndexed
lemma finitePackingLoss_measurable_of_pointIndexed {n M q : ℕ} {L : ℝ}
(rho : RuleFun n) (hrho : rho ∈ PointIndexedDecisionClass n q L)
(P : CtyLaw) (hP : CtyNonparametricClass q L P)
(centers : Fin M → Score)
(hcenters : ∀ j, centers j ∈ frontier P.support) :
Measurable (finitePackingLoss rho P centers) := by
obtain ⟨T, hT⟩ := hrho
unfold finitePackingLoss
apply Measurable.iSup
intro j
apply Measurable.ennreal_ofReal
apply Measurable.abs
apply Measurable.sub_const
rw [show (fun w : Sample n => rho w (centers j)) =
fun w => T.map (centers j) (distanceData n w (centers j)) by
funext w
exact hT P hP w (centers j) (hcenters j)]
exact (T.section_measurable (centers j)).comp
(measurable_distanceData n (centers j))
theorem midpointDecoder_error_ge_half_separation Lemma midpointDecoder_error_ge_half_separation in the paper ↗
If the midpoint decoder for two separated values chooses the wrong bit, the corresponding estimation error is at least half their separation.
Formal statement
Proof (Lean source)
-- @node: midpointDecoder_error_ge_half_separation
lemma midpointDecoder_error_ge_half_separation
(a b t delta : ℝ) (hsep : delta ≤ |b - a|) :
(decide (|t - b| ≤ |t - a|) : Bool) ≠ true → delta / 2 ≤ |t - b| := by
intro hwrong
have hdecfalse : decide (|t - b| ≤ |t - a|) = false :=
Bool.eq_false_of_not_eq_true hwrong
have hnle : ¬ |t - b| ≤ |t - a| := of_decide_eq_false hdecfalse
have hlt : |t - a| < |t - b| := by
exact lt_of_not_ge hnle
have htri : |b - a| ≤ |t - b| + |t - a| := by
calc
|b - a| = |(b - t) + (t - a)| := by ring_nf
_ ≤ |b - t| + |t - a| := abs_add_le _ _
_ = |t - b| + |t - a| := by rw [abs_sub_comm b t]
linarith
The nearest-midpoint decoder can be wrong only when the estimate is at least half the endpoint separation away from the true endpoint.
Formal statement
Proof (Lean source)
-- @node: midpointDecoder_wrong_bit_error
lemma midpointDecoder_wrong_bit_error
(a : Bool → ℝ) (t delta : ℝ) (hsep : delta ≤ |a true - a false|)
(b : Bool)
(hwrong : (decide (|t - a true| ≤ |t - a false|) : Bool) ≠ b) :
delta / 2 ≤ |t - a b| := by
cases b with
| false =>
have hdec : decide (|t - a true| ≤ |t - a false|) = true := by
cases h : decide (|t - a true| ≤ |t - a false|)
· exact (hwrong h).elim
· rfl
have hle : |t - a true| ≤ |t - a false| := of_decide_eq_true hdec
have htri : |a true - a false| ≤
|t - a true| + |t - a false| := by
calc
|a true - a false| = |(a true - t) + (t - a false)| := by ring_nf
_ ≤ |a true - t| + |t - a false| := abs_add_le _ _
_ = |t - a true| + |t - a false| := by
rw [abs_sub_comm (a true) t]
linarith
| true =>
exact midpointDecoder_error_ge_half_separation (a false) (a true) t delta
hsep hwrong
theorem finitePackingLoss_ge_of_midpointDecoder_wrong
A wrong midpoint decision at one packing center forces the finite maximum loss to exceed half the certified center-value separation.
Formal statement
hypotheses
n M :
ℕ
rho :
RuleFun n
P :
w :
Sample n
hvalues :
∀ j, P.mu (centers j) = values j (omega j)
delta :
ℝ
j :
Fin M
conclusion
ofReal (delta / 2) ≤ finitePackingLoss rho P centers w
Proof (Lean source)
-- @node: finitePackingLoss_ge_of_midpointDecoder_wrong
lemma finitePackingLoss_ge_of_midpointDecoder_wrong {n M : ℕ}
(rho : RuleFun n) (P : CtyLaw) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool) (w : Sample n)
(hvalues : ∀ j, P.mu (centers j) = values j (omega j))
(delta : ℝ) (hsep : ∀ j, delta ≤ |values j true - values j false|)
(j : Fin M)
(hwrong : (decide
(|rho w (centers j) - values j true| ≤
|rho w (centers j) - values j false|) : Bool) ≠ omega j) :
ofReal (delta / 2) ≤ finitePackingLoss rho P centers w := by
have hj : delta / 2 ≤
|rho w (centers j) - P.mu (centers j)| := by
rw [hvalues j]
exact midpointDecoder_wrong_bit_error (values j) (rho w (centers j)) delta
(hsep j) (omega j) hwrong
exact le_trans (ENNReal.ofReal_le_ofReal hj) (le_iSup (fun k : Fin M =>
ofReal |rho w (centers k) - P.mu (centers k)|) j)
Helpers.FiniteMaxDepoisson 4 declarations This file transfers the canonical marked-Poisson maximum loss to the retained fixed-size sample and controls the failed-count event.
Retention and de-Poissonization for the finite packing maximum
This file transfers the canonical marked-Poisson maximum loss to the retained fixed-size sample and controls the failed-count event.
theorem canonicalPrefix_finiteSampleMap_packingMarkedDistance
Mapping a canonical marked configuration to distances before taking its successful prefix is the same as taking the observation prefix first.
Formal statement
hypotheses
conclusion
= distanceData n (canonicalPrefixObservations (0, 0) n s) x
Proof (Lean source)
-- @node: canonicalPrefix_finiteSampleMap_packingMarkedDistance
lemma canonicalPrefix_finiteSampleMap_packingMarkedDistance {n : ℕ}
(x : Score) (s : FiniteSample (Observation × ℝ)) (h : n ≤ s.count) :
canonicalPrefixObservations (0, 0) n
(finiteSampleMap (packingMarkedDistance x) s) =
distanceData n (canonicalPrefixObservations (0, 0) n s) x := by
unfold canonicalPrefixObservations
have hmap : n ≤ (finiteSampleMap (packingMarkedDistance x) s).count := by
exact h
rw [dif_pos hmap, dif_pos h]
rfl
theorem globalPackingPoissonLoss_eq_finitePackingLoss
On the successful count event, the global Poisson loss is exactly the finite packing loss of the retained fixed-size sample.
Formal statement
hypotheses
M n :
ℕ
T :
PIRule n
rho :
RuleFun n
P :
hsection :
∀ w j, rho w (centers j) = T.map (centers j) (distanceData n w (centers j))
hvalues :
∀ j, P.mu (centers j) = values j (omega j)
s :
FiniteSample (Observation × ℝ)
hs :
n ≤ s.count
conclusion
globalPackingPoissonLoss T centers values omega s
= finitePackingLoss rho P centers (canonicalPrefixObservations (0, 0) n s)
Proof (Lean source)
-- @node: globalPackingPoissonLoss_eq_finitePackingLoss
lemma globalPackingPoissonLoss_eq_finitePackingLoss {M n : ℕ}
(T : PIRule n) (rho : RuleFun n) (P : CtyLaw)
(centers : Fin M → Score) (values : Fin M → Bool → ℝ)
(omega : Fin M → Bool)
(hsection : ∀ w j, rho w (centers j) =
T.map (centers j) (distanceData n w (centers j)))
(hvalues : ∀ j, P.mu (centers j) = values j (omega j))
(s : FiniteSample (Observation × ℝ)) (hs : n ≤ s.count) :
globalPackingPoissonLoss T centers values omega s =
finitePackingLoss rho P centers
(canonicalPrefixObservations (0, 0) n s) := by
unfold globalPackingPoissonLoss finitePackingLoss
congr 1
funext j
congr 2
rw [hvalues j, hsection]
unfold globalPackingPoissonValue
rw [if_pos hs, canonicalPrefix_finiteSampleMap_packingMarkedDistance _ _ hs]
theorem globalPackingPoissonLoss_le_on_count_lt
The count of a canonical marked-Poisson configuration is Poisson.
Formal statement
hypotheses
M n :
ℕ
T :
PIRule n
B :
ℝ
hB :
∀ j, |values j (omega j)| ≤ B
s :
FiniteSample (Observation × ℝ)
hs :
s.count < n
conclusion
globalPackingPoissonLoss T centers values omega s ≤ ofReal B
Proof (Lean source)
-- @node: canonicalMarkedPoissonSampleLaw_map_count
-- @node: globalPackingPoissonLoss_le_on_count_lt
lemma globalPackingPoissonLoss_le_on_count_lt {M n : ℕ}
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool)
(B : ℝ) (hB : ∀ j, |values j (omega j)| ≤ B)
(s : FiniteSample (Observation × ℝ)) (hs : s.count < n) :
globalPackingPoissonLoss T centers values omega s ≤ ofReal B := by
unfold globalPackingPoissonLoss
apply iSup_le
intro j
apply ENNReal.ofReal_le_ofReal
unfold globalPackingPoissonValue
rw [if_neg (Nat.not_le_of_lt hs)]
simpa only [zero_sub, abs_neg] using hB j
theorem globalPackingPoissonRisk_le_fixedRisk_add_tail
The Poissonized risk is at most the retained fixed-size risk plus the failed-count probability times a uniform zero-default bound.
Formal statement
hypotheses
M n :
ℕ
T :
PIRule n
rho :
RuleFun n
P :
hsection :
∀ w j, rho w (centers j) = T.map (centers j) (distanceData n w (centers j))
hvalues :
∀ j, P.mu (centers j) = values j (omega j)
hfiniteMeas :
Measurable (finitePackingLoss rho P centers)
B :
ℝ
hB :
∀ j, |values j (omega j)| ≤ B
conclusion
(letI : IsProbabilityMeasure P.law := P.law_isProbability ∫⁻ s, globalPackingPoissonLoss T centers values omega s ∂canonicalMarkedPoissonSampleLaw P.law packingMarkLaw (2 * n))
≤ (∫⁻ w, finitePackingLoss rho P centers w ∂sampleLaw P n)
Proof (Lean source)
-- @node: globalPackingPoissonRisk_le_fixedRisk_add_tail
lemma globalPackingPoissonRisk_le_fixedRisk_add_tail {M n : ℕ}
(T : PIRule n) (rho : RuleFun n) (P : CtyLaw)
(centers : Fin M → Score) (values : Fin M → Bool → ℝ)
(omega : Fin M → Bool)
(hsection : ∀ w j, rho w (centers j) =
T.map (centers j) (distanceData n w (centers j)))
(hvalues : ∀ j, P.mu (centers j) = values j (omega j))
(hfiniteMeas : Measurable (finitePackingLoss rho P centers))
(B : ℝ) (hB : ∀ j, |values j (omega j)| ≤ B) :
(letI : IsProbabilityMeasure P.law := P.law_isProbability
∫⁻ s, globalPackingPoissonLoss T centers values omega s
∂canonicalMarkedPoissonSampleLaw P.law packingMarkLaw (2 * n)) ≤
(∫⁻ w, finitePackingLoss rho P centers w ∂sampleLaw P n) +
ofReal B *
ofReal (exp (-(n : ℝ) * (1 - log 2))) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
let μ := canonicalMarkedPoissonSampleLaw P.law packingMarkLaw (2 * n)
let success : Set (FiniteSample (Observation × ℝ)) :=
FiniteSample.count ⁻¹' Ici n
have hsuccess : MeasurableSet success :=
measurable_finiteSample_count measurableSet_Ici
have hsplit := lintegral_add_compl
(globalPackingPoissonLoss T centers values omega) (μ := μ) hsuccess
rw [← hsplit]
apply add_le_add
· have hmap := map_canonicalPrefixObservations_restrict_count_ge
P.law packingMarkLaw (2 * n) (0, 0) n
have heq : ∫⁻ s in success,
globalPackingPoissonLoss T centers values omega s ∂μ =
∫⁻ s in success,
finitePackingLoss rho P centers
(canonicalPrefixObservations (0, 0) n s) ∂μ := by
apply lintegral_congr_ae
filter_upwards [ae_restrict_mem hsuccess] with s hs
exact globalPackingPoissonLoss_eq_finitePackingLoss T rho P centers
values omega hsection hvalues s hs
rw [heq]
change (∫⁻ s, finitePackingLoss rho P centers
(canonicalPrefixObservations (0, 0) n s) ∂μ.restrict success) ≤ _
rw [← lintegral_map'
hfiniteMeas.aemeasurable
(measurable_canonicalPrefixObservations (0, 0) n).aemeasurable]
rw [hmap, lintegral_smul_measure]
change (poissonMeasure (2 * n)) (Ici n) *
(∫⁻ w, finitePackingLoss rho P centers w ∂sampleLaw P n) ≤
∫⁻ w, finitePackingLoss rho P centers w ∂sampleLaw P n
exact mul_le_of_le_one_left (by positivity) prob_le_one
· calc
(∫⁻ s in successᶜ, globalPackingPoissonLoss T centers values omega s ∂μ) ≤
∫⁻ _s in successᶜ, ofReal B ∂μ := by
apply setLIntegral_mono measurable_const
intro s hs
apply globalPackingPoissonLoss_le_on_count_lt T centers values omega B hB s
simpa [success] using hs
_ = ofReal B * μ successᶜ := setLIntegral_const _ _
_ ≤ ofReal B *
ofReal (exp (-(n : ℝ) * (1 - log 2))) := by
gcongr
have hcount := canonicalMarkedPoissonSampleLaw_map_count
P.law packingMarkLaw (2 * n)
have hfail : μ successᶜ = (poissonMeasure (2 * n)) {k | k < n} := by
rw [← hcount]
rw [Measure.map_apply measurable_finiteSample_count (by measurability)]
congr 1
ext s
simp [success]
rw [hfail]
exact poisson_two_n_lower_tail n
Helpers.FiniteMaxExperiment 21 declarations This file identifies the hard-family marked Poisson law with the common complement block and independent coordinate-cell blocks used by the coordinatewise direct-product theorem.
The finite angular marked-Poisson experiment
This file identifies the hard-family marked Poisson law with the common complement block and independent coordinate-cell blocks used by the coordinatewise direct-product theorem.
def packingExperimentIndexMeasurableSpace
Equip the packing-experiment index set with the discrete measurable structure.
Definition (Lean source)
theorem packingExperimentIndexMeasurableSingletonClass
Every singleton packing-experiment index is measurable.
Formal statement
Proof (Lean source)
local instance packingExperimentIndexMeasurableSingletonClass (M : ℕ) :
MeasurableSingletonClass (Unit ⊕ Fin M) := ⟨fun _ => trivial⟩
A canonical vertex whose only potentially nonzero coordinate is j.
Definition (Lean source)
-- @node: packingSingleBit
def packingSingleBit {M : ℕ} (j : Fin M) (b : Bool) : Fin M → Bool :=
fun k => if k = j then b else false
theorem packingSingleBit_self
Activating the selected packing coordinate sets that coordinate to its prescribed bit.
Formal statement
Proof (Lean source)
lemma packingSingleBit_self {M : ℕ} (j : Fin M) (b : Bool) :
packingSingleBit j b j = b := by simp [packingSingleBit]
def packingCellExperiment
The canonical marked-Poisson experiment for coordinate j and bit b.
Definition (Lean source)
-- @node: packingCellExperiment
noncomputable def packingCellExperiment {M : ℕ}
(p : FiniteMeasurablePartition Observation (Unit ⊕ Fin M))
(laws : (Fin M → Bool) → CtyLaw) (lam : ℝ≥0)
(j : Fin M) (b : Bool) : Measure (FiniteSample (Observation × ℝ)) := by
letI : IsProbabilityMeasure (laws (packingSingleBit j b)).law :=
(laws (packingSingleBit j b)).law_isProbability
exact canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws (packingSingleBit j b)).law (.inr j))
packingMarkLaw
(lam * p.cellMass (laws (packingSingleBit j b)).law (.inr j))
instance packingCellExperiment_isProbabilityMeasure
The stated experiment law has total mass one and therefore defines a probability distribution.
Definition (Lean source)
instance packingCellExperiment_isProbabilityMeasure {M : ℕ}
(p : FiniteMeasurablePartition Observation (Unit ⊕ Fin M))
(laws : (Fin M → Bool) → CtyLaw) (lam : ℝ≥0)
(j : Fin M) (b : Bool) :
IsProbabilityMeasure (packingCellExperiment p laws lam j b) := by
unfold packingCellExperiment
infer_instance
def packingCommonExperiment
The common complement block, represented at the all-false vertex.
Definition (Lean source)
-- @node: packingCommonExperiment
noncomputable def packingCommonExperiment {M : ℕ}
(p : FiniteMeasurablePartition Observation (Unit ⊕ Fin M))
(laws : (Fin M → Bool) → CtyLaw) (lam : ℝ≥0) :
Measure (Unit → FiniteSample (Observation × ℝ)) := by
let omega0 : Fin M → Bool := fun _ => false
letI : IsProbabilityMeasure (laws omega0).law := (laws omega0).law_isProbability
exact Measure.pi (fun _ : Unit => canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega0).law (.inl ())) packingMarkLaw
(lam * p.cellMass (laws omega0).law (.inl ())))
instance packingCommonExperiment_isProbabilityMeasure
The stated experiment law has total mass one and therefore defines a probability distribution.
Definition (Lean source)
instance packingCommonExperiment_isProbabilityMeasure {M : ℕ}
(p : FiniteMeasurablePartition Observation (Unit ⊕ Fin M))
(laws : (Fin M → Bool) → CtyLaw) (lam : ℝ≥0) :
IsProbabilityMeasure (packingCommonExperiment p laws lam) := by
unfold packingCommonExperiment
infer_instance
Put the common block and coordinate blocks back into the sum-indexed family and superpose them in increasing mark order.
Definition (Lean source)
-- @node: synthesizePackingConfiguration
noncomputable def synthesizePackingConfiguration {M : ℕ}
(z : (Unit → FiniteSample (Observation × ℝ)) ×
(Fin M → FiniteSample (Observation × ℝ))) :
FiniteSample (Observation × ℝ) :=
superposeByMarks
((MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (Observation × ℝ))).symm z)
theorem synthesizePackingConfiguration_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
Proof (Lean source)
lemma synthesizePackingConfiguration_measurable {M : ℕ} :
Measurable (synthesizePackingConfiguration (M := M)) := by
exact measurable_superposeByMarks.comp
(MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (Observation × ℝ))).symm.measurable
theorem map_finitePoissonSampleLaw_finiteSampleMap
Pointwise measurable mapping commutes with a finite Poisson sample law.
Formal statement
hypotheses
X Y :
P :
f :
X → Y
hf :
lam :
ℝ≥0
conclusion
Measure.map (finiteSampleMap f) (finitePoissonSampleLaw P lam)
= (letI : IsProbabilityMeasure (Measure.map f P) := Measure.isProbabilityMeasure_map hf.aemeasurable finitePoissonSampleLaw (Measure.map f P) lam)
Proof (Lean source)
-- @node: map_finitePoissonSampleLaw_finiteSampleMap
lemma map_finitePoissonSampleLaw_finiteSampleMap
{X Y : Type*} [MeasurableSpace X] [MeasurableSpace Y]
(P : Measure X) [IsProbabilityMeasure P]
(f : X → Y) (hf : Measurable f) (lam : ℝ≥0) :
Measure.map (finiteSampleMap f) (finitePoissonSampleLaw P lam) =
(letI : IsProbabilityMeasure (Measure.map f P) :=
Measure.isProbabilityMeasure_map hf.aemeasurable
finitePoissonSampleLaw (Measure.map f P) lam) := by
letI : IsProbabilityMeasure (Measure.map f P) :=
Measure.isProbabilityMeasure_map hf.aemeasurable
let F := finiteSampleMap f
have hF : Measurable F := measurable_finiteSampleMap f hf
let μ := Measure.map F (finitePoissonSampleLaw P lam)
let ν := finitePoissonSampleLaw (Measure.map f P) lam
have hrest (n : ℕ) :
μ.restrict (FiniteSample.count ⁻¹' ({n} : Set ℕ)) =
ν.restrict (FiniteSample.count ⁻¹' ({n} : Set ℕ)) := by
rw [show μ = Measure.map F (finitePoissonSampleLaw P lam) by rfl,
Measure.restrict_map hF
(measurable_finiteSample_count (measurableSet_singleton n))]
have hpre : F ⁻¹' (FiniteSample.count ⁻¹' ({n} : Set ℕ)) =
FiniteSample.count ⁻¹' ({n} : Set ℕ) := by
ext s
rfl
rw [hpre, finitePoissonSampleLaw_restrict_count_eq,
show ν = finitePoissonSampleLaw (Measure.map f P) lam by rfl,
finitePoissonSampleLaw_restrict_count_eq, Measure.map_smul,
Measure.map_map hF (measurable_fixedSizeEmbed n)]
have hfun : F ∘ fixedSizeEmbed n =
fixedSizeEmbed n ∘ (fun x : Fin n → X => fun i => f (x i)) := by
funext x
exact finiteSampleMap_fixedSizeEmbed f n x
rw [hfun]
congr 1
let G : (Fin n → X) → (Fin n → Y) := fun x i => f (x i)
have hG : Measurable G :=
measurable_pi_lambda _ fun i => hf.comp (measurable_pi_apply i)
change Measure.map (fixedSizeEmbed n ∘ G) (Measure.pi fun _ : Fin n => P) = _
calc
Measure.map (fixedSizeEmbed n ∘ G) (Measure.pi fun _ : Fin n => P) =
Measure.map (fixedSizeEmbed n)
(Measure.map G (Measure.pi fun _ : Fin n => P)) :=
(Measure.map_map (measurable_fixedSizeEmbed n) hG).symm
_ = Measure.map (fixedSizeEmbed n)
(Measure.pi fun _ : Fin n => Measure.map f P) := by
rw [show G = (fun x i => f (x i)) by rfl,
Measure.pi_map_pi (fun _ => hf.aemeasurable)]
have hdecomp (η : Measure (FiniteSample Y)) :
η = Measure.sum (fun n =>
η.restrict (FiniteSample.count ⁻¹' ({n} : Set ℕ))) := by
have hdis : Pairwise (onFun Disjoint
(fun n : ℕ => (FiniteSample.count : FiniteSample Y → ℕ) ⁻¹'
({n} : Set ℕ))) := by
intro i j hij
apply Set.disjoint_left.2
intro s hi hj
apply hij
simpa using hi.symm.trans hj
have hcover : ⋃ n : ℕ, (FiniteSample.count : FiniteSample Y → ℕ) ⁻¹'
({n} : Set ℕ) = univ := by
ext s
simp
calc
η = η.restrict univ := by rw [Measure.restrict_univ]
_ = η.restrict (⋃ n : ℕ,
FiniteSample.count ⁻¹' ({n} : Set ℕ)) := by rw [hcover]
_ = Measure.sum (fun n =>
η.restrict (FiniteSample.count ⁻¹' ({n} : Set ℕ))) := by
exact Measure.restrict_iUnion hdis
(fun n => measurable_finiteSample_count (measurableSet_singleton n))
change μ = ν
rw [hdecomp μ, hdecomp ν]
congr 1
funext n
exact hrest n
theorem map_finiteMarkedPoissonSampleLaw_finiteSampleMap
Mapping only the observation coordinate commutes with a finite marked Poisson sample law.
Formal statement
hypotheses
X Y :
P :
R :
f :
X → Y
hf :
lam :
ℝ≥0
conclusion
Measure.map (finiteSampleMap (fun z : X × ℝ => (f z.1, z.2))) (finiteMarkedPoissonSampleLaw P R lam)
= (letI : IsProbabilityMeasure (Measure.map f P) := Measure.isProbabilityMeasure_map hf.aemeasurable finiteMarkedPoissonSampleLaw (Measure.map f P) R lam)
Proof (Lean source)
-- @node: map_finiteMarkedPoissonSampleLaw_finiteSampleMap
lemma map_finiteMarkedPoissonSampleLaw_finiteSampleMap
{X Y : Type*} [MeasurableSpace X] [MeasurableSpace Y]
(P : Measure X) [IsProbabilityMeasure P]
(R : Measure ℝ) [IsProbabilityMeasure R]
(f : X → Y) (hf : Measurable f) (lam : ℝ≥0) :
Measure.map (finiteSampleMap (fun z : X × ℝ => (f z.1, z.2)))
(finiteMarkedPoissonSampleLaw P R lam) =
(letI : IsProbabilityMeasure (Measure.map f P) :=
Measure.isProbabilityMeasure_map hf.aemeasurable
finiteMarkedPoissonSampleLaw (Measure.map f P) R lam) := by
letI : IsProbabilityMeasure (Measure.map f P) :=
Measure.isProbabilityMeasure_map hf.aemeasurable
let g : X × ℝ → Y × ℝ := fun z => (f z.1, z.2)
have hg : Measurable g := (hf.comp measurable_fst).prodMk measurable_snd
unfold finiteMarkedPoissonSampleLaw
rw [map_finitePoissonSampleLaw_finiteSampleMap (P.prod R) g hg lam]
congr 2
have hmap := (Measure.map_prod_map P R hf measurable_id).symm
rw [Measure.map_id] at hmap
exact hmap
The two-cell partition of outcome-distance space into radii at most w and radii larger than w.
Definition (Lean source)
-- @node: packingRadialPartition
noncomputable def packingRadialPartition (w : ℝ) :
FiniteMeasurablePartition (ℝ × ℝ) Bool :=
FiniteMeasurablePartition.ofSets
(fun b => if b then {z | w < z.2} else {z | z.2 ≤ w})
(by
intro b
cases b
· change MeasurableSet {z : ℝ × ℝ | z.2 ≤ w}
exact measurableSet_Iic.preimage
(measurable_snd : Measurable (Prod.snd : ℝ × ℝ → ℝ))
· change MeasurableSet {z : ℝ × ℝ | w < z.2}
exact measurableSet_Ioi.preimage
(measurable_snd : Measurable (Prod.snd : ℝ × ℝ → ℝ)))
(by
intro b b' h
cases b <;> cases b'
· exact (h rfl).elim
· apply Set.disjoint_left.2
intro z hz hz'
simp only [Bool.false_eq_true, if_false, Set.mem_setOf_eq] at hz
simp only [if_true, Set.mem_setOf_eq] at hz'
exact (not_lt_of_ge hz) hz'
· apply Set.disjoint_left.2
intro z hz hz'
simp only [if_true, Set.mem_setOf_eq] at hz
simp only [Bool.false_eq_true, if_false, Set.mem_setOf_eq] at hz'
exact (not_lt_of_ge hz') hz
· exact (h rfl).elim)
(by
ext z
simp only [Set.mem_iUnion, Set.mem_univ, iff_true]
by_cases h : z.2 ≤ w
· exact ⟨false, by simpa using h⟩
· exact ⟨true, by simpa using lt_of_not_ge h⟩)
theorem packingRadialPartition_cellSet_false
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Formal statement
Proof (Lean source)
lemma packingRadialPartition_cellSet_false (w : ℝ) :
(packingRadialPartition w).cellSet false = {z : ℝ × ℝ | z.2 ≤ w} := by
exact FiniteMeasurablePartition.ofSets_cellSet _ _ _ _ false
theorem map_shortRadiusBlock_finiteMarkedPoissonSampleLaw
The canonically ordered short-radius block is a measurable image of the full raw marked-Poisson outcome-distance experiment.
Formal statement
hypotheses
conclusion
Measure.map (orderByMarks ∘ (packingRadialPartition w).restrictCell false) (finiteMarkedPoissonSampleLaw P R lam)
= canonicalMarkedPoissonSampleLaw ((packingRadialPartition w).cellObservationLaw P false) R (lam * (packingRadialPartition w).cellMass P false)
Proof (Lean source)
-- @node: map_shortRadiusBlock_finiteMarkedPoissonSampleLaw
lemma map_shortRadiusBlock_finiteMarkedPoissonSampleLaw
(P : Measure (ℝ × ℝ)) [IsProbabilityMeasure P]
(R : Measure ℝ) [IsProbabilityMeasure R]
(w : ℝ) (lam : ℝ≥0) :
Measure.map (orderByMarks ∘ (packingRadialPartition w).restrictCell false)
(finiteMarkedPoissonSampleLaw P R lam) =
canonicalMarkedPoissonSampleLaw
((packingRadialPartition w).cellObservationLaw P false) R
(lam * (packingRadialPartition w).cellMass P false) := by
let p := packingRadialPartition w
have hjoint := p.map_restrictPartition_finiteMarkedPoissonSampleLaw P R lam
have hcell : Measure.map (p.restrictCell false)
(finiteMarkedPoissonSampleLaw P R lam) =
finiteMarkedPoissonSampleLaw (p.cellObservationLaw P false) R
(lam * p.cellMass P false) := by
calc
Measure.map (p.restrictCell false)
(finiteMarkedPoissonSampleLaw P R lam) =
Measure.map (Function.eval false)
(Measure.map p.restrictPartition
(finiteMarkedPoissonSampleLaw P R lam)) := by
rw [Measure.map_map (measurable_pi_apply false)
p.measurable_restrictPartition]
rfl
_ = Measure.map (Function.eval false)
(Measure.pi fun b : Bool =>
finiteMarkedPoissonSampleLaw (p.cellObservationLaw P b) R
(lam * p.cellMass P b)) := by rw [hjoint]
_ = _ := by
rw [Measure.pi_map_eval]
simp only [measure_univ, Finset.prod_const_one, one_smul]
rw [show orderByMarks ∘ p.restrictCell false =
orderByMarks ∘ p.restrictCell false by rfl,
← Measure.map_map measurable_orderByMarks (p.measurable_restrictCell false),
hcell]
rfl
theorem map_packingCell_restrict_eq_onePointDistance_restrict
For a law supported by the packing square, mapping its restriction to a packing cell into outcome-distance coordinates gives the corresponding short-radius restriction of the one-point distance law.
Formal statement
hypotheses
conclusion
Measure.map (fun o : Observation => (o.1, dist o.2 x)) (P.law.restrict {o | o.2 ∈ closedBall x w ∩ P.support})
= (onePointDistanceLaw P x).restrict {z | z.2 ≤ w}
Proof (Lean source)
-- @node: map_packingCell_restrict_eq_onePointDistance_restrict
lemma map_packingCell_restrict_eq_onePointDistance_restrict
(P : CtyLaw) (x : Score) (w : ℝ) :
Measure.map (fun o : Observation => (o.1, dist o.2 x))
(P.law.restrict {o | o.2 ∈ closedBall x w ∩ P.support}) =
(onePointDistanceLaw P x).restrict {z | z.2 ≤ w} := by
let f : Observation → ℝ × ℝ := fun o => (o.1, dist o.2 x)
have hf : Measurable f := by fun_prop
have hsupp : ∀ᵐ o ∂P.law, o.2 ∈ P.support := by
apply ae_of_ae_map measurable_snd.aemeasurable
simpa [P.support_eq_marginal_support] using
(Measure.map Prod.snd P.law).support_mem_ae
have hset : {o : Observation | o.2 ∈ closedBall x w ∩ P.support} =ᵐ[P.law]
f ⁻¹' {z : ℝ × ℝ | z.2 ≤ w} := by
filter_upwards [hsupp] with o ho
simp only [Set.mem_setOf_eq, Set.mem_preimage, f, Metric.mem_closedBall]
exact propext (and_iff_left ho)
rw [P.law.restrict_congr_set hset]
change Measure.map f (P.law.restrict (f ⁻¹' {z : ℝ × ℝ | z.2 ≤ w})) =
(Measure.map f P.law).restrict {z : ℝ × ℝ | z.2 ≤ w}
exact (Measure.restrict_map hf
(measurableSet_Iic.preimage
(measurable_snd : Measurable (Prod.snd : ℝ × ℝ → ℝ)))).symm
theorem finiteSampleMap_orderByMarks
Mapping a marked configuration pointwise without changing its marks commutes definitionally with canonical mark ordering.
Formal statement
hypotheses
conclusion
finiteSampleMap (fun z : X × ℝ => (f z.1, z.2)) (orderByMarks s)
= orderByMarks (finiteSampleMap (fun z : X × ℝ => (f z.1, z.2)) s)
Proof (Lean source)
-- @node: finiteSampleMap_orderByMarks
lemma finiteSampleMap_orderByMarks
{X Y : Type*} [MeasurableSpace X] [MeasurableSpace Y]
(f : X → Y) (s : FiniteSample (X × ℝ)) :
finiteSampleMap (fun z : X × ℝ => (f z.1, z.2)) (orderByMarks s) =
orderByMarks (finiteSampleMap (fun z : X × ℝ => (f z.1, z.2)) s) := by
rfl
theorem map_packingCellObservationLaw_eq_radialCellObservationLaw
Normalising a positive packing-cell restriction and then mapping to outcome-distance coordinates gives the normalised short-radius law.
Formal statement
hypotheses
M :
ℕ
w m :
ℝ
hdis :
∀ i j
if
i ≠ j
then
P :
hsupport :
P.support = packingSquare
hm :
0 < m
j :
Fin M
hmass :
conclusion
(letI : IsProbabilityMeasure P.law := P.law_isProbability letI : IsProbabilityMeasure (onePointDistanceLaw P (centers j)) := onePointDistanceLaw_isProbabilityMeasure P (centers j) Measure.map (fun o : Observation => (o.1, dist o.2 (centers j))) ((packingFinitePartition centers w hdis).cellObservationLaw P.law (.inr j)) = (packingRadialPartition w).cellObservationLaw (onePointDistanceLaw P (centers j)) false)
Proof (Lean source)
-- @node: map_packingCellObservationLaw_eq_radialCellObservationLaw
lemma map_packingCellObservationLaw_eq_radialCellObservationLaw {M : ℕ}
(centers : Fin M → Score) (w m : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(P : CtyLaw) (hsupport : P.support = packingSquare)
(hm : 0 < m) (j : Fin M)
(hmass : Measure.map snd P.law (packingCell centers w j) =
ofReal m) :
(letI : IsProbabilityMeasure P.law := P.law_isProbability
letI : IsProbabilityMeasure (onePointDistanceLaw P (centers j)) :=
onePointDistanceLaw_isProbabilityMeasure P (centers j)
Measure.map (fun o : Observation => (o.1, dist o.2 (centers j)))
((packingFinitePartition centers w hdis).cellObservationLaw P.law (.inr j)) =
(packingRadialPartition w).cellObservationLaw
(onePointDistanceLaw P (centers j)) false) := by
let p := packingFinitePartition centers w hdis
let r := packingRadialPartition w
let f : Observation → ℝ × ℝ := fun o => (o.1, dist o.2 (centers j))
have hf : Measurable f := by fun_prop
letI : IsProbabilityMeasure P.law := P.law_isProbability
letI : IsProbabilityMeasure (onePointDistanceLaw P (centers j)) :=
onePointDistanceLaw_isProbabilityMeasure P (centers j)
letI : IsProbabilityMeasure (p.cellObservationLaw P.law (.inr j)) := inferInstance
letI : IsProbabilityMeasure
(Measure.map f (p.cellObservationLaw P.law (.inr j))) :=
Measure.isProbabilityMeasure_map hf.aemeasurable
have hpMass : P.law (p.cellSet (.inr j)) = ofReal m := by
rw [show p = packingFinitePartition centers w hdis by rfl,
packingFinitePartition_cell_measure_eq_map_snd]
exact hmass
have hpPos : P.law (p.cellSet (.inr j)) ≠ 0 := by
rw [hpMass]
exact (ENNReal.ofReal_pos.mpr hm).ne'
have hmapRest : Measure.map f (P.law.restrict (p.cellSet (.inr j))) =
(onePointDistanceLaw P (centers j)).restrict (r.cellSet false) := by
rw [show p.cellSet (.inr j) =
{o : Observation | o.2 ∈ closedBall (centers j) w ∩ P.support} by
rw [show p = packingFinitePartition centers w hdis by rfl,
packingFinitePartition_cellSet, packingPartitionSet, hsupport]
rfl]
rw [show r.cellSet false = {z : ℝ × ℝ | z.2 ≤ w} by
exact packingRadialPartition_cellSet_false w]
exact map_packingCell_restrict_eq_onePointDistance_restrict P (centers j) w
have hrMass : onePointDistanceLaw P (centers j) (r.cellSet false) =
ofReal m := by
have hu := congrArg (fun μ : Measure (ℝ × ℝ) => μ univ) hmapRest
calc
onePointDistanceLaw P (centers j) (r.cellSet false) =
((onePointDistanceLaw P (centers j)).restrict (r.cellSet false)) univ := by
rw [Measure.restrict_apply_univ]
_ = (Measure.map f (P.law.restrict (p.cellSet (.inr j)))) univ := hu.symm
_ = P.law (p.cellSet (.inr j)) := by
rw [Measure.map_apply hf MeasurableSet.univ, Set.preimage_univ,
Measure.restrict_apply_univ]
_ = ofReal m := hpMass
have hrPos : onePointDistanceLaw P (centers j) (r.cellSet false) ≠ 0 := by
rw [hrMass]
exact (ENNReal.ofReal_pos.mpr hm).ne'
unfold FiniteMeasurablePartition.cellObservationLaw
rw [dif_neg hpPos, dif_neg hrPos, Measure.map_smul, hpMass, hrMass, hmapRest]
theorem compressedPackingCellExperiment_eq_shortRadiusBlock
A compressed canonical cell experiment is the canonical short-radius block of the full one-point outcome-distance marked-Poisson experiment.
Formal statement
hypotheses
M :
ℕ
w m :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hsupport :
∀ omega, (laws omega).support = packingSquare
hm :
0 < m
hmass :
∀ omega j,
lam :
ℝ≥0
j :
Fin M
b :
conclusion
(let P := laws (packingSingleBit j b) letI : IsProbabilityMeasure P.law := P.law_isProbability letI : IsProbabilityMeasure (onePointDistanceLaw P (centers j)) := onePointDistanceLaw_isProbabilityMeasure P (centers j) compressedCoordinateLaw (compressPackingCell centers j) (packingCellExperiment (packingFinitePartition centers w hdis) laws lam j b) = Measure.map (orderByMarks ∘ (packingRadialPartition w).restrictCell false) (finiteMarkedPoissonSampleLaw (onePointDistanceLaw (laws (packingSingleBit j b)) (centers j)) packingMarkLaw lam))
Proof (Lean source)
-- @node: compressedPackingCellExperiment_eq_shortRadiusBlock
lemma compressedPackingCellExperiment_eq_shortRadiusBlock {M : ℕ}
(centers : Fin M → Score) (w m : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(laws : (Fin M → Bool) → CtyLaw)
(hsupport : ∀ omega, (laws omega).support = packingSquare)
(hm : 0 < m)
(hmass : ∀ omega j,
Measure.map snd (laws omega).law (packingCell centers w j) =
ofReal m)
(lam : ℝ≥0) (j : Fin M) (b : Bool) :
(let P := laws (packingSingleBit j b)
letI : IsProbabilityMeasure P.law := P.law_isProbability
letI : IsProbabilityMeasure (onePointDistanceLaw P (centers j)) :=
onePointDistanceLaw_isProbabilityMeasure P (centers j)
compressedCoordinateLaw
(compressPackingCell centers j)
(packingCellExperiment (packingFinitePartition centers w hdis) laws lam j b) =
Measure.map (orderByMarks ∘ (packingRadialPartition w).restrictCell false)
(finiteMarkedPoissonSampleLaw
(onePointDistanceLaw (laws (packingSingleBit j b)) (centers j))
packingMarkLaw lam)) := by
let P := laws (packingSingleBit j b)
let p := packingFinitePartition centers w hdis
let r := packingRadialPartition w
let f : Observation → ℝ × ℝ := fun o => (o.1, dist o.2 (centers j))
have hf : Measurable f := by fun_prop
letI : IsProbabilityMeasure P.law := P.law_isProbability
letI : IsProbabilityMeasure (onePointDistanceLaw P (centers j)) :=
onePointDistanceLaw_isProbabilityMeasure P (centers j)
letI : IsProbabilityMeasure (p.cellObservationLaw P.law (.inr j)) := inferInstance
letI : IsProbabilityMeasure
(Measure.map f (p.cellObservationLaw P.law (.inr j))) :=
Measure.isProbabilityMeasure_map hf.aemeasurable
have hmapObs := map_packingCellObservationLaw_eq_radialCellObservationLaw
centers w m hdis P (hsupport _) hm j (hmass _ j)
have hmassCell : p.cellMass P.law (.inr j) = r.cellMass
(onePointDistanceLaw P (centers j)) false := by
unfold FiniteMeasurablePartition.cellMass
congr 1
have hp : P.law (p.cellSet (.inr j)) = ofReal m := by
rw [show p = packingFinitePartition centers w hdis by rfl,
packingFinitePartition_cell_measure_eq_map_snd]
exact hmass _ j
have hr : onePointDistanceLaw P (centers j) (r.cellSet false) =
ofReal m := by
have hrest : Measure.map f (P.law.restrict (p.cellSet (.inr j))) =
(onePointDistanceLaw P (centers j)).restrict (r.cellSet false) := by
rw [show p.cellSet (.inr j) =
{o : Observation | o.2 ∈ closedBall (centers j) w ∩ P.support} by
rw [show p = packingFinitePartition centers w hdis by rfl,
packingFinitePartition_cellSet, packingPartitionSet, hsupport _]
rfl]
rw [show r.cellSet false = {z : ℝ × ℝ | z.2 ≤ w} by
exact packingRadialPartition_cellSet_false w]
exact map_packingCell_restrict_eq_onePointDistance_restrict P (centers j) w
have hu := congrArg (fun μ : Measure (ℝ × ℝ) => μ univ) hrest
calc
onePointDistanceLaw P (centers j) (r.cellSet false) =
((onePointDistanceLaw P (centers j)).restrict (r.cellSet false)) univ := by
rw [Measure.restrict_apply_univ]
_ = (Measure.map f (P.law.restrict (p.cellSet (.inr j)))) univ := hu.symm
_ = P.law (p.cellSet (.inr j)) := by
rw [Measure.map_apply hf MeasurableSet.univ, Set.preimage_univ,
Measure.restrict_apply_univ]
_ = ofReal m := hp
rw [hp, hr]
unfold compressedCoordinateLaw compressPackingCell packingCellExperiment
unfold canonicalMarkedPoissonSampleLaw
rw [Measure.map_map
(measurable_finiteSampleMap _ (packingMarkedDistance_measurable _))
measurable_orderByMarks]
have hcomm :
finiteSampleMap (packingMarkedDistance (centers j)) ∘ orderByMarks =
orderByMarks ∘ finiteSampleMap
(fun z : Observation × ℝ => (f z.1, z.2)) := by
funext s
exact finiteSampleMap_orderByMarks f s
rw [hcomm, ← Measure.map_map measurable_orderByMarks
(measurable_finiteSampleMap _ (by fun_prop))]
rw [map_finiteMarkedPoissonSampleLaw_finiteSampleMap
(p.cellObservationLaw P.law (.inr j)) packingMarkLaw f (by fun_prop)
(lam * p.cellMass P.law (.inr j))]
calc
Measure.map orderByMarks
(finiteMarkedPoissonSampleLaw
(Measure.map f (p.cellObservationLaw P.law (.inr j))) packingMarkLaw
(lam * p.cellMass P.law (.inr j))) =
canonicalMarkedPoissonSampleLaw
(r.cellObservationLaw (onePointDistanceLaw P (centers j)) false)
packingMarkLaw
(lam * r.cellMass (onePointDistanceLaw P (centers j)) false) := by
unfold canonicalMarkedPoissonSampleLaw
rw [hmassCell]
congr 3
_ = Measure.map (orderByMarks ∘ r.restrictCell false)
(finiteMarkedPoissonSampleLaw
(onePointDistanceLaw P (centers j)) packingMarkLaw lam) := by
exact (map_shortRadiusBlock_finiteMarkedPoissonSampleLaw
(onePointDistanceLaw P (centers j)) packingMarkLaw w lam).symm
theorem compressedPackingCellExperiment_klDiv_le
The compressed cell KL budget is at most twice the fixed-size packing budget, exactly the factor introduced by mean-2n Poissonization.
Formal statement
hypotheses
M n :
ℕ
hn :
1 ≤ n
hM :
1 ≤ M
w m alpha :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hsupport :
∀ omega, (laws omega).support = packingSquare
hm :
0 < m
hmass :
∀ omega j,
halpha :
0 ≤ alpha
hpi :
∀ omega j,
klDiv (compressedSampleLaw (laws omega) n (centers j)) (compressedSampleLaw (laws (flipBit j omega)) n (centers j))
j :
Fin M
conclusion
klDiv (compressedCoordinateLaw (compressPackingCell centers j) (packingCellExperiment (packingFinitePartition centers w hdis) laws (2 * n) j false)) (compressedCoordinateLaw (compressPackingCell centers j) (packingCellExperiment (packingFinitePartition centers w hdis) laws (2 * n) j true))
Proof (Lean source)
-- @node: compressedPackingCellExperiment_klDiv_le
lemma compressedPackingCellExperiment_klDiv_le {M n : ℕ}
(hn : 1 ≤ n) (hM : 1 ≤ M)
(centers : Fin M → Score) (w m alpha : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(laws : (Fin M → Bool) → CtyLaw)
(hsupport : ∀ omega, (laws omega).support = packingSquare)
(hm : 0 < m)
(hmass : ∀ omega j,
Measure.map snd (laws omega).law (packingCell centers w j) =
ofReal m)
(halpha : 0 ≤ alpha)
(hpi : ∀ omega j,
klDiv
(compressedSampleLaw (laws omega) n (centers j))
(compressedSampleLaw
(laws (flipBit j omega)) n (centers j)) ≤
ofReal (alpha * log M))
(j : Fin M) :
klDiv
(compressedCoordinateLaw
(compressPackingCell centers j)
(packingCellExperiment (packingFinitePartition centers w hdis)
laws (2 * n) j false))
(compressedCoordinateLaw
(compressPackingCell centers j)
(packingCellExperiment (packingFinitePartition centers w hdis)
laws (2 * n) j true)) ≤
ofReal ((2 * alpha) * log M) := by
let P0 := laws (packingSingleBit j false)
let P1 := laws (packingSingleBit j true)
let Q0 := onePointDistanceLaw P0 (centers j)
let Q1 := onePointDistanceLaw P1 (centers j)
let F := orderByMarks ∘ (packingRadialPartition w).restrictCell false
letI : IsProbabilityMeasure Q0 := onePointDistanceLaw_isProbabilityMeasure _ _
letI : IsProbabilityMeasure Q1 := onePointDistanceLaw_isProbabilityMeasure _ _
rw [compressedPackingCellExperiment_eq_shortRadiusBlock centers w m hdis laws
hsupport hm hmass (2 * n) j false,
compressedPackingCellExperiment_eq_shortRadiusBlock centers w m hdis laws
hsupport hm hmass (2 * n) j true]
have hB : 0 ≤ alpha * log M :=
mul_nonneg halpha (Real.log_nonneg (by exact_mod_cast hM))
have hflip : flipBit j (packingSingleBit j false) =
packingSingleBit j true := by
funext k
by_cases hkj : k = j
· subst k
simp [flipBit, packingSingleBit]
· simp [flipBit, packingSingleBit, hkj]
have hfixed : klDiv
(Measure.pi fun _ : Fin n => Q0)
(Measure.pi fun _ : Fin n => Q1) ≤
ofReal (alpha * log M) := by
simpa [Q0, Q1, P0, P1, compressedSampleLaw_eq_pi_onePointDistanceLaw,
hflip] using hpi (packingSingleBit j false) j
have hpois := markedPoissonKL_le_two_mul_of_piKL Q0 Q1 packingMarkLaw
n hn hB hfixed
rw [finiteMeasureMarkedPoissonLaw_probability_eq Q0 Q0,
finiteMeasureMarkedPoissonLaw_probability_eq Q1 Q0] at hpois
calc
klDiv
(compressedCoordinateLaw F (finiteMarkedPoissonSampleLaw Q0 packingMarkLaw (2 * n)))
(compressedCoordinateLaw F (finiteMarkedPoissonSampleLaw Q1 packingMarkLaw (2 * n))) ≤
klDiv
(finiteMarkedPoissonSampleLaw Q0 packingMarkLaw (2 * n))
(finiteMarkedPoissonSampleLaw Q1 packingMarkLaw (2 * n)) :=
compressedCoordinateLaw_klDiv_le F
(measurable_orderByMarks.comp
((packingRadialPartition w).measurable_restrictCell false)) _ _
_ ≤ ofReal (2 * (alpha * log M)) := hpois
_ = ofReal ((2 * alpha) * log M) := by ring_nf
theorem packingExperiment_synthesis_law
Splitting the hard-family Poisson law gives the direct-product experiment with one common complement coordinate and one bit-dependent law per cell.
Formal statement
hypotheses
M :
ℕ
w m :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hm :
0 < m
hmass :
∀ omega j,
hlocal :
∀ omega omega' j
if
omega j = omega' j
then
(laws omega).law.restrict {o | o.2 ∈ packingCell centers w j}
= (laws omega').law.restrict {o | o.2 ∈ packingCell centers w j}
hsupport :
∀ omega, (laws omega).support = packingSquare
hoff :
∀ omega omega',
(laws omega).law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
= (laws omega').law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
lam :
ℝ≥0
conclusion
(letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability Measure.map synthesizePackingConfiguration ((packingCommonExperiment (packingFinitePartition centers w hdis) laws lam).prod (Measure.pi fun j => packingCellExperiment (packingFinitePartition centers w hdis) laws lam j (omega j))) = canonicalMarkedPoissonSampleLaw (laws omega).law packingMarkLaw lam)
Proof (Lean source)
-- @node: packingExperiment_synthesis_law
lemma packingExperiment_synthesis_law {M : ℕ}
(centers : Fin M → Score) (w m : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(laws : (Fin M → Bool) → CtyLaw)
(hm : 0 < m)
(hmass : ∀ omega j,
Measure.map snd (laws omega).law (packingCell centers w j) =
ofReal m)
(hlocal : ∀ omega omega' j, omega j = omega' j →
(laws omega).law.restrict {o | o.2 ∈ packingCell centers w j} =
(laws omega').law.restrict {o | o.2 ∈ packingCell centers w j})
(hsupport : ∀ omega, (laws omega).support = packingSquare)
(hoff : ∀ omega omega',
(laws omega).law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j} =
(laws omega').law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j})
(lam : ℝ≥0) (omega : Fin M → Bool) :
(letI : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
Measure.map synthesizePackingConfiguration
((packingCommonExperiment (packingFinitePartition centers w hdis) laws lam).prod
(Measure.pi fun j =>
packingCellExperiment (packingFinitePartition centers w hdis)
laws lam j (omega j))) =
canonicalMarkedPoissonSampleLaw (laws omega).law packingMarkLaw lam) := by
let p := packingFinitePartition centers w hdis
let omega0 : Fin M → Bool := fun _ => false
letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability
letI : IsProbabilityMeasure (laws omega0).law := (laws omega0).law_isProbability
let cellLaw (k : Unit ⊕ Fin M) : Measure (FiniteSample (Observation × ℝ)) :=
canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega).law k) packingMarkLaw
(lam * p.cellMass (laws omega).law k)
have hcoord (j : Fin M) :
packingCellExperiment p laws lam j (omega j) = cellLaw (.inr j) := by
symm
exact packingCanonicalCellLaw_eq_of_bit_eq centers w m hdis laws hm hmass
hlocal packingMarkLaw lam omega (packingSingleBit j (omega j)) j
(packingSingleBit_self j (omega j)).symm
have hcommon :
(fun _ : Unit => canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega0).law (.inl ())) packingMarkLaw
(lam * p.cellMass (laws omega0).law (.inl ()))) =
(fun _ : Unit => cellLaw (.inl ())) := by
funext u
cases u
exact packingCanonicalComplementLaw_eq centers w hdis laws hsupport hoff
packingMarkLaw lam omega0 omega
have hprod :
(packingCommonExperiment p laws lam).prod
(Measure.pi fun j => packingCellExperiment p laws lam j (omega j)) =
(Measure.pi fun u : Unit => cellLaw (.inl u)).prod
(Measure.pi fun j : Fin M => cellLaw (.inr j)) := by
change (Measure.pi (fun _ : Unit => canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega0).law (.inl ())) packingMarkLaw
(lam * p.cellMass (laws omega0).law (.inl ())))).prod
(Measure.pi fun j => packingCellExperiment p laws lam j (omega j)) = _
rw [show (fun _ : Unit => canonicalMarkedPoissonSampleLaw
(p.cellObservationLaw (laws omega0).law (.inl ())) packingMarkLaw
(lam * p.cellMass (laws omega0).law (.inl ()))) =
(fun u : Unit => cellLaw (.inl u)) from hcommon]
rw [show (fun j => packingCellExperiment p laws lam j (omega j)) =
(fun j : Fin M => cellLaw (.inr j)) by
funext j
exact hcoord j]
rw [show packingFinitePartition centers w hdis = p by rfl, hprod]
calc
Measure.map synthesizePackingConfiguration
((Measure.pi fun u : Unit => cellLaw (.inl u)).prod
(Measure.pi fun j : Fin M => cellLaw (.inr j))) =
Measure.map superposeByMarks (Measure.pi cellLaw) := by
rw [show synthesizePackingConfiguration =
superposeByMarks ∘
(MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (Observation × ℝ))).symm by rfl,
← Measure.map_map
measurable_superposeByMarks
(MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (Observation × ℝ))).symm.measurable]
rw [(measurePreserving_sumPiEquivProdPi_symm cellLaw).map_eq]
_ = canonicalMarkedPoissonSampleLaw (laws omega).law packingMarkLaw lam := by
simpa [cellLaw] using
(map_superposeByMarks_canonicalCellLaws p (laws omega).law
packingMarkLaw lam)
Helpers.FiniteMaxLowerBound 1 declarations This module assembles the angular packing, marked Poisson direct-product experiment, midpoint loss conversion, and de-Poissonization.
Shared finite-packing maximum lower bound
This module assembles the angular packing, marked Poisson direct-product experiment, midpoint loss conversion, and de-Poissonization.
theorem packing_finite_max_lower_bound
Uniformly over point-indexed rules and all sufficiently large n, one law from the angular hard family makes the measurable finite packing maximum at least a positive constant times the frontier rate.
Formal statement
conclusion
∀ q : ℕ,
∀ L : ℝ,
1
≤ q → 4 ≤ L → ∃ c : ℝ, 0 < c ∧ ∃ N : ℕ, ∀ n ≥ N, ∀ rho : RuleFun n, rho ∈ PointIndexedDecisionClass n q L → ∃ P : CtyLaw, ∃ M : ℕ, ∃ centers : Fin M → Score, CtyNonparametricClass q L P ∧ (∀ j, centers j ∈ frontier P.support) ∧ Measurable (finitePackingLoss rho P centers) ∧ ofReal (c * frontierRate n) ≤ ∫⁻ w, finitePackingLoss rho P centers w ∂sampleLaw P n
Proof (Lean source)
lemma packing_finite_max_lower_bound :
∀ q : ℕ, ∀ L : ℝ, 1 ≤ q → 4 ≤ L →
∃ c : ℝ, 0 < c ∧ ∃ N : ℕ, ∀ n ≥ N,
∀ rho : RuleFun n, rho ∈ PointIndexedDecisionClass n q L →
∃ P : CtyLaw, ∃ M : ℕ, ∃ centers : Fin M → Score,
CtyNonparametricClass q L P ∧
(∀ j, centers j ∈ frontier P.support) ∧
Measurable (finitePackingLoss rho P centers) ∧
ofReal (c * frontierRate n) ≤
∫⁻ w, finitePackingLoss rho P centers w ∂sampleLaw P n := by
intro q L hq hL
obtain ⟨c0, c1, cwLow, cwHigh, cRadial, alpha,
hc0, hc1, hcwLow, hcwHigh, hcRadial, halpha, halpha8, Npack, hpack⟩ :=
cty_support_boundary_angular_packing q L hq hL
let d : ℝ := (1 / 2 : ℝ) * (1 - exp (-(1 : ℝ) / 2))
have hd : 0 < d := by
dsimp [d]
have : exp (-(1 : ℝ) / 2) < 1 := by
rw [Real.exp_lt_one_iff]
norm_num
exact mul_pos (by norm_num) (sub_pos.mpr this)
let c : ℝ := c1 * d / 4
have hc : 0 < c := div_pos (mul_pos hc1 hd) (by norm_num)
have htailEvent : ∀ᶠ n : ℕ in atTop,
exp (-(n : ℝ) * (1 - log 2)) ≤
(c1 * d / (4 * L)) * frontierRate n := by
have hcoef : 0 < c1 * d / (4 * L) := by
have hL0 : 0 < L := lt_of_lt_of_le (by norm_num) hL
positivity
have h := poisson_remainder_isLittleO_frontier.def hcoef
filter_upwards [h, eventually_ge_atTop (2 : ℕ)] with n hnrm hn
have he0 : 0 ≤ exp (-(n : ℝ) * (1 - log 2)) := Real.exp_pos _ |>.le
have hr0 : 0 ≤ frontierRate n := (frontierRate_pos hn).le
simpa [abs_of_nonneg he0, abs_of_nonneg hr0] using hnrm
obtain ⟨Ntail, hNtail⟩ := (eventually_atTop.1 htailEvent)
refine ⟨c, hc, max Npack (max Ntail 2), ?_⟩
intro n hn rho hrho
have hnpack : Npack ≤ n := le_trans (le_max_left _ _) hn
have hntail : Ntail ≤ n :=
le_trans (le_max_left _ _) (le_trans (le_max_right _ _) hn)
have hn2 : 2 ≤ n :=
le_trans (le_max_right _ _) (le_trans (le_max_right _ _) hn)
obtain ⟨M, w, m, centers, laws, values, hMsize, hw, hcenters,
hsepCenters, hdis, hclass, hsupport, hmass, hlocal, hoff, hvalues,
hseparation, hdistflip, hradial, hkl⟩ := hpack n hnpack
have hM : 1 ≤ M := by
have hleft : 0 < c0 * rpow (frontierRate n) (-(1 : ℝ) / q) :=
mul_pos hc0 (rpow_pos_of_pos (frontierRate_pos hn2) _)
have hMr : (0 : ℝ) < M := lt_of_lt_of_le hleft hMsize
exact_mod_cast (Nat.one_le_iff_ne_zero.mpr (by
intro hzero
subst M
norm_num at hMr))
have hm : 0 < m := by
let j0 : Fin M := ⟨0, Nat.zero_lt_of_lt hM⟩
have hmass0 := hmass (fun _ => false) j0
have hcenterSupport : centers j0 ∈ (laws (fun _ => false)).support := by
rw [hsupport]
have hj := frontier_subset_closure (hcenters j0)
rw [packingSquare_isCompact.isClosed.closure_eq] at hj
exact hj
have hpos := class_pos_on_relopen (laws (fun _ => false))
(hclass (fun _ => false)) (ball (centers j0) w) Metric.isOpen_ball
(centers j0) ⟨Metric.mem_ball_self (by
have hw0 := hw.1
exact lt_of_lt_of_le
(mul_pos hcwLow (rpow_pos_of_pos (frontierRate_pos hn2) _)) hw0),
hcenterSupport⟩
have hsubset : ball (centers j0) w ∩
(laws (fun _ => false)).support ⊆ packingCell centers w j0 := by
intro x hx
rw [hsupport] at hx
exact ⟨Metric.mem_closedBall.mpr (Metric.mem_ball.mp hx.1).le, hx.2⟩
have hcellpos : 0 < Measure.map snd (laws (fun _ => false)).law
(packingCell centers w j0) := hpos.trans_le (measure_mono hsubset)
rw [hmass0] at hcellpos
exact ENNReal.ofReal_pos.mp hcellpos
obtain ⟨T, hT⟩ := hrho
have herror := packingCoordinatewiseError_lower_bound (n := n)
(Nat.one_le_of_lt hn2) hM T centers values w m alpha hdis laws
hsupport hm hmass halpha.le (by linarith) hkl
have hfiniteCoeff : ofReal d ≤
ofReal ((1 / 2 : ℝ) *
(1 - exp (-((M : ℝ) ^ (1 - 2 * alpha)) / 2))) := by
apply ENNReal.ofReal_le_ofReal
have hexp0 : 0 ≤ 1 - 2 * alpha := by linarith
have hpow : 1 ≤ (M : ℝ) ^ (1 - 2 * alpha) :=
Real.one_le_rpow (by exact_mod_cast hM) hexp0
have hexp : exp (-((M : ℝ) ^ (1 - 2 * alpha)) / 2) ≤
exp (-(1 : ℝ) / 2) := Real.exp_le_exp.mpr (by linarith)
dsimp [d]
linarith
have hcoord : ofReal d ≤ coordinatewiseErrorProbability
(fun j b => packingCellExperiment
(packingFinitePartition centers w hdis) laws (2 * n) j b)
(packingCommonExperiment
(packingFinitePartition centers w hdis) laws (2 * n))
(compressPackingCell centers)
(packingPoissonDecoder T centers values) := hfiniteCoeff.trans herror
obtain ⟨omega, hpoisson⟩ := exists_vertex_poissonLoss_ge_coordinatewiseError
T centers values w m (c1 * frontierRate n) hdis laws hsupport hm hmass
hlocal hoff hvalues hseparation
let P := laws omega
have hP : CtyNonparametricClass q L P := hclass omega
have hcentersP : ∀ j, centers j ∈ frontier P.support := by
intro j
simpa [P, hsupport omega] using hcenters j
have hmeas : Measurable (finitePackingLoss rho P centers) :=
finitePackingLoss_measurable_of_pointIndexed rho ⟨T, hT⟩ P hP centers hcentersP
have hsection : ∀ sample j, rho sample (centers j) =
T.map (centers j) (distanceData n sample (centers j)) := by
intro sample j
exact hT P hP sample (centers j) (hcentersP j)
have hbound : ∀ j, |values j (omega j)| ≤ L := by
intro j
rw [← hvalues omega j]
have hsupportCenter : centers j ∈ P.support := by
have hj := frontier_subset_closure (hcentersP j)
rw [hP.2.2.2.1.isClosed.closure_eq] at hj
exact hj
have hderiv := hP.2.2.2.2.2.2.2.1.2.1 0 (by omega)
(centers j) hsupportCenter
simpa only [norm_iteratedFDeriv_zero, Real.norm_eq_abs] using hderiv
letI : IsProbabilityMeasure P.law := P.law_isProbability
have hdepois := globalPackingPoissonRisk_le_fixedRisk_add_tail
T rho P centers values omega hsection (hvalues omega) hmeas L hbound
have hmain : ofReal ((c1 * frontierRate n) / 2) *
ofReal d ≤
∫⁻ s, globalPackingPoissonLoss T centers values omega s
∂canonicalMarkedPoissonSampleLaw P.law packingMarkLaw (2 * n) :=
(mul_le_mul_right hcoord _).trans hpoisson
have htailReal : L * exp (-(n : ℝ) * (1 - log 2)) ≤
(c1 * d / 4) * frontierRate n := by
have hL0 : 0 < L := lt_of_lt_of_le (by norm_num) hL
have := mul_le_mul_of_nonneg_left (hNtail n hntail) hL0.le
calc
L * exp (-(n : ℝ) * (1 - log 2)) ≤
L * ((c1 * d / (4 * L)) * frontierRate n) := this
_ = (c1 * d / 4) * frontierRate n := by field_simp
have htailENN : ofReal L *
ofReal (exp (-(n : ℝ) * (1 - log 2))) ≤
ofReal (c * frontierRate n) := by
rw [← ENNReal.ofReal_mul (le_trans (by norm_num) hL)]
exact ENNReal.ofReal_le_ofReal (by simpa [c] using htailReal)
have hmainEq : ofReal ((c1 * frontierRate n) / 2) *
ofReal d = ofReal (2 * (c * frontierRate n)) := by
have hdelta0 : 0 ≤ (c1 * frontierRate n) / 2 :=
div_nonneg (mul_nonneg hc1.le (frontierRate_pos hn2).le) (by norm_num)
rw [← ENNReal.ofReal_mul hdelta0]
congr 1
dsimp [c]
ring
refine ⟨P, M, centers, hP, hcentersP, hmeas, ?_⟩
have hsum : ofReal (c * frontierRate n) +
ofReal (c * frontierRate n) ≤
(∫⁻ sample, finitePackingLoss rho P centers sample ∂sampleLaw P n) +
ofReal (c * frontierRate n) := by
calc
ofReal (c * frontierRate n) +
ofReal (c * frontierRate n) =
ofReal (2 * (c * frontierRate n)) := by
have hcr0 : 0 ≤ c * frontierRate n :=
mul_nonneg hc.le (frontierRate_pos hn2).le
rw [← ENNReal.ofReal_add hcr0 hcr0]
congr 1
ring
_ = _ := hmainEq.symm
_ ≤ _ := hmain
_ ≤ (∫⁻ sample, finitePackingLoss rho P centers sample ∂sampleLaw P n) +
(ofReal L * ofReal
(exp (-(n : ℝ) * (1 - log 2)))) := hdepois
_ ≤ _ := by
simpa [add_comm] using add_le_add_left htailENN
(∫⁻ sample, finitePackingLoss rho P centers sample ∂sampleLaw P n)
exact ENNReal.le_of_add_le_add_right ENNReal.ofReal_ne_top hsum
Helpers.FiniteMaxRisk 12 declarations This file converts the coordinatewise direct-product testing error into a finite-coordinate Poissonized loss and then back into the retained fixed-size sample loss.
Direct-product error and finite packing risk
This file converts the coordinatewise direct-product testing error into a finite-coordinate Poissonized loss and then back into the retained fixed-size sample loss.
def globalPackingPoissonValue
The Poissonized value at one center as a function of the synthesized canonical global marked configuration.
Definition (Lean source)
-- @node: globalPackingPoissonValue
noncomputable def globalPackingPoissonValue {n : ℕ}
(T : PIRule n) (x : Score) (s : FiniteSample (Observation × ℝ)) : ℝ :=
if n ≤ s.count then
T.map x (canonicalPrefixObservations (0, 0) n
(finiteSampleMap (packingMarkedDistance x) s))
else 0
theorem globalPackingPoissonValue_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
Proof (Lean source)
lemma globalPackingPoissonValue_measurable {n : ℕ}
(T : PIRule n) (x : Score) : Measurable (globalPackingPoissonValue T x) := by
apply Measurable.ite
· exact measurable_finiteSample_count measurableSet_Ici
· exact (T.section_measurable x).comp
((measurable_canonicalPrefixObservations (0, 0) n).comp
(measurable_finiteSampleMap _ (packingMarkedDistance_measurable x)))
· exact measurable_const
The average probability that at least one coordinate decoder is wrong.
Definition (Lean source)
-- @node: coordinatewiseErrorProbability
noncomputable def coordinatewiseErrorProbability
{M : ℕ} {Z S : Fin M → Type*} {A : Type*}
[∀ j, MeasurableSpace (Z j)] [∀ j, MeasurableSpace (S j)]
[MeasurableSpace A]
(Q : ∀ j, Bool → Measure (Z j)) (R : Measure A)
[∀ j b, IsProbabilityMeasure (Q j b)] [IsProbabilityMeasure R]
(compress : ∀ j, Z j → S j)
(decoder : ∀ j, S j → ((k : Fin M) → Z k) → A → Bool) : ℝ≥0∞ :=
(∑ omega : Fin M → Bool,
(R.prod (Measure.pi (fun j => Q j (omega j))))
{data | ∃ j,
decoder j (compress j (data.2 j)) data.2 data.1 ≠ omega j}) /
((2 : ℝ≥0∞) ^ M)
theorem coordinatewiseErrorProbability_eq_one_sub_success
For measurable decoders, average simultaneous error is exactly one minus average simultaneous success.
Formal statement
hypotheses
M :
ℕ
Fin M → Type*
A :
Type*
∀ j, MeasurableSpace (Z j)
∀ j, StandardBorelSpace (Z j)
∀ j, MeasurableSpace (S j)
∀ j, StandardBorelSpace (S j)
R :
Measure A
∀ j b, IsProbabilityMeasure (Q j b)
compress :
∀ j
if
Z j
then
S j
hcompress :
∀ j, Measurable (compress j)
hdecoder :
∀ j, Measurable (fun p : S j × ((k : Fin M) → Z k) × A => decoder j p.1 p.2.1 p.2.2)
conclusion
coordinatewiseErrorProbability Q R compress decoder
= 1 - coordinatewiseSuccessProbability Q R compress decoder
Proof (Lean source)
-- @node: coordinatewiseErrorProbability_eq_one_sub_success
lemma coordinatewiseErrorProbability_eq_one_sub_success
{M : ℕ} {Z S : Fin M → Type*} {A : Type*}
[∀ j, MeasurableSpace (Z j)] [∀ j, StandardBorelSpace (Z j)]
[∀ j, MeasurableSpace (S j)] [∀ j, StandardBorelSpace (S j)]
[MeasurableSpace A] [StandardBorelSpace A]
(Q : ∀ j, Bool → Measure (Z j)) (R : Measure A)
[∀ j b, IsProbabilityMeasure (Q j b)] [IsProbabilityMeasure R]
(compress : ∀ j, Z j → S j) (hcompress : ∀ j, Measurable (compress j))
(decoder : ∀ j, S j → ((k : Fin M) → Z k) → A → Bool)
(hdecoder : ∀ j, Measurable
(fun p : S j × ((k : Fin M) → Z k) × A => decoder j p.1 p.2.1 p.2.2)) :
coordinatewiseErrorProbability Q R compress decoder =
1 - coordinatewiseSuccessProbability Q R compress decoder := by
classical
let μ (omega : Fin M → Bool) := R.prod (Measure.pi fun j => Q j (omega j))
let good (omega : Fin M → Bool) :=
{data : A × ((j : Fin M) → Z j) | ∀ j,
decoder j (compress j (data.2 j)) data.2 data.1 = omega j}
let bad (omega : Fin M → Bool) :=
{data : A × ((j : Fin M) → Z j) | ∃ j,
decoder j (compress j (data.2 j)) data.2 data.1 ≠ omega j}
have hgood (omega : Fin M → Bool) : MeasurableSet (good omega) := by
rw [show good omega = ⋂ j, {data |
decoder j (compress j (data.2 j)) data.2 data.1 = omega j} by
ext data
simp [good]]
apply MeasurableSet.iInter
intro j
apply measurableSet_eq_fun _ measurable_const
have hm := (hdecoder j).comp
(((hcompress j).comp ((measurable_pi_apply j).comp measurable_snd)).prodMk
(measurable_snd.prodMk measurable_fst))
exact hm
have hbad (omega : Fin M → Bool) : bad omega = (good omega)ᶜ := by
ext data
simp [bad, good]
have hmeasure (omega : Fin M → Bool) :
μ omega (bad omega) = 1 - μ omega (good omega) := by
rw [hbad, measure_compl (hgood omega) (measure_ne_top _ _), measure_univ]
unfold coordinatewiseErrorProbability coordinatewiseSuccessProbability
simp only [μ, good, bad] at hmeasure ⊢
simp_rw [hmeasure]
have hpow : (2 : ℝ≥0∞) ^ M ≠ 0 := pow_ne_zero _ (by norm_num)
have hpowtop : (2 : ℝ≥0∞) ^ M ≠ ⊤ := ENNReal.pow_ne_top ENNReal.ofNat_ne_top
have hle (omega : Fin M → Bool) : μ omega (good omega) ≤ 1 := by
calc
μ omega (good omega) ≤ μ omega univ := measure_mono (Set.subset_univ _)
_ = 1 := measure_univ
have hsumle : ∑ omega : Fin M → Bool, μ omega (good omega) ≤
(2 : ℝ≥0∞) ^ M := by
calc
∑ omega : Fin M → Bool, μ omega (good omega) ≤ ∑ _omega : Fin M → Bool, 1 :=
Finset.sum_le_sum fun omega _ => hle omega
_ = (2 : ℝ≥0∞) ^ M := by simp [Fintype.card_fun]
have hsum : (∑ omega : Fin M → Bool,
(1 - μ omega (good omega))) =
(2 : ℝ≥0∞) ^ M - ∑ omega : Fin M → Bool, μ omega (good omega) := by
have hleft : (∑ omega : Fin M → Bool,
(1 - μ omega (good omega))) ≠ ⊤ :=
(ENNReal.sum_ne_top).2 fun _ _ => ENNReal.sub_ne_top ENNReal.one_ne_top
have hright : (2 : ℝ≥0∞) ^ M -
∑ omega : Fin M → Bool, μ omega (good omega) ≠ ⊤ :=
ENNReal.sub_ne_top hpowtop
apply (ENNReal.toReal_eq_toReal_iff' hleft hright).mp
rw [ENNReal.toReal_sum (fun _ _ => ENNReal.sub_ne_top ENNReal.one_ne_top),
ENNReal.toReal_sub_of_le hsumle hpowtop,
ENNReal.toReal_sum (fun _ _ => measure_ne_top _ _)]
conv_lhs =>
enter [2, omega]
rw [ENNReal.toReal_sub_of_le (hle omega) ENNReal.one_ne_top]
rw [Finset.sum_sub_distrib]
simp [Fintype.card_fun] <;> exact hpowtop
rw [hsum, ENNReal.sub_div, ENNReal.div_self hpow hpowtop]
intro _ _
exact hpow
theorem packingCoordinatewiseError_lower_bound
The angular cell experiment inherits the finite direct-product lower bound after midpoint decoding.
Formal statement
hypotheses
M n :
ℕ
hn :
1 ≤ n
hM :
1 ≤ M
T :
PIRule n
w m alpha :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hsupport :
∀ omega, (laws omega).support = packingSquare
hm :
0 < m
hmass :
∀ omega j,
halpha :
0 ≤ alpha
halpha' :
2 * alpha < 1
hpi :
∀ omega j,
klDiv (compressedSampleLaw (laws omega) n (centers j)) (compressedSampleLaw (laws (flipBit j omega)) n (centers j))
conclusion
≤ coordinatewiseErrorProbability (fun j b => packingCellExperiment (packingFinitePartition centers w hdis) laws (2 * n) j b) (packingCommonExperiment (packingFinitePartition centers w hdis) laws (2 * n)) (compressPackingCell centers) (packingPoissonDecoder T centers values)
Proof (Lean source)
-- @node: packingCoordinatewiseError_lower_bound
lemma packingCoordinatewiseError_lower_bound {M n : ℕ}
(hn : 1 ≤ n) (hM : 1 ≤ M)
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (w m alpha : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(laws : (Fin M → Bool) → CtyLaw)
(hsupport : ∀ omega, (laws omega).support = packingSquare)
(hm : 0 < m)
(hmass : ∀ omega j,
Measure.map snd (laws omega).law (packingCell centers w j) =
ofReal m)
(halpha : 0 ≤ alpha) (halpha' : 2 * alpha < 1)
(hpi : ∀ omega j,
klDiv
(compressedSampleLaw (laws omega) n (centers j))
(compressedSampleLaw
(laws (flipBit j omega)) n (centers j)) ≤
ofReal (alpha * log M)) :
ofReal ((1 / 2 : ℝ) *
(1 - exp (-((M : ℝ) ^ (1 - 2 * alpha)) / 2))) ≤
coordinatewiseErrorProbability
(fun j b => packingCellExperiment
(packingFinitePartition centers w hdis) laws (2 * n) j b)
(packingCommonExperiment
(packingFinitePartition centers w hdis) laws (2 * n))
(compressPackingCell centers)
(packingPoissonDecoder T centers values) := by
letI : StandardBorelSpace (FiniteSample (Observation × ℝ)) :=
finiteSample_standardBorelSpace
letI : StandardBorelSpace (FiniteSample ((ℝ × ℝ) × ℝ)) :=
finiteSample_standardBorelSpace
let p := packingFinitePartition centers w hdis
let Q : ∀ j : Fin M, Bool → Measure (FiniteSample (Observation × ℝ)) :=
fun j b => packingCellExperiment p laws (2 * n) j b
let R : Measure (Unit → FiniteSample (Observation × ℝ)) :=
packingCommonExperiment p laws (2 * n)
let compress : ∀ j : Fin M,
FiniteSample (Observation × ℝ) → FiniteSample ((ℝ × ℝ) × ℝ) :=
compressPackingCell centers
let decoder := packingPoissonDecoder T centers values
have hcompress : ∀ j, Measurable (compress j) :=
fun j => compressPackingCell_measurable centers j
have hdecoder : ∀ j, Measurable
(fun z : FiniteSample ((ℝ × ℝ) × ℝ) ×
(Fin M → FiniteSample (Observation × ℝ)) ×
(Unit → FiniteSample (Observation × ℝ)) =>
decoder j z.1 z.2.1 z.2.2) :=
fun j => packingPoissonDecoder_measurable T centers values j
have hlocal : ∀ j s z z' a,
(∀ k, k ≠ j → z k = z' k) →
decoder j s z a = decoder j s z' a := by
intro j s z z' a hz
exact packingPoissonDecoder_local T centers values j s z z' a hz
have hdp := (coordinatewise_overlap_direct_product hM Q R compress
hcompress decoder hdecoder hlocal).2 (2 * alpha) halpha'
have hkl : ∀ j,
klDiv
(compressedCoordinateLaw (compress j) (Q j false))
(compressedCoordinateLaw (compress j) (Q j true)) ≤
ofReal ((2 * alpha) * log M) := by
intro j
exact compressedPackingCellExperiment_klDiv_le hn hM centers w m alpha
hdis laws hsupport hm hmass halpha hpi j
rw [coordinatewiseErrorProbability_eq_one_sub_success Q R compress hcompress
decoder hdecoder]
exact hdp hkl
theorem assemblePackingDistanceBlocks_eq_globalMap
Reassembling the distance-compressed own cell with the other raw cells is the same as mapping the synthesized global configuration.
Formal statement
hypotheses
conclusion
assemblePackingDistanceBlocks centers j (compressPackingCell centers j (cells j)) cells common
= finiteSampleMap (packingMarkedDistance (centers j)) (synthesizePackingConfiguration (common, cells))
Proof (Lean source)
-- @node: assemblePackingDistanceBlocks_eq_globalMap
lemma assemblePackingDistanceBlocks_eq_globalMap {M : ℕ}
(centers : Fin M → Score) (j : Fin M)
(cells : Fin M → FiniteSample (Observation × ℝ))
(common : Unit → FiniteSample (Observation × ℝ)) :
assemblePackingDistanceBlocks centers j
(compressPackingCell centers j (cells j)) cells common =
finiteSampleMap (packingMarkedDistance (centers j))
(synthesizePackingConfiguration (common, cells)) := by
unfold assemblePackingDistanceBlocks compressPackingCell
synthesizePackingConfiguration superposeByMarks
rw [show finiteSampleMap (packingMarkedDistance (centers j)) (orderByMarks
(superpose ((MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (Observation × ℝ))).symm
(common, cells)))) =
orderByMarks (finiteSampleMap (packingMarkedDistance (centers j))
(superpose ((MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (Observation × ℝ))).symm
(common, cells)))) by rfl]
congr 1
change superpose _ = finiteSampleMap _ (superpose _)
rw [show finiteSampleMap (packingMarkedDistance (centers j))
(superpose ((MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (Observation × ℝ))).symm
(common, cells))) =
superpose (fun k => finiteSampleMap (packingMarkedDistance (centers j))
(((MeasurableEquiv.sumPiEquivProdPi
(fun _ : Unit ⊕ Fin M => FiniteSample (Observation × ℝ))).symm
(common, cells)) k)) by rfl]
congr 1
funext k
cases k with
| inl u => rfl
| inr k =>
change (if k = j then finiteSampleMap _ (cells j)
else finiteSampleMap _ (cells k)) = finiteSampleMap _ (cells k)
by_cases h : k = j <;> simp [h]
def globalPackingPoissonLoss
Maximum Poissonized center loss on a global marked configuration.
Definition (Lean source)
-- @node: globalPackingPoissonLoss
noncomputable def globalPackingPoissonLoss {M n : ℕ}
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool)
(s : FiniteSample (Observation × ℝ)) : ℝ≥0∞ :=
⨆ j, ofReal
|globalPackingPoissonValue T (centers j) s - values j (omega j)|
theorem globalPackingPoissonLoss_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (globalPackingPoissonLoss T centers values omega)
Proof (Lean source)
lemma globalPackingPoissonLoss_measurable {M n : ℕ}
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool) :
Measurable (globalPackingPoissonLoss T centers values omega) := by
unfold globalPackingPoissonLoss
apply Measurable.iSup
intro j
exact Measurable.ennreal_ofReal
(((globalPackingPoissonValue_measurable T (centers j)).sub_const _).abs)
def blockPackingPoissonLoss
The corresponding loss on the independent common/cell blocks.
Definition (Lean source)
-- @node: blockPackingPoissonLoss
noncomputable def blockPackingPoissonLoss {M n : ℕ}
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool)
(data : (Unit → FiniteSample (Observation × ℝ)) ×
(Fin M → FiniteSample (Observation × ℝ))) : ℝ≥0∞ :=
⨆ j, ofReal
|packingPoissonValue T centers j
(compressPackingCell centers j (data.2 j)) data.2 data.1 -
values j (omega j)|
theorem blockPackingPoissonLoss_measurable
The stated statistic is a measurable function of the observed data, so it is a valid random quantity.
Formal statement
hypotheses
conclusion
Measurable (blockPackingPoissonLoss T centers values omega)
Proof (Lean source)
lemma blockPackingPoissonLoss_measurable {M n : ℕ}
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool) :
Measurable (blockPackingPoissonLoss T centers values omega) := by
unfold blockPackingPoissonLoss
apply Measurable.iSup
intro j
apply Measurable.ennreal_ofReal
apply Measurable.abs
apply Measurable.sub_const
have hm := (packingPoissonValue_measurable T centers j).comp
(((compressPackingCell_measurable centers j).comp
((measurable_pi_apply j).comp measurable_snd)).prodMk
(measurable_snd.prodMk measurable_fst))
exact hm
theorem blockPackingPoissonLoss_eq_global
The two stated constructions agree under the theorem's assumptions.
Formal statement
hypotheses
conclusion
blockPackingPoissonLoss T centers values omega data
= globalPackingPoissonLoss T centers values omega (synthesizePackingConfiguration data)
Proof (Lean source)
lemma blockPackingPoissonLoss_eq_global {M n : ℕ}
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (omega : Fin M → Bool)
(data : (Unit → FiniteSample (Observation × ℝ)) ×
(Fin M → FiniteSample (Observation × ℝ))) :
blockPackingPoissonLoss T centers values omega data =
globalPackingPoissonLoss T centers values omega
(synthesizePackingConfiguration data) := by
rcases data with ⟨common, cells⟩
unfold blockPackingPoissonLoss globalPackingPoissonLoss
congr 1
funext j
congr 2
unfold packingPoissonValue globalPackingPoissonValue
rw [assemblePackingDistanceBlocks_eq_globalMap]
rfl
theorem exists_vertex_poissonLoss_ge_coordinatewiseError
Averaging the direct-product decoder error selects one Boolean vertex whose canonical marked-Poisson maximum loss is at least separation/2 times the average error probability.
Formal statement
hypotheses
M n :
ℕ
T :
PIRule n
w m delta :
ℝ
hdis :
∀ i j
if
i ≠ j
then
hsupport :
∀ omega, (laws omega).support = packingSquare
hm :
0 < m
hmass :
∀ omega j,
hlocal :
∀ omega omega' j
if
omega j = omega' j
then
(laws omega).law.restrict {o | o.2 ∈ packingCell centers w j}
= (laws omega').law.restrict {o | o.2 ∈ packingCell centers w j}
hoff :
∀ omega omega',
(laws omega).law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
= (laws omega').law.restrict {o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j}
hvalues :
∀ omega j, (laws omega).mu (centers j) = values j (omega j)
conclusion
Proof (Lean source)
-- @node: exists_vertex_poissonLoss_ge_coordinatewiseError
lemma exists_vertex_poissonLoss_ge_coordinatewiseError {M n : ℕ}
(T : PIRule n) (centers : Fin M → Score)
(values : Fin M → Bool → ℝ) (w m delta : ℝ)
(hdis : ∀ i j, i ≠ j →
Disjoint (packingCell centers w i) (packingCell centers w j))
(laws : (Fin M → Bool) → CtyLaw)
(hsupport : ∀ omega, (laws omega).support = packingSquare)
(hm : 0 < m)
(hmass : ∀ omega j,
Measure.map snd (laws omega).law (packingCell centers w j) =
ofReal m)
(hlocal : ∀ omega omega' j, omega j = omega' j →
(laws omega).law.restrict {o | o.2 ∈ packingCell centers w j} =
(laws omega').law.restrict {o | o.2 ∈ packingCell centers w j})
(hoff : ∀ omega omega',
(laws omega).law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j} =
(laws omega').law.restrict
{o | o.2 ∈ packingSquare \ ⋃ j, packingCell centers w j})
(hvalues : ∀ omega j,
(laws omega).mu (centers j) = values j (omega j))
(hsep : ∀ j, delta ≤ |values j true - values j false|) :
∃ omega : Fin M → Bool,
letI : IsProbabilityMeasure (laws omega).law := (laws omega).law_isProbability
ofReal (delta / 2) *
coordinatewiseErrorProbability
(fun j b => packingCellExperiment
(packingFinitePartition centers w hdis) laws (2 * n) j b)
(packingCommonExperiment
(packingFinitePartition centers w hdis) laws (2 * n))
(compressPackingCell centers)
(packingPoissonDecoder T centers values) ≤
∫⁻ s, globalPackingPoissonLoss T centers values omega s
∂canonicalMarkedPoissonSampleLaw (laws omega).law packingMarkLaw (2 * n) := by
classical
letI lawProb (omega : Fin M → Bool) : IsProbabilityMeasure (laws omega).law :=
(laws omega).law_isProbability
let p := packingFinitePartition centers w hdis
let Q : ∀ j : Fin M, Bool → Measure (FiniteSample (Observation × ℝ)) :=
fun j b => packingCellExperiment p laws (2 * n) j b
let R : Measure (Unit → FiniteSample (Observation × ℝ)) :=
packingCommonExperiment p laws (2 * n)
let μ (omega : Fin M → Bool) := R.prod (Measure.pi fun j => Q j (omega j))
let bad (omega : Fin M → Bool) :=
{data : (Unit → FiniteSample (Observation × ℝ)) ×
(Fin M → FiniteSample (Observation × ℝ)) |
∃ j, packingPoissonDecoder T centers values j
(compressPackingCell centers j (data.2 j)) data.2 data.1 ≠ omega j}
let risk (omega : Fin M → Bool) :=
∫⁻ data, blockPackingPoissonLoss T centers values omega data ∂μ omega
have hrisk (omega : Fin M → Bool) :
ofReal (delta / 2) * μ omega (bad omega) ≤ risk omega := by
rw [← setLIntegral_const]
calc
(∫⁻ _ in bad omega, ofReal (delta / 2) ∂μ omega) ≤
∫⁻ data in bad omega,
blockPackingPoissonLoss T centers values omega data ∂μ omega := by
apply setLIntegral_mono
(blockPackingPoissonLoss_measurable T centers values omega)
intro data hdata
obtain ⟨j, hj⟩ := hdata
unfold blockPackingPoissonLoss
refine le_trans (ENNReal.ofReal_le_ofReal
(midpointDecoder_wrong_bit_error (values j)
(packingPoissonValue T centers j
(compressPackingCell centers j (data.2 j)) data.2 data.1)
delta (hsep j) (omega j) hj)) ?_
exact le_iSup (fun k : Fin M => ofReal
|packingPoissonValue T centers k
(compressPackingCell centers k (data.2 k)) data.2 data.1 -
values k (omega k)|) j
_ ≤ risk omega := by
exact setLIntegral_le_lintegral _ _
obtain ⟨omegaMax, -, hmax⟩ := Finset.exists_max_image
(Finset.univ : Finset (Fin M → Bool)) risk Finset.univ_nonempty
refine ⟨omegaMax, ?_⟩
have hsum : ofReal (delta / 2) *
(∑ omega : Fin M → Bool, μ omega (bad omega)) ≤
((2 : ℝ≥0∞) ^ M) * risk omegaMax := by
calc
ofReal (delta / 2) *
(∑ omega : Fin M → Bool, μ omega (bad omega)) =
∑ omega : Fin M → Bool,
ofReal (delta / 2) * μ omega (bad omega) := by
rw [Finset.mul_sum]
_ ≤ ∑ omega : Fin M → Bool, risk omega :=
Finset.sum_le_sum fun omega _ => hrisk omega
_ ≤ ∑ _omega : Fin M → Bool, risk omegaMax :=
Finset.sum_le_sum fun omega homega => hmax omega homega
_ = ((2 : ℝ≥0∞) ^ M) * risk omegaMax := by
simp [Fintype.card_fun]
have hpow : (2 : ℝ≥0∞) ^ M ≠ 0 := pow_ne_zero _ (by norm_num)
have hpowtop : (2 : ℝ≥0∞) ^ M ≠ ⊤ :=
ENNReal.pow_ne_top ENNReal.ofNat_ne_top
have havg : ofReal (delta / 2) *
((∑ omega : Fin M → Bool, μ omega (bad omega)) /
((2 : ℝ≥0∞) ^ M)) ≤ risk omegaMax := by
rw [← mul_div_assoc]
apply (ENNReal.div_le_iff_le_mul (inl hpow) (inl hpowtop)).2
simpa [mul_comm] using hsum
have hsynth := packingExperiment_synthesis_law centers w m hdis laws hm
hmass hlocal hsupport hoff (2 * n) omegaMax
have hriskEq : risk omegaMax =
∫⁻ s, globalPackingPoissonLoss T centers values omegaMax s
∂canonicalMarkedPoissonSampleLaw (laws omegaMax).law packingMarkLaw (2 * n) := by
unfold risk μ R Q p
rw [← hsynth]
rw [lintegral_map'
(globalPackingPoissonLoss_measurable T centers values omegaMax).aemeasurable
synthesizePackingConfiguration_measurable.aemeasurable]
apply lintegral_congr
intro data
exact blockPackingPoissonLoss_eq_global T centers values omegaMax data
rw [← hriskEq]
simpa [coordinatewiseErrorProbability, Q, R, μ, bad, p] using havg
Helpers.Poissonization 10 declarations This file specializes the shared finite-sample and de-Poissonization substrate to the accepted run’s observation law and frontier rate.
Run-specific Poissonization specializations
This file specializes the shared finite-sample and de-Poissonization substrate to the accepted run’s observation law and frontier rate.
def iidObservationStreamLaw
This declaration establishes the displayed property of the stated causal construction under its listed assumptions.
Definition (Lean source)
noncomputable def iidObservationStreamLaw (P : CtyLaw) : Measure (ℕ → Observation) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
exact iidStreamLaw P.law
instance iidObservationStreamLaw_isProbabilityMeasure
The infinite i.i.d. observation stream is a probability law.
Definition (Lean source)
instance iidObservationStreamLaw_isProbabilityMeasure (P : CtyLaw) :
IsProbabilityMeasure (iidObservationStreamLaw P) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
unfold iidObservationStreamLaw
infer_instance
theorem iidObservationStreamLaw_map_finPrefix
Every finite prefix of the infinite i.i.d. stream has the original product sample law.
Formal statement
Proof (Lean source)
lemma iidObservationStreamLaw_map_finPrefix (P : CtyLaw) (n : ℕ) :
Measure.map (fun z : ℕ → Observation => fun i : Fin n => z i)
(iidObservationStreamLaw P) = sampleLaw P n := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
simpa [iidObservationStreamLaw, sampleLaw] using
(iidStreamLaw_map_finPrefix P.law n)
def poissonIIDStreamLaw
A mean-2n count paired with an independent infinite i.i.d. observation stream. The first n stream coordinates implement the retained sample on the successful-count event.
Definition (Lean source)
noncomputable def poissonIIDStreamLaw (P : CtyLaw) (n : ℕ) :
Measure (ℕ × (ℕ → Observation)) :=
by
letI : IsProbabilityMeasure P.law := P.law_isProbability
exact poissonIIDStreamLaw P.law (2 * n)
instance poissonIIDStreamLaw_isProbabilityMeasure
The independent Poisson-count and i.i.d.-stream pairing is a probability law.
Definition (Lean source)
instance poissonIIDStreamLaw_isProbabilityMeasure (P : CtyLaw) (n : ℕ) :
IsProbabilityMeasure (poissonIIDStreamLaw P n) := by
unfold poissonIIDStreamLaw
infer_instance
theorem poissonIIDStreamLaw_map_count
The count coordinate of the stream construction is Poisson with mean 2n.
Formal statement
Proof (Lean source)
lemma poissonIIDStreamLaw_map_count (P : CtyLaw) (n : ℕ) :
Measure.map fst (poissonIIDStreamLaw P n) = poissonMeasure (2 * n) := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
simpa [poissonIIDStreamLaw] using
(poissonIIDStreamLaw_map_count
P.law (2 * n))
theorem poissonIIDStreamLaw_map_finPrefix
Taking the first n observations from the stream construction gives exactly the original i.i.d. sample law.
Formal statement
hypotheses
P :
n :
ℕ
conclusion
Measure.map (fun z : ℕ × (ℕ → Observation) => fun i : Fin n => z.2 i) (poissonIIDStreamLaw P n)
= sampleLaw P n
Proof (Lean source)
lemma poissonIIDStreamLaw_map_finPrefix (P : CtyLaw) (n : ℕ) :
Measure.map (fun z : ℕ × (ℕ → Observation) => fun i : Fin n => z.2 i)
(poissonIIDStreamLaw P n) = sampleLaw P n := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
simpa [poissonIIDStreamLaw, sampleLaw] using
(poissonIIDStreamLaw_map_finPrefix
P.law (2 * n) n)
def MarkedPoissonEmbedding
A coupling of a mean-2n Poisson count with an exactly i.i.d. retained sample of size n.
Definition (Lean source)
def MarkedPoissonEmbedding (P : CtyLaw) (n : ℕ) : Prop :=
∃ μ : Measure (ℕ × Sample n),
IsProbabilityMeasure μ ∧
Measure.map fst μ = poissonMeasure (2 * n) ∧
Measure.map snd μ = sampleLaw P n
theorem marked_mean_two_n_poisson_embedding
The marked mean-2n experiment can retain the n smallest marks and hence couple back to an exact P^n sample.
Formal statement
Proof (Lean source)
lemma marked_mean_two_n_poisson_embedding (P : CtyLaw) (n : ℕ) :
MarkedPoissonEmbedding P n := by
letI : IsProbabilityMeasure P.law := P.law_isProbability
let streamMap : ℕ × (ℕ → Observation) → ℕ × Sample n :=
fun z => (z.1, fun i => z.2 i)
let mu := Measure.map streamMap (poissonIIDStreamLaw P n)
have hstreamMap : Measurable streamMap := by fun_prop
refine ⟨mu, Measure.isProbabilityMeasure_map hstreamMap.aemeasurable, ?_, ?_⟩
· dsimp [mu]
rw [Measure.map_map (measurable_fst : Measurable (Prod.fst : ℕ × Sample n → ℕ))
hstreamMap,
show Prod.fst ∘ streamMap = Prod.fst by rfl,
poissonIIDStreamLaw_map_count]
· dsimp [mu]
rw [Measure.map_map (measurable_snd :
Measurable (Prod.snd : ℕ × Sample n → Sample n)) hstreamMap,
show Prod.snd ∘ streamMap =
(fun z : ℕ × (ℕ → Observation) => fun i : Fin n => z.2 i) by rfl,
poissonIIDStreamLaw_map_finPrefix]
theorem poisson_remainder_isLittleO_frontier
Read the first n observations from a configuration that is already in canonical mark order, forgetting the marks.
Formal statement
conclusion
Proof (Lean source)
-- @node: canonicalPrefixObservations
lemma poisson_remainder_isLittleO_frontier :
(fun n : ℕ => exp (-(n : ℝ) * (1 - log 2))) =o[atTop]
frontierRate := by
have ha : 0 < (1 - log 2 : ℝ) := by
linarith [Real.log_lt_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
(by norm_num : (2 : ℝ) ≠ 1)]
have hexp :
(fun n : ℕ => exp (-(1 - log 2) * (n : ℝ))) =o[atTop]
(fun n : ℕ => rpow (n : ℝ) (-(1 : ℝ) / 4)) := by
simpa [Function.comp_def] using
(isLittleO_exp_neg_mul_rpow_atTop ha (-(1 : ℝ) / 4)).comp_tendsto
tendsto_natCast_atTop_atTop
have hlog : ∀ᶠ n : ℕ in atTop, 1 ≤ log (n : ℝ) :=
(Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop).eventually_ge_atTop 1
have hnpos : ∀ᶠ n : ℕ in atTop, 1 ≤ n := eventually_ge_atTop 1
have hdom :
(fun n : ℕ => rpow (n : ℝ) (-(1 : ℝ) / 4)) =O[atTop]
frontierRate := by
rw [isBigO_iff]
refine ⟨1, ?_⟩
filter_upwards [hlog, hnpos] with n hlogn hn
have hnreal : (0 : ℝ) < n := by positivity
have hbase : (n : ℝ)⁻¹ ≤ log (n : ℝ) / (n : ℝ) := by
rw [inv_eq_one_div]
exact (div_le_div_iff_of_pos_right hnreal).2 hlogn
have hquot : 0 ≤ log (n : ℝ) / (n : ℝ) :=
div_nonneg (le_trans zero_le_one hlogn) hnreal.le
have hrpow := Real.rpow_le_rpow (inv_nonneg.mpr hnreal.le) hbase
(by norm_num : (0 : ℝ) ≤ 1 / 4)
change |(n : ℝ) ^ (-(1 : ℝ) / 4)| ≤
1 * |(log (n : ℝ) / (n : ℝ)) ^ ((1 : ℝ) / 4)|
rw [one_mul,
abs_of_nonneg (Real.rpow_nonneg hnreal.le (-(1 : ℝ) / 4)),
abs_of_nonneg (Real.rpow_nonneg hquot ((1 : ℝ) / 4)),
show -(1 : ℝ) / 4 = -(1 / 4 : ℝ) by ring,
Real.rpow_neg_eq_inv_rpow]
exact hrpow
have hexp' :
(fun n : ℕ => exp (-(n : ℝ) * (1 - log 2))) =o[atTop]
(fun n : ℕ => rpow (n : ℝ) (-(1 : ℝ) / 4)) := by
apply hexp.congr'
· filter_upwards with n
congr 1
ring
· exact EventuallyEq.rfl
exact hexp'.trans_isBigO hdom
Helpers.SquareBoundary 12 declarations This file gives an explicit piecewise-linear traversal of the boundary of the unit square and proves the Lipschitz and image properties needed by the CTY law class.
Rectifiable boundary of the packing square
This file gives an explicit piecewise-linear traversal of the boundary of the unit square and proves the Lipschitz and image properties needed by the CTY law class.
The horizontal coordinate of the counterclockwise square-boundary path.
Definition (Lean source)
-- @node: squareFrontierX
noncomputable def squareFrontierX (t : ℝ) : ℝ :=
min (1 / 2) (max (-1 / 2) (min (-1 / 2 + 4 * t) (5 / 2 - 4 * t)))
The vertical coordinate of the counterclockwise square-boundary path.
Definition (Lean source)
-- @node: squareFrontierY
noncomputable def squareFrontierY (t : ℝ) : ℝ :=
min (1 / 2) (max (-1 / 2) (min (-3 / 2 + 4 * t) (7 / 2 - 4 * t)))
An explicit traversal of the four edges of the unit square.
Definition (Lean source)
-- @node: squareFrontierParam
noncomputable def squareFrontierParam (t : ℝ) : Score :=
scorePoint (squareFrontierX t) (squareFrontierY t)
theorem squareFrontier_coordinates_lipschitz
Both scalar coordinates of the square-boundary path are globally 4-Lipschitz.
Formal statement
conclusion
Proof (Lean source)
-- @node: squareFrontier_coordinates_lipschitz
lemma squareFrontier_coordinates_lipschitz :
LipschitzWith 4 squareFrontierX ∧ LipschitzWith 4 squareFrontierY := by
have hfour : LipschitzWith 4 (fun t : ℝ => 4 * t) := by
apply LipschitzWith.of_dist_le_mul
intro s t
rw [Real.dist_eq, Real.dist_eq]
rw [show 4 * s - 4 * t = 4 * (s - t) by ring, abs_mul]
norm_num
have hnegfour : LipschitzWith 4 (fun t : ℝ => -4 * t) := by
apply LipschitzWith.of_dist_le_mul
intro s t
rw [Real.dist_eq, Real.dist_eq]
rw [show -4 * s - -4 * t = -4 * (s - t) by ring, abs_mul]
norm_num
constructor
· have hrise : LipschitzWith 4 (fun t : ℝ => -1 / 2 + 4 * t) := by
apply LipschitzWith.of_dist_le_mul
intro s t
simpa [Real.dist_eq, abs_mul, mul_comm] using hfour.dist_le_mul s t
have hfall : LipschitzWith 4 (fun t : ℝ => 5 / 2 - 4 * t) := by
apply LipschitzWith.of_dist_le_mul
intro s t
convert hnegfour.dist_le_mul s t using 1 <;> simp [Real.dist_eq]
rw [show 5 / 2 - 4 * s + 4 * t - 5 / 2 = -(4 * s - 4 * t) by ring,
abs_neg]
unfold squareFrontierX
convert ((hrise.min hfall).const_max (-1 / 2)).min_const (1 / 2) using 1 <;>
norm_num [min_comm]
· have hrise : LipschitzWith 4 (fun t : ℝ => -3 / 2 + 4 * t) := by
apply LipschitzWith.of_dist_le_mul
intro s t
simpa [Real.dist_eq, abs_mul, mul_comm] using hfour.dist_le_mul s t
have hfall : LipschitzWith 4 (fun t : ℝ => 7 / 2 - 4 * t) := by
apply LipschitzWith.of_dist_le_mul
intro s t
convert hnegfour.dist_le_mul s t using 1 <;> simp [Real.dist_eq]
rw [show 7 / 2 - 4 * s + 4 * t - 7 / 2 = -(4 * s - 4 * t) by ring,
abs_neg]
unfold squareFrontierY
convert ((hrise.min hfall).const_max (-1 / 2)).min_const (1 / 2) using 1 <;>
norm_num [min_comm]
theorem squareFrontierParam_lipschitz
The explicit square-boundary traversal is globally Lipschitz.
Formal statement
conclusion
Proof (Lean source)
-- @node: squareFrontierParam_lipschitz
lemma squareFrontierParam_lipschitz : LipschitzWith 8 squareFrontierParam := by
apply LipschitzWith.of_dist_le_mul
intro s t
have hx := squareFrontier_coordinates_lipschitz.1.dist_le_mul s t
have hy := squareFrontier_coordinates_lipschitz.2.dist_le_mul s t
have htri := dist_triangle
(scorePoint (squareFrontierX s) (squareFrontierY s))
(scorePoint (squareFrontierX t) (squareFrontierY s))
(scorePoint (squareFrontierX t) (squareFrontierY t))
rw [dist_scorePoint_same_second, dist_scorePoint_same_first] at htri
rw [squareFrontierParam, squareFrontierParam]
calc
_ ≤ |squareFrontierX s - squareFrontierX t| +
|squareFrontierY s - squareFrontierY t| := htri
_ ≤ (4 : ℝ) * dist s t + 4 * dist s t := add_le_add hx hy
_ = (8 : ℝ) * dist s t := by ring
A point is on the frontier of the unit square exactly when both coordinates are bounded by 1/2 and at least one coordinate is extremal.
Formal statement
Proof (Lean source)
-- @node: mem_frontier_scoreCube_half_iff
lemma mem_frontier_scoreCube_half_iff (x : Score) :
x ∈ frontier (scoreCube (1 / 2 : ℝ)) ↔
|x 0| ≤ 1 / 2 ∧ |x 1| ≤ 1 / 2 ∧
(|x 0| = 1 / 2 ∨ |x 1| = 1 / 2) := by
have hclosed : IsClosed (scoreCube (1 / 2 : ℝ)) := by
unfold scoreCube
rw [show {z : Score | ∀ i, |z i| ≤ (1 / 2 : ℝ)} =
⋂ i : Fin 2, {z : Score | |z i| ≤ (1 / 2 : ℝ)} by ext z; simp]
exact isClosed_iInter (fun i => isClosed_le
((PiLp.continuous_apply (p := 2) (β := fun _ : Fin 2 => ℝ) i).abs)
continuous_const)
constructor
· intro hx
have hmem : x ∈ scoreCube (1 / 2 : ℝ) := by
have := frontier_subset_closure hx
rw [hclosed.closure_eq] at this
exact this
have h0 := hmem (0 : Fin 2)
have h1 := hmem (1 : Fin 2)
refine ⟨h0, h1, ?_⟩
by_contra heq
push_neg at heq
have h0lt : |x 0| < 1 / 2 := lt_of_le_of_ne h0 heq.1
have h1lt : |x 1| < 1 / 2 := lt_of_le_of_ne h1 heq.2
let ε := min (1 / 2 - |x 0|) (1 / 2 - |x 1|)
have hε : 0 < ε := by
dsimp [ε]
exact lt_min (by linarith) (by linarith)
have hball : ball x ε ⊆ scoreCube (1 / 2 : ℝ) := by
intro y hy i
have hcoord : |y i - x i| ≤ dist y x := by
simpa [dist_eq_norm, Real.norm_eq_abs] using
(PiLp.norm_apply_le (y - x) i)
have hdist : dist y x < ε := by
simpa [Metric.mem_ball, dist_comm] using hy
have hmargin : ε ≤ 1 / 2 - |x i| := by
fin_cases i <;> simp [ε]
exact (calc
|y i| = |x i + (y i - x i)| := by congr 1 <;> ring
_ ≤ |x i| + |y i - x i| := abs_add_le _ _
_ ≤ |x i| + dist y x := by
simpa [add_comm] using add_le_add_left hcoord |x i|
_ < |x i| + ε := by simpa using add_lt_add_left hdist |x i|
_ ≤ 1 / 2 := by linarith).le
have hinterior : x ∈ interior (scoreCube (1 / 2 : ℝ)) := by
rw [mem_interior_iff_mem_nhds]
exact Filter.mem_of_superset (Metric.ball_mem_nhds x hε) hball
exact (mem_frontier_iff_notMem_interior hmem).mp hx hinterior
· rintro ⟨h0, h1, hedge⟩
have hmem : x ∈ scoreCube (1 / 2 : ℝ) := by
intro i
fin_cases i
· exact h0
· exact h1
rw [mem_frontier_iff_notMem_interior hmem]
intro hinterior
rw [mem_interior_iff_mem_nhds] at hinterior
obtain ⟨ε, hε, hball⟩ := Metric.mem_nhds_iff.mp hinterior
rcases hedge with hedge | hedge
· rcases (abs_eq (by norm_num : 0 ≤ (1 / 2 : ℝ))).mp hedge with hx0 | hx0
· let y := scorePoint (x 0 + ε / 2) (x 1)
have hxrepr : x = scorePoint (x 0) (x 1) := by
ext i
fin_cases i <;> simp [scorePoint]
have hydist : dist y x = ε / 2 := by
calc
dist y x = dist y (scorePoint (x 0) (x 1)) := congrArg (dist y) hxrepr
_ = ε / 2 := by
simp only [y]
rw [dist_scorePoint_same_second]
rw [show x 0 + ε / 2 - x 0 = ε / 2 by ring,
abs_of_pos (half_pos hε)]
have hyS := hball (show y ∈ ball x ε by
rw [Metric.mem_ball, hydist]
exact half_lt_self hε)
have := hyS (0 : Fin 2)
simp [y, scorePoint, hx0] at this
rw [abs_of_pos (by linarith : 0 < (2⁻¹ : ℝ) + ε / 2)] at this
linarith
· let y := scorePoint (x 0 - ε / 2) (x 1)
have hxrepr : x = scorePoint (x 0) (x 1) := by
ext i
fin_cases i <;> simp [scorePoint]
have hydist : dist y x = ε / 2 := by
calc
dist y x = dist y (scorePoint (x 0) (x 1)) := congrArg (dist y) hxrepr
_ = ε / 2 := by
simp only [y]
rw [dist_scorePoint_same_second]
rw [show x 0 - ε / 2 - x 0 = -(ε / 2) by ring, abs_neg,
abs_of_pos (half_pos hε)]
have hyS := hball (show y ∈ ball x ε by
rw [Metric.mem_ball, hydist]
exact half_lt_self hε)
have := hyS (0 : Fin 2)
simp [y, scorePoint, hx0] at this
rw [abs_of_neg (by linarith : (-2⁻¹ : ℝ) - ε / 2 < 0)] at this
linarith
· rcases (abs_eq (by norm_num : 0 ≤ (1 / 2 : ℝ))).mp hedge with hx1 | hx1
· let y := scorePoint (x 0) (x 1 + ε / 2)
have hxrepr : x = scorePoint (x 0) (x 1) := by
ext i
fin_cases i <;> simp [scorePoint]
have hydist : dist y x = ε / 2 := by
calc
dist y x = dist y (scorePoint (x 0) (x 1)) := congrArg (dist y) hxrepr
_ = ε / 2 := by
simp only [y]
rw [dist_scorePoint_same_first]
rw [show x 1 + ε / 2 - x 1 = ε / 2 by ring,
abs_of_pos (half_pos hε)]
have hyS := hball (show y ∈ ball x ε by
rw [Metric.mem_ball, hydist]
exact half_lt_self hε)
have := hyS (1 : Fin 2)
simp [y, scorePoint, hx1] at this
rw [abs_of_pos (by linarith : 0 < (2⁻¹ : ℝ) + ε / 2)] at this
linarith
· let y := scorePoint (x 0) (x 1 - ε / 2)
have hxrepr : x = scorePoint (x 0) (x 1) := by
ext i
fin_cases i <;> simp [scorePoint]
have hydist : dist y x = ε / 2 := by
calc
dist y x = dist y (scorePoint (x 0) (x 1)) := congrArg (dist y) hxrepr
_ = ε / 2 := by
simp only [y]
rw [dist_scorePoint_same_first]
rw [show x 1 - ε / 2 - x 1 = -(ε / 2) by ring, abs_neg,
abs_of_pos (half_pos hε)]
have hyS := hball (show y ∈ ball x ε by
rw [Metric.mem_ball, hydist]
exact half_lt_self hε)
have := hyS (1 : Fin 2)
simp [y, scorePoint, hx1] at this
rw [abs_of_neg (by linarith : (-2⁻¹ : ℝ) - ε / 2 < 0)] at this
linarith
theorem squareFrontierParam_right_edge
The second quarter of the path parametrizes the right edge.
Formal statement
hypotheses
y :
ℝ
hy0 :
-(1 / 2) ≤ y
hy1 :
y ≤ 1 / 2
conclusion
squareFrontierParam ((y + 3 / 2) / 4) = scorePoint (1 / 2) y
Proof (Lean source)
-- @node: squareFrontierParam_right_edge
lemma squareFrontierParam_right_edge {y : ℝ} (hy0 : -(1 / 2) ≤ y)
(hy1 : y ≤ 1 / 2) :
squareFrontierParam ((y + 3 / 2) / 4) = scorePoint (1 / 2) y := by
have hy0' : (-1 / 2 : ℝ) ≤ y := by norm_num at hy0 ⊢; exact hy0
rw [squareFrontierParam]
apply congrArg₂ scorePoint
· unfold squareFrontierX
rw [show -1 / 2 + 4 * ((y + 3 / 2) / 4) = y + 1 by ring,
show 5 / 2 - 4 * ((y + 3 / 2) / 4) = 1 - y by ring]
exact min_eq_left ((le_min (by linarith) (by linarith)).trans (le_max_right _ _))
· unfold squareFrontierY
rw [show -3 / 2 + 4 * ((y + 3 / 2) / 4) = y by ring,
show 7 / 2 - 4 * ((y + 3 / 2) / 4) = 2 - y by ring]
have hinner : min y (2 - y) = y := min_eq_left (by linarith)
rw [hinner, max_eq_right hy0', min_eq_right hy1]
theorem squareFrontierParam_left_edge
The fourth quarter of the path parametrizes the left edge.
Formal statement
hypotheses
y :
ℝ
hy0 :
-(1 / 2) ≤ y
hy1 :
y ≤ 1 / 2
conclusion
squareFrontierParam ((7 / 2 - y) / 4) = scorePoint (-(1 / 2)) y
Proof (Lean source)
-- @node: squareFrontierParam_left_edge
lemma squareFrontierParam_left_edge {y : ℝ} (hy0 : -(1 / 2) ≤ y)
(hy1 : y ≤ 1 / 2) :
squareFrontierParam ((7 / 2 - y) / 4) = scorePoint (-(1 / 2)) y := by
have hy0' : (-1 / 2 : ℝ) ≤ y := by norm_num at hy0 ⊢; exact hy0
rw [squareFrontierParam]
apply congrArg₂ scorePoint
· unfold squareFrontierX
rw [show -1 / 2 + 4 * ((7 / 2 - y) / 4) = 3 - y by ring,
show 5 / 2 - 4 * ((7 / 2 - y) / 4) = y - 1 by ring]
have hinner : min (3 - y) (y - 1) = y - 1 := min_eq_right (by linarith)
rw [hinner, max_eq_left (by linarith), min_eq_right (by norm_num)]
norm_num
· unfold squareFrontierY
rw [show -3 / 2 + 4 * ((7 / 2 - y) / 4) = 2 - y by ring,
show 7 / 2 - 4 * ((7 / 2 - y) / 4) = y by ring]
have hinner : min (2 - y) y = y := min_eq_right (by linarith)
rw [hinner, max_eq_right hy0', min_eq_right hy1]
theorem squareFrontierParam_top_edge
The third quarter of the path parametrizes the top edge.
Formal statement
hypotheses
x :
ℝ
hx0 :
-(1 / 2) ≤ x
hx1 :
x ≤ 1 / 2
conclusion
squareFrontierParam ((5 / 2 - x) / 4) = scorePoint x (1 / 2)
Proof (Lean source)
-- @node: squareFrontierParam_top_edge
lemma squareFrontierParam_top_edge {x : ℝ} (hx0 : -(1 / 2) ≤ x)
(hx1 : x ≤ 1 / 2) :
squareFrontierParam ((5 / 2 - x) / 4) = scorePoint x (1 / 2) := by
have hx0' : (-1 / 2 : ℝ) ≤ x := by norm_num at hx0 ⊢; exact hx0
rw [squareFrontierParam]
apply congrArg₂ scorePoint
· unfold squareFrontierX
rw [show -1 / 2 + 4 * ((5 / 2 - x) / 4) = 2 - x by ring,
show 5 / 2 - 4 * ((5 / 2 - x) / 4) = x by ring]
have hinner : min (2 - x) x = x := min_eq_right (by linarith)
rw [hinner, max_eq_right hx0', min_eq_right hx1]
· unfold squareFrontierY
rw [show -3 / 2 + 4 * ((5 / 2 - x) / 4) = 1 - x by ring,
show 7 / 2 - 4 * ((5 / 2 - x) / 4) = 1 + x by ring]
exact min_eq_left ((le_min (by linarith) (by linarith)).trans (le_max_right _ _))
theorem squareFrontierParam_bottom_edge
The first quarter of the path parametrizes the bottom edge.
Formal statement
hypotheses
x :
ℝ
hx0 :
-(1 / 2) ≤ x
hx1 :
x ≤ 1 / 2
conclusion
squareFrontierParam ((x + 1 / 2) / 4) = scorePoint x (-(1 / 2))
Proof (Lean source)
-- @node: squareFrontierParam_bottom_edge
lemma squareFrontierParam_bottom_edge {x : ℝ} (hx0 : -(1 / 2) ≤ x)
(hx1 : x ≤ 1 / 2) :
squareFrontierParam ((x + 1 / 2) / 4) = scorePoint x (-(1 / 2)) := by
have hx0' : (-1 / 2 : ℝ) ≤ x := by norm_num at hx0 ⊢; exact hx0
rw [squareFrontierParam]
apply congrArg₂ scorePoint
· unfold squareFrontierX
rw [show -1 / 2 + 4 * ((x + 1 / 2) / 4) = x by ring,
show 5 / 2 - 4 * ((x + 1 / 2) / 4) = 2 - x by ring]
have hinner : min x (2 - x) = x := min_eq_left (by linarith)
rw [hinner, max_eq_right hx0', min_eq_right hx1]
· unfold squareFrontierY
rw [show -3 / 2 + 4 * ((x + 1 / 2) / 4) = x - 1 by ring,
show 7 / 2 - 4 * ((x + 1 / 2) / 4) = 3 - x by ring]
have hinner : min (x - 1) (3 - x) = x - 1 := min_eq_left (by linarith)
rw [hinner, max_eq_left (by linarith), min_eq_right (by norm_num)]
norm_num
theorem squareFrontierParam_image
The explicit path has exactly the frontier of the unit square as its image on the unit interval.
Formal statement
conclusion
Proof (Lean source)
-- @node: squareFrontierParam_image
lemma squareFrontierParam_image :
squareFrontierParam '' Icc (0 : ℝ) 1 = frontier (scoreCube (1 / 2 : ℝ)) := by
ext x
constructor
· rintro ⟨t, ht, rfl⟩
rw [mem_frontier_scoreCube_half_iff]
simp only [squareFrontierParam, scorePoint_apply_zero, scorePoint_apply_one]
have hxrange : |squareFrontierX t| ≤ (1 / 2 : ℝ) := by
rw [abs_le]
constructor
· have hbase : -(1 / 2 : ℝ) ≤ (-1 / 2 : ℝ) := by norm_num
unfold squareFrontierX
exact le_min (by norm_num) (hbase.trans (le_max_left _ _))
· exact min_le_left _ _
have hyrange : |squareFrontierY t| ≤ (1 / 2 : ℝ) := by
rw [abs_le]
constructor
· have hbase : -(1 / 2 : ℝ) ≤ (-1 / 2 : ℝ) := by norm_num
unfold squareFrontierY
exact le_min (by norm_num) (hbase.trans (le_max_left _ _))
· exact min_le_left _ _
refine ⟨hxrange, hyrange, ?_⟩
rcases le_total t (1 / 4 : ℝ) with ht1 | ht1
· have hy : squareFrontierY t = (-1 / 2 : ℝ) := by
have hylo : -3 / 2 + 4 * t ≤ -1 / 2 := by linarith
have hyhi : -3 / 2 + 4 * t ≤ 7 / 2 - 4 * t := by linarith [ht.2]
rw [squareFrontierY, min_eq_left hyhi, max_eq_left hylo]
norm_num
exact inr (by rw [hy]; norm_num)
· rcases le_total t (1 / 2 : ℝ) with ht2 | ht2
· have hx : squareFrontierX t = (1 / 2 : ℝ) := by
have hxrise : 1 / 2 ≤ -1 / 2 + 4 * t := by linarith
have hxfall : 1 / 2 ≤ 5 / 2 - 4 * t := by linarith
rw [squareFrontierX, min_eq_left]
exact (le_min hxrise hxfall).trans (le_max_right _ _)
exact inl (by rw [hx]; norm_num)
· rcases le_total t (3 / 4 : ℝ) with ht3 | ht3
· have hy : squareFrontierY t = (1 / 2 : ℝ) := by
have hyrise : 1 / 2 ≤ -3 / 2 + 4 * t := by linarith
have hyfall : 1 / 2 ≤ 7 / 2 - 4 * t := by linarith
rw [squareFrontierY, min_eq_left]
exact (le_min hyrise hyfall).trans (le_max_right _ _)
exact inr (by rw [hy]; norm_num)
· have hx : squareFrontierX t = (-1 / 2 : ℝ) := by
have hxlo : 5 / 2 - 4 * t ≤ -1 / 2 := by linarith
have hxord : 5 / 2 - 4 * t ≤ -1 / 2 + 4 * t := by linarith
rw [squareFrontierX, min_eq_right hxord, max_eq_left hxlo]
norm_num
exact inl (by rw [hx]; norm_num)
· intro hx
rcases (mem_frontier_scoreCube_half_iff x).mp hx with ⟨h0, h1, hedge⟩
rw [abs_le] at h0 h1
rcases hedge with hedge | hedge
· rcases (abs_eq (by norm_num : 0 ≤ (1 / 2 : ℝ))).mp hedge with hx0 | hx0
· refine ⟨(x 1 + 3 / 2) / 4, ⟨by linarith, by linarith⟩, ?_⟩
rw [squareFrontierParam_right_edge h1.1 h1.2]
ext i
fin_cases i <;> simp [scorePoint, hx0]
· refine ⟨(7 / 2 - x 1) / 4, ⟨by linarith, by linarith⟩, ?_⟩
rw [squareFrontierParam_left_edge h1.1 h1.2]
ext i
fin_cases i <;> simp [scorePoint, hx0]
· rcases (abs_eq (by norm_num : 0 ≤ (1 / 2 : ℝ))).mp hedge with hx1 | hx1
· refine ⟨(5 / 2 - x 0) / 4, ⟨by linarith, by linarith⟩, ?_⟩
rw [squareFrontierParam_top_edge h0.1 h0.2]
ext i
fin_cases i <;> simp [scorePoint, hx1]
· refine ⟨(x 0 + 1 / 2) / 4, ⟨by linarith, by linarith⟩, ?_⟩
rw [squareFrontierParam_bottom_edge h0.1 h0.2]
ext i
fin_cases i <;> simp [scorePoint, hx1]
theorem packingSquare_rectifiableBoundary
The boundary of the packing square is rectifiable, witnessed by the explicit eight-Lipschitz traversal above.
Formal statement
conclusion
RectifiableBoundary (scoreCube (1 / 2 : ℝ))
Proof (Lean source)
-- @node: packingSquare_rectifiableBoundary
lemma packingSquare_rectifiableBoundary :
RectifiableBoundary (scoreCube (1 / 2 : ℝ)) := by
refine ⟨8, squareFrontierParam, squareFrontierParam_lipschitz.lipschitzOnWith, ?_⟩
exact squareFrontierParam_image
T1_SameClassLogConverse 1 declarations The inherited common-map result uses the same finite-packing maximum as the point-indexed theorem.
CTY common-map same-class logarithmic converse
The inherited common-map result uses the same finite-packing maximum as the point-indexed theorem. Its identification of completed expectation with outer expectation uses Causalean's universal measurability of analytic sets.
The inherited CTY common-map minimax risk has a positive normalized liminf at the logarithmic distance rate on the same nonparametric law class.
Formal statement
hypotheses
q :
ℕ
L :
ℝ
hq :
1 ≤ q
hL :
4 ≤ L
conclusion
∃ cCTY : ℝ,
0 < cCTY ∧
Proof (Lean source)
theorem cty_same_class_log_converse
(q : ℕ) (L : ℝ) (hq : 1 ≤ q) (hL : 4 ≤ L) :
∃ cCTY : ℝ, 0 < cCTY ∧
liminf (scaledRisk (fun n => ctyDistanceRisk n q L)) atTop =
liminf (normalizedRisk (fun n => ctyDistanceRisk n q L)) atTop ∧
ofReal cCTY ≤
liminf (normalizedRisk (fun n => ctyDistanceRisk n q L)) atTop := by
obtain ⟨c, hc, _heq, hlower⟩ :=
point_indexed_distance_log_converse q L hq hL
refine ⟨c, hc, ?_, hlower.trans ?_⟩
· apply le_antisymm
· apply Filter.liminf_le_liminf
· exact scaledRisk_eventually_eq_normalizedRisk _ |>.le
· isBoundedDefault
· isBoundedDefault
· apply Filter.liminf_le_liminf
· exact scaledRisk_eventually_eq_normalizedRisk _ |>.symm.le
· isBoundedDefault
· isBoundedDefault
· apply Filter.liminf_le_liminf
· filter_upwards [] with n
unfold normalizedRisk
gcongr
exact ctyRisk_ge_pointIndexedRisk n q L
· isBoundedDefault
· isBoundedDefault
T2_PointIndexedLogConverse 2 declarations The headline theorem lower-bounds outer-expectation risk over the exact CTY law class while permitting arbitrary law-independent point-indexed families whose fixed-point sections are Borel measurable.
Point-indexed logarithmic converse
The headline theorem lower-bounds outer-expectation risk over the exact CTY law class while permitting arbitrary law-independent point-indexed families whose fixed-point sections are Borel measurable. No joint regularity in the point is assumed.
theorem pointIndexedDistanceRisk_eventually_lower
The finite angular packing gives an eventual positive multiple of the frontier rate uniformly over all point-indexed rules.
Formal statement
hypotheses
q :
ℕ
L :
ℝ
hq :
1 ≤ q
hL :
4 ≤ L
conclusion
Proof (Lean source)
lemma pointIndexedDistanceRisk_eventually_lower
(q : ℕ) (L : ℝ) (hq : 1 ≤ q) (hL : 4 ≤ L) :
∃ c : ℝ, 0 < c ∧ ∃ N : ℕ, ∀ n ≥ N,
ofReal (c * frontierRate n) ≤ pointIndexedDistanceRisk n q L := by
obtain ⟨c, hc, N, hN⟩ := packing_finite_max_lower_bound q L hq hL
refine ⟨c, hc, N, ?_⟩
intro n hn
unfold pointIndexedDistanceRisk
apply le_iInf
intro rho
apply le_iInf
intro hrho
obtain ⟨P, M, centers, hP, hcenters, hmeas, hlower⟩ := hN n hn rho hrho
refine hlower.trans ?_
have hpoint : finitePackingLoss rho P centers ≤ boundaryLoss rho P := by
intro w
unfold finitePackingLoss boundaryLoss
apply iSup_le
intro j
exact le_iSup_of_le (centers j) (le_iSup_of_le (hcenters j) le_rfl)
have houter :
(∫⁻ w, finitePackingLoss rho P centers w ∂sampleLaw P n) ≤
outerLIntegral (sampleLaw P n) (boundaryLoss rho P) :=
lintegral_le_outerLIntegral_of_measurable_le hpoint
exact houter.trans (le_iSup_of_le P (le_iSup_of_le hP le_rfl))
For every q ≥ 1 and L ≥ 4, the point-indexed outer-expectation minimax risk has a positive normalized liminf at the logarithmic distance rate.
Formal statement
Proof (Lean source)
theorem point_indexed_distance_log_converse
(q : ℕ) (L : ℝ) (hq : 1 ≤ q) (hL : 4 ≤ L) :
∃ cPI : ℝ, 0 < cPI ∧
liminf
(scaledRisk (fun n => pointIndexedDistanceRisk n q L)) atTop =
liminf
(normalizedRisk (fun n => pointIndexedDistanceRisk n q L)) atTop ∧
ofReal cPI ≤
liminf
(normalizedRisk (fun n => pointIndexedDistanceRisk n q L)) atTop := by
obtain ⟨c, hc, N, hN⟩ := pointIndexedDistanceRisk_eventually_lower q L hq hL
refine ⟨c, hc, ?_, ?_⟩
· apply le_antisymm
· apply Filter.liminf_le_liminf
· exact scaledRisk_eventually_eq_normalizedRisk _ |>.le
· isBoundedDefault
· isBoundedDefault
· apply Filter.liminf_le_liminf
· exact scaledRisk_eventually_eq_normalizedRisk _ |>.symm.le
· isBoundedDefault
· isBoundedDefault
· apply le_liminf_of_le
· isBoundedDefault
· filter_upwards [eventually_ge_atTop (max N 2)] with n hn
have hnN : N ≤ n := le_trans (le_max_left _ _) hn
have hn2 : 2 ≤ n := le_trans (le_max_right _ _) hn
have hrate0 : ofReal (frontierRate n) ≠ 0 := by
simpa only [ne_eq, ENNReal.ofReal_eq_zero, not_le] using frontierRate_pos hn2
unfold normalizedRisk
apply (ENNReal.le_div_iff_mul_le
(inl hrate0) (inl ENNReal.ofReal_ne_top)).2
rw [← ENNReal.ofReal_mul hc.le]
exact hN n hnN