l3lab/ntp-mathlib huggingface dataset:
@[simp]
theorem prod_smul_empty (w : NormalWord d) :
    (w.prod φ) • empty = w := by
  induction w using consRecOn with
  | ofGroup => simp [ofGroup, ReducedWord.prod, of_smul_eq_smul, group_smul_def]
  | cons g u w h1 h2 ih =>
    rw [prod_cons, ← mul_assoc, mul_smul, ih, mul_smul, t_pow_smul_eq_unitsSMul,
      of_smul_eq_smul, unitsSMul]
    rw [dif_neg (not_cancels_of_cons_hyp u w h2)]
    -- The next 3 lines were a single `simp [...]` before leanprover/lean4#2644
    simp only [unitsSMulGroup]
    simp_rw [SetLike.coe_sort_coe]
    erw [(d.compl _).equiv_fst_eq_one_of_mem_of_one_mem (one_mem _) h1]
    

Proof state:
case cons
G : Type u_1
inst✝³ : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝² : Group H
M : Type u_3
inst✝¹ : Monoid M
d : TransversalPair G A B
inst✝ : DecidableEq G
g : G
u : ℤˣ
w : NormalWord d
h1 : w.head ∈ TransversalPair.set d u
h2 : ∀ u' ∈ Option.map Prod.fst (List.head? w.toList), w.head ∈ toSubgroup A B u → u = u'
ih : ReducedWord.prod φ w.toReducedWord • empty = w
⊢ g •
      cons (↑((toSubgroupEquiv φ u) { val := 1, property := (_ : 1 ∈ toSubgroup A B u) })) u
        ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).2 *
            w.head⁻¹) •
          w)
        (_ :
          ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).2 *
                  w.head⁻¹) •
                w).head ∈
            TransversalPair.set d u)
        (_ :
          ∀
            u' ∈
              Option.map Prod.fst
                (List.head?
                  ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u)))
                              w.head).2 *
                        w.head⁻¹) •
                      w).toList),
            ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).2 *
                      w.head⁻¹) •
                    w).head ∈
                toSubgroup A B u →
              u = u') =
    cons g u w h1 h2

Next tactic:
ext
@[simp]
theorem prod_smul_empty (w : NormalWord d) :
    (w.prod φ) • empty = w := by
  induction w using consRecOn with
  | ofGroup => simp [ofGroup, ReducedWord.prod, of_smul_eq_smul, group_smul_def]
  | cons g u w h1 h2 ih =>
    rw [prod_cons, ← mul_assoc, mul_smul, ih, mul_smul, t_pow_smul_eq_unitsSMul,
      of_smul_eq_smul, unitsSMul]
    rw [dif_neg (not_cancels_of_cons_hyp u w h2)]
    -- The next 3 lines were a single `simp [...]` before leanprover/lean4#2644
    simp only [unitsSMulGroup]
    simp_rw [SetLike.coe_sort_coe]
    erw [(d.compl _).equiv_fst_eq_one_of_mem_of_one_mem (one_mem _) h1]
    ext <;> 

Proof state:
case cons.h1
G : Type u_1
inst✝³ : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝² : Group H
M : Type u_3
inst✝¹ : Monoid M
d : TransversalPair G A B
inst✝ : DecidableEq G
g : G
u : ℤˣ
w : NormalWord d
h1 : w.head ∈ TransversalPair.set d u
h2 : ∀ u' ∈ Option.map Prod.fst (List.head? w.toList), w.head ∈ toSubgroup A B u → u = u'
ih : ReducedWord.prod φ w.toReducedWord • empty = w
⊢ (g •
        cons (↑((toSubgroupEquiv φ u) { val := 1, property := (_ : 1 ∈ toSubgroup A B u) })) u
          ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).2 *
              w.head⁻¹) •
            w)
          (_ :
            ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).2 *
                    w.head⁻¹) •
                  w).head ∈
              TransversalPair.set d u)
          (_ :
            ∀
              u' ∈
                Option.map Prod.fst
                  (List.head?
                    ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u)))
                                w.head).2 *
                          w.head⁻¹) •
                        w).toList),
              ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).2 *
                        w.head⁻¹) •
                      w).head ∈
                  toSubgroup A B u →
                u = u')).head =
    (cons g u w h1 h2).toReducedWord.head

Next tactic:
simp
@[simp]
theorem prod_smul_empty (w : NormalWord d) :
    (w.prod φ) • empty = w := by
  induction w using consRecOn with
  | ofGroup => simp [ofGroup, ReducedWord.prod, of_smul_eq_smul, group_smul_def]
  | cons g u w h1 h2 ih =>
    rw [prod_cons, ← mul_assoc, mul_smul, ih, mul_smul, t_pow_smul_eq_unitsSMul,
      of_smul_eq_smul, unitsSMul]
    rw [dif_neg (not_cancels_of_cons_hyp u w h2)]
    -- The next 3 lines were a single `simp [...]` before leanprover/lean4#2644
    simp only [unitsSMulGroup]
    simp_rw [SetLike.coe_sort_coe]
    erw [(d.compl _).equiv_fst_eq_one_of_mem_of_one_mem (one_mem _) h1]
    ext <;> 

Proof state:
case cons.h2.a.a
G : Type u_1
inst✝³ : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝² : Group H
M : Type u_3
inst✝¹ : Monoid M
d : TransversalPair G A B
inst✝ : DecidableEq G
g : G
u : ℤˣ
w : NormalWord d
h1 : w.head ∈ TransversalPair.set d u
h2 : ∀ u' ∈ Option.map Prod.fst (List.head? w.toList), w.head ∈ toSubgroup A B u → u = u'
ih : ReducedWord.prod φ w.toReducedWord • empty = w
n✝ : ℕ
a✝ : ℤˣ × G
⊢ a✝ ∈
      List.get?
        (g •
            cons (↑((toSubgroupEquiv φ u) { val := 1, property := (_ : 1 ∈ toSubgroup A B u) })) u
              ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).2 *
                  w.head⁻¹) •
                w)
              (_ :
                ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).2 *
                        w.head⁻¹) •
                      w).head ∈
                  TransversalPair.set d u)
              (_ :
                ∀
                  u' ∈
                    Option.map Prod.fst
                      (List.head?
                        ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u)))
                                    w.head).2 *
                              w.head⁻¹) •
                            w).toList),
                  ((↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u)))
                                  w.head).2 *
                            w.head⁻¹) •
                          w).head ∈
                      toSubgroup A B u →
                    u = u')).toList
        n✝ ↔
    a✝ ∈ List.get? (cons g u w h1 h2).toReducedWord.toList n✝

Next tactic:
simp
@[simp]
theorem prod_smul_empty (w : NormalWord d) :
    (w.prod φ) • empty = w := by
  induction w using consRecOn with
  | ofGroup => simp [ofGroup, ReducedWord.prod, of_smul_eq_smul, group_smul_def]
  | cons g u w h1 h2 ih =>
    rw [prod_cons, ← mul_assoc, mul_smul, ih, mul_smul, t_pow_smul_eq_unitsSMul,
      of_smul_eq_smul, unitsSMul]
    rw [dif_neg (not_cancels_of_cons_hyp u w h2)]
    -- The next 3 lines were a single `simp [...]` before leanprover/lean4#2644
    simp only [unitsSMulGroup]
    simp_rw [SetLike.coe_sort_coe]
    erw [(d.compl _).equiv_fst_eq_one_of_mem_of_one_mem (one_mem _) h1]
    ext <;> simp
    -- The next 4 were not needed before leanprover/lean4#2644
    · 

Proof state:
case cons.h2.a.a
G : Type u_1
inst✝³ : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝² : Group H
M : Type u_3
inst✝¹ : Monoid M
d : TransversalPair G A B
inst✝ : DecidableEq G
g : G
u : ℤˣ
w : NormalWord d
h1 : w.head ∈ TransversalPair.set d u
h2 : ∀ u' ∈ Option.map Prod.fst (List.head? w.toList), w.head ∈ toSubgroup A B u → u = u'
ih : ReducedWord.prod φ w.toReducedWord • empty = w
n✝ : ℕ
a✝ : ℤˣ × G
⊢ List.get?
        ((u, ↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).2) ::
          w.toList)
        n✝ =
      some a✝ ↔
    List.get? ((u, w.head) :: w.toList) n✝ = some a✝

Next tactic:
erw [(d.compl _).equiv_snd_eq_inv_mul]
@[simp]
theorem prod_smul_empty (w : NormalWord d) :
    (w.prod φ) • empty = w := by
  induction w using consRecOn with
  | ofGroup => simp [ofGroup, ReducedWord.prod, of_smul_eq_smul, group_smul_def]
  | cons g u w h1 h2 ih =>
    rw [prod_cons, ← mul_assoc, mul_smul, ih, mul_smul, t_pow_smul_eq_unitsSMul,
      of_smul_eq_smul, unitsSMul]
    rw [dif_neg (not_cancels_of_cons_hyp u w h2)]
    -- The next 3 lines were a single `simp [...]` before leanprover/lean4#2644
    simp only [unitsSMulGroup]
    simp_rw [SetLike.coe_sort_coe]
    erw [(d.compl _).equiv_fst_eq_one_of_mem_of_one_mem (one_mem _) h1]
    ext <;> simp
    -- The next 4 were not needed before leanprover/lean4#2644
    · erw [(d.compl _).equiv_snd_eq_inv_mul]
      

Proof state:
case cons.h2.a.a
G : Type u_1
inst✝³ : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝² : Group H
M : Type u_3
inst✝¹ : Monoid M
d : TransversalPair G A B
inst✝ : DecidableEq G
g : G
u : ℤˣ
w : NormalWord d
h1 : w.head ∈ TransversalPair.set d u
h2 : ∀ u' ∈ Option.map Prod.fst (List.head? w.toList), w.head ∈ toSubgroup A B u → u = u'
ih : ReducedWord.prod φ w.toReducedWord • empty = w
n✝ : ℕ
a✝ : ℤˣ × G
⊢ List.get?
        ((u,
            (↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).1)⁻¹ *
              w.head) ::
          w.toList)
        n✝ =
      some a✝ ↔
    List.get? ((u, w.head) :: w.toList) n✝ = some a✝

Next tactic:
simp_rw [SetLike.coe_sort_coe]
@[simp]
theorem prod_smul_empty (w : NormalWord d) :
    (w.prod φ) • empty = w := by
  induction w using consRecOn with
  | ofGroup => simp [ofGroup, ReducedWord.prod, of_smul_eq_smul, group_smul_def]
  | cons g u w h1 h2 ih =>
    rw [prod_cons, ← mul_assoc, mul_smul, ih, mul_smul, t_pow_smul_eq_unitsSMul,
      of_smul_eq_smul, unitsSMul]
    rw [dif_neg (not_cancels_of_cons_hyp u w h2)]
    -- The next 3 lines were a single `simp [...]` before leanprover/lean4#2644
    simp only [unitsSMulGroup]
    simp_rw [SetLike.coe_sort_coe]
    erw [(d.compl _).equiv_fst_eq_one_of_mem_of_one_mem (one_mem _) h1]
    ext <;> simp
    -- The next 4 were not needed before leanprover/lean4#2644
    · erw [(d.compl _).equiv_snd_eq_inv_mul]
      simp_rw [SetLike.coe_sort_coe]
      

Proof state:
case cons.h2.a.a
G : Type u_1
inst✝³ : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝² : Group H
M : Type u_3
inst✝¹ : Monoid M
d : TransversalPair G A B
inst✝ : DecidableEq G
g : G
u : ℤˣ
w : NormalWord d
h1 : w.head ∈ TransversalPair.set d u
h2 : ∀ u' ∈ Option.map Prod.fst (List.head? w.toList), w.head ∈ toSubgroup A B u → u = u'
ih : ReducedWord.prod φ w.toReducedWord • empty = w
n✝ : ℕ
a✝ : ℤˣ × G
⊢ List.get?
        ((u,
            (↑((IsComplement.equiv (_ : IsComplement (↑(toSubgroup A B u)) (TransversalPair.set d u))) w.head).1)⁻¹ *
              w.head) ::
          w.toList)
        n✝ =
      some a✝ ↔
    List.get? ((u, w.head) :: w.toList) n✝ = some a✝

Next tactic:
erw [(d.compl _).equiv_fst_eq_one_of_mem_of_one_mem (one_mem _) h1]
@[simp]
theorem prod_smul_empty (w : NormalWord d) :
    (w.prod φ) • empty = w := by
  induction w using consRecOn with
  | ofGroup => simp [ofGroup, ReducedWord.prod, of_smul_eq_smul, group_smul_def]
  | cons g u w h1 h2 ih =>
    rw [prod_cons, ← mul_assoc, mul_smul, ih, mul_smul, t_pow_smul_eq_unitsSMul,
      of_smul_eq_smul, unitsSMul]
    rw [dif_neg (not_cancels_of_cons_hyp u w h2)]
    -- The next 3 lines were a single `simp [...]` before leanprover/lean4#2644
    simp only [unitsSMulGroup]
    simp_rw [SetLike.coe_sort_coe]
    erw [(d.compl _).equiv_fst_eq_one_of_mem_of_one_mem (one_mem _) h1]
    ext <;> simp
    -- The next 4 were not needed before leanprover/lean4#2644
    · erw [(d.compl _).equiv_snd_eq_inv_mul]
      simp_rw [SetLike.coe_sort_coe]
      erw [(d.compl _).equiv_fst_eq_one_of_mem_of_one_mem (one_mem _) h1]
      

Proof state:
case cons.h2.a.a
G : Type u_1
inst✝³ : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝² : Group H
M : Type u_3
inst✝¹ : Monoid M
d : TransversalPair G A B
inst✝ : DecidableEq G
g : G
u : ℤˣ
w : NormalWord d
h1 : w.head ∈ TransversalPair.set d u
h2 : ∀ u' ∈ Option.map Prod.fst (List.head? w.toList), w.head ∈ toSubgroup A B u → u = u'
ih : ReducedWord.prod φ w.toReducedWord • empty = w
n✝ : ℕ
a✝ : ℤˣ × G
⊢ List.get? ((u, (↑{ val := 1, property := (_ : 1 ∈ toSubgroup A B u) })⁻¹ * w.head) :: w.toList) n✝ = some a✝ ↔
    List.get? ((u, w.head) :: w.toList) n✝ = some a✝

Next tactic:
simp
/-- The equivalence between elements of the HNN extension and words in normal form. -/
noncomputable def equiv : HNNExtension G A B φ ≃ NormalWord d :=
  { toFun := fun g => g • empty,
    invFun := fun w => w.prod φ,
    left_inv := fun g => by 

Proof state:
G : Type u_1
inst✝³ : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝² : Group H
M : Type u_3
inst✝¹ : Monoid M
d : TransversalPair G A B
inst✝ : DecidableEq G
g : HNNExtension G A B φ
⊢ (fun w => ReducedWord.prod φ w.toReducedWord) ((fun g => g • empty) g) = g

Next tactic:
simp [prod_smul]
/-- The equivalence between elements of the HNN extension and words in normal form. -/
noncomputable def equiv : HNNExtension G A B φ ≃ NormalWord d :=
  { toFun := fun g => g • empty,
    invFun := fun w => w.prod φ,
    left_inv := fun g => by simp [prod_smul]
    right_inv := fun w => by 

Proof state:
G : Type u_1
inst✝³ : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝² : Group H
M : Type u_3
inst✝¹ : Monoid M
d : TransversalPair G A B
inst✝ : DecidableEq G
w : NormalWord d
⊢ (fun g => g • empty) ((fun w => ReducedWord.prod φ w.toReducedWord) w) = w

Next tactic:
simp
instance : FaithfulSMul (HNNExtension G A B φ) (NormalWord d) :=
  ⟨fun h => by 

Proof state:
G : Type u_1
inst✝³ : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝² : Group H
M : Type u_3
inst✝¹ : Monoid M
d : TransversalPair G A B
inst✝ : DecidableEq G
m₁✝ m₂✝ : HNNExtension G A B φ
h : ∀ (a : NormalWord d), m₁✝ • a = m₂✝ • a
⊢ m₁✝ = m₂✝

Next tactic:
simpa using congr_arg (fun w => w.prod φ) (h empty)
theorem of_injective : Function.Injective (of : G → HNNExtension G A B φ) := by
  

Proof state:
G : Type u_1
inst✝² : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝¹ : Group H
M : Type u_3
inst✝ : Monoid M
⊢ Injective ⇑of

Next tactic:
rcases TransversalPair.nonempty G A B with ⟨d⟩
theorem of_injective : Function.Injective (of : G → HNNExtension G A B φ) := by
  rcases TransversalPair.nonempty G A B with ⟨d⟩
  

Proof state:
case intro
G : Type u_1
inst✝² : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝¹ : Group H
M : Type u_3
inst✝ : Monoid M
d : TransversalPair G A B
⊢ Injective ⇑of

Next tactic:
refine Function.Injective.of_comp
    (f := ((. • .) : HNNExtension G A B φ → NormalWord d → NormalWord d)) ?_
theorem of_injective : Function.Injective (of : G → HNNExtension G A B φ) := by
  rcases TransversalPair.nonempty G A B with ⟨d⟩
  refine Function.Injective.of_comp
    (f := ((. • .) : HNNExtension G A B φ → NormalWord d → NormalWord d)) ?_
  

Proof state:
case intro
G : Type u_1
inst✝² : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝¹ : Group H
M : Type u_3
inst✝ : Monoid M
d : TransversalPair G A B
⊢ Injective ((fun x x_1 => x • x_1) ∘ ⇑of)

Next tactic:
intros _ _ h
theorem of_injective : Function.Injective (of : G → HNNExtension G A B φ) := by
  rcases TransversalPair.nonempty G A B with ⟨d⟩
  refine Function.Injective.of_comp
    (f := ((. • .) : HNNExtension G A B φ → NormalWord d → NormalWord d)) ?_
  intros _ _ h
  

Proof state:
case intro
G : Type u_1
inst✝² : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝¹ : Group H
M : Type u_3
inst✝ : Monoid M
d : TransversalPair G A B
a₁✝ a₂✝ : G
h : ((fun x x_1 => x • x_1) ∘ ⇑of) a₁✝ = ((fun x x_1 => x • x_1) ∘ ⇑of) a₂✝
⊢ a₁✝ = a₂✝

Next tactic:
exact eq_of_smul_eq_smul (fun w : NormalWord d =>
    by simp_all [Function.funext_iff, of_smul_eq_smul])
theorem of_injective : Function.Injective (of : G → HNNExtension G A B φ) := by
  rcases TransversalPair.nonempty G A B with ⟨d⟩
  refine Function.Injective.of_comp
    (f := ((. • .) : HNNExtension G A B φ → NormalWord d → NormalWord d)) ?_
  intros _ _ h
  exact eq_of_smul_eq_smul (fun w : NormalWord d =>
    by 

Proof state:
G : Type u_1
inst✝² : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝¹ : Group H
M : Type u_3
inst✝ : Monoid M
d : TransversalPair G A B
a₁✝ a₂✝ : G
h : ((fun x x_1 => x • x_1) ∘ ⇑of) a₁✝ = ((fun x x_1 => x • x_1) ∘ ⇑of) a₂✝
w : NormalWord d
⊢ a₁✝ • w = a₂✝ • w

Next tactic:
simp_all [Function.funext_iff, of_smul_eq_smul]
theorem exists_normalWord_prod_eq
    (d : TransversalPair G A B) (w : ReducedWord G A B) :
    ∃ w' : NormalWord d, w'.prod φ = w.prod φ ∧
      w'.toList.map Prod.fst = w.toList.map Prod.fst ∧
      ∀ u ∈ w.toList.head?.map Prod.fst,
      w'.head⁻¹ * w.head ∈ toSubgroup A B (-u) := by
  

Proof state:
G : Type u_1
inst✝² : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝¹ : Group H
M : Type u_3
inst✝ : Monoid M
d : TransversalPair G A B
w : ReducedWord G A B
⊢ ∃ w',
    ReducedWord.prod φ w'.toReducedWord = ReducedWord.prod φ w ∧
      List.map Prod.fst w'.toList = List.map Prod.fst w.toList ∧
        ∀ u ∈ Option.map Prod.fst (List.head? w.toList), w'.head⁻¹ * w.head ∈ toSubgroup A B (-u)

Next tactic:
suffices : ∀ w : ReducedWord G A B,
      w.head = 1 → ∃ w' : NormalWord d, w'.prod φ = w.prod φ ∧
      w'.toList.map Prod.fst = w.toList.map Prod.fst ∧
      ∀ u ∈ w.toList.head?.map Prod.fst,
      w'.head ∈ toSubgroup A B (-u)
theorem exists_normalWord_prod_eq
    (d : TransversalPair G A B) (w : ReducedWord G A B) :
    ∃ w' : NormalWord d, w'.prod φ = w.prod φ ∧
      w'.toList.map Prod.fst = w.toList.map Prod.fst ∧
      ∀ u ∈ w.toList.head?.map Prod.fst,
      w'.head⁻¹ * w.head ∈ toSubgroup A B (-u) := by
  suffices : ∀ w : ReducedWord G A B,
      w.head = 1 → ∃ w' : NormalWord d, w'.prod φ = w.prod φ ∧
      w'.toList.map Prod.fst = w.toList.map Prod.fst ∧
      ∀ u ∈ w.toList.head?.map Prod.fst,
      w'.head ∈ toSubgroup A B (-u)
  · 

Proof state:
G : Type u_1
inst✝² : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝¹ : Group H
M : Type u_3
inst✝ : Monoid M
d : TransversalPair G A B
w : ReducedWord G A B
this :
  ∀ (w : ReducedWord G A B),
    w.head = 1 →
      ∃ w',
        ReducedWord.prod φ w'.toReducedWord = ReducedWord.prod φ w ∧
          List.map Prod.fst w'.toList = List.map Prod.fst w.toList ∧
            ∀ u ∈ Option.map Prod.fst (List.head? w.toList), w'.head ∈ toSubgroup A B (-u)
⊢ ∃ w',
    ReducedWord.prod φ w'.toReducedWord = ReducedWord.prod φ w ∧
      List.map Prod.fst w'.toList = List.map Prod.fst w.toList ∧
        ∀ u ∈ Option.map Prod.fst (List.head? w.toList), w'.head⁻¹ * w.head ∈ toSubgroup A B (-u)

Next tactic:
by_cases hw1 : w.head = 1
theorem exists_normalWord_prod_eq
    (d : TransversalPair G A B) (w : ReducedWord G A B) :
    ∃ w' : NormalWord d, w'.prod φ = w.prod φ ∧
      w'.toList.map Prod.fst = w.toList.map Prod.fst ∧
      ∀ u ∈ w.toList.head?.map Prod.fst,
      w'.head⁻¹ * w.head ∈ toSubgroup A B (-u) := by
  suffices : ∀ w : ReducedWord G A B,
      w.head = 1 → ∃ w' : NormalWord d, w'.prod φ = w.prod φ ∧
      w'.toList.map Prod.fst = w.toList.map Prod.fst ∧
      ∀ u ∈ w.toList.head?.map Prod.fst,
      w'.head ∈ toSubgroup A B (-u)
  · by_cases hw1 : w.head = 1
    · 

Proof state:
case pos
G : Type u_1
inst✝² : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝¹ : Group H
M : Type u_3
inst✝ : Monoid M
d : TransversalPair G A B
w : ReducedWord G A B
this :
  ∀ (w : ReducedWord G A B),
    w.head = 1 →
      ∃ w',
        ReducedWord.prod φ w'.toReducedWord = ReducedWord.prod φ w ∧
          List.map Prod.fst w'.toList = List.map Prod.fst w.toList ∧
            ∀ u ∈ Option.map Prod.fst (List.head? w.toList), w'.head ∈ toSubgroup A B (-u)
hw1 : w.head = 1
⊢ ∃ w',
    ReducedWord.prod φ w'.toReducedWord = ReducedWord.prod φ w ∧
      List.map Prod.fst w'.toList = List.map Prod.fst w.toList ∧
        ∀ u ∈ Option.map Prod.fst (List.head? w.toList), w'.head⁻¹ * w.head ∈ toSubgroup A B (-u)

Next tactic:
simp only [hw1, inv_mem_iff, mul_one]
theorem exists_normalWord_prod_eq
    (d : TransversalPair G A B) (w : ReducedWord G A B) :
    ∃ w' : NormalWord d, w'.prod φ = w.prod φ ∧
      w'.toList.map Prod.fst = w.toList.map Prod.fst ∧
      ∀ u ∈ w.toList.head?.map Prod.fst,
      w'.head⁻¹ * w.head ∈ toSubgroup A B (-u) := by
  suffices : ∀ w : ReducedWord G A B,
      w.head = 1 → ∃ w' : NormalWord d, w'.prod φ = w.prod φ ∧
      w'.toList.map Prod.fst = w.toList.map Prod.fst ∧
      ∀ u ∈ w.toList.head?.map Prod.fst,
      w'.head ∈ toSubgroup A B (-u)
  · by_cases hw1 : w.head = 1
    · simp only [hw1, inv_mem_iff, mul_one]
      

Proof state:
case pos
G : Type u_1
inst✝² : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝¹ : Group H
M : Type u_3
inst✝ : Monoid M
d : TransversalPair G A B
w : ReducedWord G A B
this :
  ∀ (w : ReducedWord G A B),
    w.head = 1 →
      ∃ w',
        ReducedWord.prod φ w'.toReducedWord = ReducedWord.prod φ w ∧
          List.map Prod.fst w'.toList = List.map Prod.fst w.toList ∧
            ∀ u ∈ Option.map Prod.fst (List.head? w.toList), w'.head ∈ toSubgroup A B (-u)
hw1 : w.head = 1
⊢ ∃ w',
    ReducedWord.prod φ w'.toReducedWord = ReducedWord.prod φ w ∧
      List.map Prod.fst w'.toList = List.map Prod.fst w.toList ∧
        ∀ u ∈ Option.map Prod.fst (List.head? w.toList), w'.head ∈ toSubgroup A B (-u)

Next tactic:
exact this w hw1
theorem exists_normalWord_prod_eq
    (d : TransversalPair G A B) (w : ReducedWord G A B) :
    ∃ w' : NormalWord d, w'.prod φ = w.prod φ ∧
      w'.toList.map Prod.fst = w.toList.map Prod.fst ∧
      ∀ u ∈ w.toList.head?.map Prod.fst,
      w'.head⁻¹ * w.head ∈ toSubgroup A B (-u) := by
  suffices : ∀ w : ReducedWord G A B,
      w.head = 1 → ∃ w' : NormalWord d, w'.prod φ = w.prod φ ∧
      w'.toList.map Prod.fst = w.toList.map Prod.fst ∧
      ∀ u ∈ w.toList.head?.map Prod.fst,
      w'.head ∈ toSubgroup A B (-u)
  · by_cases hw1 : w.head = 1
    · simp only [hw1, inv_mem_iff, mul_one]
      exact this w hw1
    · 

Proof state:
case neg
G : Type u_1
inst✝² : Group G
A B : Subgroup G
φ : ↥A ≃* ↥B
H : Type u_2
inst✝¹ : Group H
M : Type u_3
inst✝ : Monoid M
d : TransversalPair G A B
w : ReducedWord G A B
this :
  ∀ (w : ReducedWord G A B),
    w.head = 1 →
      ∃ w',
        ReducedWord.prod φ w'.toReducedWord = ReducedWord.prod φ w ∧
          List.map Prod.fst w'.toList = List.map Prod.fst w.toList ∧
            ∀ u ∈ Option.map Prod.fst (List.head? w.toList), w'.head ∈ toSubgroup A B (-u)
hw1 : ¬w.head = 1
⊢ ∃ w',
    ReducedWord.prod φ w'.toReducedWord = ReducedWord.prod φ w ∧
      List.map Prod.fst w'.toList = List.map Prod.fst w.toList ∧
        ∀ u ∈ Option.map Prod.fst (List.head? w.toList), w'.head⁻¹ * w.head ∈ toSubgroup A B (-u)

Next tactic:
rcases this ⟨1, w.toList, w.chain⟩ rfl with ⟨w', hw'⟩