/-- The topological Besicovitch covering theorem: there exist finitely many families of disjoint
balls covering all the centers in a package. More specifically, one can use `N` families if there
are no satellite configurations with `N+1` points. -/
theorem exist_disjoint_covering_families {N : ℕ} {τ : ℝ} (hτ : 1 < τ)
    (hN : IsEmpty (SatelliteConfig α N τ)) (q : BallPackage β α) :
    ∃ s : Fin N → Set β,
      (∀ i : Fin N, (s i).PairwiseDisjoint fun j => closedBall (q.c j) (q.r j)) ∧
        range q.c ⊆ ⋃ i : Fin N, ⋃ j ∈ s i, ball (q.c j) (q.r j) := by
  -- first exclude the trivial case where `β` is empty (we need non-emptiness for the transfinite
  -- induction, to be able to choose garbage when there is no point left).
  cases isEmpty_or_nonempty β
  · refine' ⟨fun _ => ∅, fun _ => pairwiseDisjoint_empty, _⟩
    rw [← image_univ, eq_empty_of_isEmpty (univ : Set β)]
    simp
  -- Now, assume `β` is nonempty.
  let p : TauPackage β α :=
    { q with
      τ
      one_lt_tau := hτ }
  -- we use for `s i` the balls of color `i`.
  let s := fun i : Fin N =>
    ⋃ (k : Ordinal.{u}) (_ : k < p.lastStep) (_ : p.color k = i), ({p.index k} : Set β)
  refine' ⟨s, fun i => _, _⟩
  · -- show that balls of the same color are disjoint
    intro x hx y hy x_ne_y
    obtain ⟨jx, jx_lt, jxi, rfl⟩ :
      ∃ jx : Ordinal, jx < p.lastStep ∧ p.color jx = i ∧ x = p.index jx := by
      simpa only [exists_prop, mem_iUnion, mem_singleton_iff] using hx
    obtain ⟨jy, jy_lt, jyi, rfl⟩ :
      ∃ jy : Ordinal, jy < p.lastStep ∧ p.color jy = i ∧ y = p.index jy := by
      simpa only [exists_prop, mem_iUnion, mem_singleton_iff] using hy
    wlog jxy : jx ≤ jy generalizing jx jy
    · exact (this jy jy_lt jyi hy jx jx_lt jxi hx x_ne_y.symm (le_of_not_le jxy)).symm
    replace jxy : jx < jy
    · rcases lt_or_eq_of_le jxy with (H | rfl); · { exact H }; · { exact (x_ne_y rfl).elim }
    let A : Set ℕ :=
      ⋃ (j : { j // j < jy })
        (_ : (closedBall (p.c (p.index j)) (p.r (p.index j)) ∩
          closedBall (p.c (p.index jy)) (p.r (p.index jy))).Nonempty),
        {p.color j}
    have color_j : p.color jy = sInf (univ \ A) := by rw [TauPackage.color]
    have h : p.color jy ∈ univ \ A := by
      rw [color_j]
      apply csInf_mem
      refine' ⟨N, _⟩
      simp only [not_exists, true_and_iff, exists_prop, mem_iUnion, mem_singleton_iff, not_and,
        mem_univ, mem_diff, Subtype.exists, Subtype.coe_mk]
      intro k hk _
      exact (p.color_lt (hk.trans jy_lt) hN).ne'
    simp only [not_exists, true_and_iff, exists_prop, mem_iUnion, mem_singleton_iff, not_and,
      mem_univ, mem_diff, Subtype.exists, Subtype.coe_mk] at h
    specialize h jx jxy
    contrapose! h
    

Proof state:
α : Type u_1
inst✝ : MetricSpace α
β : Type u
N : ℕ
τ : ℝ
hτ : 1 < τ
hN : IsEmpty (SatelliteConfig α N τ)
q : BallPackage β α
h✝ : Nonempty β
p : TauPackage β α :=
  {
    toBallPackage :=
      { c := q.c, r := q.r, rpos := (_ : ∀ (b : β), 0 < BallPackage.r q b), r_bound := q.r_bound,
        r_le := (_ : ∀ (b : β), BallPackage.r q b ≤ q.r_bound) },
    τ := τ, one_lt_tau := hτ }
s : Fin N → Set β := fun i => ⋃ k, ⋃ (_ : k < lastStep p), ⋃ (_ : color p k = ↑i), {index p k}
i : Fin N
jx : Ordinal.{u}
jx_lt : jx < lastStep p
jxi : color p jx = ↑i
hx : index p jx ∈ s i
jy : Ordinal.{u}
jy_lt : jy < lastStep p
jyi : color p jy = ↑i
hy : index p jy ∈ s i
x_ne_y : index p jx ≠ index p jy
jxy : jx < jy
A : Set ℕ :=
  ⋃ j,
    ⋃ (_ :
      Set.Nonempty
        (closedBall (BallPackage.c p.toBallPackage (index p ↑j)) (BallPackage.r p.toBallPackage (index p ↑j)) ∩
          closedBall (BallPackage.c p.toBallPackage (index p jy)) (BallPackage.r p.toBallPackage (index p jy)))),
      {color p ↑j}
color_j : color p jy = sInf (univ \ A)
h : ¬(Disjoint on fun j => closedBall (BallPackage.c q j) (BallPackage.r q j)) (index p jx) (index p jy)
⊢ Set.Nonempty
      (closedBall
          (BallPackage.c q
            (index
              {
                toBallPackage :=
                  { c := q.c, r := q.r, rpos := (_ : ∀ (b : β), 0 < BallPackage.r q b), r_bound := q.r_bound,
                    r_le := (_ : ∀ (b : β), BallPackage.r q b ≤ q.r_bound) },
                τ := τ, one_lt_tau := hτ }
              jx))
          (BallPackage.r q
            (index
              {
                toBallPackage :=
                  { c := q.c, r := q.r, rpos := (_ : ∀ (b : β), 0 < BallPackage.r q b), r_bound := q.r_bound,
                    r_le := (_ : ∀ (b : β), BallPackage.r q b ≤ q.r_bound) },
                τ := τ, one_lt_tau := hτ }
              jx)) ∩
        closedBall
          (BallPackage.c q
            (index
              {
                toBallPackage :=
                  { c := q.c, r := q.r, rpos := (_ : ∀ (b : β), 0 < BallPackage.r q b), r_bound := q.r_bound,
                    r_le := (_ : ∀ (b : β), BallPackage.r q b ≤ q.r_bound) },
                τ := τ, one_lt_tau := hτ }
              jy))
          (BallPackage.r q
            (index
              {
                toBallPackage :=
                  { c := q.c, r := q.r, rpos := (_ : ∀ (b : β), 0 < BallPackage.r q b), r_bound := q.r_bound,
                    r_le := (_ : ∀ (b : β), BallPackage.r q b ≤ q.r_bound) },
                τ := τ, one_lt_tau := hτ }
              jy))) ∧
    color
        {
          toBallPackage :=
            { c := q.c, r := q.r, rpos := (_ : ∀ (b : β), 0 < BallPackage.r q b), r_bound := q.r_bound,
              r_le := (_ : ∀ (b : β), BallPackage.r q b ≤ q.r_bound) },
          τ := τ, one_lt_tau := hτ }
        jy =
      color
        {
          toBallPackage :=
            { c := q.c, r := q.r, rpos := (_ : ∀ (b : β), 0 < BallPackage.r q b), r_bound := q.r_bound,
              r_le := (_ : ∀ (b : β), BallPackage.r q b ≤ q.r_bound) },
          τ := τ, one_lt_tau := hτ }
        jx

Next tactic:
simpa only [jxi, jyi, and_true_iff, eq_self_iff_true, ← not_disjoint_iff_nonempty_inter] using h