/-- 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]
      

Proof state:
case refine_1.right
ι : 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
i : ι
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
hφw :
  ∀ (j : ι) (g : G j),
    { fst := j, snd := g } ∈ (CoprodI.of ((φ i) h) • w).toList →
      ↑((equiv (_ : IsComplement (↑(MonoidHom.range (φ j))) (Transversal.set d j))) g).2 = g
hhead :
  ↑((equiv (_ : IsComplement (↑(MonoidHom.range (φ i))) (Transversal.set d i))) ((Word.equivPair i) w).head).2 =
    ((Word.equivPair i) w).head
hh1 : ¬h = 1
⊢ { fst := i,
        snd :=
          (φ i) h *
            if h : ∃ (h : w.toList ≠ []), (List.head w.toList h).fst = i then
              (_ : (List.head w.toList (_ : w.toList ≠ [])).fst = i) ▸ (List.head w.toList (_ : w.toList ≠ [])).snd
            else 1 } ∈
      tail w.toList ∨
    head? w.toList =
        some
          { fst := i,
            snd :=
              if h : ∃ (h : w.toList ≠ []), (List.head w.toList h).fst = i then
                (_ : (List.head w.toList (_ : w.toList ≠ [])).fst = i) ▸ (List.head w.toList (_ : w.toList ≠ [])).snd
              else 1 } ∨
      ¬Word.fstIdx w = some i ∧
        (if h : ∃ (h : w.toList ≠ []), (List.head w.toList h).fst = i then
            (_ : (List.head w.toList (_ : w.toList ≠ [])).fst = i) ▸ (List.head w.toList (_ : w.toList ≠ [])).snd
          else 1) =
          1

Next tactic:
dsimp