open UniqueMul in
@[to_additive] instance {ι} (G : ι → Type*) [∀ i, Mul (G i)] [∀ i, UniqueProds (G i)] :
    UniqueProds (∀ i, G i) where
  uniqueMul_of_nonempty {A} := by
    classical
    let _ := isWellFounded_ssubset (α := ∀ i, G i) -- why need this?
    apply IsWellFounded.induction (· ⊂ ·) A; intro A ihA B hA
    apply IsWellFounded.induction (· ⊂ ·) B; intro B ihB hB
    by_cases hc : A.card ≤ 1 ∧ B.card ≤ 1
    · exact of_card_le_one hA hB hc.1 hc.2
    simp_rw [not_and_or, not_le] at hc
    obtain ⟨i, hc⟩ := exists_or.mpr (hc.imp exists_of_one_lt_card_pi exists_of_one_lt_card_pi)
    obtain ⟨ai, hA, bi, hB, hi⟩ := uniqueMul_of_nonempty (hA.image (· i)) (hB.image (· i))
    rw [mem_image, ← filter_nonempty_iff] at hA hB
    let A' := A.filter (· i = ai); let B' := B.filter (· i = bi)
    obtain ⟨a0, ha0, b0, hb0, hu⟩ : ∃ a0 ∈ A', ∃ b0 ∈ B', UniqueMul A' B' a0 b0
    · rcases hc with hc | hc; · exact ihA A' (hc.2 ai) hA hB
      by_cases hA' : A' = A; rw [hA']
      

Proof state:
case pos
G✝ : Type u
H : Type v
inst✝³ : Mul G✝
inst✝² : Mul H
ι : Type ?u.379291
G : ι → Type u_1
inst✝¹ : (i : ι) → Mul (G i)
inst✝ : ∀ (i : ι), UniqueProds (G i)
A✝ : Finset ((i : ι) → G i)
x✝ : IsWellFounded (Finset ((i : ι) → G i)) fun x x_1 => x ⊂ x_1 := isWellFounded_ssubset
A : Finset ((i : ι) → G i)
ihA :
  ∀ y ⊂ A,
    ∀ {B : Finset ((i : ι) → G i)}, Finset.Nonempty y → Finset.Nonempty B → ∃ a0 ∈ y, ∃ b0 ∈ B, UniqueMul y B a0 b0
B✝ : Finset ((i : ι) → G i)
hA✝ : Finset.Nonempty A
B : Finset ((i : ι) → G i)
ihB : ∀ y ⊂ B, Finset.Nonempty y → ∃ a0 ∈ A, ∃ b0 ∈ y, UniqueMul A y a0 b0
hB✝ : Finset.Nonempty B
hc✝ : 1 < card A ∨ 1 < card B
i : ι
ai : G i
hA : Finset.Nonempty (filter (fun a => a i = ai) A)
bi : G i
hB : Finset.Nonempty (filter (fun a => a i = bi) B)
hi : UniqueMul (image (fun x => x i) A) (image (fun x => x i) B) ai bi
A' : Finset ((i : ι) → G i) := filter (fun x => x i = ai) A
B' : Finset ((i : ι) → G i) := filter (fun x => x i = bi) B
hc : 1 < card (image (fun x => x i) B) ∧ ∀ (ai : G i), filter (fun x => x i = ai) B ⊂ B
hA' : A' = A
⊢ ∃ a0 ∈ A, ∃ b0 ∈ B', UniqueMul A B' a0 b0
case neg
G✝ : Type u
H : Type v
inst✝³ : Mul G✝
inst✝² : Mul H
ι : Type ?u.379291
G : ι → Type u_1
inst✝¹ : (i : ι) → Mul (G i)
inst✝ : ∀ (i : ι), UniqueProds (G i)
A✝ : Finset ((i : ι) → G i)
x✝ : IsWellFounded (Finset ((i : ι) → G i)) fun x x_1 => x ⊂ x_1 := isWellFounded_ssubset
A : Finset ((i : ι) → G i)
ihA :
  ∀ y ⊂ A,
    ∀ {B : Finset ((i : ι) → G i)}, Finset.Nonempty y → Finset.Nonempty B → ∃ a0 ∈ y, ∃ b0 ∈ B, UniqueMul y B a0 b0
B✝ : Finset ((i : ι) → G i)
hA✝ : Finset.Nonempty A
B : Finset ((i : ι) → G i)
ihB : ∀ y ⊂ B, Finset.Nonempty y → ∃ a0 ∈ A, ∃ b0 ∈ y, UniqueMul A y a0 b0
hB✝ : Finset.Nonempty B
hc✝ : 1 < card A ∨ 1 < card B
i : ι
ai : G i
hA : Finset.Nonempty (filter (fun a => a i = ai) A)
bi : G i
hB : Finset.Nonempty (filter (fun a => a i = bi) B)
hi : UniqueMul (image (fun x => x i) A) (image (fun x => x i) B) ai bi
A' : Finset ((i : ι) → G i) := filter (fun x => x i = ai) A
B' : Finset ((i : ι) → G i) := filter (fun x => x i = bi) B
hc : 1 < card (image (fun x => x i) B) ∧ ∀ (ai : G i), filter (fun x => x i = ai) B ⊂ B
hA' : ¬A' = A
⊢ ∃ a0 ∈ A', ∃ b0 ∈ B', UniqueMul A' B' a0 b0

Next tactic:
exacts [ihB B' (hc.2 bi) hB, ihA A' ((A.filter_subset _).ssubset_of_ne hA') hA hB]