l3lab/ntp-mathlib huggingface dataset:
/-- The `Word M` represented by a `NeWord M i j` -/
def toWord {i j} (w : NeWord M i j) : Word M
    where
  toList := w.toList
  ne_one := by
    induction w
    · simpa only [toList, List.mem_singleton, ne_eq, forall_eq]
    · intro l h
      simp only [toList, List.mem_append] at h
      cases h <;> aesop
  chain_ne := by
    induction w
    · exact List.chain'_singleton _
    · refine List.Chain'.append (by assumption) (by assumption) ?_
      

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✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₁✝)
_w₂_ih✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₂✝)
⊢ ∀ x ∈ List.getLast? (toList _w₁✝), ∀ y ∈ List.head? (toList _w₂✝), x.fst ≠ y.fst

Next tactic:
intro x hx y hy
/-- The `Word M` represented by a `NeWord M i j` -/
def toWord {i j} (w : NeWord M i j) : Word M
    where
  toList := w.toList
  ne_one := by
    induction w
    · simpa only [toList, List.mem_singleton, ne_eq, forall_eq]
    · intro l h
      simp only [toList, List.mem_append] at h
      cases h <;> aesop
  chain_ne := by
    induction w
    · exact List.chain'_singleton _
    · refine List.Chain'.append (by assumption) (by assumption) ?_
      intro x hx y hy
      

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✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₁✝)
_w₂_ih✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₂✝)
x : (i : ι) × M i
hx : x ∈ List.getLast? (toList _w₁✝)
y : (i : ι) × M i
hy : y ∈ List.head? (toList _w₂✝)
⊢ x.fst ≠ y.fst

Next tactic:
rw [toList_getLast?, Option.mem_some_iff] at hx
/-- The `Word M` represented by a `NeWord M i j` -/
def toWord {i j} (w : NeWord M i j) : Word M
    where
  toList := w.toList
  ne_one := by
    induction w
    · simpa only [toList, List.mem_singleton, ne_eq, forall_eq]
    · intro l h
      simp only [toList, List.mem_append] at h
      cases h <;> aesop
  chain_ne := by
    induction w
    · exact List.chain'_singleton _
    · refine List.Chain'.append (by assumption) (by assumption) ?_
      intro x hx y hy
      rw [toList_getLast?, Option.mem_some_iff] at hx
      

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✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₁✝)
_w₂_ih✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₂✝)
x : (i : ι) × M i
hx : { fst := j✝, snd := last _w₁✝ } = x
y : (i : ι) × M i
hy : y ∈ List.head? (toList _w₂✝)
⊢ x.fst ≠ y.fst

Next tactic:
rw [toList_head?, Option.mem_some_iff] at hy
/-- The `Word M` represented by a `NeWord M i j` -/
def toWord {i j} (w : NeWord M i j) : Word M
    where
  toList := w.toList
  ne_one := by
    induction w
    · simpa only [toList, List.mem_singleton, ne_eq, forall_eq]
    · intro l h
      simp only [toList, List.mem_append] at h
      cases h <;> aesop
  chain_ne := by
    induction w
    · exact List.chain'_singleton _
    · refine List.Chain'.append (by assumption) (by assumption) ?_
      intro x hx y hy
      rw [toList_getLast?, Option.mem_some_iff] at hx
      rw [toList_head?, Option.mem_some_iff] at hy
      

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✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₁✝)
_w₂_ih✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₂✝)
x : (i : ι) × M i
hx : { fst := j✝, snd := last _w₁✝ } = x
y : (i : ι) × M i
hy : { fst := k✝, snd := head _w₂✝ } = y
⊢ x.fst ≠ y.fst

Next tactic:
subst hx
/-- The `Word M` represented by a `NeWord M i j` -/
def toWord {i j} (w : NeWord M i j) : Word M
    where
  toList := w.toList
  ne_one := by
    induction w
    · simpa only [toList, List.mem_singleton, ne_eq, forall_eq]
    · intro l h
      simp only [toList, List.mem_append] at h
      cases h <;> aesop
  chain_ne := by
    induction w
    · exact List.chain'_singleton _
    · refine List.Chain'.append (by assumption) (by assumption) ?_
      intro x hx y hy
      rw [toList_getLast?, Option.mem_some_iff] at hx
      rw [toList_head?, Option.mem_some_iff] at hy
      subst hx
      

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✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₁✝)
_w₂_ih✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₂✝)
y : (i : ι) × M i
hy : { fst := k✝, snd := head _w₂✝ } = y
⊢ { fst := j✝, snd := last _w₁✝ }.fst ≠ y.fst

Next tactic:
subst hy
/-- The `Word M` represented by a `NeWord M i j` -/
def toWord {i j} (w : NeWord M i j) : Word M
    where
  toList := w.toList
  ne_one := by
    induction w
    · simpa only [toList, List.mem_singleton, ne_eq, forall_eq]
    · intro l h
      simp only [toList, List.mem_append] at h
      cases h <;> aesop
  chain_ne := by
    induction w
    · exact List.chain'_singleton _
    · refine List.Chain'.append (by assumption) (by assumption) ?_
      intro x hx y hy
      rw [toList_getLast?, Option.mem_some_iff] at hx
      rw [toList_head?, Option.mem_some_iff] at hy
      subst hx
      subst hy
      

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✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₁✝)
_w₂_ih✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (toList _w₂✝)
⊢ { fst := j✝, snd := last _w₁✝ }.fst ≠ { fst := k✝, snd := head _w₂✝ }.fst

Next tactic:
assumption
/-- 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
  

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
w : Word M
h : w ≠ empty
⊢ ∃ i j w', toWord w' = w

Next tactic:
suffices : ∃ (i j : _) (w' : NeWord M i j), w'.toWord.toList = w.toList
/-- 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
  · 

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
w : Word M
h : w ≠ empty
this : ∃ i j w', (toWord w').toList = w.toList
⊢ ∃ i j w', toWord w' = w

Next tactic:
rcases this with ⟨i, j, w, h⟩
/-- 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⟩
    

Proof state:
case intro.intro.intro
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
w✝ : Word M
h✝ : w✝ ≠ empty
i j : ι
w : NeWord M i j
h : (toWord w).toList = w✝.toList
⊢ ∃ i j w', toWord w' = w✝

Next tactic:
refine' ⟨i, j, 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, _⟩
    

Proof state:
case intro.intro.intro
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
w✝ : Word M
h✝ : w✝ ≠ empty
i j : ι
w : NeWord M i j
h : (toWord w).toList = w✝.toList
⊢ toWord w = w✝

Next tactic:
ext
/-- 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
    

Proof state:
case intro.intro.intro.toList.a.a
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
w✝ : Word M
h✝ : w✝ ≠ empty
i j : ι
w : NeWord M i j
h : (toWord w).toList = w✝.toList
n✝ : ℕ
a✝ : (i : ι) × M i
⊢ a✝ ∈ List.get? (toWord w).toList n✝ ↔ a✝ ∈ List.get? w✝.toList n✝

Next tactic:
rw [h]
/-- 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]
  

Proof state:
case this
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
w : Word M
h : w ≠ empty
⊢ ∃ i j w', (toWord w').toList = w.toList

Next tactic:
cases' w with l hnot1 hchain
/-- 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
  

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

Next tactic:
induction' l with x l hi
/-- 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
  · 

Proof state:
case this.mk.nil
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
hnot1 : ∀ l ∈ [], l.snd ≠ 1
hchain : List.Chain' (fun l l' => l.fst ≠ l'.fst) []
h : { toList := [], ne_one := hnot1, chain_ne := hchain } ≠ empty
⊢ ∃ i j w', (toWord w').toList = { toList := [], ne_one := hnot1, chain_ne := hchain }.toList

Next tactic:
contradiction
/-- 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
  · 

Proof state:
case this.mk.cons
ι : 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)
hi :
  ∀ (hnot1 : ∀ l_1 ∈ l, l_1.snd ≠ 1) (hchain : List.Chain' (fun l l' => l.fst ≠ l'.fst) l),
    { toList := l, ne_one := hnot1, chain_ne := hchain } ≠ empty →
      ∃ i j w', (toWord w').toList = { toList := l, ne_one := hnot1, chain_ne := hchain }.toList
hnot1 : ∀ l_1 ∈ x :: l, l_1.snd ≠ 1
hchain : List.Chain' (fun l l' => l.fst ≠ l'.fst) (x :: l)
h : { toList := x :: l, ne_one := hnot1, chain_ne := hchain } ≠ empty
⊢ ∃ i j w', (toWord w').toList = { toList := x :: l, ne_one := hnot1, chain_ne := hchain }.toList

Next tactic:
rw [List.forall_mem_cons] at hnot1
/-- 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
    

Proof state:
case this.mk.cons
ι : 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)
hi :
  ∀ (hnot1 : ∀ l_1 ∈ l, l_1.snd ≠ 1) (hchain : List.Chain' (fun l l' => l.fst ≠ l'.fst) l),
    { toList := l, ne_one := hnot1, chain_ne := hchain } ≠ empty →
      ∃ i j w', (toWord w').toList = { toList := l, ne_one := hnot1, chain_ne := hchain }.toList
hnot1✝ : ∀ l_1 ∈ x :: l, l_1.snd ≠ 1
hnot1 : x.snd ≠ 1 ∧ ∀ x ∈ l, x.snd ≠ 1
hchain : List.Chain' (fun l l' => l.fst ≠ l'.fst) (x :: l)
h : { toList := x :: l, ne_one := hnot1✝, chain_ne := hchain } ≠ empty
⊢ ∃ i j w', (toWord w').toList = { toList := x :: l, ne_one := hnot1✝, chain_ne := hchain }.toList

Next tactic:
cases' l with y l
/-- 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
    · 

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

Next tactic:
refine' ⟨x.1, x.1, singleton x.2 hnot1.1, _⟩
/-- 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, _⟩
      

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

Next tactic:
simp [toWord]
/-- 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]
    · 

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

Next tactic:
rw [List.chain'_cons] at hchain
/-- 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
      

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

Next tactic:
specialize hi hnot1.2 hchain.2 (by rintro ⟨rfl⟩)
/-- 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 

Proof state:
ι : Type u_1
M : ι → Type u_2
inst✝¹ : (i : ι) → Monoid (M i)
N : Type u_3
inst✝ : Monoid N
x y : (i : ι) × M i
l : List ((i : ι) × M i)
hi :
  ∀ (hnot1 : ∀ l_1 ∈ y :: l, l_1.snd ≠ 1) (hchain : List.Chain' (fun l l' => l.fst ≠ l'.fst) (y :: l)),
    { toList := y :: l, ne_one := hnot1, chain_ne := hchain } ≠ empty →
      ∃ i j w', (toWord w').toList = { toList := y :: l, ne_one := hnot1, chain_ne := hchain }.toList
hnot1✝ : ∀ l_1 ∈ x :: y :: l, l_1.snd ≠ 1
hnot1 : x.snd ≠ 1 ∧ ∀ x ∈ y :: l, x.snd ≠ 1
hchain✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (x :: y :: l)
hchain : x.fst ≠ y.fst ∧ List.Chain' (fun l l' => l.fst ≠ l'.fst) (y :: l)
h : { toList := x :: y :: l, ne_one := hnot1✝, chain_ne := hchain✝ } ≠ empty
⊢ { toList := y :: l, ne_one := (_ : ∀ x ∈ y :: l, x.snd ≠ 1),
      chain_ne := (_ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (y :: l)) } ≠
    empty

Next tactic:
rintro ⟨rfl⟩
/-- 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⟩)
      

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

Next tactic:
obtain ⟨i, j, w', hw' : w'.toList = y::l⟩ := hi
/-- 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
      

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 y : (i : ι) × M i
l : List ((i : ι) × M i)
hnot1✝ : ∀ l_1 ∈ x :: y :: l, l_1.snd ≠ 1
hnot1 : x.snd ≠ 1 ∧ ∀ x ∈ y :: l, x.snd ≠ 1
hchain✝ : List.Chain' (fun l l' => l.fst ≠ l'.fst) (x :: y :: l)
hchain : x.fst ≠ y.fst ∧ List.Chain' (fun l l' => l.fst ≠ l'.fst) (y :: l)
h : { toList := x :: y :: l, ne_one := hnot1✝, chain_ne := hchain✝ } ≠ empty
i j : ι
w' : NeWord M i j
hw' : toList w' = y :: l
⊢ ∃ i j w', (toWord w').toList = { toList := x :: y :: l, ne_one := hnot1✝, chain_ne := hchain✝ }.toList

Next tactic:
obtain rfl : y = ⟨i, w'.head⟩ := by simpa [hw'] using w'.toList_head?
/-- 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 

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

Next tactic:
simpa [hw'] using w'.toList_head?