diff --git a/Carleson/DiscreteCarleson.lean b/Carleson/DiscreteCarleson.lean index aa8322b6..2efa6dda 100644 --- a/Carleson/DiscreteCarleson.lean +++ b/Carleson/DiscreteCarleson.lean @@ -741,10 +741,145 @@ lemma top_tiles : βˆ‘ m ∈ Finset.univ.filter (Β· ∈ 𝔐 (X := X) k n), volum end TopTiles +section π”˜ +-- Definition of function `π”˜(m)` used in the proof of Lemma 5.2.8, and some properties of `π”˜(m)` + +open Finset + +variable (k) (n) (j) (x) +private def π”˜ (m : 𝔓 X) := (π”˜β‚ k n j).toFinset.filter (fun u ↦ x ∈ π“˜ u ∧ smul 100 u ≀ smul 1 m) + +-- Ball that covers the image of `𝒬`. Radius chosen for convenience with `BallsCoverBalls.pow_mul` +private def big_ball (m : 𝔓 X) (u : 𝔓 X) := ball_(u) (𝒬 m) (2 ^ 9 * 0.2) + +variable {k} {n} {j} {x} +variable {x : X} {m u u' u'' : 𝔓 X} +variable (hu : u ∈ π”˜ k n j x m) (hu' : u' ∈ π”˜ k n j x m) (hu'' : u'' ∈ π”˜ k n j x m) + +private lemma x_mem_π“˜u : x ∈ (π“˜ u) := by + simp only [π”˜, mem_filter] at hu + exact hu.2.1 + +private lemma 𝒬m_mem_ball : 𝒬 m ∈ ball_(u) (𝒬 u) 100 := by + simp only [π”˜, mem_filter, smul] at hu + exact hu.2.2.2 (by simp) + +private lemma π“˜_not_lt_π“˜ : Β¬ π“˜ u < π“˜ u' := by + intro h + rw [Grid.lt_def] at h + have 𝒬m_mem_inter := mem_inter (𝒬m_mem_ball hu) (𝒬m_mem_ball hu') + simp only [π”˜, π”˜β‚, Grid.lt_def, and_imp, toFinset_setOf, mem_filter] at hu + exact not_disjoint_iff_nonempty_inter.2 (nonempty_of_mem 𝒬m_mem_inter) <| hu.1.2.2 + u' (mem_toFinset.mp (mem_filter.mp hu').1).1 h.1 h.2 + +private lemma π“˜_eq_π“˜ : π“˜ u = π“˜ u' := + have not_disj := Set.not_disjoint_iff.mpr ⟨x, ⟨x_mem_π“˜u hu, x_mem_π“˜u hu'⟩⟩ + le_or_ge_or_disjoint.elim (fun h ↦ (h.lt_or_eq).resolve_left (π“˜_not_lt_π“˜ hu hu')) + (fun h ↦ ((h.resolve_right not_disj).lt_or_eq.resolve_left (π“˜_not_lt_π“˜ hu' hu)).symm) + +private lemma ball_eq_ball : ball_(u) = ball_(u') := by + rw [𝔠, 𝔰, π“˜_eq_π“˜ hu hu'] + +private lemma disjoint_balls (h : u' β‰  u'') : + Disjoint (ball_(u) (𝒬 u') 0.2) (ball_(u) (𝒬 u'') 0.2) := by + nth_rewrite 1 [ball_eq_ball hu hu', ball_eq_ball hu hu''] + convert cball_disjoint h (π“˜_eq_π“˜ hu' hu'') using 2 <;> norm_num + +private lemma mem_big_ball : 𝒬 u' ∈ big_ball m u := by + have : 𝒬 m ∈ ball_(u) (𝒬 u') 100 := ball_eq_ball hu hu' β–Έ 𝒬m_mem_ball hu' + rw [@mem_ball_comm] at this + simp only [big_ball, mem_ball] at this ⊒ + exact this.trans (by norm_num) + +private lemma subset_big_ball (f : Θ X) (hf : f ∈ (π”˜ k n j x m).image 𝒬) : f ∈ big_ball m u := by + simp_rw [Finset.mem_image] at hf + rcases hf with ⟨u', hu', rfl⟩ + exact mem_big_ball hu hu' + +variable (m) (u : 𝔓 X) in +private lemma balls_cover_big_ball : CoveredByBalls (big_ball m u) (defaultA a ^ 9) 0.2 := + BallsCoverBalls.pow_mul (fun _ ↦ CompatibleFunctions.ballsCoverBalls) (𝒬 m) + +private lemma 𝒬_injOn_π”˜m : InjOn 𝒬 (π”˜ k n j x m).toSet := + fun _ hu _ hu' h ↦ 𝒬_inj h (π“˜_eq_π“˜ hu hu') + +private lemma card_π”˜m_le : (π”˜ k n j x m).card ≀ (defaultA a) ^ 9 := by + by_cases h : π”˜ k n j x m = βˆ… + Β· simp [h] + have ⟨u, hu⟩ := Finset.nonempty_of_ne_empty h + let pm := instPseudoMetricSpaceWithFunctionDistance (x := 𝔠 u) (r := (D ^ 𝔰 u / 4)) + have βŸ¨π“‘, 𝓑_card_le, 𝓑_cover⟩ := balls_cover_big_ball m u + let 𝓕 (f : Θ X) := ((π”˜ k n j x m).image 𝒬).filter (Β· ∈ @ball _ pm f 0.2) + -- `𝒬` is 1-1, `𝓑.biUnion 𝓕` covers `(π”˜ k n j x m).image 𝒬`, and each `𝓕 f` has cardinality + -- ≀ 1, so `(π”˜ k n j x m).card = ((π”˜ k n j x m).image 𝒬).card ≀ (𝓑.biUnion 𝓕).card ≀ 𝓑.card` + have π’¬π”˜_eq_union: (π”˜ k n j x m).image 𝒬 = 𝓑.biUnion 𝓕 := by + ext f + simp only [𝓕, Finset.mem_biUnion, mem_filter] + refine ⟨fun hf ↦ ?_, fun ⟨_, _, h, _⟩ ↦ h⟩ + obtain ⟨g, hg⟩ : βˆƒ g ∈ 𝓑, f ∈ @ball _ pm g 0.2 := by + simpa only [mem_iUnion, exists_prop] using 𝓑_cover (subset_big_ball hu f hf) + exact ⟨g, hg.1, hf, hg.2⟩ + have card_le_one : βˆ€ f ∈ 𝓑, (𝓕 f).card ≀ 1 := by + refine fun f _ ↦ card_le_one.mpr (fun g₁ hg₁ gβ‚‚ hgβ‚‚ ↦ ?_) + by_contra! h + simp only [mem_filter, 𝓕, Finset.mem_image] at hg₁ hgβ‚‚ + rcases hg₁.1 with ⟨u₁, hu₁, rfl⟩ + rcases hgβ‚‚.1 with ⟨uβ‚‚, huβ‚‚, rfl⟩ + apply Set.not_disjoint_iff.mpr ⟨f, mem_ball_comm.mp hg₁.2, mem_ball_comm.mp hgβ‚‚.2⟩ + exact disjoint_balls hu hu₁ huβ‚‚ (ne_of_apply_ne 𝒬 h) + rw [← card_image_iff.mpr 𝒬_injOn_π”˜m, π’¬π”˜_eq_union] + exact (mul_one 𝓑.card β–Έ card_biUnion_le_card_mul 𝓑 𝓕 1 card_le_one).trans 𝓑_card_le + +variable (k n j) (x) in +private def 𝔐' (u : 𝔓 X) := (𝔐 k n).toFinset.filter (fun m ↦ smul 100 u ≀ smul 1 m) + +-- Interchange the summations in the proof of Lemma 5.2.8 +private lemma interchange : + ((π”˜β‚ k n j).toFinset.filter (x ∈ π“˜ Β·)).sum (fun u ↦ (𝔐' k n u).sum + (fun m ↦ (π“˜ m : Set X).indicator (1 : X β†’ ℝ) x)) = + (𝔐 k n).toFinset.sum (fun m ↦ (π”˜ k n j x m).sum + (fun _ ↦ (π“˜ m : Set X).indicator (1 : X β†’ ℝ) x)) := + Finset.sum_comm' fun u m ↦ by simp only [𝔐', π”˜, Finset.mem_filter]; tauto + +end π”˜ + +-- Inequality (5.2.20) in the proof of Lemma 5.2.8 +private lemma indicator_le : βˆ€ u ∈ (π”˜β‚ k n j).toFinset.filter (x ∈ π“˜ Β·), + (π“˜ u : Set X).indicator 1 x ≀ (2 : ℝ) ^ (-j : β„€) * stackSize (𝔐' k n u) x := by + intro u hu + by_cases hx : x ∈ (π“˜ u : Set X); swap + Β· simp [hx] + suffices (2 : ℝ) ^ (j : β„€) ≀ stackSize (𝔐' k n u) x by calc + _ ≀ (2 : ℝ) ^ (-j : β„€) * (2 : ℝ) ^ (j : β„€) := by simp [hx] + _ ≀ (2 : ℝ) ^ (-j : β„€) * stackSize (𝔐' k n u) x := by gcongr + norm_cast + simp only [π”˜β‚, Finset.mem_filter, toFinset_setOf] at hu + apply le_of_le_of_eq hu.1.2.1.1.2 + simp only [Finset.coe_filter, mem_toFinset, 𝔐', Finset.card_eq_sum_ones] + refine Finset.sum_congr rfl (fun m hm ↦ ?_) + simp only [TileLike.le_def, smul_fst, Finset.mem_filter] at hm + simp [hm.2.2.1.1 hx] + +open Finset in /-- Lemma 5.2.8 -/ lemma tree_count : - stackSize (π”˜β‚ (X := X) k n j) x ≀ 2 ^ (9 * a - j) * stackSize (𝔐 (X := X) k n) x := by - sorry + stackSize (π”˜β‚ k n j) x ≀ (2 : ℝ) ^ (9 * a - j : β„€) * stackSize (𝔐 k n) x := by + -- When calculating the LHS, we need only sum over those `u` for which `x ∈ π“˜ u`. + have : βˆ‘ u ∈ univ.filter (Β· ∈ π”˜β‚ (X := X) k n j), (π“˜ u : Set X).indicator (1 : X β†’ ℝ) x = + βˆ‘ u ∈ (π”˜β‚ k n j).toFinset.filter (x ∈ π“˜ Β·), (π“˜ u : Set X).indicator (1 : X β†’ ℝ) x := by + rw [filter_mem_univ_eq_toFinset (π”˜β‚ k n j), sum_filter] + exact sum_congr rfl <| + fun u _ ↦ _root_.by_cases (p := x ∈ π“˜ u) (fun hx ↦ by simp [hx]) (fun hx ↦ by simpa [hx]) + rw [stackSize_real, this] + -- Use inequality (5.2.20) to bound the LHS by a double sum, then interchange the sums. + apply le_trans (sum_le_sum indicator_le) + simp_rw [← mul_sum, stackSize_real, mem_coe, filter_univ_mem, interchange, sum_const] + -- Replace the cardinality of `π”˜` with the upper bound proven in `card_π”˜m_le`, and simplify. + apply le_of_le_of_eq <| (mul_le_mul_left (zpow_pos_of_pos two_pos _)).mpr <| sum_le_sum <| + fun _ _ ↦ smul_le_smul_of_nonneg_right card_π”˜m_le <| Set.indicator_apply_nonneg (by simp) + simp_rw [← smul_sum, nsmul_eq_mul, ← mul_assoc, filter_mem_univ_eq_toFinset (𝔐 k n), defaultA] + rw [sub_eq_add_neg, zpow_addβ‚€ two_ne_zero, ← pow_mul, mul_comm 9, mul_comm (2 ^ _)] + norm_cast variable (X) in /-- The constant in Lemma 5.2.9, with value `D ^ (1 - ΞΊ * Z * (n + 1))` -/ diff --git a/Carleson/Forest.lean b/Carleson/Forest.lean index 82ce3c06..db7b7247 100644 --- a/Carleson/Forest.lean +++ b/Carleson/Forest.lean @@ -32,6 +32,13 @@ lemma stackSize_mono (h : C βŠ† C') : stackSize C x ≀ stackSize C' x := by apply Finset.sum_le_sum_of_subset (fun x ↦ ?_) simp [iff_true_intro (@h x)] +-- Simplify the cast of `stackSize C x` from `β„•` to `ℝ` +lemma stackSize_real (C : Set (𝔓 X)) (x : X) : (stackSize C x : ℝ) = + βˆ‘ p ∈ Finset.univ.filter (Β· ∈ C), (π“˜ p : Set X).indicator (1 : X β†’ ℝ) x := by + rw [stackSize, Nat.cast_sum] + refine Finset.sum_congr rfl (fun u _ ↦ ?_) + by_cases hx : x ∈ (π“˜ u : Set X) <;> simp [hx] + /-! We might want to develop some API about partitioning a set. But maybe `Set.PairwiseDisjoint` and `Set.Union` are enough. Related, but not quite useful: `Setoid.IsPartition`. -/ diff --git a/Carleson/TileStructure.lean b/Carleson/TileStructure.lean index 7953451f..9017846e 100644 --- a/Carleson/TileStructure.lean +++ b/Carleson/TileStructure.lean @@ -75,6 +75,10 @@ notation "ball_(" 𝔭 ")" => @ball (WithFunctionDistance (𝔠 𝔭) (D ^ 𝔰 @[simp] lemma cball_subset {p : 𝔓 X} : ball_(p) (𝒬 p) 5⁻¹ βŠ† Ξ© p := TileStructure.cball_subset @[simp] lemma subset_cball {p : 𝔓 X} : Ξ© p βŠ† ball_(p) (𝒬 p) 1 := TileStructure.subset_cball +lemma cball_disjoint {p p' : 𝔓 X} (h : p β‰  p') (hp : π“˜ p = π“˜ p') : + Disjoint (ball_(p) (𝒬 p) 5⁻¹) (ball_(p') (𝒬 p') 5⁻¹) := + disjoint_of_subset cball_subset cball_subset (disjoint_Ξ© h hp) + /-- The set `E` defined in Proposition 2.0.2. -/ def E (p : 𝔓 X) : Set X := { x ∈ π“˜ p | Q x ∈ Ξ© p ∧ 𝔰 p ∈ Icc (σ₁ x) (Οƒβ‚‚ x) } @@ -133,6 +137,10 @@ lemma toTileLike_le_smul : toTileLike p ≀ smul 5⁻¹ p := by lemma 𝒬_mem_Ξ© : 𝒬 p ∈ Ξ© p := cball_subset <| mem_ball_self <| by norm_num +lemma 𝒬_inj {p' : 𝔓 X} (h : 𝒬 p = 𝒬 p') (hπ“˜ : π“˜ p = π“˜ p') : p = p' := by + contrapose! h + exact fun h𝒬 ↦ (not_disjoint_iff.2 βŸ¨π’¬ p, 𝒬_mem_Ξ©, h𝒬 β–Έ 𝒬_mem_Ω⟩) (disjoint_Ξ© h hπ“˜) + lemma toTileLike_injective : Injective (fun p : 𝔓 X ↦ toTileLike p) := by intros p p' h simp_rw [toTileLike, TileLike, Prod.ext_iff] at h diff --git a/blueprint/src/chapter/main.tex b/blueprint/src/chapter/main.tex index 4d82be71..ca2f99de 100644 --- a/blueprint/src/chapter/main.tex +++ b/blueprint/src/chapter/main.tex @@ -2290,10 +2290,11 @@ \section{Proof of the Exceptional Sets Lemma} $B_{\fu}(\fcc(\fu),0.2)$ and $B_{\fu}(\fcc(\fu'),0.2)$, the ball $B'$ can contain at most -one of the points $\fu$, $\fu'$. +one of the points $\fcc(\fu)$, $\fcc(\fu')$. -Hence the set $\fU(\mathfrak{m})$ has at most -$2^{9a}$ many elements. +Hence the image of $\fU(\mathfrak{m})$ under $\fcc$ has at most +$2^{9a}$ elements; since $\fcc$ is injective on $\fU(\mathfrak{m})$, +the same is true of $\fU(\mathfrak{m})$. Inserting this into \eqref{usumbymsum} proves the lemma. \end{proof}