PrimeNumberTheoremAnd

The points of fromPoints s are exactly s. -/ lemma points_fromPoints {a b : ℝ} (s : Finset ℝ) (ha : a ∈ s) (hb : b ∈ s) (h_sub : (s : Set ℝ) ⊆ Set.Icc a b) : (fromPoints (a:=a) (b:=b) s ha hb h_sub).points = s := by classical -- replicate the local defs used in fromPoints, so we can reuse them let l : List ℝ := s.sort (· ≤ ·)

have hs_nonempty : s.Nonempty := ⟨a, ha⟩ have hlpos : 0 < l.length := by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr hs_nonempty)

let n : ℕ := l.length.pred have hn : n.succ = l.length := Nat.succ_pred_eq_of_pos hlpos have hn' : n + 1 = l.length := by simpa [Nat.succ_eq_add_one] using hn

ext y constructor · intro hy -- unfold points and fromPoints enough to get "y is some l.get ..." -- (we keep [l,n] in simp so it doesn't explode) have hy' : y ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i => l.get ⟨i.1, by -- this is exactly the bound proof used in fromPoints simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by -- this is what points is, after unfolding fromPoints simpa [IPartition.points, fromPoints, l, n] using hy

rcases Finset.mem_image.mp hy' with ⟨i, hiuniv, rfl⟩
-- Now show this list element is in s, since l = s.sort ...
have : l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩ ∈ l :=
  List.get_mem l _
-- Convert list-membership in l to finset-membership in s using mem_sort
exact (Finset.mem_sort (s := s) (r := (· ≤ ·))).1 (by simpa [l] using this)

· intro hy -- y ∈ s → y ∈ l have hyL : y ∈ l := (Finset.mem_sort (s := s) (r := (· ≤ ·))).2 (by simpa using hy) -- pick an index j with l.get j = y rcases List.mem_iff_get.mp hyL with ⟨j, rfl⟩

-- We need to show l.get j is in the image of x over Fin (n+1).
-- Use i := cast j into Fin (n+1).
let i : Fin (n + 1) := Fin.cast hn'.symm j

-- Unfold points/fromPoints and provide witness i
have : l.get j ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i =>
  l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by
  refine Finset.mem_image.mpr ?_
  refine ⟨i, Finset.mem_univ _, ?_⟩
  -- Compare the Fin indices used in the two gets
  -- j : Fin l.length, while the RHS uses ⟨i.1, _⟩ : Fin l.length.
  -- Show they are equal by Fin.ext (only vals matter).
  have hjlen : (⟨i.1, by
      -- i.2 : i.1 < n+1, rewrite via hn' to get i.1 < l.length
      simpa [hn', i] using i.2⟩ : Fin l.length) = j := by
    apply Fin.ext
    rfl
  -- Then the gets are equal
  simpa [hjlen]

-- now translate back to the original goal
simpa [IPartition.points, fromPoints, l, n] using this

/- The union of two partitions P and Q is the partition constructed from the union of their point sets. -/ def union {a b : ℝ} (P Q : IPartition a b) : IPartition a b := fromPoints (P.points ∪ Q.points) (by exact Finset.mem_union_left _ ( Finset.mem_image.mpr ⟨ 0, Finset.mem_univ _, P.left ⟩ )) (by exact Finset.mem_union.mpr ( Or.inl <| Finset.mem_image.mpr ⟨ Fin.last _, Finset.mem_univ _, P.right ⟩ )) (by -- Since $P$ and $Q$ are partitions of $[a, b]$, their points are within $[a, b]$. have hP : ∀ y ∈ P.points, y ∈ Set.Icc a b := by intro y hy; obtain ⟨ i, hi, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ P.monotone ( show 0 ≤ i from Nat.zero_le _ ), P.left ], by linarith [ P.monotone ( show i ≤ Fin.last P.n from Fin.le_last _ ), P.right ] ⟩ ; have hQ : ∀ y ∈ Q.points, y ∈ Set.Icc a b := by rintro y hy; obtain ⟨ i, _, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ Q.left, Q.right, Q.monotone ( show 0 ≤ i from Nat.zero_le _ ) ], by linarith [ Q.left, Q.right, Q.monotone ( show i ≤ Fin.last Q.n from Fin.le_last _ ) ] ⟩ ; grind)

lemma union_points {a b : ℝ} (P Q : IPartition a b) : (union P Q).points = P.points ∪ Q.points := by -- unfolds to fromPoints on the finset union simp [union, points_fromPoints]

/- The union of two partitions refines both. -/

lemma union_refines_left {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) P := by -- goal: P.points ⊆ (union P Q).points -- i.e. P.points ⊆ P.points ∪ Q.points simpa [IsRefinement, union_points] using (Finset.subset_union_left : P.points ⊆ P.points ∪ Q.points)

lemma union_refines_right {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) Q := by simpa [IsRefinement, union_points] using (Finset.subset_union_right : Q.points ⊆ P.points ∪ Q.points)

/- The points of a partition constructed from a set of points are strictly increasing. -/ lemma fromPoints_strictMono {a b : ℝ} {s : Finset ℝ} {ha : a ∈ s} {hb : b ∈ s} {h_sub : (s : Set ℝ) ⊆ Set.Icc a b} : StrictMono (fromPoints s ha hb h_sub).x := by intro i j hij -- Let l be the sorted list of s let l := s.sort (· ≤ ·) -- n is l.length.pred, so n + 1 = l.length let n := l.length.pred have hn : n + 1 = l.length := Nat.succ_pred_eq_of_pos (by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr ⟨a, ha⟩)) -- The type of i, j is Fin (n + 1), so their values are < l.length -- The x function is l.get ⟨i.1, _⟩ have h_sorted : List.Sorted (· < ·) l := by convert Finset.sort_sorted_lt s using 1 -- Now, i < j in Fin (n + 1) means i.1 < j.1 < l.length -- So, l.get i.1 < l.get j.1 by strict sortedness -- Unfold the definition of IPart.fromPoints.x to see the indices dsimp [IPart.fromPoints] exact h_sorted.rel_get_of_lt hij

/- The points of the union of two partitions are strictly increasing. -/ lemma union_strictMono {a b : ℝ} (P Q : IPartition a b) : StrictMono (union P Q).x := by convert fromPoints_strictMono

/- If R is a strictly monotone partition refining P via index map k, then k maps 0 to 0. -/ lemma index_map_zero {a b : ℝ} {P R : IPartition a b} (hR : StrictMono R.x) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk_eq : ∀ i, R.x (k i) = P.x i) : k 0 = 0 := by -- Since $R$ is strictly monotone and $R.x (k 0) = a$, we have $k 0 = 0$. have h_k0_eq : R.x (k 0) = R.x 0 := by exact hk_eq 0 ▸ P.left.symm ▸ R.left.symm ▸ rfl; exact hR.injective h_k0_eq

/- If R refines P, there is a monotone index map k from P to R preserving the points.

The points of fromPoints s are exactly s. -/ lemma points_fromPoints {a b : ℝ} (s : Finset ℝ) (ha : a ∈ s) (hb : b ∈ s) (h_sub : (s : Set ℝ) ⊆ Set.Icc a b) : (fromPoints (a:=a) (b:=b) s ha hb h_sub).points = s := by classical -- replicate the local defs used in fromPoints, so we can reuse them let l : List ℝ := s.sort (· ≤ ·)

have hs_nonempty : s.Nonempty := ⟨a, ha⟩ have hlpos : 0 < l.length := by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr hs_nonempty)

let n : ℕ := l.length.pred have hn : n.succ = l.length := Nat.succ_pred_eq_of_pos hlpos have hn' : n + 1 = l.length := by simpa [Nat.succ_eq_add_one] using hn

ext y constructor · intro hy -- unfold points and fromPoints enough to get "y is some l.get ..." -- (we keep [l,n] in simp so it doesn't explode) have hy' : y ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i => l.get ⟨i.1, by -- this is exactly the bound proof used in fromPoints simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by -- this is what points is, after unfolding fromPoints simpa [IPartition.points, fromPoints, l, n] using hy

rcases Finset.mem_image.mp hy' with ⟨i, hiuniv, rfl⟩
-- Now show this list element is in s, since l = s.sort ...
have : l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩ ∈ l :=
  List.get_mem l _
-- Convert list-membership in l to finset-membership in s using mem_sort
exact (Finset.mem_sort (s := s) (r := (· ≤ ·))).1 (by simpa [l] using this)

· intro hy -- y ∈ s → y ∈ l have hyL : y ∈ l := (Finset.mem_sort (s := s) (r := (· ≤ ·))).2 (by simpa using hy) -- pick an index j with l.get j = y rcases List.mem_iff_get.mp hyL with ⟨j, rfl⟩

-- We need to show l.get j is in the image of x over Fin (n+1).
-- Use i := cast j into Fin (n+1).
let i : Fin (n + 1) := Fin.cast hn'.symm j

-- Unfold points/fromPoints and provide witness i
have : l.get j ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i =>
  l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by
  refine Finset.mem_image.mpr ?_
  refine ⟨i, Finset.mem_univ _, ?_⟩
  -- Compare the Fin indices used in the two gets
  -- j : Fin l.length, while the RHS uses ⟨i.1, _⟩ : Fin l.length.
  -- Show they are equal by Fin.ext (only vals matter).
  have hjlen : (⟨i.1, by
      -- i.2 : i.1 < n+1, rewrite via hn' to get i.1 < l.length
      simpa [hn', i] using i.2⟩ : Fin l.length) = j := by
    apply Fin.ext
    rfl
  -- Then the gets are equal
  simpa [hjlen]

-- now translate back to the original goal
simpa [IPartition.points, fromPoints, l, n] using this

/- The union of two partitions P and Q is the partition constructed from the union of their point sets. -/ def union {a b : ℝ} (P Q : IPartition a b) : IPartition a b := fromPoints (P.points ∪ Q.points) (by exact Finset.mem_union_left _ ( Finset.mem_image.mpr ⟨ 0, Finset.mem_univ _, P.left ⟩ )) (by exact Finset.mem_union.mpr ( Or.inl <| Finset.mem_image.mpr ⟨ Fin.last _, Finset.mem_univ _, P.right ⟩ )) (by -- Since $P$ and $Q$ are partitions of $[a, b]$, their points are within $[a, b]$. have hP : ∀ y ∈ P.points, y ∈ Set.Icc a b := by intro y hy; obtain ⟨ i, hi, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ P.monotone ( show 0 ≤ i from Nat.zero_le _ ), P.left ], by linarith [ P.monotone ( show i ≤ Fin.last P.n from Fin.le_last _ ), P.right ] ⟩ ; have hQ : ∀ y ∈ Q.points, y ∈ Set.Icc a b := by rintro y hy; obtain ⟨ i, _, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ Q.left, Q.right, Q.monotone ( show 0 ≤ i from Nat.zero_le _ ) ], by linarith [ Q.left, Q.right, Q.monotone ( show i ≤ Fin.last Q.n from Fin.le_last _ ) ] ⟩ ; grind)

lemma union_points {a b : ℝ} (P Q : IPartition a b) : (union P Q).points = P.points ∪ Q.points := by -- unfolds to fromPoints on the finset union simp [union, points_fromPoints]

/- The union of two partitions refines both. -/

lemma union_refines_left {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) P := by -- goal: P.points ⊆ (union P Q).points -- i.e. P.points ⊆ P.points ∪ Q.points simpa [IsRefinement, union_points] using (Finset.subset_union_left : P.points ⊆ P.points ∪ Q.points)

lemma union_refines_right {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) Q := by simpa [IsRefinement, union_points] using (Finset.subset_union_right : Q.points ⊆ P.points ∪ Q.points)

/- The points of a partition constructed from a set of points are strictly increasing. -/ lemma fromPoints_strictMono {a b : ℝ} {s : Finset ℝ} {ha : a ∈ s} {hb : b ∈ s} {h_sub : (s : Set ℝ) ⊆ Set.Icc a b} : StrictMono (fromPoints s ha hb h_sub).x := by intro i j hij -- Let l be the sorted list of s let l := s.sort (· ≤ ·) -- n is l.length.pred, so n + 1 = l.length let n := l.length.pred have hn : n + 1 = l.length := Nat.succ_pred_eq_of_pos (by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr ⟨a, ha⟩)) -- The type of i, j is Fin (n + 1), so their values are < l.length -- The x function is l.get ⟨i.1, _⟩ have h_sorted : List.Sorted (· < ·) l := by convert Finset.sort_sorted_lt s using 1 -- Now, i < j in Fin (n + 1) means i.1 < j.1 < l.length -- So, l.get i.1 < l.get j.1 by strict sortedness -- Unfold the definition of IPart.fromPoints.x to see the indices dsimp [IPart.fromPoints] exact h_sorted.rel_get_of_lt hij

/- The points of the union of two partitions are strictly increasing. -/ lemma union_strictMono {a b : ℝ} (P Q : IPartition a b) : StrictMono (union P Q).x := by convert fromPoints_strictMono

/- If R is a strictly monotone partition refining P via index map k, then k maps 0 to 0. -/ lemma index_map_zero {a b : ℝ} {P R : IPartition a b} (hR : StrictMono R.x) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk_eq : ∀ i, R.x (k i) = P.x i) : k 0 = 0 := by -- Since $R$ is strictly monotone and $R.x (k 0) = a$, we have $k 0 = 0$. have h_k0_eq : R.x (k 0) = R.x 0 := by exact hk_eq 0 ▸ P.left.symm ▸ R.left.symm ▸ rfl; exact hR.injective h_k0_eq

/- If R refines P, there is a monotone index map k from P to R preserving the points. -/ lemma refinement_index_map {a b : ℝ} (P R : IPartition a b) (h_ref : IsRefinement R P) : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by -- By definition of $IsRefinement$, there exists a monotone map $k$ from $P$ to $R$ such that $R.x (k i) = P.x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : (Fin (P.n + 1)) → (Fin (R.n + 1)), (∀ i, R.x (k i) = P.x i) ∧ Monotone k := by -- By definition of $IsRefinement$, there exists a monotone map $k$ from $P$ to $R$ such that $R.x (k i) = P.x i$ for all $i$. We can construct $k$ by taking the smallest index $j$ such that $R.x j = P.x i$. have h_exists_k : ∀ i : Fin (P.n + 1), ∃ j : Fin (R.n + 1), R.x j = P.x i := by intro i have h_exists_j : P.x i ∈ R.points := by exact h_ref <| Finset.mem_image_of_mem _ <| Finset.mem_univ _ obtain ⟨j, hj⟩ := Finset.mem_image.mp h_exists_j use j aesop; have h_exists_k : ∀ i : Fin (P.n + 1), ∃ j : Fin (R.n + 1), R.x j = P.x i ∧ ∀ k : Fin (R.n + 1), R.x k = P.x i → j ≤ k := by exact fun i => ⟨ Finset.min' ( Finset.univ.filter fun j => R.x j = P.x i ) ⟨ Classical.choose ( h_exists_k i ), Finset.mem_filter.mpr ⟨ Finset.mem_univ _, Classical.choose_spec ( h_exists_k i ) ⟩ ⟩, Finset.mem_filter.mp ( Finset.min'_mem ( Finset.univ.filter fun j => R.x j = P.x i ) ⟨ Classical.choose ( h_exists_k i ), Finset.mem_filter.mpr ⟨ Finset.mem_univ _, Classical.choose_spec ( h_exists_k i ) ⟩ ⟩ ) |>.2, fun k hk => Finset.min'_le _ _ ( by aesop ) ⟩; choose k hk₁ hk₂ using h_exists_k; refine' ⟨ k, hk₁, fun i j hij => _ ⟩; have h_monotone : ∀ i j : Fin (P.n + 1), i ≤ j → P.x i ≤ P.x j := by exact fun i j hij => P.monotone hij; have h_monotone_R : ∀ i j : Fin (R.n + 1), i ≤ j → R.x i ≤ R.x j := by exact fun i j hij => R.monotone hij; contrapose! h_monotone; exact ⟨ i, j, hij, by linarith [ hk₁ i, hk₁ j, h_monotone_R _ _ h_monotone.le, show R.x ( k j ) < R.x ( k i ) from lt_of_le_of_ne ( h_monotone_R _ _ h_monotone.le ) fun h => h_monotone.ne <| le_antisymm h_monotone.le <| hk₂ _ _ <| by aesop ] ⟩; exact ⟨ k, hk.2, hk.1 ⟩

/- The sum of term over Ico u v telescopes to g(v) - g(u). -/ def term (g : ℝ → ℝ) {a b : ℝ} (R : IPartition a b) (j : ℕ) : ℝ := if h : j + 1 < R.n + 1 then g (R.x ⟨j+1, h⟩) - g (R.x ⟨j, Nat.lt_of_succ_lt h⟩) else 0

lemma sum_telescope_block {a b : ℝ} (g : ℝ → ℝ) (R : IPartition a b) (u v : Fin (R.n + 1)) (huv : u ≤ v) : ∑ j ∈ Finset.Ico u.val v.val, term g R j = g (R.x v) - g (R.x u) := by unfold term; induction' v using Fin.inductionOn with v ih ; aesop; cases huv.eq_or_lt <;> simp_all +decide [ Fin.lt_iff_val_lt_val, Nat.lt_succ_iff ]; rw [ Finset.sum_Ico_succ_top ( by linarith ), ih ( Nat.le_trans ( Nat.le_refl _ ) ‹_› ) ]; simp +decide [ Fin.add_def, Nat.mod_eq_of_lt ] ; ring!

/- A sum over consecutive intervals [k i, k (i+1)) combines into a single sum over [k 0, k n).

The points of fromPoints s are exactly s. -/ lemma points_fromPoints {a b : ℝ} (s : Finset ℝ) (ha : a ∈ s) (hb : b ∈ s) (h_sub : (s : Set ℝ) ⊆ Set.Icc a b) : (fromPoints (a:=a) (b:=b) s ha hb h_sub).points = s := by classical -- replicate the local defs used in fromPoints, so we can reuse them let l : List ℝ := s.sort (· ≤ ·)

have hs_nonempty : s.Nonempty := ⟨a, ha⟩ have hlpos : 0 < l.length := by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr hs_nonempty)

let n : ℕ := l.length.pred have hn : n.succ = l.length := Nat.succ_pred_eq_of_pos hlpos have hn' : n + 1 = l.length := by simpa [Nat.succ_eq_add_one] using hn

ext y constructor · intro hy -- unfold points and fromPoints enough to get "y is some l.get ..." -- (we keep [l,n] in simp so it doesn't explode) have hy' : y ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i => l.get ⟨i.1, by -- this is exactly the bound proof used in fromPoints simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by -- this is what points is, after unfolding fromPoints simpa [IPartition.points, fromPoints, l, n] using hy

rcases Finset.mem_image.mp hy' with ⟨i, hiuniv, rfl⟩
-- Now show this list element is in s, since l = s.sort ...
have : l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩ ∈ l :=
  List.get_mem l _
-- Convert list-membership in l to finset-membership in s using mem_sort
exact (Finset.mem_sort (s := s) (r := (· ≤ ·))).1 (by simpa [l] using this)

· intro hy -- y ∈ s → y ∈ l have hyL : y ∈ l := (Finset.mem_sort (s := s) (r := (· ≤ ·))).2 (by simpa using hy) -- pick an index j with l.get j = y rcases List.mem_iff_get.mp hyL with ⟨j, rfl⟩

-- We need to show l.get j is in the image of x over Fin (n+1).
-- Use i := cast j into Fin (n+1).
let i : Fin (n + 1) := Fin.cast hn'.symm j

-- Unfold points/fromPoints and provide witness i
have : l.get j ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i =>
  l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by
  refine Finset.mem_image.mpr ?_
  refine ⟨i, Finset.mem_univ _, ?_⟩
  -- Compare the Fin indices used in the two gets
  -- j : Fin l.length, while the RHS uses ⟨i.1, _⟩ : Fin l.length.
  -- Show they are equal by Fin.ext (only vals matter).
  have hjlen : (⟨i.1, by
      -- i.2 : i.1 < n+1, rewrite via hn' to get i.1 < l.length
      simpa [hn', i] using i.2⟩ : Fin l.length) = j := by
    apply Fin.ext
    rfl
  -- Then the gets are equal
  simpa [hjlen]

-- now translate back to the original goal
simpa [IPartition.points, fromPoints, l, n] using this

/- The union of two partitions P and Q is the partition constructed from the union of their point sets. -/ def union {a b : ℝ} (P Q : IPartition a b) : IPartition a b := fromPoints (P.points ∪ Q.points) (by exact Finset.mem_union_left _ ( Finset.mem_image.mpr ⟨ 0, Finset.mem_univ _, P.left ⟩ )) (by exact Finset.mem_union.mpr ( Or.inl <| Finset.mem_image.mpr ⟨ Fin.last _, Finset.mem_univ _, P.right ⟩ )) (by -- Since $P$ and $Q$ are partitions of $[a, b]$, their points are within $[a, b]$. have hP : ∀ y ∈ P.points, y ∈ Set.Icc a b := by intro y hy; obtain ⟨ i, hi, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ P.monotone ( show 0 ≤ i from Nat.zero_le _ ), P.left ], by linarith [ P.monotone ( show i ≤ Fin.last P.n from Fin.le_last _ ), P.right ] ⟩ ; have hQ : ∀ y ∈ Q.points, y ∈ Set.Icc a b := by rintro y hy; obtain ⟨ i, _, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ Q.left, Q.right, Q.monotone ( show 0 ≤ i from Nat.zero_le _ ) ], by linarith [ Q.left, Q.right, Q.monotone ( show i ≤ Fin.last Q.n from Fin.le_last _ ) ] ⟩ ; grind)

lemma union_points {a b : ℝ} (P Q : IPartition a b) : (union P Q).points = P.points ∪ Q.points := by -- unfolds to fromPoints on the finset union simp [union, points_fromPoints]

/- The union of two partitions refines both. -/

lemma union_refines_left {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) P := by -- goal: P.points ⊆ (union P Q).points -- i.e. P.points ⊆ P.points ∪ Q.points simpa [IsRefinement, union_points] using (Finset.subset_union_left : P.points ⊆ P.points ∪ Q.points)

lemma union_refines_right {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) Q := by simpa [IsRefinement, union_points] using (Finset.subset_union_right : Q.points ⊆ P.points ∪ Q.points)

/- The points of a partition constructed from a set of points are strictly increasing. -/ lemma fromPoints_strictMono {a b : ℝ} {s : Finset ℝ} {ha : a ∈ s} {hb : b ∈ s} {h_sub : (s : Set ℝ) ⊆ Set.Icc a b} : StrictMono (fromPoints s ha hb h_sub).x := by intro i j hij -- Let l be the sorted list of s let l := s.sort (· ≤ ·) -- n is l.length.pred, so n + 1 = l.length let n := l.length.pred have hn : n + 1 = l.length := Nat.succ_pred_eq_of_pos (by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr ⟨a, ha⟩)) -- The type of i, j is Fin (n + 1), so their values are < l.length -- The x function is l.get ⟨i.1, _⟩ have h_sorted : List.Sorted (· < ·) l := by convert Finset.sort_sorted_lt s using 1 -- Now, i < j in Fin (n + 1) means i.1 < j.1 < l.length -- So, l.get i.1 < l.get j.1 by strict sortedness -- Unfold the definition of IPart.fromPoints.x to see the indices dsimp [IPart.fromPoints] exact h_sorted.rel_get_of_lt hij

/- The points of the union of two partitions are strictly increasing. -/ lemma union_strictMono {a b : ℝ} (P Q : IPartition a b) : StrictMono (union P Q).x := by convert fromPoints_strictMono

/- If R is a strictly monotone partition refining P via index map k, then k maps 0 to 0. -/ lemma index_map_zero {a b : ℝ} {P R : IPartition a b} (hR : StrictMono R.x) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk_eq : ∀ i, R.x (k i) = P.x i) : k 0 = 0 := by -- Since $R$ is strictly monotone and $R.x (k 0) = a$, we have $k 0 = 0$. have h_k0_eq : R.x (k 0) = R.x 0 := by exact hk_eq 0 ▸ P.left.symm ▸ R.left.symm ▸ rfl; exact hR.injective h_k0_eq

/- If R refines P, there is a monotone index map k from P to R preserving the points. -/ lemma refinement_index_map {a b : ℝ} (P R : IPartition a b) (h_ref : IsRefinement R P) : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by -- By definition of $IsRefinement$, there exists a monotone map $k$ from $P$ to $R$ such that $R.x (k i) = P.x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : (Fin (P.n + 1)) → (Fin (R.n + 1)), (∀ i, R.x (k i) = P.x i) ∧ Monotone k := by -- By definition of $IsRefinement$, there exists a monotone map $k$ from $P$ to $R$ such that $R.x (k i) = P.x i$ for all $i$. We can construct $k$ by taking the smallest index $j$ such that $R.x j = P.x i$. have h_exists_k : ∀ i : Fin (P.n + 1), ∃ j : Fin (R.n + 1), R.x j = P.x i := by intro i have h_exists_j : P.x i ∈ R.points := by exact h_ref <| Finset.mem_image_of_mem _ <| Finset.mem_univ _ obtain ⟨j, hj⟩ := Finset.mem_image.mp h_exists_j use j aesop; have h_exists_k : ∀ i : Fin (P.n + 1), ∃ j : Fin (R.n + 1), R.x j = P.x i ∧ ∀ k : Fin (R.n + 1), R.x k = P.x i → j ≤ k := by exact fun i => ⟨ Finset.min' ( Finset.univ.filter fun j => R.x j = P.x i ) ⟨ Classical.choose ( h_exists_k i ), Finset.mem_filter.mpr ⟨ Finset.mem_univ _, Classical.choose_spec ( h_exists_k i ) ⟩ ⟩, Finset.mem_filter.mp ( Finset.min'_mem ( Finset.univ.filter fun j => R.x j = P.x i ) ⟨ Classical.choose ( h_exists_k i ), Finset.mem_filter.mpr ⟨ Finset.mem_univ _, Classical.choose_spec ( h_exists_k i ) ⟩ ⟩ ) |>.2, fun k hk => Finset.min'_le _ _ ( by aesop ) ⟩; choose k hk₁ hk₂ using h_exists_k; refine' ⟨ k, hk₁, fun i j hij => _ ⟩; have h_monotone : ∀ i j : Fin (P.n + 1), i ≤ j → P.x i ≤ P.x j := by exact fun i j hij => P.monotone hij; have h_monotone_R : ∀ i j : Fin (R.n + 1), i ≤ j → R.x i ≤ R.x j := by exact fun i j hij => R.monotone hij; contrapose! h_monotone; exact ⟨ i, j, hij, by linarith [ hk₁ i, hk₁ j, h_monotone_R _ _ h_monotone.le, show R.x ( k j ) < R.x ( k i ) from lt_of_le_of_ne ( h_monotone_R _ _ h_monotone.le ) fun h => h_monotone.ne <| le_antisymm h_monotone.le <| hk₂ _ _ <| by aesop ] ⟩; exact ⟨ k, hk.2, hk.1 ⟩

/- The sum of term over Ico u v telescopes to g(v) - g(u). -/ def term (g : ℝ → ℝ) {a b : ℝ} (R : IPartition a b) (j : ℕ) : ℝ := if h : j + 1 < R.n + 1 then g (R.x ⟨j+1, h⟩) - g (R.x ⟨j, Nat.lt_of_succ_lt h⟩) else 0

lemma sum_telescope_block {a b : ℝ} (g : ℝ → ℝ) (R : IPartition a b) (u v : Fin (R.n + 1)) (huv : u ≤ v) : ∑ j ∈ Finset.Ico u.val v.val, term g R j = g (R.x v) - g (R.x u) := by unfold term; induction' v using Fin.inductionOn with v ih ; aesop; cases huv.eq_or_lt <;> simp_all +decide [ Fin.lt_iff_val_lt_val, Nat.lt_succ_iff ]; rw [ Finset.sum_Ico_succ_top ( by linarith ), ih ( Nat.le_trans ( Nat.le_refl _ ) ‹_› ) ]; simp +decide [ Fin.add_def, Nat.mod_eq_of_lt ] ; ring!

/- A sum over consecutive intervals [k i, k (i+1)) combines into a single sum over [k 0, k n). -/

lemma sum_partition_blocks {M : Type*} [AddCommMonoid M] (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k) (F : ℕ → M) : ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), F j = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), F j := by rw [ ← Finset.sum_biUnion ]; · rcongr j aesop; simp +zetaDelta at *; constructor <;> intro h all_goals generalize_proofs at *; · rcases h with ⟨ i, hi ⟩ ; exact ⟨ le_trans ( hk <| Nat.zero_le _ ) hi.1, hi.2.trans_le <| hk <| Fin.le_last _ ⟩ ; · contrapose! h; intro hj have h_ind : ∀ i : Fin (n + 1), k i ≤ j := by intro i induction' i using Fin.induction with i ih all_goals generalize_proofs at *; · exact hj; · exact h i ih generalize_proofs at *; exact h_ind (Fin.last n); · intro i _ j _ hij; simp_all +decide [ Fin.ext_iff ] ; cases lt_or_gt_of_ne hij <;> simp_all +decide [ Finset.disjoint_left, hk ]; · intro a ha₁ ha₂ ha₃; linarith [ hk ( show Fin.castSucc i ≤ Fin.castSucc j from Nat.le_of_lt ‹› ), hk ( show Fin.succ i ≤ Fin.castSucc j from Nat.succ_le_of_lt ‹› ) ] ; · exact fun a ha₁ ha₂ ha₃ => le_trans ( hk <| Nat.le_of_lt_succ <| by simpa [ Fin.castSucc_lt_succ ] using ‹j < i› ) ha₁

/- That was enough of a dive. Back to maths. Well, first, two trivial estimates.-/

/- The length of the i-th subinterval of a partition P is at most the mesh of P. -/ lemma mesh_ge_diff {a b : ℝ} (P : IPartition a b) (i : Fin P.n) : P.x i.succ - P.x i.castSucc ≤ P.mesh := by apply Basic.le_max_getD apply Finset.mem_image_of_mem exact Finset.mem_univ i

/- Helper lemmas: index_map_last shows the index map preserves the last element. exists_index_between shows that for any j in the range of k, there is an interval [k i, k (i+1)) containing j. -/ lemma index_map_last {a b : ℝ} {P R : IPartition a b} (hR : StrictMono R.x) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk_eq : ∀ i, R.x (k i) = P.x i) : k (Fin.last P.n) = Fin.last R.n := by -- Since $R.x$ is strictly monotone, the only way $R.x (k (Fin.last P.n)) = b$ can hold is if $k (Fin.last P.n)$ is the last element of $R$. have h_last : R.x (k (Fin.last P.n)) = R.x (Fin.last R.n) := by cases P ; cases R ; aesop; exact hR.injective h_last

lemma exists_index_between {n m : ℕ} (k : Fin (n + 1) → Fin (m + 1)) (hk : Monotone k) (hk0 : k 0 = 0) (hkn : k (Fin.last n) = Fin.last m) (j : Fin m) : ∃ i : Fin n, k i.castSucc ≤ j.castSucc ∧ j.castSucc < k i.succ := by by_contra h_contra; -- Since $k$ is monotone and $k 0 = 0$, we have $k i \le j$ for all $i$. have h_le : ∀ i : Fin (n + 1), k i ≤ Fin.castSucc j := by intro i; induction i using Fin.inductionOn <;> aesop; exact absurd ( h_le ( Fin.last n ) ) ( by simpa [ hkn ] using Fin.castSucc_lt_last j )

/- For any j in the codomain of a monotone map k (preserving endpoints), there exists i such that k i <= j < k (i+1). -/ lemma exists_index_between_v2 {n m : ℕ} (k : Fin (n + 1) → Fin (m + 1)) (hk : Monotone k) (hk0 : k 0 = 0) (hkn : k (Fin.last n) = Fin.last m) (j : Fin m) : ∃ i : Fin n, k i.castSucc ≤ j.castSucc ∧ j.castSucc < k i.succ := by exact exists_index_between k hk hk0 hkn j

/- For any y in [a, b], there exists a subinterval of P containing y, provided P.n > 0.

The points of fromPoints s are exactly s. -/ lemma points_fromPoints {a b : ℝ} (s : Finset ℝ) (ha : a ∈ s) (hb : b ∈ s) (h_sub : (s : Set ℝ) ⊆ Set.Icc a b) : (fromPoints (a:=a) (b:=b) s ha hb h_sub).points = s := by classical -- replicate the local defs used in fromPoints, so we can reuse them let l : List ℝ := s.sort (· ≤ ·)

have hs_nonempty : s.Nonempty := ⟨a, ha⟩ have hlpos : 0 < l.length := by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr hs_nonempty)

let n : ℕ := l.length.pred have hn : n.succ = l.length := Nat.succ_pred_eq_of_pos hlpos have hn' : n + 1 = l.length := by simpa [Nat.succ_eq_add_one] using hn

ext y constructor · intro hy -- unfold points and fromPoints enough to get "y is some l.get ..." -- (we keep [l,n] in simp so it doesn't explode) have hy' : y ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i => l.get ⟨i.1, by -- this is exactly the bound proof used in fromPoints simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by -- this is what points is, after unfolding fromPoints simpa [IPartition.points, fromPoints, l, n] using hy

rcases Finset.mem_image.mp hy' with ⟨i, hiuniv, rfl⟩
-- Now show this list element is in s, since l = s.sort ...
have : l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩ ∈ l :=
  List.get_mem l _
-- Convert list-membership in l to finset-membership in s using mem_sort
exact (Finset.mem_sort (s := s) (r := (· ≤ ·))).1 (by simpa [l] using this)

· intro hy -- y ∈ s → y ∈ l have hyL : y ∈ l := (Finset.mem_sort (s := s) (r := (· ≤ ·))).2 (by simpa using hy) -- pick an index j with l.get j = y rcases List.mem_iff_get.mp hyL with ⟨j, rfl⟩

-- We need to show l.get j is in the image of x over Fin (n+1).
-- Use i := cast j into Fin (n+1).
let i : Fin (n + 1) := Fin.cast hn'.symm j

-- Unfold points/fromPoints and provide witness i
have : l.get j ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i =>
  l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by
  refine Finset.mem_image.mpr ?_
  refine ⟨i, Finset.mem_univ _, ?_⟩
  -- Compare the Fin indices used in the two gets
  -- j : Fin l.length, while the RHS uses ⟨i.1, _⟩ : Fin l.length.
  -- Show they are equal by Fin.ext (only vals matter).
  have hjlen : (⟨i.1, by
      -- i.2 : i.1 < n+1, rewrite via hn' to get i.1 < l.length
      simpa [hn', i] using i.2⟩ : Fin l.length) = j := by
    apply Fin.ext
    rfl
  -- Then the gets are equal
  simpa [hjlen]

-- now translate back to the original goal
simpa [IPartition.points, fromPoints, l, n] using this

/- The union of two partitions P and Q is the partition constructed from the union of their point sets. -/ def union {a b : ℝ} (P Q : IPartition a b) : IPartition a b := fromPoints (P.points ∪ Q.points) (by exact Finset.mem_union_left _ ( Finset.mem_image.mpr ⟨ 0, Finset.mem_univ _, P.left ⟩ )) (by exact Finset.mem_union.mpr ( Or.inl <| Finset.mem_image.mpr ⟨ Fin.last _, Finset.mem_univ _, P.right ⟩ )) (by -- Since $P$ and $Q$ are partitions of $[a, b]$, their points are within $[a, b]$. have hP : ∀ y ∈ P.points, y ∈ Set.Icc a b := by intro y hy; obtain ⟨ i, hi, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ P.monotone ( show 0 ≤ i from Nat.zero_le _ ), P.left ], by linarith [ P.monotone ( show i ≤ Fin.last P.n from Fin.le_last _ ), P.right ] ⟩ ; have hQ : ∀ y ∈ Q.points, y ∈ Set.Icc a b := by rintro y hy; obtain ⟨ i, _, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ Q.left, Q.right, Q.monotone ( show 0 ≤ i from Nat.zero_le _ ) ], by linarith [ Q.left, Q.right, Q.monotone ( show i ≤ Fin.last Q.n from Fin.le_last _ ) ] ⟩ ; grind)

lemma union_points {a b : ℝ} (P Q : IPartition a b) : (union P Q).points = P.points ∪ Q.points := by -- unfolds to fromPoints on the finset union simp [union, points_fromPoints]

/- The union of two partitions refines both. -/

lemma union_refines_left {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) P := by -- goal: P.points ⊆ (union P Q).points -- i.e. P.points ⊆ P.points ∪ Q.points simpa [IsRefinement, union_points] using (Finset.subset_union_left : P.points ⊆ P.points ∪ Q.points)

lemma union_refines_right {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) Q := by simpa [IsRefinement, union_points] using (Finset.subset_union_right : Q.points ⊆ P.points ∪ Q.points)

/- The points of a partition constructed from a set of points are strictly increasing. -/ lemma fromPoints_strictMono {a b : ℝ} {s : Finset ℝ} {ha : a ∈ s} {hb : b ∈ s} {h_sub : (s : Set ℝ) ⊆ Set.Icc a b} : StrictMono (fromPoints s ha hb h_sub).x := by intro i j hij -- Let l be the sorted list of s let l := s.sort (· ≤ ·) -- n is l.length.pred, so n + 1 = l.length let n := l.length.pred have hn : n + 1 = l.length := Nat.succ_pred_eq_of_pos (by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr ⟨a, ha⟩)) -- The type of i, j is Fin (n + 1), so their values are < l.length -- The x function is l.get ⟨i.1, _⟩ have h_sorted : List.Sorted (· < ·) l := by convert Finset.sort_sorted_lt s using 1 -- Now, i < j in Fin (n + 1) means i.1 < j.1 < l.length -- So, l.get i.1 < l.get j.1 by strict sortedness -- Unfold the definition of IPart.fromPoints.x to see the indices dsimp [IPart.fromPoints] exact h_sorted.rel_get_of_lt hij

/- The points of the union of two partitions are strictly increasing. -/ lemma union_strictMono {a b : ℝ} (P Q : IPartition a b) : StrictMono (union P Q).x := by convert fromPoints_strictMono

/- If R is a strictly monotone partition refining P via index map k, then k maps 0 to 0. -/ lemma index_map_zero {a b : ℝ} {P R : IPartition a b} (hR : StrictMono R.x) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk_eq : ∀ i, R.x (k i) = P.x i) : k 0 = 0 := by -- Since $R$ is strictly monotone and $R.x (k 0) = a$, we have $k 0 = 0$. have h_k0_eq : R.x (k 0) = R.x 0 := by exact hk_eq 0 ▸ P.left.symm ▸ R.left.symm ▸ rfl; exact hR.injective h_k0_eq

/- If R refines P, there is a monotone index map k from P to R preserving the points. -/ lemma refinement_index_map {a b : ℝ} (P R : IPartition a b) (h_ref : IsRefinement R P) : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by -- By definition of $IsRefinement$, there exists a monotone map $k$ from $P$ to $R$ such that $R.x (k i) = P.x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : (Fin (P.n + 1)) → (Fin (R.n + 1)), (∀ i, R.x (k i) = P.x i) ∧ Monotone k := by -- By definition of $IsRefinement$, there exists a monotone map $k$ from $P$ to $R$ such that $R.x (k i) = P.x i$ for all $i$. We can construct $k$ by taking the smallest index $j$ such that $R.x j = P.x i$. have h_exists_k : ∀ i : Fin (P.n + 1), ∃ j : Fin (R.n + 1), R.x j = P.x i := by intro i have h_exists_j : P.x i ∈ R.points := by exact h_ref <| Finset.mem_image_of_mem _ <| Finset.mem_univ _ obtain ⟨j, hj⟩ := Finset.mem_image.mp h_exists_j use j aesop; have h_exists_k : ∀ i : Fin (P.n + 1), ∃ j : Fin (R.n + 1), R.x j = P.x i ∧ ∀ k : Fin (R.n + 1), R.x k = P.x i → j ≤ k := by exact fun i => ⟨ Finset.min' ( Finset.univ.filter fun j => R.x j = P.x i ) ⟨ Classical.choose ( h_exists_k i ), Finset.mem_filter.mpr ⟨ Finset.mem_univ _, Classical.choose_spec ( h_exists_k i ) ⟩ ⟩, Finset.mem_filter.mp ( Finset.min'_mem ( Finset.univ.filter fun j => R.x j = P.x i ) ⟨ Classical.choose ( h_exists_k i ), Finset.mem_filter.mpr ⟨ Finset.mem_univ _, Classical.choose_spec ( h_exists_k i ) ⟩ ⟩ ) |>.2, fun k hk => Finset.min'_le _ _ ( by aesop ) ⟩; choose k hk₁ hk₂ using h_exists_k; refine' ⟨ k, hk₁, fun i j hij => _ ⟩; have h_monotone : ∀ i j : Fin (P.n + 1), i ≤ j → P.x i ≤ P.x j := by exact fun i j hij => P.monotone hij; have h_monotone_R : ∀ i j : Fin (R.n + 1), i ≤ j → R.x i ≤ R.x j := by exact fun i j hij => R.monotone hij; contrapose! h_monotone; exact ⟨ i, j, hij, by linarith [ hk₁ i, hk₁ j, h_monotone_R _ _ h_monotone.le, show R.x ( k j ) < R.x ( k i ) from lt_of_le_of_ne ( h_monotone_R _ _ h_monotone.le ) fun h => h_monotone.ne <| le_antisymm h_monotone.le <| hk₂ _ _ <| by aesop ] ⟩; exact ⟨ k, hk.2, hk.1 ⟩

/- The sum of term over Ico u v telescopes to g(v) - g(u). -/ def term (g : ℝ → ℝ) {a b : ℝ} (R : IPartition a b) (j : ℕ) : ℝ := if h : j + 1 < R.n + 1 then g (R.x ⟨j+1, h⟩) - g (R.x ⟨j, Nat.lt_of_succ_lt h⟩) else 0

lemma sum_telescope_block {a b : ℝ} (g : ℝ → ℝ) (R : IPartition a b) (u v : Fin (R.n + 1)) (huv : u ≤ v) : ∑ j ∈ Finset.Ico u.val v.val, term g R j = g (R.x v) - g (R.x u) := by unfold term; induction' v using Fin.inductionOn with v ih ; aesop; cases huv.eq_or_lt <;> simp_all +decide [ Fin.lt_iff_val_lt_val, Nat.lt_succ_iff ]; rw [ Finset.sum_Ico_succ_top ( by linarith ), ih ( Nat.le_trans ( Nat.le_refl _ ) ‹_› ) ]; simp +decide [ Fin.add_def, Nat.mod_eq_of_lt ] ; ring!

/- A sum over consecutive intervals [k i, k (i+1)) combines into a single sum over [k 0, k n). -/

lemma sum_partition_blocks {M : Type*} [AddCommMonoid M] (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k) (F : ℕ → M) : ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), F j = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), F j := by rw [ ← Finset.sum_biUnion ]; · rcongr j aesop; simp +zetaDelta at *; constructor <;> intro h all_goals generalize_proofs at *; · rcases h with ⟨ i, hi ⟩ ; exact ⟨ le_trans ( hk <| Nat.zero_le _ ) hi.1, hi.2.trans_le <| hk <| Fin.le_last _ ⟩ ; · contrapose! h; intro hj have h_ind : ∀ i : Fin (n + 1), k i ≤ j := by intro i induction' i using Fin.induction with i ih all_goals generalize_proofs at *; · exact hj; · exact h i ih generalize_proofs at *; exact h_ind (Fin.last n); · intro i _ j _ hij; simp_all +decide [ Fin.ext_iff ] ; cases lt_or_gt_of_ne hij <;> simp_all +decide [ Finset.disjoint_left, hk ]; · intro a ha₁ ha₂ ha₃; linarith [ hk ( show Fin.castSucc i ≤ Fin.castSucc j from Nat.le_of_lt ‹› ), hk ( show Fin.succ i ≤ Fin.castSucc j from Nat.succ_le_of_lt ‹› ) ] ; · exact fun a ha₁ ha₂ ha₃ => le_trans ( hk <| Nat.le_of_lt_succ <| by simpa [ Fin.castSucc_lt_succ ] using ‹j < i› ) ha₁

/- That was enough of a dive. Back to maths. Well, first, two trivial estimates.-/

/- The length of the i-th subinterval of a partition P is at most the mesh of P. -/ lemma mesh_ge_diff {a b : ℝ} (P : IPartition a b) (i : Fin P.n) : P.x i.succ - P.x i.castSucc ≤ P.mesh := by apply Basic.le_max_getD apply Finset.mem_image_of_mem exact Finset.mem_univ i

/- Helper lemmas: index_map_last shows the index map preserves the last element. exists_index_between shows that for any j in the range of k, there is an interval [k i, k (i+1)) containing j. -/ lemma index_map_last {a b : ℝ} {P R : IPartition a b} (hR : StrictMono R.x) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk_eq : ∀ i, R.x (k i) = P.x i) : k (Fin.last P.n) = Fin.last R.n := by -- Since $R.x$ is strictly monotone, the only way $R.x (k (Fin.last P.n)) = b$ can hold is if $k (Fin.last P.n)$ is the last element of $R$. have h_last : R.x (k (Fin.last P.n)) = R.x (Fin.last R.n) := by cases P ; cases R ; aesop; exact hR.injective h_last

lemma exists_index_between {n m : ℕ} (k : Fin (n + 1) → Fin (m + 1)) (hk : Monotone k) (hk0 : k 0 = 0) (hkn : k (Fin.last n) = Fin.last m) (j : Fin m) : ∃ i : Fin n, k i.castSucc ≤ j.castSucc ∧ j.castSucc < k i.succ := by by_contra h_contra; -- Since $k$ is monotone and $k 0 = 0$, we have $k i \le j$ for all $i$. have h_le : ∀ i : Fin (n + 1), k i ≤ Fin.castSucc j := by intro i; induction i using Fin.inductionOn <;> aesop; exact absurd ( h_le ( Fin.last n ) ) ( by simpa [ hkn ] using Fin.castSucc_lt_last j )

/- For any j in the codomain of a monotone map k (preserving endpoints), there exists i such that k i <= j < k (i+1). -/ lemma exists_index_between_v2 {n m : ℕ} (k : Fin (n + 1) → Fin (m + 1)) (hk : Monotone k) (hk0 : k 0 = 0) (hkn : k (Fin.last n) = Fin.last m) (j : Fin m) : ∃ i : Fin n, k i.castSucc ≤ j.castSucc ∧ j.castSucc < k i.succ := by exact exists_index_between k hk hk0 hkn j

/- For any y in [a, b], there exists a subinterval of P containing y, provided P.n > 0. -/ lemma mem_subinterval {a b : ℝ} (P : IPartition a b) (hn : 0 < P.n) {y : ℝ} (hy : y ∈ Set.Icc a b) : ∃ i : Fin P.n, y ∈ Set.Icc (P.x i.castSucc) (P.x i.succ) := by by_contra h_contra; -- Since the intervals [P.x i, P.x (i+1)] cover [a, b], there must be some i such that y is in [P.x i, P.x (i+1)]. have h_cover : ∀ y ∈ Set.Icc a b, ∃ i : Fin P.n, y ∈ Set.Icc (P.x i.castSucc) (P.x i.succ) := by intro y hy obtain ⟨i, hi⟩ : ∃ i : Fin (P.n + 1), y ≤ P.x i ∧ ∀ j : Fin (P.n + 1), y ≤ P.x j → i ≤ j := by have h_exists_i : ∃ i : Fin (P.n + 1), y ≤ P.x i := by exact ⟨ Fin.last _, by linarith [ hy.2, P.right ] ⟩; exact ⟨ Finset.min' ( Finset.univ.filter fun i => y ≤ P.x i ) ⟨ h_exists_i.choose, Finset.mem_filter.mpr ⟨ Finset.mem_univ _, h_exists_i.choose_spec ⟩ ⟩, Finset.mem_filter.mp ( Finset.min'_mem ( Finset.univ.filter fun i => y ≤ P.x i ) ⟨ h_exists_i.choose, Finset.mem_filter.mpr ⟨ Finset.mem_univ _, h_exists_i.choose_spec ⟩ ⟩ ) |>.2, fun j hj => Finset.min'_le _ _ <| by aesop ⟩; induction' i using Fin.inductionOn with i IH; · exact ⟨ ⟨ 0, hn ⟩, by simpa [ P.left ] using hy.1, by simpa [ P.left ] using P.monotone ( Nat.zero_le _ ) |> le_trans hi.1 ⟩; · exact ⟨ i, ⟨ by exact le_of_not_gt fun h => not_lt_of_ge ( hi.2 _ h.le ) ( Fin.castSucc_lt_succ i ), hi.1 ⟩ ⟩; exact h_contra <| h_cover y hy

/- The following lemmas on partitions are an overly complicated route towards the simple bound at the end of this namespace (IPart) -/ /- There are no partition points strictly between two consecutive points of a partition.

The points of fromPoints s are exactly s. -/ lemma points_fromPoints {a b : ℝ} (s : Finset ℝ) (ha : a ∈ s) (hb : b ∈ s) (h_sub : (s : Set ℝ) ⊆ Set.Icc a b) : (fromPoints (a:=a) (b:=b) s ha hb h_sub).points = s := by classical -- replicate the local defs used in fromPoints, so we can reuse them let l : List ℝ := s.sort (· ≤ ·)

have hs_nonempty : s.Nonempty := ⟨a, ha⟩ have hlpos : 0 < l.length := by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr hs_nonempty)

let n : ℕ := l.length.pred have hn : n.succ = l.length := Nat.succ_pred_eq_of_pos hlpos have hn' : n + 1 = l.length := by simpa [Nat.succ_eq_add_one] using hn

ext y constructor · intro hy -- unfold points and fromPoints enough to get "y is some l.get ..." -- (we keep [l,n] in simp so it doesn't explode) have hy' : y ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i => l.get ⟨i.1, by -- this is exactly the bound proof used in fromPoints simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by -- this is what points is, after unfolding fromPoints simpa [IPartition.points, fromPoints, l, n] using hy

rcases Finset.mem_image.mp hy' with ⟨i, hiuniv, rfl⟩
-- Now show this list element is in s, since l = s.sort ...
have : l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩ ∈ l :=
  List.get_mem l _
-- Convert list-membership in l to finset-membership in s using mem_sort
exact (Finset.mem_sort (s := s) (r := (· ≤ ·))).1 (by simpa [l] using this)

· intro hy -- y ∈ s → y ∈ l have hyL : y ∈ l := (Finset.mem_sort (s := s) (r := (· ≤ ·))).2 (by simpa using hy) -- pick an index j with l.get j = y rcases List.mem_iff_get.mp hyL with ⟨j, rfl⟩

-- We need to show l.get j is in the image of x over Fin (n+1).
-- Use i := cast j into Fin (n+1).
let i : Fin (n + 1) := Fin.cast hn'.symm j

-- Unfold points/fromPoints and provide witness i
have : l.get j ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i =>
  l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by
  refine Finset.mem_image.mpr ?_
  refine ⟨i, Finset.mem_univ _, ?_⟩
  -- Compare the Fin indices used in the two gets
  -- j : Fin l.length, while the RHS uses ⟨i.1, _⟩ : Fin l.length.
  -- Show they are equal by Fin.ext (only vals matter).
  have hjlen : (⟨i.1, by
      -- i.2 : i.1 < n+1, rewrite via hn' to get i.1 < l.length
      simpa [hn', i] using i.2⟩ : Fin l.length) = j := by
    apply Fin.ext
    rfl
  -- Then the gets are equal
  simpa [hjlen]

-- now translate back to the original goal
simpa [IPartition.points, fromPoints, l, n] using this

/- The union of two partitions P and Q is the partition constructed from the union of their point sets. -/ def union {a b : ℝ} (P Q : IPartition a b) : IPartition a b := fromPoints (P.points ∪ Q.points) (by exact Finset.mem_union_left _ ( Finset.mem_image.mpr ⟨ 0, Finset.mem_univ _, P.left ⟩ )) (by exact Finset.mem_union.mpr ( Or.inl <| Finset.mem_image.mpr ⟨ Fin.last _, Finset.mem_univ _, P.right ⟩ )) (by -- Since $P$ and $Q$ are partitions of $[a, b]$, their points are within $[a, b]$. have hP : ∀ y ∈ P.points, y ∈ Set.Icc a b := by intro y hy; obtain ⟨ i, hi, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ P.monotone ( show 0 ≤ i from Nat.zero_le _ ), P.left ], by linarith [ P.monotone ( show i ≤ Fin.last P.n from Fin.le_last _ ), P.right ] ⟩ ; have hQ : ∀ y ∈ Q.points, y ∈ Set.Icc a b := by rintro y hy; obtain ⟨ i, _, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ Q.left, Q.right, Q.monotone ( show 0 ≤ i from Nat.zero_le _ ) ], by linarith [ Q.left, Q.right, Q.monotone ( show i ≤ Fin.last Q.n from Fin.le_last _ ) ] ⟩ ; grind)

lemma union_points {a b : ℝ} (P Q : IPartition a b) : (union P Q).points = P.points ∪ Q.points := by -- unfolds to fromPoints on the finset union simp [union, points_fromPoints]

/- The union of two partitions refines both. -/

lemma union_refines_left {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) P := by -- goal: P.points ⊆ (union P Q).points -- i.e. P.points ⊆ P.points ∪ Q.points simpa [IsRefinement, union_points] using (Finset.subset_union_left : P.points ⊆ P.points ∪ Q.points)

lemma union_refines_right {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) Q := by simpa [IsRefinement, union_points] using (Finset.subset_union_right : Q.points ⊆ P.points ∪ Q.points)

/- The points of a partition constructed from a set of points are strictly increasing. -/ lemma fromPoints_strictMono {a b : ℝ} {s : Finset ℝ} {ha : a ∈ s} {hb : b ∈ s} {h_sub : (s : Set ℝ) ⊆ Set.Icc a b} : StrictMono (fromPoints s ha hb h_sub).x := by intro i j hij -- Let l be the sorted list of s let l := s.sort (· ≤ ·) -- n is l.length.pred, so n + 1 = l.length let n := l.length.pred have hn : n + 1 = l.length := Nat.succ_pred_eq_of_pos (by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr ⟨a, ha⟩)) -- The type of i, j is Fin (n + 1), so their values are < l.length -- The x function is l.get ⟨i.1, _⟩ have h_sorted : List.Sorted (· < ·) l := by convert Finset.sort_sorted_lt s using 1 -- Now, i < j in Fin (n + 1) means i.1 < j.1 < l.length -- So, l.get i.1 < l.get j.1 by strict sortedness -- Unfold the definition of IPart.fromPoints.x to see the indices dsimp [IPart.fromPoints] exact h_sorted.rel_get_of_lt hij

/- The points of the union of two partitions are strictly increasing. -/ lemma union_strictMono {a b : ℝ} (P Q : IPartition a b) : StrictMono (union P Q).x := by convert fromPoints_strictMono

/- If R is a strictly monotone partition refining P via index map k, then k maps 0 to 0. -/ lemma index_map_zero {a b : ℝ} {P R : IPartition a b} (hR : StrictMono R.x) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk_eq : ∀ i, R.x (k i) = P.x i) : k 0 = 0 := by -- Since $R$ is strictly monotone and $R.x (k 0) = a$, we have $k 0 = 0$. have h_k0_eq : R.x (k 0) = R.x 0 := by exact hk_eq 0 ▸ P.left.symm ▸ R.left.symm ▸ rfl; exact hR.injective h_k0_eq

/- If R refines P, there is a monotone index map k from P to R preserving the points. -/ lemma refinement_index_map {a b : ℝ} (P R : IPartition a b) (h_ref : IsRefinement R P) : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by -- By definition of $IsRefinement$, there exists a monotone map $k$ from $P$ to $R$ such that $R.x (k i) = P.x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : (Fin (P.n + 1)) → (Fin (R.n + 1)), (∀ i, R.x (k i) = P.x i) ∧ Monotone k := by -- By definition of $IsRefinement$, there exists a monotone map $k$ from $P$ to $R$ such that $R.x (k i) = P.x i$ for all $i$. We can construct $k$ by taking the smallest index $j$ such that $R.x j = P.x i$. have h_exists_k : ∀ i : Fin (P.n + 1), ∃ j : Fin (R.n + 1), R.x j = P.x i := by intro i have h_exists_j : P.x i ∈ R.points := by exact h_ref <| Finset.mem_image_of_mem _ <| Finset.mem_univ _ obtain ⟨j, hj⟩ := Finset.mem_image.mp h_exists_j use j aesop; have h_exists_k : ∀ i : Fin (P.n + 1), ∃ j : Fin (R.n + 1), R.x j = P.x i ∧ ∀ k : Fin (R.n + 1), R.x k = P.x i → j ≤ k := by exact fun i => ⟨ Finset.min' ( Finset.univ.filter fun j => R.x j = P.x i ) ⟨ Classical.choose ( h_exists_k i ), Finset.mem_filter.mpr ⟨ Finset.mem_univ _, Classical.choose_spec ( h_exists_k i ) ⟩ ⟩, Finset.mem_filter.mp ( Finset.min'_mem ( Finset.univ.filter fun j => R.x j = P.x i ) ⟨ Classical.choose ( h_exists_k i ), Finset.mem_filter.mpr ⟨ Finset.mem_univ _, Classical.choose_spec ( h_exists_k i ) ⟩ ⟩ ) |>.2, fun k hk => Finset.min'_le _ _ ( by aesop ) ⟩; choose k hk₁ hk₂ using h_exists_k; refine' ⟨ k, hk₁, fun i j hij => _ ⟩; have h_monotone : ∀ i j : Fin (P.n + 1), i ≤ j → P.x i ≤ P.x j := by exact fun i j hij => P.monotone hij; have h_monotone_R : ∀ i j : Fin (R.n + 1), i ≤ j → R.x i ≤ R.x j := by exact fun i j hij => R.monotone hij; contrapose! h_monotone; exact ⟨ i, j, hij, by linarith [ hk₁ i, hk₁ j, h_monotone_R _ _ h_monotone.le, show R.x ( k j ) < R.x ( k i ) from lt_of_le_of_ne ( h_monotone_R _ _ h_monotone.le ) fun h => h_monotone.ne <| le_antisymm h_monotone.le <| hk₂ _ _ <| by aesop ] ⟩; exact ⟨ k, hk.2, hk.1 ⟩

/- The sum of term over Ico u v telescopes to g(v) - g(u). -/ def term (g : ℝ → ℝ) {a b : ℝ} (R : IPartition a b) (j : ℕ) : ℝ := if h : j + 1 < R.n + 1 then g (R.x ⟨j+1, h⟩) - g (R.x ⟨j, Nat.lt_of_succ_lt h⟩) else 0

lemma sum_telescope_block {a b : ℝ} (g : ℝ → ℝ) (R : IPartition a b) (u v : Fin (R.n + 1)) (huv : u ≤ v) : ∑ j ∈ Finset.Ico u.val v.val, term g R j = g (R.x v) - g (R.x u) := by unfold term; induction' v using Fin.inductionOn with v ih ; aesop; cases huv.eq_or_lt <;> simp_all +decide [ Fin.lt_iff_val_lt_val, Nat.lt_succ_iff ]; rw [ Finset.sum_Ico_succ_top ( by linarith ), ih ( Nat.le_trans ( Nat.le_refl _ ) ‹_› ) ]; simp +decide [ Fin.add_def, Nat.mod_eq_of_lt ] ; ring!

/- A sum over consecutive intervals [k i, k (i+1)) combines into a single sum over [k 0, k n). -/

lemma sum_partition_blocks {M : Type*} [AddCommMonoid M] (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k) (F : ℕ → M) : ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), F j = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), F j := by rw [ ← Finset.sum_biUnion ]; · rcongr j aesop; simp +zetaDelta at *; constructor <;> intro h all_goals generalize_proofs at *; · rcases h with ⟨ i, hi ⟩ ; exact ⟨ le_trans ( hk <| Nat.zero_le _ ) hi.1, hi.2.trans_le <| hk <| Fin.le_last _ ⟩ ; · contrapose! h; intro hj have h_ind : ∀ i : Fin (n + 1), k i ≤ j := by intro i induction' i using Fin.induction with i ih all_goals generalize_proofs at *; · exact hj; · exact h i ih generalize_proofs at *; exact h_ind (Fin.last n); · intro i _ j _ hij; simp_all +decide [ Fin.ext_iff ] ; cases lt_or_gt_of_ne hij <;> simp_all +decide [ Finset.disjoint_left, hk ]; · intro a ha₁ ha₂ ha₃; linarith [ hk ( show Fin.castSucc i ≤ Fin.castSucc j from Nat.le_of_lt ‹› ), hk ( show Fin.succ i ≤ Fin.castSucc j from Nat.succ_le_of_lt ‹› ) ] ; · exact fun a ha₁ ha₂ ha₃ => le_trans ( hk <| Nat.le_of_lt_succ <| by simpa [ Fin.castSucc_lt_succ ] using ‹j < i› ) ha₁

/- That was enough of a dive. Back to maths. Well, first, two trivial estimates.-/

/- The length of the i-th subinterval of a partition P is at most the mesh of P. -/ lemma mesh_ge_diff {a b : ℝ} (P : IPartition a b) (i : Fin P.n) : P.x i.succ - P.x i.castSucc ≤ P.mesh := by apply Basic.le_max_getD apply Finset.mem_image_of_mem exact Finset.mem_univ i

/- Helper lemmas: index_map_last shows the index map preserves the last element. exists_index_between shows that for any j in the range of k, there is an interval [k i, k (i+1)) containing j. -/ lemma index_map_last {a b : ℝ} {P R : IPartition a b} (hR : StrictMono R.x) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk_eq : ∀ i, R.x (k i) = P.x i) : k (Fin.last P.n) = Fin.last R.n := by -- Since $R.x$ is strictly monotone, the only way $R.x (k (Fin.last P.n)) = b$ can hold is if $k (Fin.last P.n)$ is the last element of $R$. have h_last : R.x (k (Fin.last P.n)) = R.x (Fin.last R.n) := by cases P ; cases R ; aesop; exact hR.injective h_last

lemma exists_index_between {n m : ℕ} (k : Fin (n + 1) → Fin (m + 1)) (hk : Monotone k) (hk0 : k 0 = 0) (hkn : k (Fin.last n) = Fin.last m) (j : Fin m) : ∃ i : Fin n, k i.castSucc ≤ j.castSucc ∧ j.castSucc < k i.succ := by by_contra h_contra; -- Since $k$ is monotone and $k 0 = 0$, we have $k i \le j$ for all $i$. have h_le : ∀ i : Fin (n + 1), k i ≤ Fin.castSucc j := by intro i; induction i using Fin.inductionOn <;> aesop; exact absurd ( h_le ( Fin.last n ) ) ( by simpa [ hkn ] using Fin.castSucc_lt_last j )

/- For any j in the codomain of a monotone map k (preserving endpoints), there exists i such that k i <= j < k (i+1). -/ lemma exists_index_between_v2 {n m : ℕ} (k : Fin (n + 1) → Fin (m + 1)) (hk : Monotone k) (hk0 : k 0 = 0) (hkn : k (Fin.last n) = Fin.last m) (j : Fin m) : ∃ i : Fin n, k i.castSucc ≤ j.castSucc ∧ j.castSucc < k i.succ := by exact exists_index_between k hk hk0 hkn j

/- For any y in [a, b], there exists a subinterval of P containing y, provided P.n > 0. -/ lemma mem_subinterval {a b : ℝ} (P : IPartition a b) (hn : 0 < P.n) {y : ℝ} (hy : y ∈ Set.Icc a b) : ∃ i : Fin P.n, y ∈ Set.Icc (P.x i.castSucc) (P.x i.succ) := by by_contra h_contra; -- Since the intervals [P.x i, P.x (i+1)] cover [a, b], there must be some i such that y is in [P.x i, P.x (i+1)]. have h_cover : ∀ y ∈ Set.Icc a b, ∃ i : Fin P.n, y ∈ Set.Icc (P.x i.castSucc) (P.x i.succ) := by intro y hy obtain ⟨i, hi⟩ : ∃ i : Fin (P.n + 1), y ≤ P.x i ∧ ∀ j : Fin (P.n + 1), y ≤ P.x j → i ≤ j := by have h_exists_i : ∃ i : Fin (P.n + 1), y ≤ P.x i := by exact ⟨ Fin.last _, by linarith [ hy.2, P.right ] ⟩; exact ⟨ Finset.min' ( Finset.univ.filter fun i => y ≤ P.x i ) ⟨ h_exists_i.choose, Finset.mem_filter.mpr ⟨ Finset.mem_univ _, h_exists_i.choose_spec ⟩ ⟩, Finset.mem_filter.mp ( Finset.min'_mem ( Finset.univ.filter fun i => y ≤ P.x i ) ⟨ h_exists_i.choose, Finset.mem_filter.mpr ⟨ Finset.mem_univ _, h_exists_i.choose_spec ⟩ ⟩ ) |>.2, fun j hj => Finset.min'_le _ _ <| by aesop ⟩; induction' i using Fin.inductionOn with i IH; · exact ⟨ ⟨ 0, hn ⟩, by simpa [ P.left ] using hy.1, by simpa [ P.left ] using P.monotone ( Nat.zero_le _ ) |> le_trans hi.1 ⟩; · exact ⟨ i, ⟨ by exact le_of_not_gt fun h => not_lt_of_ge ( hi.2 _ h.le ) ( Fin.castSucc_lt_succ i ), hi.1 ⟩ ⟩; exact h_contra <| h_cover y hy

/- The following lemmas on partitions are an overly complicated route towards the simple bound at the end of this namespace (IPart) -/ /- There are no partition points strictly between two consecutive points of a partition. -/ lemma no_points_between {a b : ℝ} (R : IPartition a b) (j : Fin R.n) (k : Fin (R.n + 1)) : ¬ (R.x j.castSucc < R.x k ∧ R.x k < R.x j.succ) := by intro hRS.IPart.fromPoints_strictMono; -- Since $R$ is a partition, $R.x$ is monotone, so $R.x j.castSucc < R.x k$ implies $j.castSucc < k$. have h_castSucc_lt_k : j.castSucc < k := by exact lt_of_not_ge fun h => hRS.IPart.fromPoints_strictMono.1.not_ge ( R.monotone ( by simpa ) ); -- Since $R$ is a partition, $R.x$ is monotone, so $R.x k < R.x j.succ$ implies $k < j.succ$. have h_k_lt_succ : k < j.succ := by exact lt_of_not_ge fun h => hRS.IPart.fromPoints_strictMono.2.not_ge <| R.monotone h; exact h_castSucc_lt_k.not_ge ( Nat.le_of_lt_succ h_k_lt_succ )

/- No point of partition P lies strictly between two consecutive points of its refinement R. -/ lemma no_P_point_between {a b : ℝ} {P R : IPartition a b} (h : IsRefinement R P) (j : Fin R.n) (i : Fin (P.n + 1)) : ¬ (R.x j.castSucc < P.x i ∧ P.x i < R.x j.succ) := by exact Classical.not_not.1 fun H => no_points_between R j ( Classical.choose ( Finset.mem_image.1 ( h ( Finset.mem_image_of_mem _ ( Finset.mem_univ i ) ) ) ) ) |>.elim <| by have := Classical.choose_spec ( Finset.mem_image.1 ( h ( Finset.mem_image_of_mem _ ( Finset.mem_univ i ) ) ) ) ; aesop;

/- If partition R refines partition P, then every subinterval of R is contained in some subinterval of P.

The points of fromPoints s are exactly s. -/ lemma points_fromPoints {a b : ℝ} (s : Finset ℝ) (ha : a ∈ s) (hb : b ∈ s) (h_sub : (s : Set ℝ) ⊆ Set.Icc a b) : (fromPoints (a:=a) (b:=b) s ha hb h_sub).points = s := by classical -- replicate the local defs used in fromPoints, so we can reuse them let l : List ℝ := s.sort (· ≤ ·)

have hs_nonempty : s.Nonempty := ⟨a, ha⟩ have hlpos : 0 < l.length := by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr hs_nonempty)

let n : ℕ := l.length.pred have hn : n.succ = l.length := Nat.succ_pred_eq_of_pos hlpos have hn' : n + 1 = l.length := by simpa [Nat.succ_eq_add_one] using hn

ext y constructor · intro hy -- unfold points and fromPoints enough to get "y is some l.get ..." -- (we keep [l,n] in simp so it doesn't explode) have hy' : y ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i => l.get ⟨i.1, by -- this is exactly the bound proof used in fromPoints simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by -- this is what points is, after unfolding fromPoints simpa [IPartition.points, fromPoints, l, n] using hy

rcases Finset.mem_image.mp hy' with ⟨i, hiuniv, rfl⟩
-- Now show this list element is in s, since l = s.sort ...
have : l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩ ∈ l :=
  List.get_mem l _
-- Convert list-membership in l to finset-membership in s using mem_sort
exact (Finset.mem_sort (s := s) (r := (· ≤ ·))).1 (by simpa [l] using this)

· intro hy -- y ∈ s → y ∈ l have hyL : y ∈ l := (Finset.mem_sort (s := s) (r := (· ≤ ·))).2 (by simpa using hy) -- pick an index j with l.get j = y rcases List.mem_iff_get.mp hyL with ⟨j, rfl⟩

-- We need to show l.get j is in the image of x over Fin (n+1).
-- Use i := cast j into Fin (n+1).
let i : Fin (n + 1) := Fin.cast hn'.symm j

-- Unfold points/fromPoints and provide witness i
have : l.get j ∈ (Finset.univ : Finset (Fin (n + 1))).image (fun i =>
  l.get ⟨i.1, by
    simpa [n, Nat.sub_add_cancel (Nat.succ_le_iff.mp hlpos)] using i.2⟩) := by
  refine Finset.mem_image.mpr ?_
  refine ⟨i, Finset.mem_univ _, ?_⟩
  -- Compare the Fin indices used in the two gets
  -- j : Fin l.length, while the RHS uses ⟨i.1, _⟩ : Fin l.length.
  -- Show they are equal by Fin.ext (only vals matter).
  have hjlen : (⟨i.1, by
      -- i.2 : i.1 < n+1, rewrite via hn' to get i.1 < l.length
      simpa [hn', i] using i.2⟩ : Fin l.length) = j := by
    apply Fin.ext
    rfl
  -- Then the gets are equal
  simpa [hjlen]

-- now translate back to the original goal
simpa [IPartition.points, fromPoints, l, n] using this

/- The union of two partitions P and Q is the partition constructed from the union of their point sets. -/ def union {a b : ℝ} (P Q : IPartition a b) : IPartition a b := fromPoints (P.points ∪ Q.points) (by exact Finset.mem_union_left _ ( Finset.mem_image.mpr ⟨ 0, Finset.mem_univ _, P.left ⟩ )) (by exact Finset.mem_union.mpr ( Or.inl <| Finset.mem_image.mpr ⟨ Fin.last _, Finset.mem_univ _, P.right ⟩ )) (by -- Since $P$ and $Q$ are partitions of $[a, b]$, their points are within $[a, b]$. have hP : ∀ y ∈ P.points, y ∈ Set.Icc a b := by intro y hy; obtain ⟨ i, hi, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ P.monotone ( show 0 ≤ i from Nat.zero_le _ ), P.left ], by linarith [ P.monotone ( show i ≤ Fin.last P.n from Fin.le_last _ ), P.right ] ⟩ ; have hQ : ∀ y ∈ Q.points, y ∈ Set.Icc a b := by rintro y hy; obtain ⟨ i, _, rfl ⟩ := Finset.mem_image.mp hy; exact ⟨ by linarith [ Q.left, Q.right, Q.monotone ( show 0 ≤ i from Nat.zero_le _ ) ], by linarith [ Q.left, Q.right, Q.monotone ( show i ≤ Fin.last Q.n from Fin.le_last _ ) ] ⟩ ; grind)

lemma union_points {a b : ℝ} (P Q : IPartition a b) : (union P Q).points = P.points ∪ Q.points := by -- unfolds to fromPoints on the finset union simp [union, points_fromPoints]

/- The union of two partitions refines both. -/

lemma union_refines_left {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) P := by -- goal: P.points ⊆ (union P Q).points -- i.e. P.points ⊆ P.points ∪ Q.points simpa [IsRefinement, union_points] using (Finset.subset_union_left : P.points ⊆ P.points ∪ Q.points)

lemma union_refines_right {a b : ℝ} (P Q : IPartition a b) : IsRefinement (union P Q) Q := by simpa [IsRefinement, union_points] using (Finset.subset_union_right : Q.points ⊆ P.points ∪ Q.points)

/- The points of a partition constructed from a set of points are strictly increasing. -/ lemma fromPoints_strictMono {a b : ℝ} {s : Finset ℝ} {ha : a ∈ s} {hb : b ∈ s} {h_sub : (s : Set ℝ) ⊆ Set.Icc a b} : StrictMono (fromPoints s ha hb h_sub).x := by intro i j hij -- Let l be the sorted list of s let l := s.sort (· ≤ ·) -- n is l.length.pred, so n + 1 = l.length let n := l.length.pred have hn : n + 1 = l.length := Nat.succ_pred_eq_of_pos (by simpa [l, Finset.length_sort] using (Finset.card_pos.mpr ⟨a, ha⟩)) -- The type of i, j is Fin (n + 1), so their values are < l.length -- The x function is l.get ⟨i.1, _⟩ have h_sorted : List.Sorted (· < ·) l := by convert Finset.sort_sorted_lt s using 1 -- Now, i < j in Fin (n + 1) means i.1 < j.1 < l.length -- So, l.get i.1 < l.get j.1 by strict sortedness -- Unfold the definition of IPart.fromPoints.x to see the indices dsimp [IPart.fromPoints] exact h_sorted.rel_get_of_lt hij

/- The points of the union of two partitions are strictly increasing. -/ lemma union_strictMono {a b : ℝ} (P Q : IPartition a b) : StrictMono (union P Q).x := by convert fromPoints_strictMono

/- If R is a strictly monotone partition refining P via index map k, then k maps 0 to 0. -/ lemma index_map_zero {a b : ℝ} {P R : IPartition a b} (hR : StrictMono R.x) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk_eq : ∀ i, R.x (k i) = P.x i) : k 0 = 0 := by -- Since $R$ is strictly monotone and $R.x (k 0) = a$, we have $k 0 = 0$. have h_k0_eq : R.x (k 0) = R.x 0 := by exact hk_eq 0 ▸ P.left.symm ▸ R.left.symm ▸ rfl; exact hR.injective h_k0_eq

/- If R refines P, there is a monotone index map k from P to R preserving the points. -/ lemma refinement_index_map {a b : ℝ} (P R : IPartition a b) (h_ref : IsRefinement R P) : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by -- By definition of $IsRefinement$, there exists a monotone map $k$ from $P$ to $R$ such that $R.x (k i) = P.x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : (Fin (P.n + 1)) → (Fin (R.n + 1)), (∀ i, R.x (k i) = P.x i) ∧ Monotone k := by -- By definition of $IsRefinement$, there exists a monotone map $k$ from $P$ to $R$ such that $R.x (k i) = P.x i$ for all $i$. We can construct $k$ by taking the smallest index $j$ such that $R.x j = P.x i$. have h_exists_k : ∀ i : Fin (P.n + 1), ∃ j : Fin (R.n + 1), R.x j = P.x i := by intro i have h_exists_j : P.x i ∈ R.points := by exact h_ref <| Finset.mem_image_of_mem _ <| Finset.mem_univ _ obtain ⟨j, hj⟩ := Finset.mem_image.mp h_exists_j use j aesop; have h_exists_k : ∀ i : Fin (P.n + 1), ∃ j : Fin (R.n + 1), R.x j = P.x i ∧ ∀ k : Fin (R.n + 1), R.x k = P.x i → j ≤ k := by exact fun i => ⟨ Finset.min' ( Finset.univ.filter fun j => R.x j = P.x i ) ⟨ Classical.choose ( h_exists_k i ), Finset.mem_filter.mpr ⟨ Finset.mem_univ _, Classical.choose_spec ( h_exists_k i ) ⟩ ⟩, Finset.mem_filter.mp ( Finset.min'_mem ( Finset.univ.filter fun j => R.x j = P.x i ) ⟨ Classical.choose ( h_exists_k i ), Finset.mem_filter.mpr ⟨ Finset.mem_univ _, Classical.choose_spec ( h_exists_k i ) ⟩ ⟩ ) |>.2, fun k hk => Finset.min'_le _ _ ( by aesop ) ⟩; choose k hk₁ hk₂ using h_exists_k; refine' ⟨ k, hk₁, fun i j hij => _ ⟩; have h_monotone : ∀ i j : Fin (P.n + 1), i ≤ j → P.x i ≤ P.x j := by exact fun i j hij => P.monotone hij; have h_monotone_R : ∀ i j : Fin (R.n + 1), i ≤ j → R.x i ≤ R.x j := by exact fun i j hij => R.monotone hij; contrapose! h_monotone; exact ⟨ i, j, hij, by linarith [ hk₁ i, hk₁ j, h_monotone_R _ _ h_monotone.le, show R.x ( k j ) < R.x ( k i ) from lt_of_le_of_ne ( h_monotone_R _ _ h_monotone.le ) fun h => h_monotone.ne <| le_antisymm h_monotone.le <| hk₂ _ _ <| by aesop ] ⟩; exact ⟨ k, hk.2, hk.1 ⟩

/- The sum of term over Ico u v telescopes to g(v) - g(u). -/ def term (g : ℝ → ℝ) {a b : ℝ} (R : IPartition a b) (j : ℕ) : ℝ := if h : j + 1 < R.n + 1 then g (R.x ⟨j+1, h⟩) - g (R.x ⟨j, Nat.lt_of_succ_lt h⟩) else 0

lemma sum_telescope_block {a b : ℝ} (g : ℝ → ℝ) (R : IPartition a b) (u v : Fin (R.n + 1)) (huv : u ≤ v) : ∑ j ∈ Finset.Ico u.val v.val, term g R j = g (R.x v) - g (R.x u) := by unfold term; induction' v using Fin.inductionOn with v ih ; aesop; cases huv.eq_or_lt <;> simp_all +decide [ Fin.lt_iff_val_lt_val, Nat.lt_succ_iff ]; rw [ Finset.sum_Ico_succ_top ( by linarith ), ih ( Nat.le_trans ( Nat.le_refl _ ) ‹_› ) ]; simp +decide [ Fin.add_def, Nat.mod_eq_of_lt ] ; ring!

/- A sum over consecutive intervals [k i, k (i+1)) combines into a single sum over [k 0, k n). -/

lemma sum_partition_blocks {M : Type*} [AddCommMonoid M] (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k) (F : ℕ → M) : ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), F j = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), F j := by rw [ ← Finset.sum_biUnion ]; · rcongr j aesop; simp +zetaDelta at *; constructor <;> intro h all_goals generalize_proofs at *; · rcases h with ⟨ i, hi ⟩ ; exact ⟨ le_trans ( hk <| Nat.zero_le _ ) hi.1, hi.2.trans_le <| hk <| Fin.le_last _ ⟩ ; · contrapose! h; intro hj have h_ind : ∀ i : Fin (n + 1), k i ≤ j := by intro i induction' i using Fin.induction with i ih all_goals generalize_proofs at *; · exact hj; · exact h i ih generalize_proofs at *; exact h_ind (Fin.last n); · intro i _ j _ hij; simp_all +decide [ Fin.ext_iff ] ; cases lt_or_gt_of_ne hij <;> simp_all +decide [ Finset.disjoint_left, hk ]; · intro a ha₁ ha₂ ha₃; linarith [ hk ( show Fin.castSucc i ≤ Fin.castSucc j from Nat.le_of_lt ‹› ), hk ( show Fin.succ i ≤ Fin.castSucc j from Nat.succ_le_of_lt ‹› ) ] ; · exact fun a ha₁ ha₂ ha₃ => le_trans ( hk <| Nat.le_of_lt_succ <| by simpa [ Fin.castSucc_lt_succ ] using ‹j < i› ) ha₁

/- That was enough of a dive. Back to maths. Well, first, two trivial estimates.-/

/- The length of the i-th subinterval of a partition P is at most the mesh of P. -/ lemma mesh_ge_diff {a b : ℝ} (P : IPartition a b) (i : Fin P.n) : P.x i.succ - P.x i.castSucc ≤ P.mesh := by apply Basic.le_max_getD apply Finset.mem_image_of_mem exact Finset.mem_univ i

/- Helper lemmas: index_map_last shows the index map preserves the last element. exists_index_between shows that for any j in the range of k, there is an interval [k i, k (i+1)) containing j. -/ lemma index_map_last {a b : ℝ} {P R : IPartition a b} (hR : StrictMono R.x) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk_eq : ∀ i, R.x (k i) = P.x i) : k (Fin.last P.n) = Fin.last R.n := by -- Since $R.x$ is strictly monotone, the only way $R.x (k (Fin.last P.n)) = b$ can hold is if $k (Fin.last P.n)$ is the last element of $R$. have h_last : R.x (k (Fin.last P.n)) = R.x (Fin.last R.n) := by cases P ; cases R ; aesop; exact hR.injective h_last

lemma exists_index_between {n m : ℕ} (k : Fin (n + 1) → Fin (m + 1)) (hk : Monotone k) (hk0 : k 0 = 0) (hkn : k (Fin.last n) = Fin.last m) (j : Fin m) : ∃ i : Fin n, k i.castSucc ≤ j.castSucc ∧ j.castSucc < k i.succ := by by_contra h_contra; -- Since $k$ is monotone and $k 0 = 0$, we have $k i \le j$ for all $i$. have h_le : ∀ i : Fin (n + 1), k i ≤ Fin.castSucc j := by intro i; induction i using Fin.inductionOn <;> aesop; exact absurd ( h_le ( Fin.last n ) ) ( by simpa [ hkn ] using Fin.castSucc_lt_last j )

/- For any j in the codomain of a monotone map k (preserving endpoints), there exists i such that k i <= j < k (i+1). -/ lemma exists_index_between_v2 {n m : ℕ} (k : Fin (n + 1) → Fin (m + 1)) (hk : Monotone k) (hk0 : k 0 = 0) (hkn : k (Fin.last n) = Fin.last m) (j : Fin m) : ∃ i : Fin n, k i.castSucc ≤ j.castSucc ∧ j.castSucc < k i.succ := by exact exists_index_between k hk hk0 hkn j

/- For any y in [a, b], there exists a subinterval of P containing y, provided P.n > 0. -/ lemma mem_subinterval {a b : ℝ} (P : IPartition a b) (hn : 0 < P.n) {y : ℝ} (hy : y ∈ Set.Icc a b) : ∃ i : Fin P.n, y ∈ Set.Icc (P.x i.castSucc) (P.x i.succ) := by by_contra h_contra; -- Since the intervals [P.x i, P.x (i+1)] cover [a, b], there must be some i such that y is in [P.x i, P.x (i+1)]. have h_cover : ∀ y ∈ Set.Icc a b, ∃ i : Fin P.n, y ∈ Set.Icc (P.x i.castSucc) (P.x i.succ) := by intro y hy obtain ⟨i, hi⟩ : ∃ i : Fin (P.n + 1), y ≤ P.x i ∧ ∀ j : Fin (P.n + 1), y ≤ P.x j → i ≤ j := by have h_exists_i : ∃ i : Fin (P.n + 1), y ≤ P.x i := by exact ⟨ Fin.last _, by linarith [ hy.2, P.right ] ⟩; exact ⟨ Finset.min' ( Finset.univ.filter fun i => y ≤ P.x i ) ⟨ h_exists_i.choose, Finset.mem_filter.mpr ⟨ Finset.mem_univ _, h_exists_i.choose_spec ⟩ ⟩, Finset.mem_filter.mp ( Finset.min'_mem ( Finset.univ.filter fun i => y ≤ P.x i ) ⟨ h_exists_i.choose, Finset.mem_filter.mpr ⟨ Finset.mem_univ _, h_exists_i.choose_spec ⟩ ⟩ ) |>.2, fun j hj => Finset.min'_le _ _ <| by aesop ⟩; induction' i using Fin.inductionOn with i IH; · exact ⟨ ⟨ 0, hn ⟩, by simpa [ P.left ] using hy.1, by simpa [ P.left ] using P.monotone ( Nat.zero_le _ ) |> le_trans hi.1 ⟩; · exact ⟨ i, ⟨ by exact le_of_not_gt fun h => not_lt_of_ge ( hi.2 _ h.le ) ( Fin.castSucc_lt_succ i ), hi.1 ⟩ ⟩; exact h_contra <| h_cover y hy

/- The following lemmas on partitions are an overly complicated route towards the simple bound at the end of this namespace (IPart) -/ /- There are no partition points strictly between two consecutive points of a partition. -/ lemma no_points_between {a b : ℝ} (R : IPartition a b) (j : Fin R.n) (k : Fin (R.n + 1)) : ¬ (R.x j.castSucc < R.x k ∧ R.x k < R.x j.succ) := by intro hRS.IPart.fromPoints_strictMono; -- Since $R$ is a partition, $R.x$ is monotone, so $R.x j.castSucc < R.x k$ implies $j.castSucc < k$. have h_castSucc_lt_k : j.castSucc < k := by exact lt_of_not_ge fun h => hRS.IPart.fromPoints_strictMono.1.not_ge ( R.monotone ( by simpa ) ); -- Since $R$ is a partition, $R.x$ is monotone, so $R.x k < R.x j.succ$ implies $k < j.succ$. have h_k_lt_succ : k < j.succ := by exact lt_of_not_ge fun h => hRS.IPart.fromPoints_strictMono.2.not_ge <| R.monotone h; exact h_castSucc_lt_k.not_ge ( Nat.le_of_lt_succ h_k_lt_succ )

/- No point of partition P lies strictly between two consecutive points of its refinement R. -/ lemma no_P_point_between {a b : ℝ} {P R : IPartition a b} (h : IsRefinement R P) (j : Fin R.n) (i : Fin (P.n + 1)) : ¬ (R.x j.castSucc < P.x i ∧ P.x i < R.x j.succ) := by exact Classical.not_not.1 fun H => no_points_between R j ( Classical.choose ( Finset.mem_image.1 ( h ( Finset.mem_image_of_mem _ ( Finset.mem_univ i ) ) ) ) ) |>.elim <| by have := Classical.choose_spec ( Finset.mem_image.1 ( h ( Finset.mem_image_of_mem _ ( Finset.mem_univ i ) ) ) ) ; aesop;

/- If partition R refines partition P, then every subinterval of R is contained in some subinterval of P. -/ lemma refinement_interval_subset {a b : ℝ} {P R : IPartition a b} (h : IsRefinement R P) (hn : P.n > 0) (j : Fin R.n) : ∃ i : Fin P.n, P.x i.castSucc ≤ R.x j.castSucc ∧ R.x j.succ ≤ P.x i.succ := by have h_max : ∃ i : Fin P.n, P.x i.castSucc ≤ R.x j.castSucc ∧ ∀ k : Fin P.n, P.x k.castSucc ≤ R.x j.castSucc → k ≤ i := by have h_max : ∃ i ∈ Finset.univ.filter (fun k : Fin P.n => P.x k.castSucc ≤ R.x j.castSucc), ∀ k ∈ Finset.univ.filter (fun k : Fin P.n => P.x k.castSucc ≤ R.x j.castSucc), i ≥ k := by apply_rules [ Finset.exists_max_image ]; exact ⟨ ⟨ 0, hn ⟩, by simpa using by linarith [ P.monotone ( show 0 ≤ Fin.last _ from Nat.zero_le _ ), P.left, P.right, R.monotone ( show 0 ≤ Fin.castSucc j from Nat.zero_le _ ), R.left, R.right ] ⟩; aesop; obtain ⟨ i, hi₁, hi₂ ⟩ := h_max; by_cases hi₃ : P.x i.succ ≤ R.x j.castSucc; · contrapose! hi₂; use ⟨ i + 1, by by_contra h_contra; have := hi₂ i hi₁; simp_all +decide [ Fin.eq_last_of_not_lt ] ; linarith [ P.right, R.left, R.right, R.monotone ( show j.succ ≤ Fin.last R.n from Fin.le_last _ ) ] ⟩ generalize_proofs at *; exact ⟨ hi₃, Nat.lt_succ_self _ ⟩; · refine' ⟨ i, hi₁, _ ⟩; contrapose! hi₂; exact False.elim <| no_P_point_between h j ( i.succ ) ⟨ by linarith, by linarith ⟩

/- Every subinterval of a refinement R has length at most the mesh of P.

Sum of absolute increments of g over an untagged partition. -/ def sumAbsDiff {a b : ℝ} (g : ℝ → ℝ) (P : IPart.IPartition a b) : ℝ := ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)|

/- The absolute difference of g over a subinterval of P is bounded by the sum of absolute differences of g over the corresponding subintervals of R. -/ lemma sumAbsDiff_block_le {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) (i : Fin P.n) : |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by rw [← hk_eq i.succ, ← hk_eq i.castSucc] rw [← IPart.sum_telescope_block g R (k i.castSucc) (k i.succ) (hk (Nat.le_succ _))] apply Finset.abs_sum_le_sum_abs

/- sumAbsDiff is monotonic with respect to partition refinement.

Sum of absolute increments of g over an untagged partition. -/ def sumAbsDiff {a b : ℝ} (g : ℝ → ℝ) (P : IPart.IPartition a b) : ℝ := ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)|

/- The absolute difference of g over a subinterval of P is bounded by the sum of absolute differences of g over the corresponding subintervals of R. -/ lemma sumAbsDiff_block_le {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) (i : Fin P.n) : |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by rw [← hk_eq i.succ, ← hk_eq i.castSucc] rw [← IPart.sum_telescope_block g R (k i.castSucc) (k i.succ) (hk (Nat.le_succ _))] apply Finset.abs_sum_le_sum_abs

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_mono_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by -- Use refinement_index_map to get k. obtain ⟨k, , hk_eq⟩ : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by exact IPart.refinement_index_map P R hPR; -- Apply sumAbsDiff_block_le to bound the sum over P by the double sum over blocks of R. have h_sum_le_double_sum : ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by exact Finset.sum_le_sum fun i _ => sumAbsDiff_block_le k ‹› ‹_› i; -- Use sum_partition_blocks to collapse the double sum into a single sum over Ico (k 0) (k P.n). have h_double_sum_to_single_sum : ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| := by have h_double_sum_to_single_sum : ∀ (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k), ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), |IPart.term g R j| := by exact fun n k hk ↦ IPart.sum_partition_blocks n k hk fun j ↦ |IPart.term g R j|; convert h_double_sum_to_single_sum P.n ( fun i => ( k i : ℕ ) ) ( fun i j hij => by simpa using ‹Monotone k› hij ) using 1; -- Bound this sum by the sum over range R.n (since terms are non-negative and the interval is a subset). have h_single_sum_le_range : ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| ≤ ∑ j ∈ Finset.Ico 0 R.n, |IPart.term g R j| := by refine' Finset.sum_le_sum_of_subset_of_nonneg _ fun _ _ _ => abs_nonneg _; refine' Finset.Ico_subset_Ico _ _ <;> norm_num; exact Nat.le_of_lt_succ ( Fin.is_lt _ ); convert h_sum_le_double_sum.trans ( h_double_sum_to_single_sum.le.trans h_single_sum_le_range ) using 1; simp +decide [ sumAbsDiff, Finset.sum_range, Fin.cast_val_eq_self ]; refine' Finset.sum_congr rfl fun i hi => _ ; unfold IPart.term ; aesop

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_le_sumAbsDiff_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by convert sumAbsDiff_mono_of_refinement hPR using 1

/- If x is a monotone sequence of points contained in partition P, then the sum of absolute differences of g along x is bounded by sumAbsDiff g P.

Sum of absolute increments of g over an untagged partition. -/ def sumAbsDiff {a b : ℝ} (g : ℝ → ℝ) (P : IPart.IPartition a b) : ℝ := ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)|

/- The absolute difference of g over a subinterval of P is bounded by the sum of absolute differences of g over the corresponding subintervals of R. -/ lemma sumAbsDiff_block_le {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) (i : Fin P.n) : |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by rw [← hk_eq i.succ, ← hk_eq i.castSucc] rw [← IPart.sum_telescope_block g R (k i.castSucc) (k i.succ) (hk (Nat.le_succ _))] apply Finset.abs_sum_le_sum_abs

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_mono_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by -- Use refinement_index_map to get k. obtain ⟨k, , hk_eq⟩ : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by exact IPart.refinement_index_map P R hPR; -- Apply sumAbsDiff_block_le to bound the sum over P by the double sum over blocks of R. have h_sum_le_double_sum : ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by exact Finset.sum_le_sum fun i _ => sumAbsDiff_block_le k ‹› ‹_› i; -- Use sum_partition_blocks to collapse the double sum into a single sum over Ico (k 0) (k P.n). have h_double_sum_to_single_sum : ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| := by have h_double_sum_to_single_sum : ∀ (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k), ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), |IPart.term g R j| := by exact fun n k hk ↦ IPart.sum_partition_blocks n k hk fun j ↦ |IPart.term g R j|; convert h_double_sum_to_single_sum P.n ( fun i => ( k i : ℕ ) ) ( fun i j hij => by simpa using ‹Monotone k› hij ) using 1; -- Bound this sum by the sum over range R.n (since terms are non-negative and the interval is a subset). have h_single_sum_le_range : ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| ≤ ∑ j ∈ Finset.Ico 0 R.n, |IPart.term g R j| := by refine' Finset.sum_le_sum_of_subset_of_nonneg _ fun _ _ _ => abs_nonneg _; refine' Finset.Ico_subset_Ico _ _ <;> norm_num; exact Nat.le_of_lt_succ ( Fin.is_lt _ ); convert h_sum_le_double_sum.trans ( h_double_sum_to_single_sum.le.trans h_single_sum_le_range ) using 1; simp +decide [ sumAbsDiff, Finset.sum_range, Fin.cast_val_eq_self ]; refine' Finset.sum_congr rfl fun i hi => _ ; unfold IPart.term ; aesop

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_le_sumAbsDiff_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by convert sumAbsDiff_mono_of_refinement hPR using 1

/- If x is a monotone sequence of points contained in partition P, then the sum of absolute differences of g along x is bounded by sumAbsDiff g P. -/ lemma sum_le_sumAbsDiff_of_points_subset {a b : ℝ} (g : ℝ → ℝ) (P : RS.IPart.IPartition a b) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (h_subset : ∀ i, x i ∈ P.points) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ RS.SumDiff.sumAbsDiff g P := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : Fin (p + 1) → Fin (P.n + 1), Monotone k ∧ ∀ i : Fin (p + 1), P.x (k i) = x i := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$ by the properties of the points of $P$. have h_k_exists : ∀ y ∈ P.points, ∃ i : Fin (P.n + 1), P.x i = y := by exact fun y hy => by rw [ IPart.IPartition.points ] at hy; aesop; choose k hk using h_k_exists; use fun i => k ( x i ) ( h_subset i ); have h_k_mono : ∀ i j : Fin (p + 1), x i ≤ x j → k (x i) (h_subset i) ≤ k (x j) (h_subset j) := by intros i j hij have h_k_mono : P.x (k (x i) (h_subset i)) ≤ P.x (k (x j) (h_subset j)) := by aesop; contrapose! h_k_mono; apply_rules [ P.monotone, lt_of_le_of_ne ]; · exact le_of_lt h_k_mono; · grind; exact ⟨ fun i j hij => h_k_mono i j <| hx hij, fun i => hk _ _ ⟩; -- Apply the lemma sum_telescope_abs_le to each term in the sum. have h_telescope : ∀ i : Fin p, |g (x (i.succ)) - g (x (i.castSucc))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by intros i have h_telescope : |g (P.x (k (i.succ))) - g (P.x (k (i.castSucc)))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by convert IPart.sum_telescope_abs_le g P ( k ( Fin.castSucc i ) ) ( k ( Fin.succ i ) ) _ using 1; exact hk.1 ( Nat.le_succ _ ); aesop; -- Apply the lemma sum_partition_blocks to combine the sums over the intervals [k i, k (i+1)). have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| ≤ ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by convert RS.IPart.sum_partition_blocks p ( fun i => ( k i : ℕ ) ) hk.1 _ using 1; grind; refine le_trans ( Finset.sum_le_sum fun i _ => h_telescope i ) ( h_sum_partition_blocks.trans ?_ ); refine' le_trans ( Finset.sum_le_sum_of_subset_of_nonneg ( Finset.subset_iff.mpr _ ) fun _ _ _ => abs_nonneg _ ) _; exact Finset.range P.n; · simp +zetaDelta at *; intro i hi₁ hi₂; exact lt_of_lt_of_le hi₂ ( Nat.le_of_lt_succ <| by simp [ Fin.is_lt ] ) ; · simp +decide [ Finset.sum_range, IPart.term ]; rfl

lemma sum_le_K_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : RS.IPart.IPartition a b, sumAbsDiff g P ≤ K) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by -- Let s be the set of values of x union {a, b}. set s : Finset ℝ := Finset.image x Finset.univ ∪ {a, b} with hs_def; -- Construct a partition P from s using RS.IPart.fromPoints. obtain ⟨P, hP⟩ : ∃ P : IPart.IPartition a b, P.points = s := by refine' ⟨ IPart.fromPoints s _ _ _, _ ⟩ <;> norm_num [ hs_def ]; grind; convert IPart.points_fromPoints _ _ _ _; convert sum_le_sumAbsDiff_of_points_subset g P p x hx _ |> le_trans <| hK P; grind

/- If the sum of absolute differences of g over any partition is bounded by K, then the total variation of g is bounded by K.

Sum of absolute increments of g over an untagged partition. -/ def sumAbsDiff {a b : ℝ} (g : ℝ → ℝ) (P : IPart.IPartition a b) : ℝ := ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)|

/- The absolute difference of g over a subinterval of P is bounded by the sum of absolute differences of g over the corresponding subintervals of R. -/ lemma sumAbsDiff_block_le {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) (i : Fin P.n) : |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by rw [← hk_eq i.succ, ← hk_eq i.castSucc] rw [← IPart.sum_telescope_block g R (k i.castSucc) (k i.succ) (hk (Nat.le_succ _))] apply Finset.abs_sum_le_sum_abs

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_mono_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by -- Use refinement_index_map to get k. obtain ⟨k, , hk_eq⟩ : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by exact IPart.refinement_index_map P R hPR; -- Apply sumAbsDiff_block_le to bound the sum over P by the double sum over blocks of R. have h_sum_le_double_sum : ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by exact Finset.sum_le_sum fun i _ => sumAbsDiff_block_le k ‹› ‹_› i; -- Use sum_partition_blocks to collapse the double sum into a single sum over Ico (k 0) (k P.n). have h_double_sum_to_single_sum : ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| := by have h_double_sum_to_single_sum : ∀ (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k), ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), |IPart.term g R j| := by exact fun n k hk ↦ IPart.sum_partition_blocks n k hk fun j ↦ |IPart.term g R j|; convert h_double_sum_to_single_sum P.n ( fun i => ( k i : ℕ ) ) ( fun i j hij => by simpa using ‹Monotone k› hij ) using 1; -- Bound this sum by the sum over range R.n (since terms are non-negative and the interval is a subset). have h_single_sum_le_range : ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| ≤ ∑ j ∈ Finset.Ico 0 R.n, |IPart.term g R j| := by refine' Finset.sum_le_sum_of_subset_of_nonneg _ fun _ _ _ => abs_nonneg _; refine' Finset.Ico_subset_Ico _ _ <;> norm_num; exact Nat.le_of_lt_succ ( Fin.is_lt _ ); convert h_sum_le_double_sum.trans ( h_double_sum_to_single_sum.le.trans h_single_sum_le_range ) using 1; simp +decide [ sumAbsDiff, Finset.sum_range, Fin.cast_val_eq_self ]; refine' Finset.sum_congr rfl fun i hi => _ ; unfold IPart.term ; aesop

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_le_sumAbsDiff_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by convert sumAbsDiff_mono_of_refinement hPR using 1

/- If x is a monotone sequence of points contained in partition P, then the sum of absolute differences of g along x is bounded by sumAbsDiff g P. -/ lemma sum_le_sumAbsDiff_of_points_subset {a b : ℝ} (g : ℝ → ℝ) (P : RS.IPart.IPartition a b) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (h_subset : ∀ i, x i ∈ P.points) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ RS.SumDiff.sumAbsDiff g P := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : Fin (p + 1) → Fin (P.n + 1), Monotone k ∧ ∀ i : Fin (p + 1), P.x (k i) = x i := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$ by the properties of the points of $P$. have h_k_exists : ∀ y ∈ P.points, ∃ i : Fin (P.n + 1), P.x i = y := by exact fun y hy => by rw [ IPart.IPartition.points ] at hy; aesop; choose k hk using h_k_exists; use fun i => k ( x i ) ( h_subset i ); have h_k_mono : ∀ i j : Fin (p + 1), x i ≤ x j → k (x i) (h_subset i) ≤ k (x j) (h_subset j) := by intros i j hij have h_k_mono : P.x (k (x i) (h_subset i)) ≤ P.x (k (x j) (h_subset j)) := by aesop; contrapose! h_k_mono; apply_rules [ P.monotone, lt_of_le_of_ne ]; · exact le_of_lt h_k_mono; · grind; exact ⟨ fun i j hij => h_k_mono i j <| hx hij, fun i => hk _ _ ⟩; -- Apply the lemma sum_telescope_abs_le to each term in the sum. have h_telescope : ∀ i : Fin p, |g (x (i.succ)) - g (x (i.castSucc))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by intros i have h_telescope : |g (P.x (k (i.succ))) - g (P.x (k (i.castSucc)))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by convert IPart.sum_telescope_abs_le g P ( k ( Fin.castSucc i ) ) ( k ( Fin.succ i ) ) _ using 1; exact hk.1 ( Nat.le_succ _ ); aesop; -- Apply the lemma sum_partition_blocks to combine the sums over the intervals [k i, k (i+1)). have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| ≤ ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by convert RS.IPart.sum_partition_blocks p ( fun i => ( k i : ℕ ) ) hk.1 _ using 1; grind; refine le_trans ( Finset.sum_le_sum fun i _ => h_telescope i ) ( h_sum_partition_blocks.trans ?_ ); refine' le_trans ( Finset.sum_le_sum_of_subset_of_nonneg ( Finset.subset_iff.mpr _ ) fun _ _ _ => abs_nonneg _ ) _; exact Finset.range P.n; · simp +zetaDelta at *; intro i hi₁ hi₂; exact lt_of_lt_of_le hi₂ ( Nat.le_of_lt_succ <| by simp [ Fin.is_lt ] ) ; · simp +decide [ Finset.sum_range, IPart.term ]; rfl

lemma sum_le_K_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : RS.IPart.IPartition a b, sumAbsDiff g P ≤ K) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by -- Let s be the set of values of x union {a, b}. set s : Finset ℝ := Finset.image x Finset.univ ∪ {a, b} with hs_def; -- Construct a partition P from s using RS.IPart.fromPoints. obtain ⟨P, hP⟩ : ∃ P : IPart.IPartition a b, P.points = s := by refine' ⟨ IPart.fromPoints s _ _ _, _ ⟩ <;> norm_num [ hs_def ]; grind; convert IPart.points_fromPoints _ _ _ _; convert sum_le_sumAbsDiff_of_points_subset g P p x hx _ |> le_trans <| hK P; grind

/- If the sum of absolute differences of g over any partition is bounded by K, then the total variation of g is bounded by K. -/ lemma variation_le_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : IPart.IPartition a b, sumAbsDiff g P ≤ K) : (eVariationOn g (Set.Icc a b)).toReal ≤ K := by -- We know that for any monotone sequence x, the sum of absolute differences is ≤ K. have h_sum_le : ∀ (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b), ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by intro p x hx hx_mem exact sum_le_K_of_forall_sumAbsDiff_le hab g K hK p x hx hx_mem

-- Now we relate this to eVariationOn. -- eVariationOn is the supremum of these sums (converted to ENNReal). -- We show eVariationOn ≤ ENNReal.ofReal K. have h_var_le : eVariationOn g (Set.Icc a b) ≤ ENNReal.ofReal K := by -- Unfold eVariationOn to its definition as a supremum -- Since eVariationOn is defined as a supr, we use iSup_le -- Note: The definition might be wrapped. -- We can try to use eVariationOn properties or just unfold it. -- Assuming standard definition: -- ref: https://leanprover-community.github.io/mathlib4_docs/Mathlib/Analysis/Variation.html#eVariationOn -- It is iSup over p, x. refine' iSup_le _; rintro ⟨ p, ⟨ x, hx₁, hx₂ ⟩ ⟩; simp_all +decide [ edist_dist, Real.dist_eq ]; convert ENNReal.ofReal_le_ofReal ( h_sum_le p ( fun i => x i ) ( fun i j hij => hx₁ hij ) ( fun i => hx₂ i ) ) using 1; rw [ ENNReal.ofReal_sum_of_nonneg fun _ _ => abs_nonneg _, Finset.sum_range ]; exact rfl

/- If the sum of absolute differences of g over any partition is bounded by K, then the sum of absolute differences along any monotone sequence in [a, b] is bounded by K. -/

-- Finally, convert to Real. apply ENNReal.toReal_le_of_le_ofReal · -- K ≥ 0 have P := RS.IPart.uniformPartition 1 hab have := hK P calc 0 ≤ RS.SumDiff.sumAbsDiff g P := by apply Finset.sum_nonneg intro i _ apply abs_nonneg _ ≤ K := this · exact h_var_le

end SumDiff

/- First, a definition of tagged partitions, followed by some basic lemmas -/ /- A tagged Riemann-Stieltjes partition includes points xi in each subinterval [x_i, x_{i+1}]. -/

namespace Integ

structure TaggedPartition (a b : ℝ) extends IPart.IPartition a b where xi : Fin n → ℝ h_xi : ∀ i : Fin n, x i.castSucc ≤ xi i ∧ xi i ≤ x i.succ

/- The filter of tagged partitions with mesh tending to 0. -/ def TaggedPartitionFilter (a b : ℝ) : Filter (TaggedPartition a b) := Filter.comap (fun P => P.mesh) (nhds 0)

/- A uniform partition with left tags. We need that simply because our filter is a filter of tagged partitions. -/ def taggedUniformPartition {a b : ℝ} (n : ℕ) (hab : a < b) : TaggedPartition a b := let P := IPart.uniformPartition n hab { toIPartition := P xi := fun i => P.x i.castSucc h_xi := by intro i constructor · exact le_refl _ · apply P.monotone apply Nat.le_succ }

/- The partition filter is proper, that is, there exist partitions of [a,b] of arbitrarily small mesh.

Sum of absolute increments of g over an untagged partition. -/ def sumAbsDiff {a b : ℝ} (g : ℝ → ℝ) (P : IPart.IPartition a b) : ℝ := ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)|

/- The absolute difference of g over a subinterval of P is bounded by the sum of absolute differences of g over the corresponding subintervals of R. -/ lemma sumAbsDiff_block_le {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) (i : Fin P.n) : |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by rw [← hk_eq i.succ, ← hk_eq i.castSucc] rw [← IPart.sum_telescope_block g R (k i.castSucc) (k i.succ) (hk (Nat.le_succ _))] apply Finset.abs_sum_le_sum_abs

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_mono_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by -- Use refinement_index_map to get k. obtain ⟨k, , hk_eq⟩ : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by exact IPart.refinement_index_map P R hPR; -- Apply sumAbsDiff_block_le to bound the sum over P by the double sum over blocks of R. have h_sum_le_double_sum : ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by exact Finset.sum_le_sum fun i _ => sumAbsDiff_block_le k ‹› ‹_› i; -- Use sum_partition_blocks to collapse the double sum into a single sum over Ico (k 0) (k P.n). have h_double_sum_to_single_sum : ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| := by have h_double_sum_to_single_sum : ∀ (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k), ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), |IPart.term g R j| := by exact fun n k hk ↦ IPart.sum_partition_blocks n k hk fun j ↦ |IPart.term g R j|; convert h_double_sum_to_single_sum P.n ( fun i => ( k i : ℕ ) ) ( fun i j hij => by simpa using ‹Monotone k› hij ) using 1; -- Bound this sum by the sum over range R.n (since terms are non-negative and the interval is a subset). have h_single_sum_le_range : ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| ≤ ∑ j ∈ Finset.Ico 0 R.n, |IPart.term g R j| := by refine' Finset.sum_le_sum_of_subset_of_nonneg _ fun _ _ _ => abs_nonneg _; refine' Finset.Ico_subset_Ico _ _ <;> norm_num; exact Nat.le_of_lt_succ ( Fin.is_lt _ ); convert h_sum_le_double_sum.trans ( h_double_sum_to_single_sum.le.trans h_single_sum_le_range ) using 1; simp +decide [ sumAbsDiff, Finset.sum_range, Fin.cast_val_eq_self ]; refine' Finset.sum_congr rfl fun i hi => _ ; unfold IPart.term ; aesop

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_le_sumAbsDiff_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by convert sumAbsDiff_mono_of_refinement hPR using 1

/- If x is a monotone sequence of points contained in partition P, then the sum of absolute differences of g along x is bounded by sumAbsDiff g P. -/ lemma sum_le_sumAbsDiff_of_points_subset {a b : ℝ} (g : ℝ → ℝ) (P : RS.IPart.IPartition a b) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (h_subset : ∀ i, x i ∈ P.points) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ RS.SumDiff.sumAbsDiff g P := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : Fin (p + 1) → Fin (P.n + 1), Monotone k ∧ ∀ i : Fin (p + 1), P.x (k i) = x i := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$ by the properties of the points of $P$. have h_k_exists : ∀ y ∈ P.points, ∃ i : Fin (P.n + 1), P.x i = y := by exact fun y hy => by rw [ IPart.IPartition.points ] at hy; aesop; choose k hk using h_k_exists; use fun i => k ( x i ) ( h_subset i ); have h_k_mono : ∀ i j : Fin (p + 1), x i ≤ x j → k (x i) (h_subset i) ≤ k (x j) (h_subset j) := by intros i j hij have h_k_mono : P.x (k (x i) (h_subset i)) ≤ P.x (k (x j) (h_subset j)) := by aesop; contrapose! h_k_mono; apply_rules [ P.monotone, lt_of_le_of_ne ]; · exact le_of_lt h_k_mono; · grind; exact ⟨ fun i j hij => h_k_mono i j <| hx hij, fun i => hk _ _ ⟩; -- Apply the lemma sum_telescope_abs_le to each term in the sum. have h_telescope : ∀ i : Fin p, |g (x (i.succ)) - g (x (i.castSucc))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by intros i have h_telescope : |g (P.x (k (i.succ))) - g (P.x (k (i.castSucc)))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by convert IPart.sum_telescope_abs_le g P ( k ( Fin.castSucc i ) ) ( k ( Fin.succ i ) ) _ using 1; exact hk.1 ( Nat.le_succ _ ); aesop; -- Apply the lemma sum_partition_blocks to combine the sums over the intervals [k i, k (i+1)). have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| ≤ ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by convert RS.IPart.sum_partition_blocks p ( fun i => ( k i : ℕ ) ) hk.1 _ using 1; grind; refine le_trans ( Finset.sum_le_sum fun i _ => h_telescope i ) ( h_sum_partition_blocks.trans ?_ ); refine' le_trans ( Finset.sum_le_sum_of_subset_of_nonneg ( Finset.subset_iff.mpr _ ) fun _ _ _ => abs_nonneg _ ) _; exact Finset.range P.n; · simp +zetaDelta at *; intro i hi₁ hi₂; exact lt_of_lt_of_le hi₂ ( Nat.le_of_lt_succ <| by simp [ Fin.is_lt ] ) ; · simp +decide [ Finset.sum_range, IPart.term ]; rfl

lemma sum_le_K_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : RS.IPart.IPartition a b, sumAbsDiff g P ≤ K) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by -- Let s be the set of values of x union {a, b}. set s : Finset ℝ := Finset.image x Finset.univ ∪ {a, b} with hs_def; -- Construct a partition P from s using RS.IPart.fromPoints. obtain ⟨P, hP⟩ : ∃ P : IPart.IPartition a b, P.points = s := by refine' ⟨ IPart.fromPoints s _ _ _, _ ⟩ <;> norm_num [ hs_def ]; grind; convert IPart.points_fromPoints _ _ _ _; convert sum_le_sumAbsDiff_of_points_subset g P p x hx _ |> le_trans <| hK P; grind

/- If the sum of absolute differences of g over any partition is bounded by K, then the total variation of g is bounded by K. -/ lemma variation_le_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : IPart.IPartition a b, sumAbsDiff g P ≤ K) : (eVariationOn g (Set.Icc a b)).toReal ≤ K := by -- We know that for any monotone sequence x, the sum of absolute differences is ≤ K. have h_sum_le : ∀ (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b), ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by intro p x hx hx_mem exact sum_le_K_of_forall_sumAbsDiff_le hab g K hK p x hx hx_mem

-- Now we relate this to eVariationOn. -- eVariationOn is the supremum of these sums (converted to ENNReal). -- We show eVariationOn ≤ ENNReal.ofReal K. have h_var_le : eVariationOn g (Set.Icc a b) ≤ ENNReal.ofReal K := by -- Unfold eVariationOn to its definition as a supremum -- Since eVariationOn is defined as a supr, we use iSup_le -- Note: The definition might be wrapped. -- We can try to use eVariationOn properties or just unfold it. -- Assuming standard definition: -- ref: https://leanprover-community.github.io/mathlib4_docs/Mathlib/Analysis/Variation.html#eVariationOn -- It is iSup over p, x. refine' iSup_le _; rintro ⟨ p, ⟨ x, hx₁, hx₂ ⟩ ⟩; simp_all +decide [ edist_dist, Real.dist_eq ]; convert ENNReal.ofReal_le_ofReal ( h_sum_le p ( fun i => x i ) ( fun i j hij => hx₁ hij ) ( fun i => hx₂ i ) ) using 1; rw [ ENNReal.ofReal_sum_of_nonneg fun _ _ => abs_nonneg _, Finset.sum_range ]; exact rfl

/- If the sum of absolute differences of g over any partition is bounded by K, then the sum of absolute differences along any monotone sequence in [a, b] is bounded by K. -/

-- Finally, convert to Real. apply ENNReal.toReal_le_of_le_ofReal · -- K ≥ 0 have P := RS.IPart.uniformPartition 1 hab have := hK P calc 0 ≤ RS.SumDiff.sumAbsDiff g P := by apply Finset.sum_nonneg intro i _ apply abs_nonneg _ ≤ K := this · exact h_var_le

end SumDiff

/- First, a definition of tagged partitions, followed by some basic lemmas -/ /- A tagged Riemann-Stieltjes partition includes points xi in each subinterval [x_i, x_{i+1}]. -/

namespace Integ

structure TaggedPartition (a b : ℝ) extends IPart.IPartition a b where xi : Fin n → ℝ h_xi : ∀ i : Fin n, x i.castSucc ≤ xi i ∧ xi i ≤ x i.succ

/- The filter of tagged partitions with mesh tending to 0. -/ def TaggedPartitionFilter (a b : ℝ) : Filter (TaggedPartition a b) := Filter.comap (fun P => P.mesh) (nhds 0)

/- A uniform partition with left tags. We need that simply because our filter is a filter of tagged partitions. -/ def taggedUniformPartition {a b : ℝ} (n : ℕ) (hab : a < b) : TaggedPartition a b := let P := IPart.uniformPartition n hab { toIPartition := P xi := fun i => P.x i.castSucc h_xi := by intro i constructor · exact le_refl _ · apply P.monotone apply Nat.le_succ }

/- The partition filter is proper, that is, there exist partitions of [a,b] of arbitrarily small mesh. -/ lemma TaggedPartitionFilter_neBot {a b : ℝ} (hab : a < b) : Filter.NeBot (TaggedPartitionFilter a b) := by refine' Filter.neBot_iff.mpr _; rw [ Ne.eq_def, Filter.ext_iff ]; simp +zetaDelta at *; use ∅; intro h; obtain ⟨ U, hU₁, hU₂ ⟩ := Filter.mem_comap.mp h; simp_all +decide [ Set.subset_def ]; contrapose! hU₂; rcases Metric.mem_nhds_iff.mp hU₁ with ⟨ ε, εpos, hε ⟩; -- Choose $n$ such that $(b - a) / (n + 1) < \epsilon$. obtain ⟨ n, hn ⟩ : ∃ n : ℕ, (b - a) / (n + 1) < ε := by exact ⟨ ⌊ ( b - a ) / ε⌋₊, by rw [ div_lt_iff₀ ] <;> nlinarith [ Nat.lt_floor_add_one ( ( b - a ) / ε ), mul_div_cancel₀ ( b - a ) εpos.ne' ] ⟩; refine' ⟨ taggedUniformPartition n hab, hε _ ⟩; simp +zetaDelta at *; rw [ abs_of_nonneg ( IPart.mesh_nonneg _ ) ]; convert hn using 1; convert IPart.mesh_uniformPartition n hab using 1

/- A tagged partition where the tags are the left endpoints of the intervals. -/ def tagLeft {a b : ℝ} (P : IPart.IPartition a b) : TaggedPartition a b := { P with xi := fun i => P.x i.castSucc h_xi := fun i => ⟨le_refl _, P.monotone (Nat.le_succ _)⟩ }

/- We finally come to Riemann-Stieltjes sums and to the definition of Riemann-Stieltjes integrals!-/ /- The Riemann-Stieltjes sum S(P, f, g) is the sum of f(xi_i) * (g(x_{i+1}) - g(x_i)). -/ def RSSum {a b : ℝ} (f g : ℝ → ℝ) (P : TaggedPartition a b) : ℝ := ∑ i : Fin P.n, f (P.xi i) * (g (P.x i.succ) - g (P.x i.castSucc))

/- The Riemann-Stieltjes integral of f with respect to g on [a, b] has value I. -/ def HasRSIntegral (f g : ℝ → ℝ) (a b I : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P : TaggedPartition a b), P.mesh ≤ δ → |RSSum f g P - I| < ε

/- HasRSIntegral is equivalent to convergence along the tagged partition filter.

Sum of absolute increments of g over an untagged partition. -/ def sumAbsDiff {a b : ℝ} (g : ℝ → ℝ) (P : IPart.IPartition a b) : ℝ := ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)|

/- The absolute difference of g over a subinterval of P is bounded by the sum of absolute differences of g over the corresponding subintervals of R. -/ lemma sumAbsDiff_block_le {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) (i : Fin P.n) : |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by rw [← hk_eq i.succ, ← hk_eq i.castSucc] rw [← IPart.sum_telescope_block g R (k i.castSucc) (k i.succ) (hk (Nat.le_succ _))] apply Finset.abs_sum_le_sum_abs

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_mono_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by -- Use refinement_index_map to get k. obtain ⟨k, , hk_eq⟩ : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by exact IPart.refinement_index_map P R hPR; -- Apply sumAbsDiff_block_le to bound the sum over P by the double sum over blocks of R. have h_sum_le_double_sum : ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by exact Finset.sum_le_sum fun i _ => sumAbsDiff_block_le k ‹› ‹_› i; -- Use sum_partition_blocks to collapse the double sum into a single sum over Ico (k 0) (k P.n). have h_double_sum_to_single_sum : ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| := by have h_double_sum_to_single_sum : ∀ (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k), ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), |IPart.term g R j| := by exact fun n k hk ↦ IPart.sum_partition_blocks n k hk fun j ↦ |IPart.term g R j|; convert h_double_sum_to_single_sum P.n ( fun i => ( k i : ℕ ) ) ( fun i j hij => by simpa using ‹Monotone k› hij ) using 1; -- Bound this sum by the sum over range R.n (since terms are non-negative and the interval is a subset). have h_single_sum_le_range : ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| ≤ ∑ j ∈ Finset.Ico 0 R.n, |IPart.term g R j| := by refine' Finset.sum_le_sum_of_subset_of_nonneg _ fun _ _ _ => abs_nonneg _; refine' Finset.Ico_subset_Ico _ _ <;> norm_num; exact Nat.le_of_lt_succ ( Fin.is_lt _ ); convert h_sum_le_double_sum.trans ( h_double_sum_to_single_sum.le.trans h_single_sum_le_range ) using 1; simp +decide [ sumAbsDiff, Finset.sum_range, Fin.cast_val_eq_self ]; refine' Finset.sum_congr rfl fun i hi => _ ; unfold IPart.term ; aesop

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_le_sumAbsDiff_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by convert sumAbsDiff_mono_of_refinement hPR using 1

/- If x is a monotone sequence of points contained in partition P, then the sum of absolute differences of g along x is bounded by sumAbsDiff g P. -/ lemma sum_le_sumAbsDiff_of_points_subset {a b : ℝ} (g : ℝ → ℝ) (P : RS.IPart.IPartition a b) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (h_subset : ∀ i, x i ∈ P.points) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ RS.SumDiff.sumAbsDiff g P := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : Fin (p + 1) → Fin (P.n + 1), Monotone k ∧ ∀ i : Fin (p + 1), P.x (k i) = x i := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$ by the properties of the points of $P$. have h_k_exists : ∀ y ∈ P.points, ∃ i : Fin (P.n + 1), P.x i = y := by exact fun y hy => by rw [ IPart.IPartition.points ] at hy; aesop; choose k hk using h_k_exists; use fun i => k ( x i ) ( h_subset i ); have h_k_mono : ∀ i j : Fin (p + 1), x i ≤ x j → k (x i) (h_subset i) ≤ k (x j) (h_subset j) := by intros i j hij have h_k_mono : P.x (k (x i) (h_subset i)) ≤ P.x (k (x j) (h_subset j)) := by aesop; contrapose! h_k_mono; apply_rules [ P.monotone, lt_of_le_of_ne ]; · exact le_of_lt h_k_mono; · grind; exact ⟨ fun i j hij => h_k_mono i j <| hx hij, fun i => hk _ _ ⟩; -- Apply the lemma sum_telescope_abs_le to each term in the sum. have h_telescope : ∀ i : Fin p, |g (x (i.succ)) - g (x (i.castSucc))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by intros i have h_telescope : |g (P.x (k (i.succ))) - g (P.x (k (i.castSucc)))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by convert IPart.sum_telescope_abs_le g P ( k ( Fin.castSucc i ) ) ( k ( Fin.succ i ) ) _ using 1; exact hk.1 ( Nat.le_succ _ ); aesop; -- Apply the lemma sum_partition_blocks to combine the sums over the intervals [k i, k (i+1)). have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| ≤ ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by convert RS.IPart.sum_partition_blocks p ( fun i => ( k i : ℕ ) ) hk.1 _ using 1; grind; refine le_trans ( Finset.sum_le_sum fun i _ => h_telescope i ) ( h_sum_partition_blocks.trans ?_ ); refine' le_trans ( Finset.sum_le_sum_of_subset_of_nonneg ( Finset.subset_iff.mpr _ ) fun _ _ _ => abs_nonneg _ ) _; exact Finset.range P.n; · simp +zetaDelta at *; intro i hi₁ hi₂; exact lt_of_lt_of_le hi₂ ( Nat.le_of_lt_succ <| by simp [ Fin.is_lt ] ) ; · simp +decide [ Finset.sum_range, IPart.term ]; rfl

lemma sum_le_K_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : RS.IPart.IPartition a b, sumAbsDiff g P ≤ K) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by -- Let s be the set of values of x union {a, b}. set s : Finset ℝ := Finset.image x Finset.univ ∪ {a, b} with hs_def; -- Construct a partition P from s using RS.IPart.fromPoints. obtain ⟨P, hP⟩ : ∃ P : IPart.IPartition a b, P.points = s := by refine' ⟨ IPart.fromPoints s _ _ _, _ ⟩ <;> norm_num [ hs_def ]; grind; convert IPart.points_fromPoints _ _ _ _; convert sum_le_sumAbsDiff_of_points_subset g P p x hx _ |> le_trans <| hK P; grind

/- If the sum of absolute differences of g over any partition is bounded by K, then the total variation of g is bounded by K. -/ lemma variation_le_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : IPart.IPartition a b, sumAbsDiff g P ≤ K) : (eVariationOn g (Set.Icc a b)).toReal ≤ K := by -- We know that for any monotone sequence x, the sum of absolute differences is ≤ K. have h_sum_le : ∀ (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b), ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by intro p x hx hx_mem exact sum_le_K_of_forall_sumAbsDiff_le hab g K hK p x hx hx_mem

-- Now we relate this to eVariationOn. -- eVariationOn is the supremum of these sums (converted to ENNReal). -- We show eVariationOn ≤ ENNReal.ofReal K. have h_var_le : eVariationOn g (Set.Icc a b) ≤ ENNReal.ofReal K := by -- Unfold eVariationOn to its definition as a supremum -- Since eVariationOn is defined as a supr, we use iSup_le -- Note: The definition might be wrapped. -- We can try to use eVariationOn properties or just unfold it. -- Assuming standard definition: -- ref: https://leanprover-community.github.io/mathlib4_docs/Mathlib/Analysis/Variation.html#eVariationOn -- It is iSup over p, x. refine' iSup_le _; rintro ⟨ p, ⟨ x, hx₁, hx₂ ⟩ ⟩; simp_all +decide [ edist_dist, Real.dist_eq ]; convert ENNReal.ofReal_le_ofReal ( h_sum_le p ( fun i => x i ) ( fun i j hij => hx₁ hij ) ( fun i => hx₂ i ) ) using 1; rw [ ENNReal.ofReal_sum_of_nonneg fun _ _ => abs_nonneg _, Finset.sum_range ]; exact rfl

/- If the sum of absolute differences of g over any partition is bounded by K, then the sum of absolute differences along any monotone sequence in [a, b] is bounded by K. -/

-- Finally, convert to Real. apply ENNReal.toReal_le_of_le_ofReal · -- K ≥ 0 have P := RS.IPart.uniformPartition 1 hab have := hK P calc 0 ≤ RS.SumDiff.sumAbsDiff g P := by apply Finset.sum_nonneg intro i _ apply abs_nonneg _ ≤ K := this · exact h_var_le

end SumDiff

/- First, a definition of tagged partitions, followed by some basic lemmas -/ /- A tagged Riemann-Stieltjes partition includes points xi in each subinterval [x_i, x_{i+1}]. -/

namespace Integ

structure TaggedPartition (a b : ℝ) extends IPart.IPartition a b where xi : Fin n → ℝ h_xi : ∀ i : Fin n, x i.castSucc ≤ xi i ∧ xi i ≤ x i.succ

/- The filter of tagged partitions with mesh tending to 0. -/ def TaggedPartitionFilter (a b : ℝ) : Filter (TaggedPartition a b) := Filter.comap (fun P => P.mesh) (nhds 0)

/- A uniform partition with left tags. We need that simply because our filter is a filter of tagged partitions. -/ def taggedUniformPartition {a b : ℝ} (n : ℕ) (hab : a < b) : TaggedPartition a b := let P := IPart.uniformPartition n hab { toIPartition := P xi := fun i => P.x i.castSucc h_xi := by intro i constructor · exact le_refl _ · apply P.monotone apply Nat.le_succ }

/- The partition filter is proper, that is, there exist partitions of [a,b] of arbitrarily small mesh. -/ lemma TaggedPartitionFilter_neBot {a b : ℝ} (hab : a < b) : Filter.NeBot (TaggedPartitionFilter a b) := by refine' Filter.neBot_iff.mpr _; rw [ Ne.eq_def, Filter.ext_iff ]; simp +zetaDelta at *; use ∅; intro h; obtain ⟨ U, hU₁, hU₂ ⟩ := Filter.mem_comap.mp h; simp_all +decide [ Set.subset_def ]; contrapose! hU₂; rcases Metric.mem_nhds_iff.mp hU₁ with ⟨ ε, εpos, hε ⟩; -- Choose $n$ such that $(b - a) / (n + 1) < \epsilon$. obtain ⟨ n, hn ⟩ : ∃ n : ℕ, (b - a) / (n + 1) < ε := by exact ⟨ ⌊ ( b - a ) / ε⌋₊, by rw [ div_lt_iff₀ ] <;> nlinarith [ Nat.lt_floor_add_one ( ( b - a ) / ε ), mul_div_cancel₀ ( b - a ) εpos.ne' ] ⟩; refine' ⟨ taggedUniformPartition n hab, hε _ ⟩; simp +zetaDelta at *; rw [ abs_of_nonneg ( IPart.mesh_nonneg _ ) ]; convert hn using 1; convert IPart.mesh_uniformPartition n hab using 1

/- A tagged partition where the tags are the left endpoints of the intervals. -/ def tagLeft {a b : ℝ} (P : IPart.IPartition a b) : TaggedPartition a b := { P with xi := fun i => P.x i.castSucc h_xi := fun i => ⟨le_refl _, P.monotone (Nat.le_succ _)⟩ }

/- We finally come to Riemann-Stieltjes sums and to the definition of Riemann-Stieltjes integrals!-/ /- The Riemann-Stieltjes sum S(P, f, g) is the sum of f(xi_i) * (g(x_{i+1}) - g(x_i)). -/ def RSSum {a b : ℝ} (f g : ℝ → ℝ) (P : TaggedPartition a b) : ℝ := ∑ i : Fin P.n, f (P.xi i) * (g (P.x i.succ) - g (P.x i.castSucc))

/- The Riemann-Stieltjes integral of f with respect to g on [a, b] has value I. -/ def HasRSIntegral (f g : ℝ → ℝ) (a b I : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P : TaggedPartition a b), P.mesh ≤ δ → |RSSum f g P - I| < ε

/- HasRSIntegral is equivalent to convergence along the tagged partition filter. -/ lemma hasRSIntegral_iff_tendsto {f g : ℝ → ℝ} {a b I : ℝ} : HasRSIntegral f g a b I ↔ Filter.Tendsto (RSSum f g) (TaggedPartitionFilter a b) (nhds I) := by constructor <;> intro h; · refine' Metric.tendsto_nhds.mpr _; intro ε hε; obtain ⟨ δ, hδ, H ⟩ := h ε hε; filter_upwards [ Filter.preimage_mem_comap ( Iio_mem_nhds hδ ) ] with P hP using H P <| le_of_lt hP; · intro ε hε; obtain ⟨ δ, hδ ⟩ := Metric.tendsto_nhds.mp h ε hε; -- Since δ is a neighborhood of 0, there exists a δ' > 0 such that (0, δ') is contained in δ. obtain ⟨δ', hδ'⟩ : ∃ δ' > 0, Metric.ball 0 δ' ⊆ δ := by exact Metric.mem_nhds_iff.mp hδ.1; use δ' / 2; exact ⟨ half_pos hδ'.1, fun P hP => hδ.2 <| hδ'.2 <| mem_ball_zero_iff.mpr <| abs_lt.mpr ⟨ by linarith [ show 0 ≤ P.mesh from IPart.mesh_nonneg _ ], by linarith [ show 0 ≤ P.mesh from IPart.mesh_nonneg _ ] ⟩ ⟩

/- The Cauchy condition for Riemann-Stieltjes sums. -/ def RSCauchyCondition (f g : ℝ → ℝ) (a b : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P Q : TaggedPartition a b), P.mesh ≤ δ → Q.mesh ≤ δ → |RSSum f g P - RSSum f g Q| < ε

/- The image of the partition filter under the Riemann sum map is a Cauchy filter.

Sum of absolute increments of g over an untagged partition. -/ def sumAbsDiff {a b : ℝ} (g : ℝ → ℝ) (P : IPart.IPartition a b) : ℝ := ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)|

/- The absolute difference of g over a subinterval of P is bounded by the sum of absolute differences of g over the corresponding subintervals of R. -/ lemma sumAbsDiff_block_le {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) (i : Fin P.n) : |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by rw [← hk_eq i.succ, ← hk_eq i.castSucc] rw [← IPart.sum_telescope_block g R (k i.castSucc) (k i.succ) (hk (Nat.le_succ _))] apply Finset.abs_sum_le_sum_abs

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_mono_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by -- Use refinement_index_map to get k. obtain ⟨k, , hk_eq⟩ : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by exact IPart.refinement_index_map P R hPR; -- Apply sumAbsDiff_block_le to bound the sum over P by the double sum over blocks of R. have h_sum_le_double_sum : ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by exact Finset.sum_le_sum fun i _ => sumAbsDiff_block_le k ‹› ‹_› i; -- Use sum_partition_blocks to collapse the double sum into a single sum over Ico (k 0) (k P.n). have h_double_sum_to_single_sum : ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| := by have h_double_sum_to_single_sum : ∀ (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k), ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), |IPart.term g R j| := by exact fun n k hk ↦ IPart.sum_partition_blocks n k hk fun j ↦ |IPart.term g R j|; convert h_double_sum_to_single_sum P.n ( fun i => ( k i : ℕ ) ) ( fun i j hij => by simpa using ‹Monotone k› hij ) using 1; -- Bound this sum by the sum over range R.n (since terms are non-negative and the interval is a subset). have h_single_sum_le_range : ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| ≤ ∑ j ∈ Finset.Ico 0 R.n, |IPart.term g R j| := by refine' Finset.sum_le_sum_of_subset_of_nonneg _ fun _ _ _ => abs_nonneg _; refine' Finset.Ico_subset_Ico _ _ <;> norm_num; exact Nat.le_of_lt_succ ( Fin.is_lt _ ); convert h_sum_le_double_sum.trans ( h_double_sum_to_single_sum.le.trans h_single_sum_le_range ) using 1; simp +decide [ sumAbsDiff, Finset.sum_range, Fin.cast_val_eq_self ]; refine' Finset.sum_congr rfl fun i hi => _ ; unfold IPart.term ; aesop

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_le_sumAbsDiff_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by convert sumAbsDiff_mono_of_refinement hPR using 1

/- If x is a monotone sequence of points contained in partition P, then the sum of absolute differences of g along x is bounded by sumAbsDiff g P. -/ lemma sum_le_sumAbsDiff_of_points_subset {a b : ℝ} (g : ℝ → ℝ) (P : RS.IPart.IPartition a b) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (h_subset : ∀ i, x i ∈ P.points) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ RS.SumDiff.sumAbsDiff g P := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : Fin (p + 1) → Fin (P.n + 1), Monotone k ∧ ∀ i : Fin (p + 1), P.x (k i) = x i := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$ by the properties of the points of $P$. have h_k_exists : ∀ y ∈ P.points, ∃ i : Fin (P.n + 1), P.x i = y := by exact fun y hy => by rw [ IPart.IPartition.points ] at hy; aesop; choose k hk using h_k_exists; use fun i => k ( x i ) ( h_subset i ); have h_k_mono : ∀ i j : Fin (p + 1), x i ≤ x j → k (x i) (h_subset i) ≤ k (x j) (h_subset j) := by intros i j hij have h_k_mono : P.x (k (x i) (h_subset i)) ≤ P.x (k (x j) (h_subset j)) := by aesop; contrapose! h_k_mono; apply_rules [ P.monotone, lt_of_le_of_ne ]; · exact le_of_lt h_k_mono; · grind; exact ⟨ fun i j hij => h_k_mono i j <| hx hij, fun i => hk _ _ ⟩; -- Apply the lemma sum_telescope_abs_le to each term in the sum. have h_telescope : ∀ i : Fin p, |g (x (i.succ)) - g (x (i.castSucc))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by intros i have h_telescope : |g (P.x (k (i.succ))) - g (P.x (k (i.castSucc)))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by convert IPart.sum_telescope_abs_le g P ( k ( Fin.castSucc i ) ) ( k ( Fin.succ i ) ) _ using 1; exact hk.1 ( Nat.le_succ _ ); aesop; -- Apply the lemma sum_partition_blocks to combine the sums over the intervals [k i, k (i+1)). have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| ≤ ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by convert RS.IPart.sum_partition_blocks p ( fun i => ( k i : ℕ ) ) hk.1 _ using 1; grind; refine le_trans ( Finset.sum_le_sum fun i _ => h_telescope i ) ( h_sum_partition_blocks.trans ?_ ); refine' le_trans ( Finset.sum_le_sum_of_subset_of_nonneg ( Finset.subset_iff.mpr _ ) fun _ _ _ => abs_nonneg _ ) _; exact Finset.range P.n; · simp +zetaDelta at *; intro i hi₁ hi₂; exact lt_of_lt_of_le hi₂ ( Nat.le_of_lt_succ <| by simp [ Fin.is_lt ] ) ; · simp +decide [ Finset.sum_range, IPart.term ]; rfl

lemma sum_le_K_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : RS.IPart.IPartition a b, sumAbsDiff g P ≤ K) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by -- Let s be the set of values of x union {a, b}. set s : Finset ℝ := Finset.image x Finset.univ ∪ {a, b} with hs_def; -- Construct a partition P from s using RS.IPart.fromPoints. obtain ⟨P, hP⟩ : ∃ P : IPart.IPartition a b, P.points = s := by refine' ⟨ IPart.fromPoints s _ _ _, _ ⟩ <;> norm_num [ hs_def ]; grind; convert IPart.points_fromPoints _ _ _ _; convert sum_le_sumAbsDiff_of_points_subset g P p x hx _ |> le_trans <| hK P; grind

/- If the sum of absolute differences of g over any partition is bounded by K, then the total variation of g is bounded by K. -/ lemma variation_le_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : IPart.IPartition a b, sumAbsDiff g P ≤ K) : (eVariationOn g (Set.Icc a b)).toReal ≤ K := by -- We know that for any monotone sequence x, the sum of absolute differences is ≤ K. have h_sum_le : ∀ (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b), ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by intro p x hx hx_mem exact sum_le_K_of_forall_sumAbsDiff_le hab g K hK p x hx hx_mem

-- Now we relate this to eVariationOn. -- eVariationOn is the supremum of these sums (converted to ENNReal). -- We show eVariationOn ≤ ENNReal.ofReal K. have h_var_le : eVariationOn g (Set.Icc a b) ≤ ENNReal.ofReal K := by -- Unfold eVariationOn to its definition as a supremum -- Since eVariationOn is defined as a supr, we use iSup_le -- Note: The definition might be wrapped. -- We can try to use eVariationOn properties or just unfold it. -- Assuming standard definition: -- ref: https://leanprover-community.github.io/mathlib4_docs/Mathlib/Analysis/Variation.html#eVariationOn -- It is iSup over p, x. refine' iSup_le _; rintro ⟨ p, ⟨ x, hx₁, hx₂ ⟩ ⟩; simp_all +decide [ edist_dist, Real.dist_eq ]; convert ENNReal.ofReal_le_ofReal ( h_sum_le p ( fun i => x i ) ( fun i j hij => hx₁ hij ) ( fun i => hx₂ i ) ) using 1; rw [ ENNReal.ofReal_sum_of_nonneg fun _ _ => abs_nonneg _, Finset.sum_range ]; exact rfl

/- If the sum of absolute differences of g over any partition is bounded by K, then the sum of absolute differences along any monotone sequence in [a, b] is bounded by K. -/

-- Finally, convert to Real. apply ENNReal.toReal_le_of_le_ofReal · -- K ≥ 0 have P := RS.IPart.uniformPartition 1 hab have := hK P calc 0 ≤ RS.SumDiff.sumAbsDiff g P := by apply Finset.sum_nonneg intro i _ apply abs_nonneg _ ≤ K := this · exact h_var_le

end SumDiff

/- First, a definition of tagged partitions, followed by some basic lemmas -/ /- A tagged Riemann-Stieltjes partition includes points xi in each subinterval [x_i, x_{i+1}]. -/

namespace Integ

structure TaggedPartition (a b : ℝ) extends IPart.IPartition a b where xi : Fin n → ℝ h_xi : ∀ i : Fin n, x i.castSucc ≤ xi i ∧ xi i ≤ x i.succ

/- The filter of tagged partitions with mesh tending to 0. -/ def TaggedPartitionFilter (a b : ℝ) : Filter (TaggedPartition a b) := Filter.comap (fun P => P.mesh) (nhds 0)

/- A uniform partition with left tags. We need that simply because our filter is a filter of tagged partitions. -/ def taggedUniformPartition {a b : ℝ} (n : ℕ) (hab : a < b) : TaggedPartition a b := let P := IPart.uniformPartition n hab { toIPartition := P xi := fun i => P.x i.castSucc h_xi := by intro i constructor · exact le_refl _ · apply P.monotone apply Nat.le_succ }

/- The partition filter is proper, that is, there exist partitions of [a,b] of arbitrarily small mesh. -/ lemma TaggedPartitionFilter_neBot {a b : ℝ} (hab : a < b) : Filter.NeBot (TaggedPartitionFilter a b) := by refine' Filter.neBot_iff.mpr _; rw [ Ne.eq_def, Filter.ext_iff ]; simp +zetaDelta at *; use ∅; intro h; obtain ⟨ U, hU₁, hU₂ ⟩ := Filter.mem_comap.mp h; simp_all +decide [ Set.subset_def ]; contrapose! hU₂; rcases Metric.mem_nhds_iff.mp hU₁ with ⟨ ε, εpos, hε ⟩; -- Choose $n$ such that $(b - a) / (n + 1) < \epsilon$. obtain ⟨ n, hn ⟩ : ∃ n : ℕ, (b - a) / (n + 1) < ε := by exact ⟨ ⌊ ( b - a ) / ε⌋₊, by rw [ div_lt_iff₀ ] <;> nlinarith [ Nat.lt_floor_add_one ( ( b - a ) / ε ), mul_div_cancel₀ ( b - a ) εpos.ne' ] ⟩; refine' ⟨ taggedUniformPartition n hab, hε _ ⟩; simp +zetaDelta at *; rw [ abs_of_nonneg ( IPart.mesh_nonneg _ ) ]; convert hn using 1; convert IPart.mesh_uniformPartition n hab using 1

/- A tagged partition where the tags are the left endpoints of the intervals. -/ def tagLeft {a b : ℝ} (P : IPart.IPartition a b) : TaggedPartition a b := { P with xi := fun i => P.x i.castSucc h_xi := fun i => ⟨le_refl _, P.monotone (Nat.le_succ _)⟩ }

/- We finally come to Riemann-Stieltjes sums and to the definition of Riemann-Stieltjes integrals!-/ /- The Riemann-Stieltjes sum S(P, f, g) is the sum of f(xi_i) * (g(x_{i+1}) - g(x_i)). -/ def RSSum {a b : ℝ} (f g : ℝ → ℝ) (P : TaggedPartition a b) : ℝ := ∑ i : Fin P.n, f (P.xi i) * (g (P.x i.succ) - g (P.x i.castSucc))

/- The Riemann-Stieltjes integral of f with respect to g on [a, b] has value I. -/ def HasRSIntegral (f g : ℝ → ℝ) (a b I : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P : TaggedPartition a b), P.mesh ≤ δ → |RSSum f g P - I| < ε

/- HasRSIntegral is equivalent to convergence along the tagged partition filter. -/ lemma hasRSIntegral_iff_tendsto {f g : ℝ → ℝ} {a b I : ℝ} : HasRSIntegral f g a b I ↔ Filter.Tendsto (RSSum f g) (TaggedPartitionFilter a b) (nhds I) := by constructor <;> intro h; · refine' Metric.tendsto_nhds.mpr _; intro ε hε; obtain ⟨ δ, hδ, H ⟩ := h ε hε; filter_upwards [ Filter.preimage_mem_comap ( Iio_mem_nhds hδ ) ] with P hP using H P <| le_of_lt hP; · intro ε hε; obtain ⟨ δ, hδ ⟩ := Metric.tendsto_nhds.mp h ε hε; -- Since δ is a neighborhood of 0, there exists a δ' > 0 such that (0, δ') is contained in δ. obtain ⟨δ', hδ'⟩ : ∃ δ' > 0, Metric.ball 0 δ' ⊆ δ := by exact Metric.mem_nhds_iff.mp hδ.1; use δ' / 2; exact ⟨ half_pos hδ'.1, fun P hP => hδ.2 <| hδ'.2 <| mem_ball_zero_iff.mpr <| abs_lt.mpr ⟨ by linarith [ show 0 ≤ P.mesh from IPart.mesh_nonneg _ ], by linarith [ show 0 ≤ P.mesh from IPart.mesh_nonneg _ ] ⟩ ⟩

/- The Cauchy condition for Riemann-Stieltjes sums. -/ def RSCauchyCondition (f g : ℝ → ℝ) (a b : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P Q : TaggedPartition a b), P.mesh ≤ δ → Q.mesh ≤ δ → |RSSum f g P - RSSum f g Q| < ε

/- The image of the partition filter under the Riemann sum map is a Cauchy filter. -/ lemma cauchy_map_RSSum {f g : ℝ → ℝ} {a b : ℝ} (hab : a < b) (h : RSCauchyCondition f g a b) : Cauchy (Filter.map (RSSum f g) (TaggedPartitionFilter a b)) := by have h_cauchy : ∀ ε > 0, ∃ S ∈ TaggedPartitionFilter a b, ∀ P Q : TaggedPartition a b, P ∈ S → Q ∈ S → |RSSum f g P - RSSum f g Q| < ε := by intro ε hε_pos obtain ⟨δ, hδ_pos, hδ⟩ := h ε hε_pos use {P : TaggedPartition a b | P.mesh ≤ δ}; exact ⟨ Filter.mem_comap.mpr ⟨ Set.Iic δ, Iic_mem_nhds hδ_pos, by aesop ⟩, hδ ⟩; rw [ Metric.cauchy_iff ]; constructor; · apply_rules [ Filter.map_neBot ]; exact TaggedPartitionFilter_neBot hab; · exact fun ε ε_pos => by obtain ⟨ S, hS₁, hS₂ ⟩ := h_cauchy ε ε_pos; exact ⟨ RSSum f g '' S, Filter.image_mem_map hS₁, by aesop ⟩ ;

/- The Cauchy condition implies the existence of the Riemann-Stieltjes integral.

Sum of absolute increments of g over an untagged partition. -/ def sumAbsDiff {a b : ℝ} (g : ℝ → ℝ) (P : IPart.IPartition a b) : ℝ := ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)|

/- The absolute difference of g over a subinterval of P is bounded by the sum of absolute differences of g over the corresponding subintervals of R. -/ lemma sumAbsDiff_block_le {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) (i : Fin P.n) : |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by rw [← hk_eq i.succ, ← hk_eq i.castSucc] rw [← IPart.sum_telescope_block g R (k i.castSucc) (k i.succ) (hk (Nat.le_succ _))] apply Finset.abs_sum_le_sum_abs

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_mono_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by -- Use refinement_index_map to get k. obtain ⟨k, , hk_eq⟩ : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by exact IPart.refinement_index_map P R hPR; -- Apply sumAbsDiff_block_le to bound the sum over P by the double sum over blocks of R. have h_sum_le_double_sum : ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by exact Finset.sum_le_sum fun i _ => sumAbsDiff_block_le k ‹› ‹_› i; -- Use sum_partition_blocks to collapse the double sum into a single sum over Ico (k 0) (k P.n). have h_double_sum_to_single_sum : ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| := by have h_double_sum_to_single_sum : ∀ (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k), ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), |IPart.term g R j| := by exact fun n k hk ↦ IPart.sum_partition_blocks n k hk fun j ↦ |IPart.term g R j|; convert h_double_sum_to_single_sum P.n ( fun i => ( k i : ℕ ) ) ( fun i j hij => by simpa using ‹Monotone k› hij ) using 1; -- Bound this sum by the sum over range R.n (since terms are non-negative and the interval is a subset). have h_single_sum_le_range : ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| ≤ ∑ j ∈ Finset.Ico 0 R.n, |IPart.term g R j| := by refine' Finset.sum_le_sum_of_subset_of_nonneg _ fun _ _ _ => abs_nonneg _; refine' Finset.Ico_subset_Ico _ _ <;> norm_num; exact Nat.le_of_lt_succ ( Fin.is_lt _ ); convert h_sum_le_double_sum.trans ( h_double_sum_to_single_sum.le.trans h_single_sum_le_range ) using 1; simp +decide [ sumAbsDiff, Finset.sum_range, Fin.cast_val_eq_self ]; refine' Finset.sum_congr rfl fun i hi => _ ; unfold IPart.term ; aesop

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_le_sumAbsDiff_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by convert sumAbsDiff_mono_of_refinement hPR using 1

/- If x is a monotone sequence of points contained in partition P, then the sum of absolute differences of g along x is bounded by sumAbsDiff g P. -/ lemma sum_le_sumAbsDiff_of_points_subset {a b : ℝ} (g : ℝ → ℝ) (P : RS.IPart.IPartition a b) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (h_subset : ∀ i, x i ∈ P.points) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ RS.SumDiff.sumAbsDiff g P := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : Fin (p + 1) → Fin (P.n + 1), Monotone k ∧ ∀ i : Fin (p + 1), P.x (k i) = x i := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$ by the properties of the points of $P$. have h_k_exists : ∀ y ∈ P.points, ∃ i : Fin (P.n + 1), P.x i = y := by exact fun y hy => by rw [ IPart.IPartition.points ] at hy; aesop; choose k hk using h_k_exists; use fun i => k ( x i ) ( h_subset i ); have h_k_mono : ∀ i j : Fin (p + 1), x i ≤ x j → k (x i) (h_subset i) ≤ k (x j) (h_subset j) := by intros i j hij have h_k_mono : P.x (k (x i) (h_subset i)) ≤ P.x (k (x j) (h_subset j)) := by aesop; contrapose! h_k_mono; apply_rules [ P.monotone, lt_of_le_of_ne ]; · exact le_of_lt h_k_mono; · grind; exact ⟨ fun i j hij => h_k_mono i j <| hx hij, fun i => hk _ _ ⟩; -- Apply the lemma sum_telescope_abs_le to each term in the sum. have h_telescope : ∀ i : Fin p, |g (x (i.succ)) - g (x (i.castSucc))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by intros i have h_telescope : |g (P.x (k (i.succ))) - g (P.x (k (i.castSucc)))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by convert IPart.sum_telescope_abs_le g P ( k ( Fin.castSucc i ) ) ( k ( Fin.succ i ) ) _ using 1; exact hk.1 ( Nat.le_succ _ ); aesop; -- Apply the lemma sum_partition_blocks to combine the sums over the intervals [k i, k (i+1)). have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| ≤ ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by convert RS.IPart.sum_partition_blocks p ( fun i => ( k i : ℕ ) ) hk.1 _ using 1; grind; refine le_trans ( Finset.sum_le_sum fun i _ => h_telescope i ) ( h_sum_partition_blocks.trans ?_ ); refine' le_trans ( Finset.sum_le_sum_of_subset_of_nonneg ( Finset.subset_iff.mpr _ ) fun _ _ _ => abs_nonneg _ ) _; exact Finset.range P.n; · simp +zetaDelta at *; intro i hi₁ hi₂; exact lt_of_lt_of_le hi₂ ( Nat.le_of_lt_succ <| by simp [ Fin.is_lt ] ) ; · simp +decide [ Finset.sum_range, IPart.term ]; rfl

lemma sum_le_K_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : RS.IPart.IPartition a b, sumAbsDiff g P ≤ K) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by -- Let s be the set of values of x union {a, b}. set s : Finset ℝ := Finset.image x Finset.univ ∪ {a, b} with hs_def; -- Construct a partition P from s using RS.IPart.fromPoints. obtain ⟨P, hP⟩ : ∃ P : IPart.IPartition a b, P.points = s := by refine' ⟨ IPart.fromPoints s _ _ _, _ ⟩ <;> norm_num [ hs_def ]; grind; convert IPart.points_fromPoints _ _ _ _; convert sum_le_sumAbsDiff_of_points_subset g P p x hx _ |> le_trans <| hK P; grind

/- If the sum of absolute differences of g over any partition is bounded by K, then the total variation of g is bounded by K. -/ lemma variation_le_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : IPart.IPartition a b, sumAbsDiff g P ≤ K) : (eVariationOn g (Set.Icc a b)).toReal ≤ K := by -- We know that for any monotone sequence x, the sum of absolute differences is ≤ K. have h_sum_le : ∀ (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b), ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by intro p x hx hx_mem exact sum_le_K_of_forall_sumAbsDiff_le hab g K hK p x hx hx_mem

-- Now we relate this to eVariationOn. -- eVariationOn is the supremum of these sums (converted to ENNReal). -- We show eVariationOn ≤ ENNReal.ofReal K. have h_var_le : eVariationOn g (Set.Icc a b) ≤ ENNReal.ofReal K := by -- Unfold eVariationOn to its definition as a supremum -- Since eVariationOn is defined as a supr, we use iSup_le -- Note: The definition might be wrapped. -- We can try to use eVariationOn properties or just unfold it. -- Assuming standard definition: -- ref: https://leanprover-community.github.io/mathlib4_docs/Mathlib/Analysis/Variation.html#eVariationOn -- It is iSup over p, x. refine' iSup_le _; rintro ⟨ p, ⟨ x, hx₁, hx₂ ⟩ ⟩; simp_all +decide [ edist_dist, Real.dist_eq ]; convert ENNReal.ofReal_le_ofReal ( h_sum_le p ( fun i => x i ) ( fun i j hij => hx₁ hij ) ( fun i => hx₂ i ) ) using 1; rw [ ENNReal.ofReal_sum_of_nonneg fun _ _ => abs_nonneg _, Finset.sum_range ]; exact rfl

/- If the sum of absolute differences of g over any partition is bounded by K, then the sum of absolute differences along any monotone sequence in [a, b] is bounded by K. -/

-- Finally, convert to Real. apply ENNReal.toReal_le_of_le_ofReal · -- K ≥ 0 have P := RS.IPart.uniformPartition 1 hab have := hK P calc 0 ≤ RS.SumDiff.sumAbsDiff g P := by apply Finset.sum_nonneg intro i _ apply abs_nonneg _ ≤ K := this · exact h_var_le

end SumDiff

/- First, a definition of tagged partitions, followed by some basic lemmas -/ /- A tagged Riemann-Stieltjes partition includes points xi in each subinterval [x_i, x_{i+1}]. -/

namespace Integ

structure TaggedPartition (a b : ℝ) extends IPart.IPartition a b where xi : Fin n → ℝ h_xi : ∀ i : Fin n, x i.castSucc ≤ xi i ∧ xi i ≤ x i.succ

/- The filter of tagged partitions with mesh tending to 0. -/ def TaggedPartitionFilter (a b : ℝ) : Filter (TaggedPartition a b) := Filter.comap (fun P => P.mesh) (nhds 0)

/- A uniform partition with left tags. We need that simply because our filter is a filter of tagged partitions. -/ def taggedUniformPartition {a b : ℝ} (n : ℕ) (hab : a < b) : TaggedPartition a b := let P := IPart.uniformPartition n hab { toIPartition := P xi := fun i => P.x i.castSucc h_xi := by intro i constructor · exact le_refl _ · apply P.monotone apply Nat.le_succ }

/- The partition filter is proper, that is, there exist partitions of [a,b] of arbitrarily small mesh. -/ lemma TaggedPartitionFilter_neBot {a b : ℝ} (hab : a < b) : Filter.NeBot (TaggedPartitionFilter a b) := by refine' Filter.neBot_iff.mpr _; rw [ Ne.eq_def, Filter.ext_iff ]; simp +zetaDelta at *; use ∅; intro h; obtain ⟨ U, hU₁, hU₂ ⟩ := Filter.mem_comap.mp h; simp_all +decide [ Set.subset_def ]; contrapose! hU₂; rcases Metric.mem_nhds_iff.mp hU₁ with ⟨ ε, εpos, hε ⟩; -- Choose $n$ such that $(b - a) / (n + 1) < \epsilon$. obtain ⟨ n, hn ⟩ : ∃ n : ℕ, (b - a) / (n + 1) < ε := by exact ⟨ ⌊ ( b - a ) / ε⌋₊, by rw [ div_lt_iff₀ ] <;> nlinarith [ Nat.lt_floor_add_one ( ( b - a ) / ε ), mul_div_cancel₀ ( b - a ) εpos.ne' ] ⟩; refine' ⟨ taggedUniformPartition n hab, hε _ ⟩; simp +zetaDelta at *; rw [ abs_of_nonneg ( IPart.mesh_nonneg _ ) ]; convert hn using 1; convert IPart.mesh_uniformPartition n hab using 1

/- A tagged partition where the tags are the left endpoints of the intervals. -/ def tagLeft {a b : ℝ} (P : IPart.IPartition a b) : TaggedPartition a b := { P with xi := fun i => P.x i.castSucc h_xi := fun i => ⟨le_refl _, P.monotone (Nat.le_succ _)⟩ }

/- We finally come to Riemann-Stieltjes sums and to the definition of Riemann-Stieltjes integrals!-/ /- The Riemann-Stieltjes sum S(P, f, g) is the sum of f(xi_i) * (g(x_{i+1}) - g(x_i)). -/ def RSSum {a b : ℝ} (f g : ℝ → ℝ) (P : TaggedPartition a b) : ℝ := ∑ i : Fin P.n, f (P.xi i) * (g (P.x i.succ) - g (P.x i.castSucc))

/- The Riemann-Stieltjes integral of f with respect to g on [a, b] has value I. -/ def HasRSIntegral (f g : ℝ → ℝ) (a b I : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P : TaggedPartition a b), P.mesh ≤ δ → |RSSum f g P - I| < ε

/- HasRSIntegral is equivalent to convergence along the tagged partition filter. -/ lemma hasRSIntegral_iff_tendsto {f g : ℝ → ℝ} {a b I : ℝ} : HasRSIntegral f g a b I ↔ Filter.Tendsto (RSSum f g) (TaggedPartitionFilter a b) (nhds I) := by constructor <;> intro h; · refine' Metric.tendsto_nhds.mpr _; intro ε hε; obtain ⟨ δ, hδ, H ⟩ := h ε hε; filter_upwards [ Filter.preimage_mem_comap ( Iio_mem_nhds hδ ) ] with P hP using H P <| le_of_lt hP; · intro ε hε; obtain ⟨ δ, hδ ⟩ := Metric.tendsto_nhds.mp h ε hε; -- Since δ is a neighborhood of 0, there exists a δ' > 0 such that (0, δ') is contained in δ. obtain ⟨δ', hδ'⟩ : ∃ δ' > 0, Metric.ball 0 δ' ⊆ δ := by exact Metric.mem_nhds_iff.mp hδ.1; use δ' / 2; exact ⟨ half_pos hδ'.1, fun P hP => hδ.2 <| hδ'.2 <| mem_ball_zero_iff.mpr <| abs_lt.mpr ⟨ by linarith [ show 0 ≤ P.mesh from IPart.mesh_nonneg _ ], by linarith [ show 0 ≤ P.mesh from IPart.mesh_nonneg _ ] ⟩ ⟩

/- The Cauchy condition for Riemann-Stieltjes sums. -/ def RSCauchyCondition (f g : ℝ → ℝ) (a b : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P Q : TaggedPartition a b), P.mesh ≤ δ → Q.mesh ≤ δ → |RSSum f g P - RSSum f g Q| < ε

/- The image of the partition filter under the Riemann sum map is a Cauchy filter. -/ lemma cauchy_map_RSSum {f g : ℝ → ℝ} {a b : ℝ} (hab : a < b) (h : RSCauchyCondition f g a b) : Cauchy (Filter.map (RSSum f g) (TaggedPartitionFilter a b)) := by have h_cauchy : ∀ ε > 0, ∃ S ∈ TaggedPartitionFilter a b, ∀ P Q : TaggedPartition a b, P ∈ S → Q ∈ S → |RSSum f g P - RSSum f g Q| < ε := by intro ε hε_pos obtain ⟨δ, hδ_pos, hδ⟩ := h ε hε_pos use {P : TaggedPartition a b | P.mesh ≤ δ}; exact ⟨ Filter.mem_comap.mpr ⟨ Set.Iic δ, Iic_mem_nhds hδ_pos, by aesop ⟩, hδ ⟩; rw [ Metric.cauchy_iff ]; constructor; · apply_rules [ Filter.map_neBot ]; exact TaggedPartitionFilter_neBot hab; · exact fun ε ε_pos => by obtain ⟨ S, hS₁, hS₂ ⟩ := h_cauchy ε ε_pos; exact ⟨ RSSum f g '' S, Filter.image_mem_map hS₁, by aesop ⟩ ;

/- The Cauchy condition implies the existence of the Riemann-Stieltjes integral. -/ theorem RSCauchy_implies_exists (f g : ℝ → ℝ) (a b : ℝ) (hab : a < b) (h : RSCauchyCondition f g a b) : ∃ I, HasRSIntegral f g a b I := by -- By cauchy_map_RSSum, the filter map (RSSum f g) (TaggedPartitionFilter a b) is Cauchy. have h_cauchy : Cauchy (Filter.map (RSSum f g) (TaggedPartitionFilter a b)) := by exact cauchy_map_RSSum hab h -- Since ℝ is a complete metric space, every Cauchy filter converges. obtain ⟨I, hI⟩ : ∃ I : ℝ, Filter.Tendsto (RSSum f g) (TaggedPartitionFilter a b) (nhds I) := by exact CompleteSpace.complete h_cauchy exact ⟨ I, by simpa only [ hasRSIntegral_iff_tendsto ] using hI ⟩

/- Rewrite S(P) as a double sum using the refinement index map.

Sum of absolute increments of g over an untagged partition. -/ def sumAbsDiff {a b : ℝ} (g : ℝ → ℝ) (P : IPart.IPartition a b) : ℝ := ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)|

/- The absolute difference of g over a subinterval of P is bounded by the sum of absolute differences of g over the corresponding subintervals of R. -/ lemma sumAbsDiff_block_le {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) (i : Fin P.n) : |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by rw [← hk_eq i.succ, ← hk_eq i.castSucc] rw [← IPart.sum_telescope_block g R (k i.castSucc) (k i.succ) (hk (Nat.le_succ _))] apply Finset.abs_sum_le_sum_abs

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_mono_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by -- Use refinement_index_map to get k. obtain ⟨k, , hk_eq⟩ : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by exact IPart.refinement_index_map P R hPR; -- Apply sumAbsDiff_block_le to bound the sum over P by the double sum over blocks of R. have h_sum_le_double_sum : ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by exact Finset.sum_le_sum fun i _ => sumAbsDiff_block_le k ‹› ‹_› i; -- Use sum_partition_blocks to collapse the double sum into a single sum over Ico (k 0) (k P.n). have h_double_sum_to_single_sum : ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| := by have h_double_sum_to_single_sum : ∀ (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k), ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), |IPart.term g R j| := by exact fun n k hk ↦ IPart.sum_partition_blocks n k hk fun j ↦ |IPart.term g R j|; convert h_double_sum_to_single_sum P.n ( fun i => ( k i : ℕ ) ) ( fun i j hij => by simpa using ‹Monotone k› hij ) using 1; -- Bound this sum by the sum over range R.n (since terms are non-negative and the interval is a subset). have h_single_sum_le_range : ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| ≤ ∑ j ∈ Finset.Ico 0 R.n, |IPart.term g R j| := by refine' Finset.sum_le_sum_of_subset_of_nonneg _ fun _ _ _ => abs_nonneg _; refine' Finset.Ico_subset_Ico _ _ <;> norm_num; exact Nat.le_of_lt_succ ( Fin.is_lt _ ); convert h_sum_le_double_sum.trans ( h_double_sum_to_single_sum.le.trans h_single_sum_le_range ) using 1; simp +decide [ sumAbsDiff, Finset.sum_range, Fin.cast_val_eq_self ]; refine' Finset.sum_congr rfl fun i hi => _ ; unfold IPart.term ; aesop

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_le_sumAbsDiff_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by convert sumAbsDiff_mono_of_refinement hPR using 1

/- If x is a monotone sequence of points contained in partition P, then the sum of absolute differences of g along x is bounded by sumAbsDiff g P. -/ lemma sum_le_sumAbsDiff_of_points_subset {a b : ℝ} (g : ℝ → ℝ) (P : RS.IPart.IPartition a b) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (h_subset : ∀ i, x i ∈ P.points) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ RS.SumDiff.sumAbsDiff g P := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : Fin (p + 1) → Fin (P.n + 1), Monotone k ∧ ∀ i : Fin (p + 1), P.x (k i) = x i := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$ by the properties of the points of $P$. have h_k_exists : ∀ y ∈ P.points, ∃ i : Fin (P.n + 1), P.x i = y := by exact fun y hy => by rw [ IPart.IPartition.points ] at hy; aesop; choose k hk using h_k_exists; use fun i => k ( x i ) ( h_subset i ); have h_k_mono : ∀ i j : Fin (p + 1), x i ≤ x j → k (x i) (h_subset i) ≤ k (x j) (h_subset j) := by intros i j hij have h_k_mono : P.x (k (x i) (h_subset i)) ≤ P.x (k (x j) (h_subset j)) := by aesop; contrapose! h_k_mono; apply_rules [ P.monotone, lt_of_le_of_ne ]; · exact le_of_lt h_k_mono; · grind; exact ⟨ fun i j hij => h_k_mono i j <| hx hij, fun i => hk _ _ ⟩; -- Apply the lemma sum_telescope_abs_le to each term in the sum. have h_telescope : ∀ i : Fin p, |g (x (i.succ)) - g (x (i.castSucc))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by intros i have h_telescope : |g (P.x (k (i.succ))) - g (P.x (k (i.castSucc)))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by convert IPart.sum_telescope_abs_le g P ( k ( Fin.castSucc i ) ) ( k ( Fin.succ i ) ) _ using 1; exact hk.1 ( Nat.le_succ _ ); aesop; -- Apply the lemma sum_partition_blocks to combine the sums over the intervals [k i, k (i+1)). have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| ≤ ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by convert RS.IPart.sum_partition_blocks p ( fun i => ( k i : ℕ ) ) hk.1 _ using 1; grind; refine le_trans ( Finset.sum_le_sum fun i _ => h_telescope i ) ( h_sum_partition_blocks.trans ?_ ); refine' le_trans ( Finset.sum_le_sum_of_subset_of_nonneg ( Finset.subset_iff.mpr _ ) fun _ _ _ => abs_nonneg _ ) _; exact Finset.range P.n; · simp +zetaDelta at *; intro i hi₁ hi₂; exact lt_of_lt_of_le hi₂ ( Nat.le_of_lt_succ <| by simp [ Fin.is_lt ] ) ; · simp +decide [ Finset.sum_range, IPart.term ]; rfl

lemma sum_le_K_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : RS.IPart.IPartition a b, sumAbsDiff g P ≤ K) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by -- Let s be the set of values of x union {a, b}. set s : Finset ℝ := Finset.image x Finset.univ ∪ {a, b} with hs_def; -- Construct a partition P from s using RS.IPart.fromPoints. obtain ⟨P, hP⟩ : ∃ P : IPart.IPartition a b, P.points = s := by refine' ⟨ IPart.fromPoints s _ _ _, _ ⟩ <;> norm_num [ hs_def ]; grind; convert IPart.points_fromPoints _ _ _ _; convert sum_le_sumAbsDiff_of_points_subset g P p x hx _ |> le_trans <| hK P; grind

/- If the sum of absolute differences of g over any partition is bounded by K, then the total variation of g is bounded by K. -/ lemma variation_le_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : IPart.IPartition a b, sumAbsDiff g P ≤ K) : (eVariationOn g (Set.Icc a b)).toReal ≤ K := by -- We know that for any monotone sequence x, the sum of absolute differences is ≤ K. have h_sum_le : ∀ (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b), ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by intro p x hx hx_mem exact sum_le_K_of_forall_sumAbsDiff_le hab g K hK p x hx hx_mem

-- Now we relate this to eVariationOn. -- eVariationOn is the supremum of these sums (converted to ENNReal). -- We show eVariationOn ≤ ENNReal.ofReal K. have h_var_le : eVariationOn g (Set.Icc a b) ≤ ENNReal.ofReal K := by -- Unfold eVariationOn to its definition as a supremum -- Since eVariationOn is defined as a supr, we use iSup_le -- Note: The definition might be wrapped. -- We can try to use eVariationOn properties or just unfold it. -- Assuming standard definition: -- ref: https://leanprover-community.github.io/mathlib4_docs/Mathlib/Analysis/Variation.html#eVariationOn -- It is iSup over p, x. refine' iSup_le _; rintro ⟨ p, ⟨ x, hx₁, hx₂ ⟩ ⟩; simp_all +decide [ edist_dist, Real.dist_eq ]; convert ENNReal.ofReal_le_ofReal ( h_sum_le p ( fun i => x i ) ( fun i j hij => hx₁ hij ) ( fun i => hx₂ i ) ) using 1; rw [ ENNReal.ofReal_sum_of_nonneg fun _ _ => abs_nonneg _, Finset.sum_range ]; exact rfl

/- If the sum of absolute differences of g over any partition is bounded by K, then the sum of absolute differences along any monotone sequence in [a, b] is bounded by K. -/

-- Finally, convert to Real. apply ENNReal.toReal_le_of_le_ofReal · -- K ≥ 0 have P := RS.IPart.uniformPartition 1 hab have := hK P calc 0 ≤ RS.SumDiff.sumAbsDiff g P := by apply Finset.sum_nonneg intro i _ apply abs_nonneg _ ≤ K := this · exact h_var_le

end SumDiff

/- First, a definition of tagged partitions, followed by some basic lemmas -/ /- A tagged Riemann-Stieltjes partition includes points xi in each subinterval [x_i, x_{i+1}]. -/

namespace Integ

structure TaggedPartition (a b : ℝ) extends IPart.IPartition a b where xi : Fin n → ℝ h_xi : ∀ i : Fin n, x i.castSucc ≤ xi i ∧ xi i ≤ x i.succ

/- The filter of tagged partitions with mesh tending to 0. -/ def TaggedPartitionFilter (a b : ℝ) : Filter (TaggedPartition a b) := Filter.comap (fun P => P.mesh) (nhds 0)

/- A uniform partition with left tags. We need that simply because our filter is a filter of tagged partitions. -/ def taggedUniformPartition {a b : ℝ} (n : ℕ) (hab : a < b) : TaggedPartition a b := let P := IPart.uniformPartition n hab { toIPartition := P xi := fun i => P.x i.castSucc h_xi := by intro i constructor · exact le_refl _ · apply P.monotone apply Nat.le_succ }

/- The partition filter is proper, that is, there exist partitions of [a,b] of arbitrarily small mesh. -/ lemma TaggedPartitionFilter_neBot {a b : ℝ} (hab : a < b) : Filter.NeBot (TaggedPartitionFilter a b) := by refine' Filter.neBot_iff.mpr _; rw [ Ne.eq_def, Filter.ext_iff ]; simp +zetaDelta at *; use ∅; intro h; obtain ⟨ U, hU₁, hU₂ ⟩ := Filter.mem_comap.mp h; simp_all +decide [ Set.subset_def ]; contrapose! hU₂; rcases Metric.mem_nhds_iff.mp hU₁ with ⟨ ε, εpos, hε ⟩; -- Choose $n$ such that $(b - a) / (n + 1) < \epsilon$. obtain ⟨ n, hn ⟩ : ∃ n : ℕ, (b - a) / (n + 1) < ε := by exact ⟨ ⌊ ( b - a ) / ε⌋₊, by rw [ div_lt_iff₀ ] <;> nlinarith [ Nat.lt_floor_add_one ( ( b - a ) / ε ), mul_div_cancel₀ ( b - a ) εpos.ne' ] ⟩; refine' ⟨ taggedUniformPartition n hab, hε _ ⟩; simp +zetaDelta at *; rw [ abs_of_nonneg ( IPart.mesh_nonneg _ ) ]; convert hn using 1; convert IPart.mesh_uniformPartition n hab using 1

/- A tagged partition where the tags are the left endpoints of the intervals. -/ def tagLeft {a b : ℝ} (P : IPart.IPartition a b) : TaggedPartition a b := { P with xi := fun i => P.x i.castSucc h_xi := fun i => ⟨le_refl _, P.monotone (Nat.le_succ _)⟩ }

/- We finally come to Riemann-Stieltjes sums and to the definition of Riemann-Stieltjes integrals!-/ /- The Riemann-Stieltjes sum S(P, f, g) is the sum of f(xi_i) * (g(x_{i+1}) - g(x_i)). -/ def RSSum {a b : ℝ} (f g : ℝ → ℝ) (P : TaggedPartition a b) : ℝ := ∑ i : Fin P.n, f (P.xi i) * (g (P.x i.succ) - g (P.x i.castSucc))

/- The Riemann-Stieltjes integral of f with respect to g on [a, b] has value I. -/ def HasRSIntegral (f g : ℝ → ℝ) (a b I : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P : TaggedPartition a b), P.mesh ≤ δ → |RSSum f g P - I| < ε

/- HasRSIntegral is equivalent to convergence along the tagged partition filter. -/ lemma hasRSIntegral_iff_tendsto {f g : ℝ → ℝ} {a b I : ℝ} : HasRSIntegral f g a b I ↔ Filter.Tendsto (RSSum f g) (TaggedPartitionFilter a b) (nhds I) := by constructor <;> intro h; · refine' Metric.tendsto_nhds.mpr _; intro ε hε; obtain ⟨ δ, hδ, H ⟩ := h ε hε; filter_upwards [ Filter.preimage_mem_comap ( Iio_mem_nhds hδ ) ] with P hP using H P <| le_of_lt hP; · intro ε hε; obtain ⟨ δ, hδ ⟩ := Metric.tendsto_nhds.mp h ε hε; -- Since δ is a neighborhood of 0, there exists a δ' > 0 such that (0, δ') is contained in δ. obtain ⟨δ', hδ'⟩ : ∃ δ' > 0, Metric.ball 0 δ' ⊆ δ := by exact Metric.mem_nhds_iff.mp hδ.1; use δ' / 2; exact ⟨ half_pos hδ'.1, fun P hP => hδ.2 <| hδ'.2 <| mem_ball_zero_iff.mpr <| abs_lt.mpr ⟨ by linarith [ show 0 ≤ P.mesh from IPart.mesh_nonneg _ ], by linarith [ show 0 ≤ P.mesh from IPart.mesh_nonneg _ ] ⟩ ⟩

/- The Cauchy condition for Riemann-Stieltjes sums. -/ def RSCauchyCondition (f g : ℝ → ℝ) (a b : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P Q : TaggedPartition a b), P.mesh ≤ δ → Q.mesh ≤ δ → |RSSum f g P - RSSum f g Q| < ε

/- The image of the partition filter under the Riemann sum map is a Cauchy filter. -/ lemma cauchy_map_RSSum {f g : ℝ → ℝ} {a b : ℝ} (hab : a < b) (h : RSCauchyCondition f g a b) : Cauchy (Filter.map (RSSum f g) (TaggedPartitionFilter a b)) := by have h_cauchy : ∀ ε > 0, ∃ S ∈ TaggedPartitionFilter a b, ∀ P Q : TaggedPartition a b, P ∈ S → Q ∈ S → |RSSum f g P - RSSum f g Q| < ε := by intro ε hε_pos obtain ⟨δ, hδ_pos, hδ⟩ := h ε hε_pos use {P : TaggedPartition a b | P.mesh ≤ δ}; exact ⟨ Filter.mem_comap.mpr ⟨ Set.Iic δ, Iic_mem_nhds hδ_pos, by aesop ⟩, hδ ⟩; rw [ Metric.cauchy_iff ]; constructor; · apply_rules [ Filter.map_neBot ]; exact TaggedPartitionFilter_neBot hab; · exact fun ε ε_pos => by obtain ⟨ S, hS₁, hS₂ ⟩ := h_cauchy ε ε_pos; exact ⟨ RSSum f g '' S, Filter.image_mem_map hS₁, by aesop ⟩ ;

/- The Cauchy condition implies the existence of the Riemann-Stieltjes integral. -/ theorem RSCauchy_implies_exists (f g : ℝ → ℝ) (a b : ℝ) (hab : a < b) (h : RSCauchyCondition f g a b) : ∃ I, HasRSIntegral f g a b I := by -- By cauchy_map_RSSum, the filter map (RSSum f g) (TaggedPartitionFilter a b) is Cauchy. have h_cauchy : Cauchy (Filter.map (RSSum f g) (TaggedPartitionFilter a b)) := by exact cauchy_map_RSSum hab h -- Since ℝ is a complete metric space, every Cauchy filter converges. obtain ⟨I, hI⟩ : ∃ I : ℝ, Filter.Tendsto (RSSum f g) (TaggedPartitionFilter a b) (nhds I) := by exact CompleteSpace.complete h_cauchy exact ⟨ I, by simpa only [ hasRSIntegral_iff_tendsto ] using hI ⟩

/- Rewrite S(P) as a double sum using the refinement index map. -/ lemma RSSum_P_rewrite {a b : ℝ} (f g : ℝ → ℝ) (P R : TaggedPartition a b) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) : RSSum f g P = ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, f (P.xi i) * IPart.term g R.toIPartition j := by apply Finset.sum_congr rfl fun i _ => ?_; have h_telescope : ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, IPart.term g R.toIPartition j = g (R.x (k i.succ)) - g (R.x (k i.castSucc)) := by convert IPart.sum_telescope_block g R.toIPartition ( k i.castSucc ) ( k i.succ ) ( hk ( Nat.le_succ _ ) ) using 1; simp_all +decide [ ← Finset.mul_sum _ _ _, ← Finset.sum_mul ]

/- Term in Riemann sum of R at index j. -/ def term_f_g {a b : ℝ} (f g : ℝ → ℝ) (R : TaggedPartition a b) (j : ℕ) : ℝ := if h : j < R.n then f (R.xi ⟨j, h⟩) * IPart.term g R.toIPartition j else 0

/- Rewrite the Riemann sum of R as a double sum over blocks defined by P, using the index map k.

Sum of absolute increments of g over an untagged partition. -/ def sumAbsDiff {a b : ℝ} (g : ℝ → ℝ) (P : IPart.IPartition a b) : ℝ := ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)|

/- The absolute difference of g over a subinterval of P is bounded by the sum of absolute differences of g over the corresponding subintervals of R. -/ lemma sumAbsDiff_block_le {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) (i : Fin P.n) : |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by rw [← hk_eq i.succ, ← hk_eq i.castSucc] rw [← IPart.sum_telescope_block g R (k i.castSucc) (k i.succ) (hk (Nat.le_succ _))] apply Finset.abs_sum_le_sum_abs

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_mono_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by -- Use refinement_index_map to get k. obtain ⟨k, , hk_eq⟩ : ∃ k : Fin (P.n + 1) → Fin (R.n + 1), Monotone k ∧ ∀ i, R.x (k i) = P.x i := by exact IPart.refinement_index_map P R hPR; -- Apply sumAbsDiff_block_le to bound the sum over P by the double sum over blocks of R. have h_sum_le_double_sum : ∑ i : Fin P.n, |g (P.x i.succ) - g (P.x i.castSucc)| ≤ ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| := by exact Finset.sum_le_sum fun i _ => sumAbsDiff_block_le k ‹› ‹_› i; -- Use sum_partition_blocks to collapse the double sum into a single sum over Ico (k 0) (k P.n). have h_double_sum_to_single_sum : ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| := by have h_double_sum_to_single_sum : ∀ (n : ℕ) (k : Fin (n + 1) → ℕ) (hk : Monotone k), ∑ i : Fin n, ∑ j ∈ Finset.Ico (k i.castSucc) (k i.succ), |IPart.term g R j| = ∑ j ∈ Finset.Ico (k 0) (k (Fin.last n)), |IPart.term g R j| := by exact fun n k hk ↦ IPart.sum_partition_blocks n k hk fun j ↦ |IPart.term g R j|; convert h_double_sum_to_single_sum P.n ( fun i => ( k i : ℕ ) ) ( fun i j hij => by simpa using ‹Monotone k› hij ) using 1; -- Bound this sum by the sum over range R.n (since terms are non-negative and the interval is a subset). have h_single_sum_le_range : ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last P.n)).val, |IPart.term g R j| ≤ ∑ j ∈ Finset.Ico 0 R.n, |IPart.term g R j| := by refine' Finset.sum_le_sum_of_subset_of_nonneg _ fun _ _ _ => abs_nonneg _; refine' Finset.Ico_subset_Ico _ _ <;> norm_num; exact Nat.le_of_lt_succ ( Fin.is_lt _ ); convert h_sum_le_double_sum.trans ( h_double_sum_to_single_sum.le.trans h_single_sum_le_range ) using 1; simp +decide [ sumAbsDiff, Finset.sum_range, Fin.cast_val_eq_self ]; refine' Finset.sum_congr rfl fun i hi => _ ; unfold IPart.term ; aesop

/- sumAbsDiff is monotonic with respect to partition refinement. -/ lemma sumAbsDiff_le_sumAbsDiff_of_refinement {a b : ℝ} {g : ℝ → ℝ} {P R : IPart.IPartition a b} (hPR : IPart.IsRefinement R P) : sumAbsDiff g P ≤ sumAbsDiff g R := by convert sumAbsDiff_mono_of_refinement hPR using 1

/- If x is a monotone sequence of points contained in partition P, then the sum of absolute differences of g along x is bounded by sumAbsDiff g P. -/ lemma sum_le_sumAbsDiff_of_points_subset {a b : ℝ} (g : ℝ → ℝ) (P : RS.IPart.IPartition a b) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (h_subset : ∀ i, x i ∈ P.points) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ RS.SumDiff.sumAbsDiff g P := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$. obtain ⟨k, hk⟩ : ∃ k : Fin (p + 1) → Fin (P.n + 1), Monotone k ∧ ∀ i : Fin (p + 1), P.x (k i) = x i := by -- By definition of $P.points$, there exists a monotone map $k : Fin (p + 1) → Fin (P.n + 1)$ such that $P.x (k i) = x i$ for all $i$ by the properties of the points of $P$. have h_k_exists : ∀ y ∈ P.points, ∃ i : Fin (P.n + 1), P.x i = y := by exact fun y hy => by rw [ IPart.IPartition.points ] at hy; aesop; choose k hk using h_k_exists; use fun i => k ( x i ) ( h_subset i ); have h_k_mono : ∀ i j : Fin (p + 1), x i ≤ x j → k (x i) (h_subset i) ≤ k (x j) (h_subset j) := by intros i j hij have h_k_mono : P.x (k (x i) (h_subset i)) ≤ P.x (k (x j) (h_subset j)) := by aesop; contrapose! h_k_mono; apply_rules [ P.monotone, lt_of_le_of_ne ]; · exact le_of_lt h_k_mono; · grind; exact ⟨ fun i j hij => h_k_mono i j <| hx hij, fun i => hk _ _ ⟩; -- Apply the lemma sum_telescope_abs_le to each term in the sum. have h_telescope : ∀ i : Fin p, |g (x (i.succ)) - g (x (i.castSucc))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by intros i have h_telescope : |g (P.x (k (i.succ))) - g (P.x (k (i.castSucc)))| ≤ ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| := by convert IPart.sum_telescope_abs_le g P ( k ( Fin.castSucc i ) ) ( k ( Fin.succ i ) ) _ using 1; exact hk.1 ( Nat.le_succ _ ); aesop; -- Apply the lemma sum_partition_blocks to combine the sums over the intervals [k i, k (i+1)). have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| ≤ ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by have h_sum_partition_blocks : ∑ i : Fin p, ∑ j ∈ Finset.Ico (k (i.castSucc)).val (k (i.succ)).val, |RS.IPart.term g P j| = ∑ j ∈ Finset.Ico (k 0).val (k (Fin.last p)).val, |RS.IPart.term g P j| := by convert RS.IPart.sum_partition_blocks p ( fun i => ( k i : ℕ ) ) hk.1 _ using 1; grind; refine le_trans ( Finset.sum_le_sum fun i _ => h_telescope i ) ( h_sum_partition_blocks.trans ?_ ); refine' le_trans ( Finset.sum_le_sum_of_subset_of_nonneg ( Finset.subset_iff.mpr _ ) fun _ _ _ => abs_nonneg _ ) _; exact Finset.range P.n; · simp +zetaDelta at *; intro i hi₁ hi₂; exact lt_of_lt_of_le hi₂ ( Nat.le_of_lt_succ <| by simp [ Fin.is_lt ] ) ; · simp +decide [ Finset.sum_range, IPart.term ]; rfl

lemma sum_le_K_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : RS.IPart.IPartition a b, sumAbsDiff g P ≤ K) (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b) : ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by -- Let s be the set of values of x union {a, b}. set s : Finset ℝ := Finset.image x Finset.univ ∪ {a, b} with hs_def; -- Construct a partition P from s using RS.IPart.fromPoints. obtain ⟨P, hP⟩ : ∃ P : IPart.IPartition a b, P.points = s := by refine' ⟨ IPart.fromPoints s _ _ _, _ ⟩ <;> norm_num [ hs_def ]; grind; convert IPart.points_fromPoints _ _ _ _; convert sum_le_sumAbsDiff_of_points_subset g P p x hx _ |> le_trans <| hK P; grind

/- If the sum of absolute differences of g over any partition is bounded by K, then the total variation of g is bounded by K. -/ lemma variation_le_of_forall_sumAbsDiff_le {a b : ℝ} (hab : a < b) (g : ℝ → ℝ) (K : ℝ) (hK : ∀ P : IPart.IPartition a b, sumAbsDiff g P ≤ K) : (eVariationOn g (Set.Icc a b)).toReal ≤ K := by -- We know that for any monotone sequence x, the sum of absolute differences is ≤ K. have h_sum_le : ∀ (p : ℕ) (x : Fin (p + 1) → ℝ) (hx : Monotone x) (hx_mem : ∀ i, x i ∈ Set.Icc a b), ∑ i : Fin p, |g (x i.succ) - g (x i.castSucc)| ≤ K := by intro p x hx hx_mem exact sum_le_K_of_forall_sumAbsDiff_le hab g K hK p x hx hx_mem

-- Now we relate this to eVariationOn. -- eVariationOn is the supremum of these sums (converted to ENNReal). -- We show eVariationOn ≤ ENNReal.ofReal K. have h_var_le : eVariationOn g (Set.Icc a b) ≤ ENNReal.ofReal K := by -- Unfold eVariationOn to its definition as a supremum -- Since eVariationOn is defined as a supr, we use iSup_le -- Note: The definition might be wrapped. -- We can try to use eVariationOn properties or just unfold it. -- Assuming standard definition: -- ref: https://leanprover-community.github.io/mathlib4_docs/Mathlib/Analysis/Variation.html#eVariationOn -- It is iSup over p, x. refine' iSup_le _; rintro ⟨ p, ⟨ x, hx₁, hx₂ ⟩ ⟩; simp_all +decide [ edist_dist, Real.dist_eq ]; convert ENNReal.ofReal_le_ofReal ( h_sum_le p ( fun i => x i ) ( fun i j hij => hx₁ hij ) ( fun i => hx₂ i ) ) using 1; rw [ ENNReal.ofReal_sum_of_nonneg fun _ _ => abs_nonneg _, Finset.sum_range ]; exact rfl

/- If the sum of absolute differences of g over any partition is bounded by K, then the sum of absolute differences along any monotone sequence in [a, b] is bounded by K. -/

-- Finally, convert to Real. apply ENNReal.toReal_le_of_le_ofReal · -- K ≥ 0 have P := RS.IPart.uniformPartition 1 hab have := hK P calc 0 ≤ RS.SumDiff.sumAbsDiff g P := by apply Finset.sum_nonneg intro i _ apply abs_nonneg _ ≤ K := this · exact h_var_le

end SumDiff

/- First, a definition of tagged partitions, followed by some basic lemmas -/ /- A tagged Riemann-Stieltjes partition includes points xi in each subinterval [x_i, x_{i+1}]. -/

namespace Integ

structure TaggedPartition (a b : ℝ) extends IPart.IPartition a b where xi : Fin n → ℝ h_xi : ∀ i : Fin n, x i.castSucc ≤ xi i ∧ xi i ≤ x i.succ

/- The filter of tagged partitions with mesh tending to 0. -/ def TaggedPartitionFilter (a b : ℝ) : Filter (TaggedPartition a b) := Filter.comap (fun P => P.mesh) (nhds 0)

/- A uniform partition with left tags. We need that simply because our filter is a filter of tagged partitions. -/ def taggedUniformPartition {a b : ℝ} (n : ℕ) (hab : a < b) : TaggedPartition a b := let P := IPart.uniformPartition n hab { toIPartition := P xi := fun i => P.x i.castSucc h_xi := by intro i constructor · exact le_refl _ · apply P.monotone apply Nat.le_succ }

/- The partition filter is proper, that is, there exist partitions of [a,b] of arbitrarily small mesh. -/ lemma TaggedPartitionFilter_neBot {a b : ℝ} (hab : a < b) : Filter.NeBot (TaggedPartitionFilter a b) := by refine' Filter.neBot_iff.mpr _; rw [ Ne.eq_def, Filter.ext_iff ]; simp +zetaDelta at *; use ∅; intro h; obtain ⟨ U, hU₁, hU₂ ⟩ := Filter.mem_comap.mp h; simp_all +decide [ Set.subset_def ]; contrapose! hU₂; rcases Metric.mem_nhds_iff.mp hU₁ with ⟨ ε, εpos, hε ⟩; -- Choose $n$ such that $(b - a) / (n + 1) < \epsilon$. obtain ⟨ n, hn ⟩ : ∃ n : ℕ, (b - a) / (n + 1) < ε := by exact ⟨ ⌊ ( b - a ) / ε⌋₊, by rw [ div_lt_iff₀ ] <;> nlinarith [ Nat.lt_floor_add_one ( ( b - a ) / ε ), mul_div_cancel₀ ( b - a ) εpos.ne' ] ⟩; refine' ⟨ taggedUniformPartition n hab, hε _ ⟩; simp +zetaDelta at *; rw [ abs_of_nonneg ( IPart.mesh_nonneg _ ) ]; convert hn using 1; convert IPart.mesh_uniformPartition n hab using 1

/- A tagged partition where the tags are the left endpoints of the intervals. -/ def tagLeft {a b : ℝ} (P : IPart.IPartition a b) : TaggedPartition a b := { P with xi := fun i => P.x i.castSucc h_xi := fun i => ⟨le_refl _, P.monotone (Nat.le_succ _)⟩ }

/- We finally come to Riemann-Stieltjes sums and to the definition of Riemann-Stieltjes integrals!-/ /- The Riemann-Stieltjes sum S(P, f, g) is the sum of f(xi_i) * (g(x_{i+1}) - g(x_i)). -/ def RSSum {a b : ℝ} (f g : ℝ → ℝ) (P : TaggedPartition a b) : ℝ := ∑ i : Fin P.n, f (P.xi i) * (g (P.x i.succ) - g (P.x i.castSucc))

/- The Riemann-Stieltjes integral of f with respect to g on [a, b] has value I. -/ def HasRSIntegral (f g : ℝ → ℝ) (a b I : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P : TaggedPartition a b), P.mesh ≤ δ → |RSSum f g P - I| < ε

/- HasRSIntegral is equivalent to convergence along the tagged partition filter. -/ lemma hasRSIntegral_iff_tendsto {f g : ℝ → ℝ} {a b I : ℝ} : HasRSIntegral f g a b I ↔ Filter.Tendsto (RSSum f g) (TaggedPartitionFilter a b) (nhds I) := by constructor <;> intro h; · refine' Metric.tendsto_nhds.mpr _; intro ε hε; obtain ⟨ δ, hδ, H ⟩ := h ε hε; filter_upwards [ Filter.preimage_mem_comap ( Iio_mem_nhds hδ ) ] with P hP using H P <| le_of_lt hP; · intro ε hε; obtain ⟨ δ, hδ ⟩ := Metric.tendsto_nhds.mp h ε hε; -- Since δ is a neighborhood of 0, there exists a δ' > 0 such that (0, δ') is contained in δ. obtain ⟨δ', hδ'⟩ : ∃ δ' > 0, Metric.ball 0 δ' ⊆ δ := by exact Metric.mem_nhds_iff.mp hδ.1; use δ' / 2; exact ⟨ half_pos hδ'.1, fun P hP => hδ.2 <| hδ'.2 <| mem_ball_zero_iff.mpr <| abs_lt.mpr ⟨ by linarith [ show 0 ≤ P.mesh from IPart.mesh_nonneg _ ], by linarith [ show 0 ≤ P.mesh from IPart.mesh_nonneg _ ] ⟩ ⟩

/- The Cauchy condition for Riemann-Stieltjes sums. -/ def RSCauchyCondition (f g : ℝ → ℝ) (a b : ℝ) : Prop := ∀ ε > 0, ∃ δ > 0, ∀ (P Q : TaggedPartition a b), P.mesh ≤ δ → Q.mesh ≤ δ → |RSSum f g P - RSSum f g Q| < ε

/- The image of the partition filter under the Riemann sum map is a Cauchy filter. -/ lemma cauchy_map_RSSum {f g : ℝ → ℝ} {a b : ℝ} (hab : a < b) (h : RSCauchyCondition f g a b) : Cauchy (Filter.map (RSSum f g) (TaggedPartitionFilter a b)) := by have h_cauchy : ∀ ε > 0, ∃ S ∈ TaggedPartitionFilter a b, ∀ P Q : TaggedPartition a b, P ∈ S → Q ∈ S → |RSSum f g P - RSSum f g Q| < ε := by intro ε hε_pos obtain ⟨δ, hδ_pos, hδ⟩ := h ε hε_pos use {P : TaggedPartition a b | P.mesh ≤ δ}; exact ⟨ Filter.mem_comap.mpr ⟨ Set.Iic δ, Iic_mem_nhds hδ_pos, by aesop ⟩, hδ ⟩; rw [ Metric.cauchy_iff ]; constructor; · apply_rules [ Filter.map_neBot ]; exact TaggedPartitionFilter_neBot hab; · exact fun ε ε_pos => by obtain ⟨ S, hS₁, hS₂ ⟩ := h_cauchy ε ε_pos; exact ⟨ RSSum f g '' S, Filter.image_mem_map hS₁, by aesop ⟩ ;

/- The Cauchy condition implies the existence of the Riemann-Stieltjes integral. -/ theorem RSCauchy_implies_exists (f g : ℝ → ℝ) (a b : ℝ) (hab : a < b) (h : RSCauchyCondition f g a b) : ∃ I, HasRSIntegral f g a b I := by -- By cauchy_map_RSSum, the filter map (RSSum f g) (TaggedPartitionFilter a b) is Cauchy. have h_cauchy : Cauchy (Filter.map (RSSum f g) (TaggedPartitionFilter a b)) := by exact cauchy_map_RSSum hab h -- Since ℝ is a complete metric space, every Cauchy filter converges. obtain ⟨I, hI⟩ : ∃ I : ℝ, Filter.Tendsto (RSSum f g) (TaggedPartitionFilter a b) (nhds I) := by exact CompleteSpace.complete h_cauchy exact ⟨ I, by simpa only [ hasRSIntegral_iff_tendsto ] using hI ⟩

/- Rewrite S(P) as a double sum using the refinement index map. -/ lemma RSSum_P_rewrite {a b : ℝ} (f g : ℝ → ℝ) (P R : TaggedPartition a b) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_eq : ∀ i, R.x (k i) = P.x i) : RSSum f g P = ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, f (P.xi i) * IPart.term g R.toIPartition j := by apply Finset.sum_congr rfl fun i _ => ?_; have h_telescope : ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, IPart.term g R.toIPartition j = g (R.x (k i.succ)) - g (R.x (k i.castSucc)) := by convert IPart.sum_telescope_block g R.toIPartition ( k i.castSucc ) ( k i.succ ) ( hk ( Nat.le_succ _ ) ) using 1; simp_all +decide [ ← Finset.mul_sum _ _ _, ← Finset.sum_mul ]

/- Term in Riemann sum of R at index j. -/ def term_f_g {a b : ℝ} (f g : ℝ → ℝ) (R : TaggedPartition a b) (j : ℕ) : ℝ := if h : j < R.n then f (R.xi ⟨j, h⟩) * IPart.term g R.toIPartition j else 0

/- Rewrite the Riemann sum of R as a double sum over blocks defined by P, using the index map k. -/ lemma RSSum_R_rewrite {a b : ℝ} (f g : ℝ → ℝ) (P R : TaggedPartition a b) (k : Fin (P.n + 1) → Fin (R.n + 1)) (hk : Monotone k) (hk_0 : k 0 = 0) (hk_eq : ∀ i, R.x (k i) = P.x i) : RSSum f g R = ∑ i : Fin P.n, ∑ j ∈ Finset.Ico (k i.castSucc).val (k i.succ).val, term_f_g f g R j := by have h_rewrite : ∑ j ∈ Finset.range R.n, term_f_g f g R j = ∑ j ∈ Finset.Ico 0 (k (Fin.last P.n)).val, term_f_g f g R j := by -- Since $R.x m = b$ and $R.x$ is monotone, for $j \geq m$, $R.x j = b$. have h_monotone : ∀ j : Fin (R.n + 1), (k (Fin.last P.n)).val ≤ j.val → R.x j = b := by intros j hj have h_monotone : ∀ i j : Fin (R.n + 1), i ≤ j → R.x i ≤ R.x j := by exact R.monotone; have h_monotone : R.x (k (Fin.last P.n)) = b := by exact hk_eq _ ▸ P.right; exact le_antisymm ( by linarith [ R.monotone ( show j ≤ Fin.last _ from Fin.le_last _ ), R.right ] ) ( by linarith [ ‹∀ i j : Fin ( R.n + 1 ), i ≤ j → R.x i ≤ R.x j› _ _ ( show k ( Fin.last P.n ) ≤ j from hj ) ] ); -- Since $R.x j = b$ for $j \geq m$, the term_f_g $f$ $g$ $R$ $j$ is zero for $j \geq m$. have h_zero : ∀ j : ℕ, (k (Fin.last P.n)).val ≤ j → j < R.n → term_f_g f g R j = 0 := by intros j hj₁ hj₂ have h_x_eq_b : R.x ⟨j + 1, by linarith⟩ = b := by exact h_monotone _ ( Nat.le_succ_of_le hj₁ ); have h_x_eq_b : R.x ⟨j, by linarith⟩ = b := by exact h_monotone ⟨ j, by linarith ⟩ hj₁; unfold term_f_g IPart.term; aesop; rw [ ← Finset.sum_range_add_sum_Ico _ ( show ( k ( Fin.last P.n ) |> Fin.val ) ≤ R.n from Nat.le_of_lt_succ <| Fin.is_lt _ ) ]; simp +zetaDelta at *; exact Finset.sum_eq_zero fun x hx => h_zero x ( Finset.mem_Ico.mp hx |>.1 ) ( Finset.mem_Ico.mp hx |>.2 ); convert h_rewrite using 1; · unfold RSSum term_f_g; unfold IPart.term; simp +decide [ Finset.sum_range, Fin.sum_univ_castSucc ] ; rfl; · convert IPart.sum_partition_blocks P.n ( fun i => ( k i : ℕ ) ) ( fun i j hij => by simpa using hk hij ) ( fun j => term_f_g f g R j ) using 1; aesop

/- Now we start proving meaningful bounds.-/

/- The sum of absolute differences of g over a partition is bounded by the total variation of g.