l3lab/ntp-mathlib huggingface dataset:
/-- Every nonempty `Word M` can be constructed as a `NeWord M i j` -/
theorem of_word (w : Word M) (h : w ≠ empty) : ∃ (i j : _) (w' : NeWord M i j), w'.toWord = w := by
  suffices : ∃ (i j : _) (w' : NeWord M i j), w'.toWord.toList = w.toList
  · rcases this with ⟨i, j, w, h⟩
    refine' ⟨i, j, w, _⟩
    ext
    rw [h]
  cases' w with l hnot1 hchain
  induction' l with x l hi
  · contradiction
  · rw [List.forall_mem_cons] at hnot1
    cases' l with y l
    · refine' ⟨x.1, x.1, singleton x.2 hnot1.1, _⟩
      simp [toWord]
    · rw [List.chain'_cons] at hchain
      specialize hi hnot1.2 hchain.2 (by rintro ⟨rfl⟩)
      obtain ⟨i, j, w', hw' : w'.toList = y::l⟩ := hi
      obtain rfl : y = ⟨i, w'.head⟩ := by simpa [hw'] using w'.toList_head?
      

Proof state:
case this.mk.cons.cons.intro.intro.intro
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
x : (i : ι) × M i
l : List ((i : ι) × M i)
i j : ι
w' : NeWord M i j
hnot1✝ : ∀ l_1 ∈ x :: { fst := i, snd := head w' } :: l, l_1.snd ≠ 1
hnot1 : x.snd ≠ 1 ∧ ∀ x ∈ { fst := i, snd := head w' } :: l, x.snd ≠ 1
hchain✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (x :: { fst := i, snd := head w' } :: l)
hchain :
  x.fst ≠ { fst := i, snd := head w' }.fst ∧
    List.Chain' (fun l l' => l.fst ≠ l'.fst) ({ fst := i, snd := head w' } :: l)
h : { toList := x :: { fst := i, snd := head w' } :: l, ne_one := hnot1✝, chain_ne := hchain✝ } ≠ empty
hw' : toList w' = { fst := i, snd := head w' } :: l
⊢ ∃ i_1 j_1 w'_1,
    (toWord w'_1).toList =
      { toList := x :: { fst := i, snd := head w' } :: l, ne_one := hnot1✝, chain_ne := hchain✝ }.toList

Next tactic:
refine' ⟨x.1, j, append (singleton x.2 hnot1.1) hchain.1 w', _⟩
/-- Every nonempty `Word M` can be constructed as a `NeWord M i j` -/
theorem of_word (w : Word M) (h : w ≠ empty) : ∃ (i j : _) (w' : NeWord M i j), w'.toWord = w := by
  suffices : ∃ (i j : _) (w' : NeWord M i j), w'.toWord.toList = w.toList
  · rcases this with ⟨i, j, w, h⟩
    refine' ⟨i, j, w, _⟩
    ext
    rw [h]
  cases' w with l hnot1 hchain
  induction' l with x l hi
  · contradiction
  · rw [List.forall_mem_cons] at hnot1
    cases' l with y l
    · refine' ⟨x.1, x.1, singleton x.2 hnot1.1, _⟩
      simp [toWord]
    · rw [List.chain'_cons] at hchain
      specialize hi hnot1.2 hchain.2 (by rintro ⟨rfl⟩)
      obtain ⟨i, j, w', hw' : w'.toList = y::l⟩ := hi
      obtain rfl : y = ⟨i, w'.head⟩ := by simpa [hw'] using w'.toList_head?
      refine' ⟨x.1, j, append (singleton x.2 hnot1.1) hchain.1 w', _⟩
      · 

Proof state:
case this.mk.cons.cons.intro.intro.intro
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
x : (i : ι) × M i
l : List ((i : ι) × M i)
i j : ι
w' : NeWord M i j
hnot1✝ : ∀ l_1 ∈ x :: { fst := i, snd := head w' } :: l, l_1.snd ≠ 1
hnot1 : x.snd ≠ 1 ∧ ∀ x ∈ { fst := i, snd := head w' } :: l, x.snd ≠ 1
hchain✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (x :: { fst := i, snd := head w' } :: l)
hchain :
  x.fst ≠ { fst := i, snd := head w' }.fst ∧
    List.Chain' (fun l l' => l.fst ≠ l'.fst) ({ fst := i, snd := head w' } :: l)
h : { toList := x :: { fst := i, snd := head w' } :: l, ne_one := hnot1✝, chain_ne := hchain✝ } ≠ empty
hw' : toList w' = { fst := i, snd := head w' } :: l
⊢ (toWord (append (singleton x.snd (_ : x.snd ≠ 1)) (_ : x.fst ≠ { fst := i, snd := head w' }.fst) w')).toList =
    { toList := x :: { fst := i, snd := head w' } :: l, ne_one := hnot1✝, chain_ne := hchain✝ }.toList

Next tactic:
simpa [toWord] using hw'
@[simp]
theorem prod_singleton {i} (x : M i) (hne_one : x ≠ 1) : (singleton x hne_one).prod = of x := by
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i : ι
x : M i
hne_one : x ≠ 1
⊢ prod (singleton x hne_one) = of x

Next tactic:
simp [toWord, prod, Word.prod]
@[simp]
theorem append_prod {i j k l} {w₁ : NeWord M i j} {hne : j ≠ k} {w₂ : NeWord M k l} :
    (append w₁ hne w₂).prod = w₁.prod * w₂.prod := by 

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j k l : ι
w₁ : NeWord M i j
hne : j ≠ k
w₂ : NeWord M k l
⊢ prod (append w₁ hne w₂) = prod w₁ * prod w₂

Next tactic:
simp [toWord, prod, Word.prod]
@[simp]
theorem replaceHead_head {i j : ι} (x : M i) (hnotone : x ≠ 1) (w : NeWord M i j) :
    (replaceHead x hnotone w).head = x := by
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j : ι
x : M i
hnotone : x ≠ 1
w : NeWord M i j
⊢ head (replaceHead x hnotone w) = x

Next tactic:
induction w
@[simp]
theorem replaceHead_head {i j : ι} (x : M i) (hnotone : x ≠ 1) (w : NeWord M i j) :
    (replaceHead x hnotone w).head = x := by
  induction w
  

Proof state:
case singleton
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ : ι
x✝ : M i✝
a✝ : x✝ ≠ 1
x : M i✝
hnotone : x ≠ 1
⊢ head (replaceHead x hnotone (singleton x✝ a✝)) = x
case append
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord M i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord M k✝ l✝
_w₁_ih✝ : ∀ (x : M i✝) (hnotone : x ≠ 1), head (replaceHead x hnotone _w₁✝) = x
_w₂_ih✝ : ∀ (x : M k✝) (hnotone : x ≠ 1), head (replaceHead x hnotone _w₂✝) = x
x : M i✝
hnotone : x ≠ 1
⊢ head (replaceHead x hnotone (append _w₁✝ _hne✝ _w₂✝)) = x

Next tactic:
rfl
@[simp]
theorem replaceHead_head {i j : ι} (x : M i) (hnotone : x ≠ 1) (w : NeWord M i j) :
    (replaceHead x hnotone w).head = x := by
  induction w
  rfl
  

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord M i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord M k✝ l✝
_w₁_ih✝ : ∀ (x : M i✝) (hnotone : x ≠ 1), head (replaceHead x hnotone _w₁✝) = x
_w₂_ih✝ : ∀ (x : M k✝) (hnotone : x ≠ 1), head (replaceHead x hnotone _w₂✝) = x
x : M i✝
hnotone : x ≠ 1
⊢ head (replaceHead x hnotone (append _w₁✝ _hne✝ _w₂✝)) = x

Next tactic:
simp [*]
@[simp]
theorem mulHead_head {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).head = x * w.head := by
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j : ι
w : NeWord M i j
x : M i
hnotone : x * head w ≠ 1
⊢ head (mulHead w x hnotone) = x * head w

Next tactic:
induction w
@[simp]
theorem mulHead_head {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).head = x * w.head := by
  induction w
  

Proof state:
case singleton
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ : ι
x✝ : M i✝
a✝ : x✝ ≠ 1
x : M i✝
hnotone : x * head (singleton x✝ a✝) ≠ 1
⊢ head (mulHead (singleton x✝ a✝) x hnotone) = x * head (singleton x✝ a✝)
case append
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord M i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord M k✝ l✝
_w₁_ih✝ : ∀ (x : M i✝) (hnotone : x * head _w₁✝ ≠ 1), head (mulHead _w₁✝ x hnotone) = x * head _w₁✝
_w₂_ih✝ : ∀ (x : M k✝) (hnotone : x * head _w₂✝ ≠ 1), head (mulHead _w₂✝ x hnotone) = x * head _w₂✝
x : M i✝
hnotone : x * head (append _w₁✝ _hne✝ _w₂✝) ≠ 1
⊢ head (mulHead (append _w₁✝ _hne✝ _w₂✝) x hnotone) = x * head (append _w₁✝ _hne✝ _w₂✝)

Next tactic:
rfl
@[simp]
theorem mulHead_head {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).head = x * w.head := by
  induction w
  rfl
  

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord M i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord M k✝ l✝
_w₁_ih✝ : ∀ (x : M i✝) (hnotone : x * head _w₁✝ ≠ 1), head (mulHead _w₁✝ x hnotone) = x * head _w₁✝
_w₂_ih✝ : ∀ (x : M k✝) (hnotone : x * head _w₂✝ ≠ 1), head (mulHead _w₂✝ x hnotone) = x * head _w₂✝
x : M i✝
hnotone : x * head (append _w₁✝ _hne✝ _w₂✝) ≠ 1
⊢ head (mulHead (append _w₁✝ _hne✝ _w₂✝) x hnotone) = x * head (append _w₁✝ _hne✝ _w₂✝)

Next tactic:
simp [*]
@[simp]
theorem mulHead_prod {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).prod = of x * w.prod := by
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j : ι
w : NeWord M i j
x : M i
hnotone : x * head w ≠ 1
⊢ prod (mulHead w x hnotone) = of x * prod w

Next tactic:
unfold mulHead
@[simp]
theorem mulHead_prod {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).prod = of x * w.prod := by
  unfold mulHead
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j : ι
w : NeWord M i j
x : M i
hnotone : x * head w ≠ 1
⊢ prod (replaceHead (x * head w) hnotone w) = of x * prod w

Next tactic:
induction' w with _ _ _ _ _ _ _ _ _ _ w_ih_w₁ w_ih_w₂
@[simp]
theorem mulHead_prod {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).prod = of x * w.prod := by
  unfold mulHead
  induction' w with _ _ _ _ _ _ _ _ _ _ w_ih_w₁ w_ih_w₂
  · 

Proof state:
case singleton
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ : ι
x✝ : M i✝
a✝ : x✝ ≠ 1
x : M i✝
hnotone : x * head (singleton x✝ a✝) ≠ 1
⊢ prod (replaceHead (x * head (singleton x✝ a✝)) hnotone (singleton x✝ a✝)) = of x * prod (singleton x✝ a✝)

Next tactic:
simp [mulHead, replaceHead]
@[simp]
theorem mulHead_prod {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).prod = of x * w.prod := by
  unfold mulHead
  induction' w with _ _ _ _ _ _ _ _ _ _ w_ih_w₁ w_ih_w₂
  · simp [mulHead, replaceHead]
  · 

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord M i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord M k✝ l✝
w_ih_w₁ : ∀ (x : M i✝) (hnotone : x * head _w₁✝ ≠ 1), prod (replaceHead (x * head _w₁✝) hnotone _w₁✝) = of x * prod _w₁✝
w_ih_w₂ : ∀ (x : M k✝) (hnotone : x * head _w₂✝ ≠ 1), prod (replaceHead (x * head _w₂✝) hnotone _w₂✝) = of x * prod _w₂✝
x : M i✝
hnotone : x * head (append _w₁✝ _hne✝ _w₂✝) ≠ 1
⊢ prod (replaceHead (x * head (append _w₁✝ _hne✝ _w₂✝)) hnotone (append _w₁✝ _hne✝ _w₂✝)) =
    of x * prod (append _w₁✝ _hne✝ _w₂✝)

Next tactic:
specialize w_ih_w₁ _ hnotone
@[simp]
theorem mulHead_prod {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).prod = of x * w.prod := by
  unfold mulHead
  induction' w with _ _ _ _ _ _ _ _ _ _ w_ih_w₁ w_ih_w₂
  · simp [mulHead, replaceHead]
  · specialize w_ih_w₁ _ hnotone
    

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord M i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord M k✝ l✝
w_ih_w₂ : ∀ (x : M k✝) (hnotone : x * head _w₂✝ ≠ 1), prod (replaceHead (x * head _w₂✝) hnotone _w₂✝) = of x * prod _w₂✝
x : M i✝
hnotone : x * head (append _w₁✝ _hne✝ _w₂✝) ≠ 1
w_ih_w₁ : prod (replaceHead (x * head _w₁✝) hnotone _w₁✝) = of x * prod _w₁✝
⊢ prod (replaceHead (x * head (append _w₁✝ _hne✝ _w₂✝)) hnotone (append _w₁✝ _hne✝ _w₂✝)) =
    of x * prod (append _w₁✝ _hne✝ _w₂✝)

Next tactic:
clear w_ih_w₂
@[simp]
theorem mulHead_prod {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).prod = of x * w.prod := by
  unfold mulHead
  induction' w with _ _ _ _ _ _ _ _ _ _ w_ih_w₁ w_ih_w₂
  · simp [mulHead, replaceHead]
  · specialize w_ih_w₁ _ hnotone
    clear w_ih_w₂
    

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord M i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord M k✝ l✝
x : M i✝
hnotone : x * head (append _w₁✝ _hne✝ _w₂✝) ≠ 1
w_ih_w₁ : prod (replaceHead (x * head _w₁✝) hnotone _w₁✝) = of x * prod _w₁✝
⊢ prod (replaceHead (x * head (append _w₁✝ _hne✝ _w₂✝)) hnotone (append _w₁✝ _hne✝ _w₂✝)) =
    of x * prod (append _w₁✝ _hne✝ _w₂✝)

Next tactic:
simp? [replaceHead, ← mul_assoc] at * says
      simp only [replaceHead, head, append_prod, ← mul_assoc] at *
@[simp]
theorem mulHead_prod {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).prod = of x * w.prod := by
  unfold mulHead
  induction' w with _ _ _ _ _ _ _ _ _ _ w_ih_w₁ w_ih_w₂
  · simp [mulHead, replaceHead]
  · specialize w_ih_w₁ _ hnotone
    clear w_ih_w₂
    simp? [replaceHead, ← mul_assoc] at * says
      

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord M i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord M k✝ l✝
x : M i✝
hnotone : x * head (append _w₁✝ _hne✝ _w₂✝) ≠ 1
w_ih_w₁ : prod (replaceHead (x * head _w₁✝) hnotone _w₁✝) = of x * prod _w₁✝
⊢ prod (replaceHead (x * head (append _w₁✝ _hne✝ _w₂✝)) hnotone (append _w₁✝ _hne✝ _w₂✝)) =
    of x * prod (append _w₁✝ _hne✝ _w₂✝)

Next tactic:
simp only [replaceHead, head, append_prod, ← mul_assoc] at *
@[simp]
theorem mulHead_prod {i j : ι} (w : NeWord M i j) (x : M i) (hnotone : x * w.head ≠ 1) :
    (mulHead w x hnotone).prod = of x * w.prod := by
  unfold mulHead
  induction' w with _ _ _ _ _ _ _ _ _ _ w_ih_w₁ w_ih_w₂
  · simp [mulHead, replaceHead]
  · specialize w_ih_w₁ _ hnotone
    clear w_ih_w₂
    simp? [replaceHead, ← mul_assoc] at * says
      simp only [replaceHead, head, append_prod, ← mul_assoc] at *
    

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord M i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord M k✝ l✝
x : M i✝
hnotone : x * head (append _w₁✝ _hne✝ _w₂✝) ≠ 1
w_ih_w₁ : prod (replaceHead (x * head _w₁✝) hnotone _w₁✝) = of x * prod _w₁✝
⊢ prod (replaceHead (x * head _w₁✝) (_ : x * head _w₁✝ ≠ 1) _w₁✝) * prod _w₂✝ = of x * prod _w₁✝ * prod _w₂✝

Next tactic:
congr 1
@[simp]
theorem inv_prod {i j} (w : NeWord G i j) : w.inv.prod = w.prod⁻¹ := by
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝² : (i : ι) → Monoid (M i)
N : Type u_3
inst✝¹ : Monoid N
G : ι → Type u_4
inst✝ : (i : ι) → Group (G i)
i j : ι
w : NeWord G i j
⊢ prod (inv w) = (prod w)⁻¹

Next tactic:
induction w
@[simp]
theorem inv_prod {i j} (w : NeWord G i j) : w.inv.prod = w.prod⁻¹ := by
  induction w <;> 

Proof state:
case singleton
ι : Type u_1
M : ι → Type u_2
inst✝² : (i : ι) → Monoid (M i)
N : Type u_3
inst✝¹ : Monoid N
G : ι → Type u_4
inst✝ : (i : ι) → Group (G i)
i j i✝ : ι
x✝ : G i✝
a✝ : x✝ ≠ 1
⊢ prod (inv (singleton x✝ a✝)) = (prod (singleton x✝ a✝))⁻¹

Next tactic:
simp [inv, *]
@[simp]
theorem inv_prod {i j} (w : NeWord G i j) : w.inv.prod = w.prod⁻¹ := by
  induction w <;> 

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝² : (i : ι) → Monoid (M i)
N : Type u_3
inst✝¹ : Monoid N
G : ι → Type u_4
inst✝ : (i : ι) → Group (G i)
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord G i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord G k✝ l✝
_w₁_ih✝ : prod (inv _w₁✝) = (prod _w₁✝)⁻¹
_w₂_ih✝ : prod (inv _w₂✝) = (prod _w₂✝)⁻¹
⊢ prod (inv (append _w₁✝ _hne✝ _w₂✝)) = (prod (append _w₁✝ _hne✝ _w₂✝))⁻¹

Next tactic:
simp [inv, *]
@[simp]
theorem inv_head {i j} (w : NeWord G i j) : w.inv.head = w.last⁻¹ := by
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝² : (i : ι) → Monoid (M i)
N : Type u_3
inst✝¹ : Monoid N
G : ι → Type u_4
inst✝ : (i : ι) → Group (G i)
i j : ι
w : NeWord G i j
⊢ head (inv w) = (last w)⁻¹

Next tactic:
induction w
@[simp]
theorem inv_head {i j} (w : NeWord G i j) : w.inv.head = w.last⁻¹ := by
  induction w <;> 

Proof state:
case singleton
ι : Type u_1
M : ι → Type u_2
inst✝² : (i : ι) → Monoid (M i)
N : Type u_3
inst✝¹ : Monoid N
G : ι → Type u_4
inst✝ : (i : ι) → Group (G i)
i j i✝ : ι
x✝ : G i✝
a✝ : x✝ ≠ 1
⊢ head (inv (singleton x✝ a✝)) = (last (singleton x✝ a✝))⁻¹

Next tactic:
simp [inv, *]
@[simp]
theorem inv_head {i j} (w : NeWord G i j) : w.inv.head = w.last⁻¹ := by
  induction w <;> 

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝² : (i : ι) → Monoid (M i)
N : Type u_3
inst✝¹ : Monoid N
G : ι → Type u_4
inst✝ : (i : ι) → Group (G i)
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord G i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord G k✝ l✝
_w₁_ih✝ : head (inv _w₁✝) = (last _w₁✝)⁻¹
_w₂_ih✝ : head (inv _w₂✝) = (last _w₂✝)⁻¹
⊢ head (inv (append _w₁✝ _hne✝ _w₂✝)) = (last (append _w₁✝ _hne✝ _w₂✝))⁻¹

Next tactic:
simp [inv, *]
@[simp]
theorem inv_last {i j} (w : NeWord G i j) : w.inv.last = w.head⁻¹ := by
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝² : (i : ι) → Monoid (M i)
N : Type u_3
inst✝¹ : Monoid N
G : ι → Type u_4
inst✝ : (i : ι) → Group (G i)
i j : ι
w : NeWord G i j
⊢ last (inv w) = (head w)⁻¹

Next tactic:
induction w
@[simp]
theorem inv_last {i j} (w : NeWord G i j) : w.inv.last = w.head⁻¹ := by
  induction w <;> 

Proof state:
case singleton
ι : Type u_1
M : ι → Type u_2
inst✝² : (i : ι) → Monoid (M i)
N : Type u_3
inst✝¹ : Monoid N
G : ι → Type u_4
inst✝ : (i : ι) → Group (G i)
i j i✝ : ι
x✝ : G i✝
a✝ : x✝ ≠ 1
⊢ last (inv (singleton x✝ a✝)) = (head (singleton x✝ a✝))⁻¹

Next tactic:
simp [inv, *]
@[simp]
theorem inv_last {i j} (w : NeWord G i j) : w.inv.last = w.head⁻¹ := by
  induction w <;> 

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝² : (i : ι) → Monoid (M i)
N : Type u_3
inst✝¹ : Monoid N
G : ι → Type u_4
inst✝ : (i : ι) → Group (G i)
i j i✝ j✝ k✝ l✝ : ι
_w₁✝ : NeWord G i✝ j✝
_hne✝ : j✝ ≠ k✝
_w₂✝ : NeWord G k✝ l✝
_w₁_ih✝ : last (inv _w₁✝) = (head _w₁✝)⁻¹
_w₂_ih✝ : last (inv _w₂✝) = (head _w₂✝)⁻¹
⊢ last (inv (append _w₁✝ _hne✝ _w₂✝)) = (head (append _w₁✝ _hne✝ _w₂✝))⁻¹

Next tactic:
simp [inv, *]
theorem lift_word_ping_pong {i j k} (w : NeWord H i j) (hk : j ≠ k) :
    lift f w.prod • X k ⊆ X i := by
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝⁴ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝³ : Monoid N
hnontriv : Nontrivial ι
G : Type u_4
inst✝² : Group G
H : ι → Type u_5
inst✝¹ : (i : ι) → Group (H i)
f : (i : ι) → H i →* G
hcard : 3 ≤ #ι ∨ ∃ i, 3 ≤ #(H i)
α : Type u_6
inst✝ : MulAction G α
X : ι → Set α
hXnonempty : ∀ (i : ι), Set.Nonempty (X i)
hXdisj : Pairwise fun i j => Disjoint (X i) (X j)
hpp : Pairwise fun i j => ∀ (h : H i), h ≠ 1 → (f i) h • X j ⊆ X i
i j k : ι
w : NeWord H i j
hk : j ≠ k
⊢ (lift f) (NeWord.prod w) • X k ⊆ X i

Next tactic:
induction' w with i x hne_one i j k l w₁ hne w₂ hIw₁ hIw₂ generalizing k
theorem lift_word_ping_pong {i j k} (w : NeWord H i j) (hk : j ≠ k) :
    lift f w.prod • X k ⊆ X i := by
  induction' w with i x hne_one i j k l w₁ hne w₂ hIw₁ hIw₂ generalizing k
  · 

Proof state:
case singleton
ι : Type u_1
M : ι → Type u_2
inst✝⁴ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝³ : Monoid N
hnontriv : Nontrivial ι
G : Type u_4
inst✝² : Group G
H : ι → Type u_5
inst✝¹ : (i : ι) → Group (H i)
f : (i : ι) → H i →* G
hcard : 3 ≤ #ι ∨ ∃ i, 3 ≤ #(H i)
α : Type u_6
inst✝ : MulAction G α
X : ι → Set α
hXnonempty : ∀ (i : ι), Set.Nonempty (X i)
hXdisj : Pairwise fun i j => Disjoint (X i) (X j)
hpp : Pairwise fun i j => ∀ (h : H i), h ≠ 1 → (f i) h • X j ⊆ X i
i✝ j i : ι
x : H i
hne_one : x ≠ 1
k : ι
hk : i ≠ k
⊢ (lift f) (NeWord.prod (NeWord.singleton x hne_one)) • X k ⊆ X i

Next tactic:
simpa using hpp hk _ hne_one
theorem lift_word_ping_pong {i j k} (w : NeWord H i j) (hk : j ≠ k) :
    lift f w.prod • X k ⊆ X i := by
  induction' w with i x hne_one i j k l w₁ hne w₂ hIw₁ hIw₂ generalizing k
  · simpa using hpp hk _ hne_one
  · 

Proof state:
case append
ι : Type u_1
M : ι → Type u_2
inst✝⁴ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝³ : Monoid N
hnontriv : Nontrivial ι
G : Type u_4
inst✝² : Group G
H : ι → Type u_5
inst✝¹ : (i : ι) → Group (H i)
f : (i : ι) → H i →* G
hcard : 3 ≤ #ι ∨ ∃ i, 3 ≤ #(H i)
α : Type u_6
inst✝ : MulAction G α
X : ι → Set α
hXnonempty : ∀ (i : ι), Set.Nonempty (X i)
hXdisj : Pairwise fun i j => Disjoint (X i) (X j)
hpp : Pairwise fun i j => ∀ (h : H i), h ≠ 1 → (f i) h • X j ⊆ X i
i✝ j✝ i j k✝ l : ι
w₁ : NeWord H i j
hne : j ≠ k✝
w₂ : NeWord H k✝ l
hIw₁ : ∀ {k : ι}, j ≠ k → (lift f) (NeWord.prod w₁) • X k ⊆ X i
hIw₂ : ∀ {k : ι}, l ≠ k → (lift f) (NeWord.prod w₂) • X k ⊆ X k✝
k : ι
hk : l ≠ k
⊢ (lift f) (NeWord.prod (NeWord.append w₁ hne w₂)) • X k ⊆ X i

Next tactic:
calc
      lift f (NeWord.append w₁ hne w₂).prod • X k = lift f w₁.prod • lift f w₂.prod • X k := by
        simp [MulAction.mul_smul]
      _ ⊆ lift f w₁.prod • X _ := (set_smul_subset_set_smul_iff.mpr (hIw₂ hk))
      _ ⊆ X i := hIw₁ hne
theorem lift_word_ping_pong {i j k} (w : NeWord H i j) (hk : j ≠ k) :
    lift f w.prod • X k ⊆ X i := by
  induction' w with i x hne_one i j k l w₁ hne w₂ hIw₁ hIw₂ generalizing k
  · simpa using hpp hk _ hne_one
  · calc
      lift f (NeWord.append w₁ hne w₂).prod • X k = lift f w₁.prod • lift f w₂.prod • X k := by
        

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝⁴ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝³ : Monoid N
hnontriv : Nontrivial ι
G : Type u_4
inst✝² : Group G
H : ι → Type u_5
inst✝¹ : (i : ι) → Group (H i)
f : (i : ι) → H i →* G
hcard : 3 ≤ #ι ∨ ∃ i, 3 ≤ #(H i)
α : Type u_6
inst✝ : MulAction G α
X : ι → Set α
hXnonempty : ∀ (i : ι), Set.Nonempty (X i)
hXdisj : Pairwise fun i j => Disjoint (X i) (X j)
hpp : Pairwise fun i j => ∀ (h : H i), h ≠ 1 → (f i) h • X j ⊆ X i
i✝ j✝ i j k✝ l : ι
w₁ : NeWord H i j
hne : j ≠ k✝
w₂ : NeWord H k✝ l
hIw₁ : ∀ {k : ι}, j ≠ k → (lift f) (NeWord.prod w₁) • X k ⊆ X i
hIw₂ : ∀ {k : ι}, l ≠ k → (lift f) (NeWord.prod w₂) • X k ⊆ X k✝
k : ι
hk : l ≠ k
⊢ (lift f) (NeWord.prod (NeWord.append w₁ hne w₂)) • X k = (lift f) (NeWord.prod w₁) • (lift f) (NeWord.prod w₂) • X k

Next tactic:
simp [MulAction.mul_smul]
theorem lift_word_prod_nontrivial_of_other_i {i j k} (w : NeWord H i j) (hhead : k ≠ i)
    (hlast : k ≠ j) : lift f w.prod ≠ 1 := by
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝⁴ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝³ : Monoid N
hnontriv : Nontrivial ι
G : Type u_4
inst✝² : Group G
H : ι → Type u_5
inst✝¹ : (i : ι) → Group (H i)
f : (i : ι) → H i →* G
hcard : 3 ≤ #ι ∨ ∃ i, 3 ≤ #(H i)
α : Type u_6
inst✝ : MulAction G α
X : ι → Set α
hXnonempty : ∀ (i : ι), Set.Nonempty (X i)
hXdisj : Pairwise fun i j => Disjoint (X i) (X j)
hpp : Pairwise fun i j => ∀ (h : H i), h ≠ 1 → (f i) h • X j ⊆ X i
i j k : ι
w : NeWord H i j
hhead : k ≠ i
hlast : k ≠ j
⊢ (lift f) (NeWord.prod w) ≠ 1

Next tactic:
intro heq1
theorem lift_word_prod_nontrivial_of_other_i {i j k} (w : NeWord H i j) (hhead : k ≠ i)
    (hlast : k ≠ j) : lift f w.prod ≠ 1 := by
  intro heq1
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝⁴ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝³ : Monoid N
hnontriv : Nontrivial ι
G : Type u_4
inst✝² : Group G
H : ι → Type u_5
inst✝¹ : (i : ι) → Group (H i)
f : (i : ι) → H i →* G
hcard : 3 ≤ #ι ∨ ∃ i, 3 ≤ #(H i)
α : Type u_6
inst✝ : MulAction G α
X : ι → Set α
hXnonempty : ∀ (i : ι), Set.Nonempty (X i)
hXdisj : Pairwise fun i j => Disjoint (X i) (X j)
hpp : Pairwise fun i j => ∀ (h : H i), h ≠ 1 → (f i) h • X j ⊆ X i
i j k : ι
w : NeWord H i j
hhead : k ≠ i
hlast : k ≠ j
heq1 : (lift f) (NeWord.prod w) = 1
⊢ False

Next tactic:
have : X k ⊆ X i := by simpa [heq1] using lift_word_ping_pong f X hpp w hlast.symm
theorem lift_word_prod_nontrivial_of_other_i {i j k} (w : NeWord H i j) (hhead : k ≠ i)
    (hlast : k ≠ j) : lift f w.prod ≠ 1 := by
  intro heq1
  have : X k ⊆ X i := by 

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝⁴ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝³ : Monoid N
hnontriv : Nontrivial ι
G : Type u_4
inst✝² : Group G
H : ι → Type u_5
inst✝¹ : (i : ι) → Group (H i)
f : (i : ι) → H i →* G
hcard : 3 ≤ #ι ∨ ∃ i, 3 ≤ #(H i)
α : Type u_6
inst✝ : MulAction G α
X : ι → Set α
hXnonempty : ∀ (i : ι), Set.Nonempty (X i)
hXdisj : Pairwise fun i j => Disjoint (X i) (X j)
hpp : Pairwise fun i j => ∀ (h : H i), h ≠ 1 → (f i) h • X j ⊆ X i
i j k : ι
w : NeWord H i j
hhead : k ≠ i
hlast : k ≠ j
heq1 : (lift f) (NeWord.prod w) = 1
⊢ X k ⊆ X i

Next tactic:
simpa [heq1] using lift_word_ping_pong f X hpp w hlast.symm