/-- Given a word in `CoprodI`, if every letter is in the transversal and when
we multiply by an element of the base group it still has this property,
then the element of the base group we multiplied by was one.  -/
theorem eq_one_of_smul_normalized (w : CoprodI.Word G) {i : ι} (h : H)
    (hw : ∀ i g, ⟨i, g⟩ ∈ w.toList → g ∈ d.set i)
    (hφw : ∀ j g, ⟨j, g⟩ ∈ (CoprodI.of (φ i h) • w).toList → g ∈ d.set j) :
    h = 1 := by
  simp only [← (d.compl _).equiv_snd_eq_self_iff_mem (one_mem _)] at hw hφw
  have hhead : ((d.compl i).equiv (Word.equivPair i w).head).2 =
      (Word.equivPair i w).head := by
    rw [Word.equivPair_head]
    dsimp only
    split_ifs with h
    · rcases h with ⟨_, rfl⟩
      exact hw _ _ (List.head_mem _)
    · rw [equiv_one (d.compl i) (one_mem _) (d.one_mem _)]
  by_contra hh1
  have := hφw i (φ i h * (Word.equivPair i w).head) ?_
  · apply hh1
    rw [equiv_mul_left_of_mem (d.compl i) ⟨_, rfl⟩, hhead] at this
    simpa [((injective_iff_map_eq_one' _).1 (d.injective i))] using this
  · simp only [Word.mem_smul_iff, not_true, false_and, ne_eq, Option.mem_def, mul_right_inj,
      exists_eq_right', mul_right_eq_self, exists_prop, true_and, false_or]
    constructor
    · intro h
      apply_fun (d.compl i).equiv at h
      simp only [Prod.ext_iff, equiv_one (d.compl i) (one_mem _) (d.one_mem _),
        equiv_mul_left_of_mem (d.compl i) ⟨_, rfl⟩ , hhead, Subtype.ext_iff,
        Prod.ext_iff, Subgroup.coe_mul] at h
      rcases h with ⟨h₁, h₂⟩
      rw [h₂, equiv_one (d.compl i) (one_mem _) (d.one_mem _), mul_one,
        ((injective_iff_map_eq_one' _).1 (d.injective i))] at h₁
      contradiction
    · rw [Word.equivPair_head]
      dsimp
      split_ifs with hep
      · rcases hep with ⟨hnil, rfl⟩
        

Proof state:
case pos.intro
ι : Type u_1
G : ι → Type u_2
H : Type u_3
K : Type u_4
inst✝⁴ : Monoid K
inst✝³ : (i : ι) → Group (G i)
inst✝² : Group H
φ : (i : ι) → H →* G i
d : Transversal φ
inst✝¹ : DecidableEq ι
inst✝ : (i : ι) → DecidableEq (G i)
w : Word G
h : H
hw :
  ∀ (i : ι) (g : G i),
    { fst := i, snd := g } ∈ w.toList →
      ↑((equiv (_ : IsComplement (↑(MonoidHom.range (φ i))) (Transversal.set d i))) g).2 = g
hh1 : ¬h = 1
hnil : ¬w.toList = []
hφw :
  ∀ (j : ι) (g : G j),
    { fst := j, snd := g } ∈ (CoprodI.of ((φ (List.head w.toList hnil).fst) h) • w).toList →
      ↑((equiv (_ : IsComplement (↑(MonoidHom.range (φ j))) (Transversal.set d j))) g).2 = g
hhead :
  ↑((equiv
            (_ :
              IsComplement (↑(MonoidHom.range (φ (List.head w.toList hnil).fst)))
                (Transversal.set d (List.head w.toList hnil).fst)))
          ((Word.equivPair (List.head w.toList hnil).fst) w).head).2 =
    ((Word.equivPair (List.head w.toList hnil).fst) w).head
⊢ { fst := (List.head w.toList hnil).fst,
        snd :=
          (φ (List.head w.toList hnil).fst) h *
            (_ : (List.head w.toList (_ : ¬w.toList = [])).fst = (List.head w.toList hnil).fst) ▸
              (List.head w.toList (_ : ¬w.toList = [])).snd } ∈
      tail w.toList ∨
    head? w.toList =
        some
          { fst := (List.head w.toList hnil).fst,
            snd :=
              (_ : (List.head w.toList (_ : ¬w.toList = [])).fst = (List.head w.toList hnil).fst) ▸
                (List.head w.toList (_ : ¬w.toList = [])).snd } ∨
      ¬Word.fstIdx w = some (List.head w.toList hnil).fst ∧
        (_ : (List.head w.toList (_ : ¬w.toList = [])).fst = (List.head w.toList hnil).fst) ▸
            (List.head w.toList (_ : ¬w.toList = [])).snd =
          1

Next tactic:
rw [head?_eq_head _ hnil]