/-- The measurable Besicovitch covering theorem. Assume that, for any `x` in a set `s`,
one is given a set of admissible closed balls centered at `x`, with arbitrarily small radii.
Then there exists a disjoint covering of almost all `s` by admissible closed balls centered at some
points of `s`. We can even require that the radius at `x` is bounded by a given function `R x`.
(Take `R = 1` if you don't need this additional feature).
This version requires that the underlying measure is sigma-finite, and that the space has the
Besicovitch covering property (which is satisfied for instance by normed real vector spaces).
-/
theorem exists_disjoint_closedBall_covering_ae (μ : Measure α) [SigmaFinite μ] (f : α → Set ℝ)
    (s : Set α) (hf : ∀ x ∈ s, ∀ δ > 0, (f x ∩ Ioo 0 δ).Nonempty) (R : α → ℝ)
    (hR : ∀ x ∈ s, 0 < R x) :
    ∃ (t : Set α) (r : α → ℝ), t.Countable ∧ t ⊆ s ∧
      (∀ x ∈ t, r x ∈ f x ∩ Ioo 0 (R x)) ∧ μ (s \ ⋃ x ∈ t, closedBall x (r x)) = 0 ∧
        t.PairwiseDisjoint fun x => closedBall x (r x) := by
  let g x := f x ∩ Ioo 0 (R x)
  have hg : ∀ x ∈ s, ∀ δ > 0, (g x ∩ Ioo 0 δ).Nonempty := by
    intro x hx δ δpos
    rcases hf x hx (min δ (R x)) (lt_min δpos (hR x hx)) with ⟨r, hr⟩
    exact
      ⟨r,
        ⟨⟨hr.1, hr.2.1, hr.2.2.trans_le (min_le_right _ _)⟩,
          ⟨hr.2.1, hr.2.2.trans_le (min_le_left _ _)⟩⟩⟩
  rcases exists_disjoint_closedBall_covering_ae_aux μ g s hg with ⟨v, v_count, vs, vg, μv, v_disj⟩
  let t := Prod.fst '' v
  have : ∀ x ∈ t, ∃ r : ℝ, (x, r) ∈ v := by
    intro x hx
    rcases (mem_image _ _ _).1 hx with ⟨⟨p, q⟩, hp, rfl⟩
    exact ⟨q, hp⟩
  choose! r hr using this
  have im_t : (fun x => (x, r x)) '' t = v := by
    have I : ∀ p : α × ℝ, p ∈ v → 0 ≤ p.2 := fun p hp => (vg p hp).2.1.le
    apply Subset.antisymm
    · simp only [image_subset_iff]
      rintro ⟨x, p⟩ hxp
      simp only [mem_preimage]
      exact hr _ (mem_image_of_mem _ hxp)
    · rintro ⟨x, p⟩ hxp
      have hxrx : (x, r x) ∈ v := hr _ (mem_image_of_mem _ hxp)
      have : p = r x := by
        by_contra h
        have A : (x, p) ≠ (x, r x) := by
          simpa only [true_and_iff, Prod.mk.inj_iff, eq_self_iff_true, Ne.def] using h
        have H := v_disj hxp hxrx A
        contrapose H
        rw [not_disjoint_iff_nonempty_inter]
        refine' ⟨x, by simp (config := { proj := false }) [I _ hxp, I _ hxrx]⟩
      rw [this]
      apply mem_image_of_mem
      exact mem_image_of_mem _ hxp
  refine' ⟨t, r, v_count.image _, _, _, _, _⟩
  · intro x hx
    rcases (mem_image _ _ _).1 hx with ⟨⟨p, q⟩, hp, rfl⟩
    exact vs _ hp
  · intro x hx
    rcases (mem_image _ _ _).1 hx with ⟨⟨p, q⟩, _, rfl⟩
    exact vg _ (hr _ hx)
  · have :
      ⋃ (x : α) (_ : x ∈ t), closedBall x (r x) =
        ⋃ (p : α × ℝ) (_ : p ∈ (fun x => (x, r x)) '' t), closedBall p.1 p.2 :=
      by conv_rhs => rw [biUnion_image]
    rw [this, im_t]
    exact μv
  · have A : InjOn (fun x : α => (x, r x)) t := by
      simp (config := { contextual := true }) only [InjOn, Prod.mk.inj_iff, imp_true_iff,
        eq_self_iff_true]
    

Proof state:
case intro.intro.intro.intro.intro.refine'_4
α : Type u_1
inst✝⁵ : MetricSpace α
β : Type u
inst✝⁴ : SecondCountableTopology α
inst✝³ : MeasurableSpace α
inst✝² : OpensMeasurableSpace α
inst✝¹ : HasBesicovitchCovering α
μ : Measure α
inst✝ : SigmaFinite μ
f : α → Set ℝ
s : Set α
hf : ∀ x ∈ s, ∀ δ > 0, Set.Nonempty (f x ∩ Ioo 0 δ)
R : α → ℝ
hR : ∀ x ∈ s, 0 < R x
g : α → Set ℝ := fun x => f x ∩ Ioo 0 (R x)
hg : ∀ x ∈ s, ∀ δ > 0, Set.Nonempty (g x ∩ Ioo 0 δ)
v : Set (α × ℝ)
v_count : Set.Countable v
vs : ∀ p ∈ v, p.1 ∈ s
vg : ∀ p ∈ v, p.2 ∈ g p.1
μv : ↑↑μ (s \ ⋃ p ∈ v, closedBall p.1 p.2) = 0
v_disj : PairwiseDisjoint v fun p => closedBall p.1 p.2
t : Set α := Prod.fst '' v
r : α → ℝ
hr : ∀ x ∈ t, (x, r x) ∈ v
im_t : (fun x => (x, r x)) '' t = v
A : InjOn (fun x => (x, r x)) t
⊢ PairwiseDisjoint t fun x => closedBall x (r x)

Next tactic:
rwa [← im_t, A.pairwiseDisjoint_image] at v_disj