/-- Higman's Lemma, which states that for any reflexive, transitive relation `r` which is
  partially well-ordered on a set `s`, the relation `List.SublistForall₂ r` is partially
  well-ordered on the set of lists of elements of `s`. That relation is defined so that
  `List.SublistForall₂ r l₁ l₂` whenever `l₁` related pointwise by `r` to a sublist of `l₂`.  -/
theorem partiallyWellOrderedOn_sublistForall₂ (r : α → α → Prop) [IsRefl α r] [IsTrans α r]
    {s : Set α} (h : s.PartiallyWellOrderedOn r) :
    { l : List α | ∀ x, x ∈ l → x ∈ s }.PartiallyWellOrderedOn (List.SublistForall₂ r) := by
  rcases isEmpty_or_nonempty α
  · exact subsingleton_of_subsingleton.partiallyWellOrderedOn
  inhabit α
  rw [iff_not_exists_isMinBadSeq List.length]
  rintro ⟨f, hf1, hf2⟩
  have hnil : ∀ n, f n ≠ List.nil := fun n con =>
    hf1.2 n n.succ n.lt_succ_self (con.symm ▸ List.SublistForall₂.nil)
  have : ∀ n, (f n).headI ∈ s
  · exact fun n => hf1.1 n _ (List.head!_mem_self (hnil n))
  obtain ⟨g, hg⟩ := h.exists_monotone_subseq (fun n => (f n).headI) this
  have hf' :=
    hf2 (g 0) (fun n => if n < g 0 then f n else List.tail (f (g (n - g 0))))
      (fun m hm => (if_pos hm).symm) ?_
  swap;
  · simp only [if_neg (lt_irrefl (g 0)), tsub_self]
    rw [List.length_tail, ← Nat.pred_eq_sub_one]
    exact Nat.pred_lt fun con => hnil _ (List.length_eq_zero.1 con)
  rw [IsBadSeq] at hf'
  push_neg at hf'
  obtain ⟨m, n, mn, hmn⟩ := hf' <| fun n x hx => by
    split_ifs at hx with hn
    

Proof state:
case pos
ι : Type u_1
α : Type u_2
β : Type u_3
γ : Type u_4
π : ι → Type u_5
r✝ r : α → α → Prop
inst✝¹ : IsRefl α r
inst✝ : IsTrans α r
s : Set α
h : PartiallyWellOrderedOn s r
h✝ : Nonempty α
inhabited_h : Inhabited α
f : ℕ → List α
hf1 : IsBadSeq (List.SublistForall₂ r) {l | ∀ x ∈ l, x ∈ s} f
hf2 : ∀ (n : ℕ), IsMinBadSeq (List.SublistForall₂ r) List.length {l | ∀ x ∈ l, x ∈ s} n f
hnil : ∀ (n : ℕ), f n ≠ []
this : ∀ (n : ℕ), List.headI (f n) ∈ s
g : ℕ ↪o ℕ
hg : ∀ (m n : ℕ), m ≤ n → r (List.headI (f (g m))) (List.headI (f (g n)))
hf' :
  (∀ (n : ℕ), (if n < g 0 then f n else List.tail (f (g (n - g 0)))) ∈ {l | ∀ x ∈ l, x ∈ s}) →
    ∃ m n,
      m < n ∧
        List.SublistForall₂ r (if m < g 0 then f m else List.tail (f (g (m - g 0))))
          (if n < g 0 then f n else List.tail (f (g (n - g 0))))
n : ℕ
x : α
hn : n < g 0
hx : x ∈ f n
⊢ x ∈ s
case neg
ι : Type u_1
α : Type u_2
β : Type u_3
γ : Type u_4
π : ι → Type u_5
r✝ r : α → α → Prop
inst✝¹ : IsRefl α r
inst✝ : IsTrans α r
s : Set α
h : PartiallyWellOrderedOn s r
h✝ : Nonempty α
inhabited_h : Inhabited α
f : ℕ → List α
hf1 : IsBadSeq (List.SublistForall₂ r) {l | ∀ x ∈ l, x ∈ s} f
hf2 : ∀ (n : ℕ), IsMinBadSeq (List.SublistForall₂ r) List.length {l | ∀ x ∈ l, x ∈ s} n f
hnil : ∀ (n : ℕ), f n ≠ []
this : ∀ (n : ℕ), List.headI (f n) ∈ s
g : ℕ ↪o ℕ
hg : ∀ (m n : ℕ), m ≤ n → r (List.headI (f (g m))) (List.headI (f (g n)))
hf' :
  (∀ (n : ℕ), (if n < g 0 then f n else List.tail (f (g (n - g 0)))) ∈ {l | ∀ x ∈ l, x ∈ s}) →
    ∃ m n,
      m < n ∧
        List.SublistForall₂ r (if m < g 0 then f m else List.tail (f (g (m - g 0))))
          (if n < g 0 then f n else List.tail (f (g (n - g 0))))
n : ℕ
x : α
hn : ¬n < g 0
hx : x ∈ List.tail (f (g (n - g 0)))
⊢ x ∈ s

Next tactic:
exacts [hf1.1 _ _ hx, hf1.1 _ _ (List.tail_subset _ hx)]