/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky

! This file was ported from Lean 3 source module data.list.cycle
! leanprover-community/mathlib commit 728baa2f54e6062c5879a3e397ac6bac323e506f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Multiset.Sort
import Mathlib.Data.Fintype.List
import Mathlib.Data.List.Rotate

/-!
# Cycles of a list

Lists have an equivalence relation of whether they are rotational permutations of one another.
This relation is defined as `IsRotated`.

Based on this, we define the quotient of lists by the rotation relation, called `Cycle`.

We also define a representation of concrete cycles, available when viewing them in a goal state or
via `#eval`, when over representatble types. For example, the cycle `(2 1 4 3)` will be shown
as `c[2, 1, 4, 3]`. Two equal cycles may be printed differently if their internal representation
is different.

-/

namespace List

variable {α : Type _} [DecidableEq α]

/-- Return the `z` such that `x :: z :: _` appears in `xs`, or `default` if there is no such `z`. -/
def nextOr : ∀ (_ : List α) (_ _ : α), α
  | [], _, default => default
  | [_], _, default => default
  -- Handles the not-found and the wraparound case
  | y :: z :: xs, x, default => if x = y then z else nextOr (z :: xs) x default
#align list.next_or List.nextOr

@[simp]
theorem nextOr_nil (x d : α) : nextOr [] x d = d :=
  rfl
#align list.next_or_nil List.nextOr_nil

@[simp]
theorem nextOr_singleton (x y d : α) : nextOr [y] x d = d :=
  rfl
#align list.next_or_singleton List.nextOr_singleton

@[simp]
theorem nextOr_self_cons_cons (xs : List α) (x y d : α) : nextOr (x :: y :: xs) x d = y :=
  if_pos rfl
#align list.next_or_self_cons_cons List.nextOr_self_cons_cons

theorem nextOr_cons_of_ne (xs : List α) (y x d : α) (h : x ≠ y) :
    nextOr (y :: xs) x d = nextOr xs x d := by
  cases' xs with z zs
  · rfl
  · exact if_neg h
#align list.next_or_cons_of_ne List.nextOr_cons_of_ne

/-- `nextOr` does not depend on the default value, if the next value appears. -/
theorem nextOr_eq_nextOr_of_mem_of_ne (xs : List α) (x d d' : α) (x_mem : x ∈ xs)
    (x_ne : x ≠ xs.getLast (ne_nil_of_mem x_mem)) : nextOr xs x d = nextOr xs x d' :=
  by
  induction' xs with y ys IH
  · cases x_mem
  cases' ys with z zs
  · simp at x_mem x_ne
    contradiction
  by_cases h : x = y
  · rw [h, nextOr_self_cons_cons, nextOr_self_cons_cons]
  · rw [nextOr, nextOr, IH]
    . simpa [h] using x_mem
    . simpa using x_ne
#align list.next_or_eq_next_or_of_mem_of_ne List.nextOr_eq_nextOr_of_mem_of_ne

theorem mem_of_nextOr_ne {xs : List α} {x d : α} (h : nextOr xs x d ≠ d) : x ∈ xs :=
  by
  induction' xs with y ys IH
  · simp at h
  cases' ys with z zs
  · simp at h
  · by_cases hx : x = y
    · simp [hx]
    · rw [nextOr_cons_of_ne _ _ _ _ hx] at h
      simpa [hx] using IH h
#align list.mem_of_next_or_ne List.mem_of_nextOr_ne

theorem nextOr_concat {xs : List α} {x : α} (d : α) (h : x ∉ xs) : nextOr (xs ++ [x]) x d = d :=
  by
  induction' xs with z zs IH
  · simp
  · obtain ⟨hz, hzs⟩ := not_or.mp (mt mem_cons.2 h)
    rw [cons_append, nextOr_cons_of_ne _ _ _ _ hz, IH hzs]
#align list.next_or_concat List.nextOr_concat

theorem nextOr_mem {xs : List α} {x d : α} (hd : d ∈ xs) : nextOr xs x d ∈ xs := by
  revert hd
  suffices ∀ (xs' : List α) (_ : ∀ x ∈ xs, x ∈ xs') (_ : d ∈ xs'), nextOr xs x d ∈ xs' by
    exact this xs fun _ => id
  intro xs' hxs' hd
  induction' xs with y ys ih
  · exact hd
  cases' ys with z zs
  · exact hd
  rw [nextOr]
  split_ifs with h
  · exact hxs' _ (mem_cons_of_mem _ (mem_cons_self _ _))
  · exact ih fun _ h => hxs' _ (mem_cons_of_mem _ h)
#align list.next_or_mem List.nextOr_mem

/-- Given an element `x : α` of `l : list α` such that `x ∈ l`, get the next
element of `l`. This works from head to tail, (including a check for last element)
so it will match on first hit, ignoring later duplicates.

For example:
 * `next [1, 2, 3] 2 _ = 3`
 * `next [1, 2, 3] 3 _ = 1`
 * `next [1, 2, 3, 2, 4] 2 _ = 3`
 * `next [1, 2, 3, 2] 2 _ = 3`
 * `next [1, 1, 2, 3, 2] 1 _ = 1`
-/
def next (l : List α) (x : α) (h : x ∈ l) : α :=
  nextOr l x (l.get ⟨0, length_pos_of_mem h⟩)
#align list.next List.next

/-- Given an element `x : α` of `l : list α` such that `x ∈ l`, get the previous
element of `l`. This works from head to tail, (including a check for last element)
so it will match on first hit, ignoring later duplicates.

 * `prev [1, 2, 3] 2 _ = 1`
 * `prev [1, 2, 3] 1 _ = 3`
 * `prev [1, 2, 3, 2, 4] 2 _ = 1`
 * `prev [1, 2, 3, 4, 2] 2 _ = 1`
 * `prev [1, 1, 2] 1 _ = 2`
-/
def prev : ∀ (l : List α) (x : α) (_h : x ∈ l), α
  | [], _, h => by simp at h
  | [y], _, _ => y
  | y :: z :: xs, x, h =>
    if hx : x = y then getLast (z :: xs) (cons_ne_nil _ _)
    else if x = z then y else prev (z :: xs) x (by simpa [hx] using h)
#align list.prev List.prev

variable (l : List α) (x : α)

@[simp]
theorem next_singleton (x y : α) (h : x ∈ [y]) : next [y] x h = y :=
  rfl
#align list.next_singleton List.next_singleton

@[simp]
theorem prev_singleton (x y : α) (h : x ∈ [y]) : prev [y] x h = y :=
  rfl
#align list.prev_singleton List.prev_singleton

theorem next_cons_cons_eq' (y z : α) (h : x ∈ y :: z :: l) (hx : x = y) :
    next (y :: z :: l) x h = z := by rw [next, nextOr, if_pos hx]
#align list.next_cons_cons_eq' List.next_cons_cons_eq'

@[simp]
theorem next_cons_cons_eq (z : α) (h : x ∈ x :: z :: l) : next (x :: z :: l) x h = z :=
  next_cons_cons_eq' l x x z h rfl
#align list.next_cons_cons_eq List.next_cons_cons_eq

theorem next_ne_head_ne_getLast (h : x ∈ l) (y : α) (h : x ∈ y :: l) (hy : x ≠ y)
    (hx : x ≠ getLast (y :: l) (cons_ne_nil _ _)) :
    next (y :: l) x h = next l x (by simpa [hy] using h) := by
  rw [next, next, nextOr_cons_of_ne _ _ _ _ hy, nextOr_eq_nextOr_of_mem_of_ne]
  · rwa [getLast_cons] at hx
    exact ne_nil_of_mem (by assumption)
  · rwa [getLast_cons] at hx
#align list.next_ne_head_ne_last List.next_ne_head_ne_getLast

theorem next_cons_concat (y : α) (hy : x ≠ y) (hx : x ∉ l)
    (h : x ∈ y :: l ++ [x] := mem_append_right _ (mem_singleton_self x)) :
    next (y :: l ++ [x]) x h = y := by
  rw [next, nextOr_concat]
  · rfl
  · simp [hy, hx]
#align list.next_cons_concat List.next_cons_concat

theorem next_getLast_cons (h : x ∈ l) (y : α) (h : x ∈ y :: l) (hy : x ≠ y)
    (hx : x = getLast (y :: l) (cons_ne_nil _ _)) (hl : Nodup l) : next (y :: l) x h = y :=
  by
  rw [next, get, ← dropLast_append_getLast (cons_ne_nil y l), hx, nextOr_concat]
  subst hx
  intro H
  obtain ⟨⟨_ | k, hk⟩, hk'⟩ := get_of_mem H
  · rw [← Option.some_inj] at hk'
    rw [← get?_eq_get, dropLast_eq_take, get?_take, get?_zero, head?_cons,
      Option.some_inj] at hk'
    exact hy (Eq.symm hk')
    rw [Nat.zero_eq, length_cons, Nat.pred_succ]
    exact length_pos_of_mem (by assumption)
  suffices k.succ = l.length by simp [this] at hk
  cases' l with hd tl
  · simp at hk
  · rw [nodup_iff_injective_get] at hl
    rw [length, Nat.succ_inj']
    refine' Fin.veq_of_eq (@hl ⟨k, Nat.lt_of_succ_lt <| by simpa using hk⟩ ⟨tl.length, by simp⟩ _)
    rw [← Option.some_inj] at hk'
    rw [← get?_eq_get, dropLast_eq_take, get?_take, get?, get?_eq_get, Option.some_inj] at hk'
    rw [hk']
    simp [getLast_eq_get]
    simpa using hk
#align list.next_last_cons List.next_getLast_cons

theorem prev_getLast_cons' (y : α) (hxy : x ∈ y :: l) (hx : x = y) :
    prev (y :: l) x hxy = getLast (y :: l) (cons_ne_nil _ _) := by cases l <;> simp [prev, hx]
#align list.prev_last_cons' List.prev_getLast_cons'

@[simp]
theorem prev_getLast_cons (h : x ∈ x :: l) :
    prev (x :: l) x h = getLast (x :: l) (cons_ne_nil _ _) :=
  prev_getLast_cons' l x x h rfl
#align list.prev_last_cons List.prev_getLast_cons

theorem prev_cons_cons_eq' (y z : α) (h : x ∈ y :: z :: l) (hx : x = y) :
    prev (y :: z :: l) x h = getLast (z :: l) (cons_ne_nil _ _) := by rw [prev, dif_pos hx]
#align list.prev_cons_cons_eq' List.prev_cons_cons_eq'

--@[simp] Porting note: `simp` can prove it
theorem prev_cons_cons_eq (z : α) (h : x ∈ x :: z :: l) :
    prev (x :: z :: l) x h = getLast (z :: l) (cons_ne_nil _ _) :=
  prev_cons_cons_eq' l x x z h rfl
#align list.prev_cons_cons_eq List.prev_cons_cons_eq

theorem prev_cons_cons_of_ne' (y z : α) (h : x ∈ y :: z :: l) (hy : x ≠ y) (hz : x = z) :
    prev (y :: z :: l) x h = y := by
  cases l
  · simp [prev, hy, hz]
  · rw [prev, dif_neg hy, if_pos hz]
#align list.prev_cons_cons_of_ne' List.prev_cons_cons_of_ne'

theorem prev_cons_cons_of_ne (y : α) (h : x ∈ y :: x :: l) (hy : x ≠ y) :
    prev (y :: x :: l) x h = y :=
  prev_cons_cons_of_ne' _ _ _ _ _ hy rfl
#align list.prev_cons_cons_of_ne List.prev_cons_cons_of_ne

theorem prev_ne_cons_cons (y z : α) (h : x ∈ y :: z :: l) (hy : x ≠ y) (hz : x ≠ z) :
    prev (y :: z :: l) x h = prev (z :: l) x (by simpa [hy] using h) := by
  cases l
  · simp [hy, hz] at h
  · rw [prev, dif_neg hy, if_neg hz]
#align list.prev_ne_cons_cons List.prev_ne_cons_cons

theorem next_mem (h : x ∈ l) : l.next x h ∈ l :=
  nextOr_mem (get_mem _ _ _)
#align list.next_mem List.next_mem

theorem prev_mem (h : x ∈ l) : l.prev x h ∈ l := by
  cases' l with hd tl
  · simp at h
  induction' tl with hd' tl hl generalizing hd
  · simp
  · by_cases hx : x = hd
    · simp only [hx, prev_cons_cons_eq]
      exact mem_cons_of_mem _ (getLast_mem _)
    · rw [prev, dif_neg hx]
      split_ifs with hm
      · exact mem_cons_self _ _
      · exact mem_cons_of_mem _ (hl _ _)
#align list.prev_mem List.prev_mem

--Porting note: new theorem
theorem next_get : ∀ (l : List α) (_h : Nodup l) (i : Fin l.length),
    next l (l.get i) (get_mem _ _ _) = l.get ⟨(i + 1) % l.length,
      Nat.mod_lt _ (i.1.zero_le.trans_lt i.2)⟩
  | [], _, i => by simpa using i.2
  | [_], _, _ => by simp
  | x::y::l, _h, ⟨0, h0⟩ => by
    have h₁ : get (x :: y :: l) { val := 0, isLt := h0 } = x := by simp
    rw [next_cons_cons_eq' _ _ _ _ _ h₁]
    simp
  | x::y::l, hn, ⟨i+1, hi⟩ => by
    have hx' : (x :: y :: l).get ⟨i+1, hi⟩ ≠ x := by
      intro H
      suffices (i + 1 : ℕ) = 0 by simpa
      rw [nodup_iff_injective_get] at hn
      refine' Fin.veq_of_eq (@hn ⟨i + 1, hi⟩ ⟨0, by simp⟩ _)
      simpa using H
    have hi' : i ≤ l.length := Nat.le_of_lt_succ (Nat.succ_lt_succ_iff.1 hi)
    rcases hi'.eq_or_lt with (hi' | hi')
    · subst hi'
      rw [next_getLast_cons]
      · simp [hi', get]
      . rw [get_cons_succ]; exact get_mem _ _ _
      . exact hx'
      . simp [getLast_eq_get]
      . exact hn.of_cons
    . rw [next_ne_head_ne_getLast _ _ _ _ _ hx']
      simp only [get_cons_succ]
      rw [next_get (y::l), ← get_cons_succ (a := x)]
      congr
      dsimp
      rw [Nat.mod_eq_of_lt (Nat.succ_lt_succ_iff.2 hi'),
        Nat.mod_eq_of_lt (Nat.succ_lt_succ_iff.2 (Nat.succ_lt_succ_iff.2 hi'))]
      . simp [Nat.mod_eq_of_lt (Nat.succ_lt_succ_iff.2 hi'), Nat.succ_eq_add_one, hi']
      . exact hn.of_cons
      . rw [getLast_eq_get]
        intro h
        have := nodup_iff_injective_get.1 hn h
        simp at this; simp [this] at hi'
      . rw [get_cons_succ]; exact get_mem _ _ _

set_option linter.deprecated false in
@[deprecated next_get]
theorem next_nthLe (l : List α) (h : Nodup l) (n : ℕ) (hn : n < l.length) :
    next l (l.nthLe n hn) (nthLe_mem _ _ _) =
      l.nthLe ((n + 1) % l.length) (Nat.mod_lt _ (n.zero_le.trans_lt hn)) :=
  next_get l h ⟨n, hn⟩
#align list.next_nth_le List.next_nthLe

set_option linter.deprecated false in
theorem prev_nthLe (l : List α) (h : Nodup l) (n : ℕ) (hn : n < l.length) :
    prev l (l.nthLe n hn) (nthLe_mem _ _ _) =
      l.nthLe ((n + (l.length - 1)) % l.length) (Nat.mod_lt _ (n.zero_le.trans_lt hn)) := by
  cases' l with x l
  · simp at hn
  induction' l with y l hl generalizing n x
  · simp
  · rcases n with (_ | _ | n)
    · simp [Nat.add_succ_sub_one, add_zero, List.prev_cons_cons_eq, Nat.zero_eq, List.length,
        List.nthLe, Nat.succ_add_sub_one, zero_add, getLast_eq_get,
        Nat.mod_eq_of_lt (Nat.succ_lt_succ l.length.lt_succ_self)]
    · simp only [mem_cons, nodup_cons] at h
      push_neg  at h
      simp only [List.prev_cons_cons_of_ne _ _ _ _ h.left.left.symm, Nat.zero_eq, List.length,
        List.nthLe, add_comm, eq_self_iff_true, Nat.succ_add_sub_one, Nat.mod_self, zero_add,
        List.get]
    · rw [prev_ne_cons_cons]
      · convert hl n.succ y h.of_cons (Nat.le_of_succ_le_succ hn) using 1
        have : ∀ k hk, (y :: l).nthLe k hk = (x :: y :: l).nthLe (k + 1) (Nat.succ_lt_succ hk) :=
          by
          intros
          simp [List.nthLe]
        rw [this]
        congr
        simp only [Nat.add_succ_sub_one, add_zero, length]
        simp only [length, Nat.succ_lt_succ_iff] at hn
        set k := l.length
        rw [Nat.succ_add, ← Nat.add_succ, Nat.add_mod_right, Nat.succ_add, ← Nat.add_succ _ k,
          Nat.add_mod_right, Nat.mod_eq_of_lt, Nat.mod_eq_of_lt]
        · exact Nat.lt_succ_of_lt hn
        · exact Nat.succ_lt_succ (Nat.lt_succ_of_lt hn)
      · intro H
        suffices n.succ.succ = 0 by simpa
        rw [nodup_iff_nthLe_inj] at h
        refine' h _ _ hn Nat.succ_pos' _
        simpa using H
      · intro H
        suffices n.succ.succ = 1 by simpa
        rw [nodup_iff_nthLe_inj] at h
        refine' h _ _ hn (Nat.succ_lt_succ Nat.succ_pos') _
        simpa using H
#align list.prev_nth_le List.prev_nthLe

set_option linter.deprecated false in
theorem pmap_next_eq_rotate_one (h : Nodup l) : (l.pmap l.next fun _ h => h) = l.rotate 1 := by
  apply List.ext_nthLe
  · simp
  · intros
    rw [nthLe_pmap, nthLe_rotate, next_nthLe _ h]
#align list.pmap_next_eq_rotate_one List.pmap_next_eq_rotate_one

set_option linter.deprecated false in
theorem pmap_prev_eq_rotate_length_sub_one (h : Nodup l) :
    (l.pmap l.prev fun _ h => h) = l.rotate (l.length - 1) :=
  by
  apply List.ext_nthLe
  · simp
  · intro n hn hn'
    rw [nthLe_rotate, nthLe_pmap, prev_nthLe _ h]
#align list.pmap_prev_eq_rotate_length_sub_one List.pmap_prev_eq_rotate_length_sub_one

set_option linter.deprecated false in
theorem prev_next (l : List α) (h : Nodup l) (x : α) (hx : x ∈ l) :
    prev l (next l x hx) (next_mem _ _ _) = x :=
  by
  obtain ⟨n, hn, rfl⟩ := nthLe_of_mem hx
  simp only [next_nthLe, prev_nthLe, h, Nat.mod_add_mod]
  cases' l with hd tl
  · simp at hx
  · have : (n + 1 + length tl) % (length tl + 1) = n := by
      rw [length_cons] at hn
      rw [add_assoc, add_comm 1, Nat.add_mod_right, Nat.mod_eq_of_lt hn]
    simp only [length_cons, Nat.succ_sub_succ_eq_sub, tsub_zero, Nat.succ_eq_add_one, this]
#align list.prev_next List.prev_next

set_option linter.deprecated false in
theorem next_prev (l : List α) (h : Nodup l) (x : α) (hx : x ∈ l) :
    next l (prev l x hx) (prev_mem _ _ _) = x :=
  by
  obtain ⟨n, hn, rfl⟩ := nthLe_of_mem hx
  simp only [next_nthLe, prev_nthLe, h, Nat.mod_add_mod]
  cases' l with hd tl
  · simp at hx
  · have : (n + length tl + 1) % (length tl + 1) = n := by
      rw [length_cons] at hn
      rw [add_assoc, Nat.add_mod_right, Nat.mod_eq_of_lt hn]
    simp [this]
#align list.next_prev List.next_prev

set_option linter.deprecated false in
theorem prev_reverse_eq_next (l : List α) (h : Nodup l) (x : α) (hx : x ∈ l) :
    prev l.reverse x (mem_reverse'.mpr hx) = next l x hx :=
  by
  obtain ⟨k, hk, rfl⟩ := nthLe_of_mem hx
  have lpos : 0 < l.length := k.zero_le.trans_lt hk
  have key : l.length - 1 - k < l.length :=
    (Nat.sub_le _ _).trans_lt (tsub_lt_self lpos Nat.succ_pos')
  rw [← nthLe_pmap l.next (fun _ h => h) (by simpa using hk)]
  simp_rw [← nthLe_reverse l k (key.trans_le (by simp)), pmap_next_eq_rotate_one _ h]
  rw [← nthLe_pmap l.reverse.prev fun _ h => h]
  · simp_rw [pmap_prev_eq_rotate_length_sub_one _ (nodup_reverse.mpr h), rotate_reverse,
      length_reverse, Nat.mod_eq_of_lt (tsub_lt_self lpos Nat.succ_pos'),
      tsub_tsub_cancel_of_le (Nat.succ_le_of_lt lpos)]
    rw [← nthLe_reverse]
    · simp [tsub_tsub_cancel_of_le (Nat.le_pred_of_lt hk)]
    · simpa using (Nat.sub_le _ _).trans_lt (tsub_lt_self lpos Nat.succ_pos')
    . simpa
#align list.prev_reverse_eq_next List.prev_reverse_eq_next

theorem next_reverse_eq_prev (l : List α) (h : Nodup l) (x : α) (hx : x ∈ l) :
    next l.reverse x (mem_reverse'.mpr hx) = prev l x hx :=
  by
  convert (prev_reverse_eq_next l.reverse (nodup_reverse.mpr h) x ((mem_reverse _ _).mpr hx)).symm
  exact (reverse_reverse l).symm
#align list.next_reverse_eq_prev List.next_reverse_eq_prev

set_option linter.deprecated false in
theorem isRotated_next_eq {l l' : List α} (h : l ~r l') (hn : Nodup l) {x : α} (hx : x ∈ l) :
    l.next x hx = l'.next x (h.mem_iff.mp hx) :=
  by
  obtain ⟨k, hk, rfl⟩ := nthLe_of_mem hx
  obtain ⟨n, rfl⟩ := id h
  rw [next_nthLe _ hn]
  simp_rw [← nthLe_rotate' _ n k]
  rw [next_nthLe _ (h.nodup_iff.mp hn), ← nthLe_rotate' _ n]
  simp [add_assoc]
#align list.is_rotated_next_eq List.isRotated_next_eq

theorem isRotated_prev_eq {l l' : List α} (h : l ~r l') (hn : Nodup l) {x : α} (hx : x ∈ l) :
    l.prev x hx = l'.prev x (h.mem_iff.mp hx) :=
  by
  rw [← next_reverse_eq_prev _ hn, ← next_reverse_eq_prev _ (h.nodup_iff.mp hn)]
  exact isRotated_next_eq h.reverse (nodup_reverse.mpr hn) _
#align list.is_rotated_prev_eq List.isRotated_prev_eq

end List

open List

/-- `Cycle α` is the quotient of `List α` by cyclic permutation.
Duplicates are allowed.
-/
def Cycle (α : Type _) : Type _ :=
  Quotient (IsRotated.setoid α)
#align cycle Cycle

namespace Cycle

variable {α : Type _}

--Porting note: new definition
/-- The coercion from `List α` to `Cycle α` -/
@[coe] def ofList : List α → Cycle α :=
  Quot.mk _

instance : Coe (List α) (Cycle α) :=
  ⟨ofList⟩

@[simp]
theorem coe_eq_coe {l₁ l₂ : List α} : (l₁ : Cycle α) = (l₂ : Cycle α) ↔ l₁ ~r l₂ :=
  @Quotient.eq _ (IsRotated.setoid _) _ _
#align cycle.coe_eq_coe Cycle.coe_eq_coe

@[simp]
theorem mk_eq_coe (l : List α) : Quot.mk _ l = (l : Cycle α) :=
  rfl
#align cycle.mk_eq_coe Cycle.mk_eq_coe

@[simp]
theorem mk''_eq_coe (l : List α) : Quotient.mk'' l = (l : Cycle α) :=
  rfl
#align cycle.mk'_eq_coe Cycle.mk''_eq_coe

theorem coe_cons_eq_coe_append (l : List α) (a : α) :
    (↑(a :: l) : Cycle α) = (↑(l ++ [a]) : Cycle α) :=
  Quot.sound ⟨1, by rw [rotate_cons_succ, rotate_zero]⟩
#align cycle.coe_cons_eq_coe_append Cycle.coe_cons_eq_coe_append

/-- The unique empty cycle. -/
def nil : Cycle α :=
  ([] : List α)
#align cycle.nil Cycle.nil

@[simp]
theorem coe_nil : ↑([] : List α) = @nil α :=
  rfl
#align cycle.coe_nil Cycle.coe_nil

@[simp]
theorem coe_eq_nil (l : List α) : (l : Cycle α) = nil ↔ l = [] :=
  coe_eq_coe.trans isRotated_nil_iff
#align cycle.coe_eq_nil Cycle.coe_eq_nil

/-- For consistency with `EmptyCollection (List α)`. -/
instance : EmptyCollection (Cycle α) :=
  ⟨nil⟩

@[simp]
theorem empty_eq : ∅ = @nil α :=
  rfl
#align cycle.empty_eq Cycle.empty_eq

instance : Inhabited (Cycle α) :=
  ⟨nil⟩

/-- An induction principle for `Cycle`. Use as `induction s using Cycle.induction_on`. -/
@[elab_as_elim]
theorem induction_on {C : Cycle α → Prop} (s : Cycle α) (H0 : C nil)
    (HI : ∀ (a) (l : List α), C ↑l → C ↑(a :: l)) : C s :=
  Quotient.inductionOn' s fun l => by
    refine List.recOn l ?_ ?_ <;> simp
    assumption'
#align cycle.induction_on Cycle.induction_on

/-- For `x : α`, `s : Cycle α`, `x ∈ s` indicates that `x` occurs at least once in `s`. -/
def Mem (a : α) (s : Cycle α) : Prop :=
  Quot.liftOn s (fun l => a ∈ l) fun _ _ e => propext <| e.mem_iff
#align cycle.mem Cycle.Mem

instance : Membership α (Cycle α) :=
  ⟨Mem⟩

@[simp]
theorem mem_coe_iff {a : α} {l : List α} : a ∈ (↑l : Cycle α) ↔ a ∈ l :=
  Iff.rfl
#align cycle.mem_coe_iff Cycle.mem_coe_iff

@[simp]
theorem not_mem_nil : ∀ a, a ∉ @nil α :=
  List.not_mem_nil
#align cycle.not_mem_nil Cycle.not_mem_nil

instance [DecidableEq α] : DecidableEq (Cycle α) := fun s₁ s₂ =>
  Quotient.recOnSubsingleton₂' s₁ s₂ fun _ _ => decidable_of_iff' _ Quotient.eq''

instance [DecidableEq α] (x : α) (s : Cycle α) : Decidable (x ∈ s) :=
  Quotient.recOnSubsingleton' s fun l => show Decidable (x ∈ l) from inferInstance

/-- Reverse a `s : Cycle α` by reversing the underlying `List`. -/
nonrec def reverse (s : Cycle α) : Cycle α :=
  Quot.map reverse (fun _ _ => IsRotated.reverse) s
#align cycle.reverse Cycle.reverse

@[simp]
theorem reverse_coe (l : List α) : (l : Cycle α).reverse = l.reverse :=
  rfl
#align cycle.reverse_coe Cycle.reverse_coe

@[simp]
theorem mem_reverse_iff {a : α} {s : Cycle α} : a ∈ s.reverse ↔ a ∈ s :=
  Quot.inductionOn s fun _ => mem_reverse'
#align cycle.mem_reverse_iff Cycle.mem_reverse_iff

@[simp]
theorem reverse_reverse (s : Cycle α) : s.reverse.reverse = s :=
  Quot.inductionOn s fun _ => by simp
#align cycle.reverse_reverse Cycle.reverse_reverse

@[simp]
theorem reverse_nil : nil.reverse = @nil α :=
  rfl
#align cycle.reverse_nil Cycle.reverse_nil

/-- The length of the `s : Cycle α`, which is the number of elements, counting duplicates. -/
def length (s : Cycle α) : ℕ :=
  Quot.liftOn s List.length fun _ _ e => e.perm.length_eq
#align cycle.length Cycle.length

@[simp]
theorem length_coe (l : List α) : length (l : Cycle α) = l.length :=
  rfl
#align cycle.length_coe Cycle.length_coe

@[simp]
theorem length_nil : length (@nil α) = 0 :=
  rfl
#align cycle.length_nil Cycle.length_nil

@[simp]
theorem length_reverse (s : Cycle α) : s.reverse.length = s.length :=
  Quot.inductionOn s List.length_reverse
#align cycle.length_reverse Cycle.length_reverse

/-- A `s : Cycle α` that is at most one element. -/
def Subsingleton (s : Cycle α) : Prop :=
  s.length ≤ 1
#align cycle.subsingleton Cycle.Subsingleton

theorem subsingleton_nil : Subsingleton (@nil α) :=
  zero_le_one
#align cycle.subsingleton_nil Cycle.subsingleton_nil

theorem length_subsingleton_iff {s : Cycle α} : Subsingleton s ↔ length s ≤ 1 :=
  Iff.rfl
#align cycle.length_subsingleton_iff Cycle.length_subsingleton_iff

@[simp]
theorem subsingleton_reverse_iff {s : Cycle α} : s.reverse.Subsingleton ↔ s.Subsingleton := by
  simp [length_subsingleton_iff]
#align cycle.subsingleton_reverse_iff Cycle.subsingleton_reverse_iff

theorem Subsingleton.congr {s : Cycle α} (h : Subsingleton s) :
    ∀ ⦃x⦄ (_hx : x ∈ s) ⦃y⦄ (_hy : y ∈ s), x = y :=
  by
  induction' s using Quot.inductionOn with l
  simp only [length_subsingleton_iff, length_coe, mk_eq_coe, le_iff_lt_or_eq, Nat.lt_add_one_iff,
    length_eq_zero, length_eq_one, Nat.not_lt_zero, false_or_iff] at h
  rcases h with (rfl | ⟨z, rfl⟩) <;> simp
#align cycle.subsingleton.congr Cycle.Subsingleton.congr

/-- A `s : Cycle α` that is made up of at least two unique elements. -/
def Nontrivial (s : Cycle α) : Prop :=
  ∃ (x y : α)(_h : x ≠ y), x ∈ s ∧ y ∈ s
#align cycle.nontrivial Cycle.Nontrivial

@[simp]
theorem nontrivial_coe_nodup_iff {l : List α} (hl : l.Nodup) :
    Nontrivial (l : Cycle α) ↔ 2 ≤ l.length :=
  by
  rw [Nontrivial]
  rcases l with (_ | ⟨hd, _ | ⟨hd', tl⟩⟩)
  · simp
  · simp
  · simp only [mem_cons, exists_prop, mem_coe_iff, List.length, Ne.def, Nat.succ_le_succ_iff,
      zero_le, iff_true_iff]
    refine' ⟨hd, hd', _, by simp⟩
    simp only [not_or, mem_cons, nodup_cons] at hl
    exact hl.left.left
#align cycle.nontrivial_coe_nodup_iff Cycle.nontrivial_coe_nodup_iff

@[simp]
theorem nontrivial_reverse_iff {s : Cycle α} : s.reverse.Nontrivial ↔ s.Nontrivial := by
  simp [Nontrivial]
#align cycle.nontrivial_reverse_iff Cycle.nontrivial_reverse_iff

theorem length_nontrivial {s : Cycle α} (h : Nontrivial s) : 2 ≤ length s := by
  obtain ⟨x, y, hxy, hx, hy⟩ := h
  induction' s using Quot.inductionOn with l
  rcases l with (_ | ⟨hd, _ | ⟨hd', tl⟩⟩)
  · simp at hx
  · simp only [mem_coe_iff, mk_eq_coe, mem_singleton] at hx hy
    simp [hx, hy] at hxy
  · simp [Nat.succ_le_succ_iff]
#align cycle.length_nontrivial Cycle.length_nontrivial

/-- The `s : Cycle α` contains no duplicates. -/
nonrec def Nodup (s : Cycle α) : Prop :=
  Quot.liftOn s Nodup fun _l₁ _l₂ e => propext <| e.nodup_iff
#align cycle.nodup Cycle.Nodup

@[simp]
nonrec theorem nodup_nil : Nodup (@nil α) :=
  nodup_nil
#align cycle.nodup_nil Cycle.nodup_nil

@[simp]
theorem nodup_coe_iff {l : List α} : Nodup (l : Cycle α) ↔ l.Nodup :=
  Iff.rfl
#align cycle.nodup_coe_iff Cycle.nodup_coe_iff

@[simp]
theorem nodup_reverse_iff {s : Cycle α} : s.reverse.Nodup ↔ s.Nodup :=
  Quot.inductionOn s fun _ => nodup_reverse
#align cycle.nodup_reverse_iff Cycle.nodup_reverse_iff

theorem Subsingleton.nodup {s : Cycle α} (h : Subsingleton s) : Nodup s :=
  by
  induction' s using Quot.inductionOn with l
  cases' l with hd tl
  · simp
  · have : tl = [] := by simpa [Subsingleton, length_eq_zero, Nat.succ_le_succ_iff] using h
    simp [this]
#align cycle.subsingleton.nodup Cycle.Subsingleton.nodup

theorem Nodup.nontrivial_iff {s : Cycle α} (h : Nodup s) : Nontrivial s ↔ ¬Subsingleton s :=
  by
  rw [length_subsingleton_iff]
  induction s using Quotient.inductionOn'
  simp only [mk''_eq_coe, nodup_coe_iff] at h
  simp [h, Nat.succ_le_iff]
#align cycle.nodup.nontrivial_iff Cycle.Nodup.nontrivial_iff

/-- The `s : Cycle α` as a `Multiset α`.
-/
def toMultiset (s : Cycle α) : Multiset α :=
  Quotient.liftOn' s (↑) fun _ _  h => Multiset.coe_eq_coe.mpr h.perm
#align cycle.to_multiset Cycle.toMultiset

@[simp]
theorem coe_toMultiset (l : List α) : (l : Cycle α).toMultiset = l :=
  rfl
#align cycle.coe_to_multiset Cycle.coe_toMultiset

@[simp]
theorem nil_toMultiset : nil.toMultiset = (0 : Multiset α) :=
  rfl
#align cycle.nil_to_multiset Cycle.nil_toMultiset

@[simp]
theorem card_toMultiset (s : Cycle α) : Multiset.card s.toMultiset = s.length :=
  Quotient.inductionOn' s (by simp)
#align cycle.card_to_multiset Cycle.card_toMultiset

@[simp]
theorem toMultiset_eq_nil {s : Cycle α} : s.toMultiset = 0 ↔ s = Cycle.nil :=
  Quotient.inductionOn' s (by simp)
#align cycle.to_multiset_eq_nil Cycle.toMultiset_eq_nil

/-- The lift of `list.map`. -/
def map {β : Type _} (f : α → β) : Cycle α → Cycle β :=
  Quotient.map' (List.map f) fun _ _ h => h.map _
#align cycle.map Cycle.map

@[simp]
theorem map_nil {β : Type _} (f : α → β) : map f nil = nil :=
  rfl
#align cycle.map_nil Cycle.map_nil

@[simp]
theorem map_coe {β : Type _} (f : α → β) (l : List α) : map f ↑l = List.map f l :=
  rfl
#align cycle.map_coe Cycle.map_coe

@[simp]
theorem map_eq_nil {β : Type _} (f : α → β) (s : Cycle α) : map f s = nil ↔ s = nil :=
  Quotient.inductionOn' s (by simp)
#align cycle.map_eq_nil Cycle.map_eq_nil

@[simp]
theorem mem_map {β : Type _} {f : α → β} {b : β} {s : Cycle α} :
    b ∈ s.map f ↔ ∃ a, a ∈ s ∧ f a = b :=
  Quotient.inductionOn' s (by simp)
#align cycle.mem_map Cycle.mem_map

/-- The `Multiset` of lists that can make the cycle. -/
def lists (s : Cycle α) : Multiset (List α) :=
  Quotient.liftOn' s (fun l => (l.cyclicPermutations : Multiset (List α))) fun l₁ l₂ h => by
    simpa using h.cyclicPermutations.perm
#align cycle.lists Cycle.lists

@[simp]

@[simp]
theorem mem_lists_iff_coe_eq {s : Cycle α} {l : List α} : l ∈ s.lists ↔ (l : Cycle α) = s :=
  Quotient.inductionOn' s fun l => by
    rw [lists, Quotient.liftOn'_mk'']
    simp
#align cycle.mem_lists_iff_coe_eq Cycle.mem_lists_iff_coe_eq

@[simp]
theorem lists_nil : lists (@nil α) = [([] : List α)] := by
  rw [nil, lists_coe, cyclicPermutations_nil]
#align cycle.lists_nil Cycle.lists_nil

section Decidable

variable [DecidableEq α]

/-- Auxiliary decidability algorithm for lists that contain at least two unique elements.
-/
def decidableNontrivialCoe : ∀ l : List α, Decidable (Nontrivial (l : Cycle α))
  | [] => isFalse (by simp [Nontrivial])
  | [x] => isFalse (by simp [Nontrivial])
  | x :: y :: l =>
    if h : x = y then
      @decidable_of_iff' _ (Nontrivial (x :: l : Cycle α)) (by simp [h, Nontrivial])
        (decidableNontrivialCoe (x :: l))
    else isTrue ⟨x, y, h, by simp, by simp⟩
#align cycle.decidable_nontrivial_coe Cycle.decidableNontrivialCoe

instance {s : Cycle α} : Decidable (Nontrivial s) :=
  Quot.recOnSubsingleton' s decidableNontrivialCoe

instance {s : Cycle α} : Decidable (Nodup s) :=
  Quot.recOnSubsingleton' s List.nodupDecidable

instance fintypeNodupCycle [Fintype α] : Fintype { s : Cycle α // s.Nodup } :=
  Fintype.ofSurjective (fun l : { l : List α // l.Nodup } => ⟨l.val, by simpa using l.prop⟩)
    fun ⟨s, hs⟩ => by
    induction' s using Quotient.inductionOn' with s hs
    exact ⟨⟨s, hs⟩, by simp⟩
#align cycle.fintype_nodup_cycle Cycle.fintypeNodupCycle

instance fintypeNodupNontrivialCycle [Fintype α] :
    Fintype { s : Cycle α // s.Nodup ∧ s.Nontrivial } :=
  Fintype.subtype
    (((Finset.univ : Finset { s : Cycle α // s.Nodup }).map (Function.Embedding.subtype _)).filter
      Cycle.Nontrivial)
    (by simp)
#align cycle.fintype_nodup_nontrivial_cycle Cycle.fintypeNodupNontrivialCycle

/-- The `s : Cycle α` as a `Finset α`. -/
def toFinset (s : Cycle α) : Finset α :=
  s.toMultiset.toFinset
#align cycle.to_finset Cycle.toFinset

@[simp]
theorem toFinset_toMultiset (s : Cycle α) : s.toMultiset.toFinset = s.toFinset :=
  rfl
#align cycle.to_finset_to_multiset Cycle.toFinset_toMultiset

@[simp]
theorem coe_toFinset (l : List α) : (l : Cycle α).toFinset = l.toFinset :=
  rfl
#align cycle.coe_to_finset Cycle.coe_toFinset

@[simp]
theorem nil_toFinset : (@nil α).toFinset = ∅ :=
  rfl
#align cycle.nil_to_finset Cycle.nil_toFinset

@[simp]
theorem toFinset_eq_nil {s : Cycle α} : s.toFinset = ∅ ↔ s = Cycle.nil :=
  Quotient.inductionOn' s (by simp)
#align cycle.to_finset_eq_nil Cycle.toFinset_eq_nil

/-- Given a `s : Cycle α` such that `Nodup s`, retrieve the next element after `x ∈ s`. -/
nonrec def next : ∀ (s : Cycle α) (_hs : Nodup s) (x : α) (_hx : x ∈ s), α := fun s =>
  Quot.hrecOn (motive := fun (s : Cycle α) => ∀ (_hs : Cycle.Nodup s) (x : α) (_hx : x ∈ s), α) s
  (fun l _hn x hx => next l x hx) fun l₁ l₂ h =>
    Function.hfunext (propext h.nodup_iff) fun h₁ h₂ _he =>
      Function.hfunext rfl fun x y hxy =>
        Function.hfunext (propext (by rw [eq_of_heq hxy]; simpa [eq_of_heq hxy] using h.mem_iff))
  fun hm hm' he' => heq_of_eq
    (by rw [heq_iff_eq] at hxy; subst x; simpa using isRotated_next_eq h h₁ _)
#align cycle.next Cycle.next

/-- Given a `s : Cycle α` such that `Nodup s`, retrieve the previous element before `x ∈ s`. -/
nonrec def prev : ∀ (s : Cycle α) (_hs : Nodup s) (x : α) (_hx : x ∈ s), α := fun s =>
  Quot.hrecOn (motive := fun (s : Cycle α) => ∀ (_hs : Cycle.Nodup s) (x : α) (_hx : x ∈ s), α) s
  (fun l _hn x hx => prev l x hx) fun l₁ l₂ h =>
    Function.hfunext (propext h.nodup_iff) fun h₁ h₂ _he =>
      Function.hfunext rfl fun x y hxy =>
        Function.hfunext (propext (by rw [eq_of_heq hxy]; simpa [eq_of_heq hxy] using h.mem_iff))
  fun hm hm' he' => heq_of_eq
    (by rw [heq_iff_eq] at hxy; subst x; simpa using isRotated_prev_eq h h₁ _)
#align cycle.prev Cycle.prev

--Porting note: removed `simp` and added `prev_reverse_eq_next'` with `simp` attribute
nonrec theorem prev_reverse_eq_next (s : Cycle α) : ∀ (hs : Nodup s) (x : α) (hx : x ∈ s),
    s.reverse.prev (nodup_reverse_iff.mpr hs) x (mem_reverse_iff.mpr hx) = s.next hs x hx :=
  Quotient.inductionOn' s prev_reverse_eq_next
#align cycle.prev_reverse_eq_next Cycle.prev_reverse_eq_next

--Porting note: new theorem
@[simp]
nonrec theorem prev_reverse_eq_next' (s : Cycle α) (hs : Nodup s.reverse) (x : α)
    (hx : x ∈ s.reverse) :
    s.reverse.prev hs x hx = s.next (nodup_reverse_iff.mp hs) x (mem_reverse_iff.mp hx) :=
  prev_reverse_eq_next s (nodup_reverse_iff.mp hs) x (mem_reverse_iff.mp hx)

--Porting note: removed `simp` and added `next_reverse_eq_prev'` with `simp` attribute
theorem next_reverse_eq_prev (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s) :
    s.reverse.next (nodup_reverse_iff.mpr hs) x (mem_reverse_iff.mpr hx) = s.prev hs x hx := by
  simp [← prev_reverse_eq_next]
#align cycle.next_reverse_eq_prev Cycle.next_reverse_eq_prev

--Porting note: new theorem
@[simp]
theorem next_reverse_eq_prev' (s : Cycle α) (hs : Nodup s.reverse) (x : α) (hx : x ∈ s.reverse) :
    s.reverse.next hs x hx = s.prev (nodup_reverse_iff.mp hs) x (mem_reverse_iff.mp hx) := by
  simp [← prev_reverse_eq_next]

@[simp]
nonrec theorem next_mem (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s) : s.next hs x hx ∈ s := by
  induction s using Quot.inductionOn
  apply next_mem; assumption
#align cycle.next_mem Cycle.next_mem

theorem prev_mem (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s) : s.prev hs x hx ∈ s :=
  by
  rw [← next_reverse_eq_prev, ← mem_reverse_iff]
  apply next_mem
#align cycle.prev_mem Cycle.prev_mem

@[simp]
nonrec theorem prev_next (s : Cycle α) : ∀ (hs : Nodup s) (x : α) (hx : x ∈ s),
    s.prev hs (s.next hs x hx) (next_mem s hs x hx) = x :=
  Quotient.inductionOn' s prev_next
#align cycle.prev_next Cycle.prev_next

@[simp]
nonrec theorem next_prev (s : Cycle α) : ∀ (hs : Nodup s) (x : α) (hx : x ∈ s),
    s.next hs (s.prev hs x hx) (prev_mem s hs x hx) = x :=
  Quotient.inductionOn' s next_prev
#align cycle.next_prev Cycle.next_prev

end Decidable

/-- We define a representation of concrete cycles, available when viewing them in a goal state or
via `#eval`, when over representable types. For example, the cycle `(2 1 4 3)` will be shown
as `c[2, 1, 4, 3]`. Two equal cycles may be printed differently if their internal representation
is different.
-/
unsafe instance [Repr α] : Repr (Cycle α) :=
  ⟨fun s _ => "c[" ++ Std.Format.joinSep (s.map repr).lists.unquot.head! ", " ++ "]"⟩

/-- `chain R s` means that `R` holds between adjacent elements of `s`.

`chain R ([a, b, c] : Cycle α) ↔ R a b ∧ R b c ∧ R c a` -/
nonrec def Chain (r : α → α → Prop) (c : Cycle α) : Prop :=
  Quotient.liftOn' c
    (fun l =>
      match l with
      | [] => True
      | a :: m => Chain r a (m ++ [a]))
    fun a b hab =>
    propext <| by
      cases' a with a l <;> cases' b with b m
      · rfl
      · have := isRotated_nil_iff'.1 hab
        contradiction
      · have := isRotated_nil_iff.1 hab
        contradiction
      · dsimp only
        cases' hab with n hn
        induction' n with d hd generalizing a b l m
        · simp only [Nat.zero_eq, rotate_zero, cons.injEq] at hn
          rw [hn.1, hn.2]
        · cases' l with c s
          · simp only [rotate_cons_succ, nil_append, rotate_singleton, cons.injEq] at hn
            rw [hn.1, hn.2]
          · rw [Nat.succ_eq_one_add, ← rotate_rotate, rotate_cons_succ, rotate_zero,
              cons_append] at hn
            rw [← hd c _ _ _ hn]
            simp [and_comm]
#align cycle.chain Cycle.Chain

@[simp]
theorem Chain.nil (r : α → α → Prop) : Cycle.Chain r (@nil α) := by trivial
#align cycle.chain.nil Cycle.Chain.nil

@[simp]
theorem chain_coe_cons (r : α → α → Prop) (a : α) (l : List α) :
    Chain r (a :: l) ↔ List.Chain r a (l ++ [a]) :=
  Iff.rfl
#align cycle.chain_coe_cons Cycle.chain_coe_cons

--@[simp] Porting note: `simp` can prove it
theorem chain_singleton (r : α → α → Prop) (a : α) : Chain r [a] ↔ r a a := by
  rw [chain_coe_cons, nil_append, List.chain_singleton]
#align cycle.chain_singleton Cycle.chain_singleton

theorem chain_ne_nil (r : α → α → Prop) {l : List α} :
    ∀ hl : l ≠ [], Chain r l ↔ List.Chain r (getLast l hl) l :=
  l.reverseRecOn (fun hm => hm.irrefl.elim) (by
    intro m a _H _
    rw [← coe_cons_eq_coe_append, chain_coe_cons, getLast_append_singleton])
#align cycle.chain_ne_nil Cycle.chain_ne_nil

theorem chain_map {β : Type _} {r : α → α → Prop} (f : β → α) {s : Cycle β} :
    Chain r (s.map f) ↔ Chain (fun a b => r (f a) (f b)) s :=
  Quotient.inductionOn' s fun l => by
    cases' l with a l
    rfl
    dsimp only [Chain, ← mk''_eq_coe, Quotient.liftOn'_mk'', Cycle.map, Quotient.map', Quot.map,
      Quotient.mk'', Quotient.liftOn', Quotient.liftOn, Quot.liftOn_mk, List.map]
    rw [← concat_eq_append, ← List.map_concat, List.chain_map f]
    simp
#align cycle.chain_map Cycle.chain_map

nonrec theorem chain_range_succ (r : ℕ → ℕ → Prop) (n : ℕ) :
    Chain r (List.range n.succ) ↔ r n 0 ∧ ∀ m < n, r m m.succ := by
  rw [range_succ, ← coe_cons_eq_coe_append, chain_coe_cons, ← range_succ, chain_range_succ]
#align cycle.chain_range_succ Cycle.chain_range_succ

variable {r : α → α → Prop} {s : Cycle α}

theorem chain_of_pairwise : (∀ a ∈ s, ∀ b ∈ s, r a b) → Chain r s := by
  induction' s using Cycle.induction_on with a l _
  exact fun _ => Cycle.Chain.nil r
  intro hs
  have Ha : a ∈ (a :: l : Cycle α) := by simp
  have Hl : ∀ {b} (_hb : b ∈ l), b ∈ (a :: l : Cycle α) := @fun b hb => by simp [hb]
  rw [Cycle.chain_coe_cons]
  apply Pairwise.chain
  rw [pairwise_cons]
  refine'
    ⟨fun b hb => _,
      pairwise_append.2
        ⟨pairwise_of_forall_mem_list fun b hb c hc => hs b (Hl hb) c (Hl hc),
          pairwise_singleton r a, fun b hb c hc => _⟩⟩
  · rw [mem_append] at hb
    cases' hb with hb hb
    · exact hs a Ha b (Hl hb)
    · rw [mem_singleton] at hb
      rw [hb]
      exact hs a Ha a Ha
  · rw [mem_singleton] at hc
    rw [hc]
    exact hs b (Hl hb) a Ha
#align cycle.chain_of_pairwise Cycle.chain_of_pairwise

theorem chain_iff_pairwise [IsTrans α r] : Chain r s ↔ ∀ a ∈ s, ∀ b ∈ s, r a b :=
  ⟨by
    induction' s using Cycle.induction_on with a l _
    · exact fun _ b hb => (not_mem_nil _ hb).elim
    intro hs b hb c hc
    rw [Cycle.chain_coe_cons, List.chain_iff_pairwise] at hs
    simp only [pairwise_append, pairwise_cons, mem_append, mem_singleton, List.not_mem_nil,
      IsEmpty.forall_iff, imp_true_iff, Pairwise.nil, forall_eq, true_and_iff] at hs
    simp only [mem_coe_iff, mem_cons] at hb hc
    rcases hb with (rfl | hb) <;> rcases hc with (rfl | hc)
    · exact hs.1 c (Or.inr rfl)
    · exact hs.1 c (Or.inl hc)
    · exact hs.2.2 b hb
    · exact _root_.trans (hs.2.2 b hb) (hs.1 c (Or.inl hc)), Cycle.chain_of_pairwise⟩
#align cycle.chain_iff_pairwise Cycle.chain_iff_pairwise

theorem forall_eq_of_chain [IsTrans α r] [IsAntisymm α r] (hs : Chain r s) {a b : α} (ha : a ∈ s)
    (hb : b ∈ s) : a = b := by
  rw [chain_iff_pairwise] at hs
  exact antisymm (hs a ha b hb) (hs b hb a ha)
#align cycle.forall_eq_of_chain Cycle.forall_eq_of_chain

end Cycle


/- Type classes -/

namespace tp

  structure Add1 (α : Type u) where
    add : α → α → α

  def double (s : Add1 α) (x : α) :=
    s.add x x

  #eval double {add := Nat.add} 10 -- 20

  class Add (α : Type u) where
    add : α → α → α

  instance : Add Nat where
    add := Nat.add

  instance [Add α] : Add (Array α) where
    add x y := Array.zipWith x y (Add.add . .)

  #eval Add.add #[1, 2] #[3, 4] -- #[4, 6]

  namespace Ex

    class Inhabited (α : Type u) where
      default : α

    instance : Inhabited Bool where
      default := true

    instance : Inhabited Nat where
      default := 0

    export Inhabited (default)

    #eval (default : Nat)  -- 0
    #eval (default : Bool) -- true

  end Ex
end tp

/- Chaining Instances -/

namespace ci

  instance [Inhabited α] [Inhabited β] : Inhabited (α × β) where
    default := (default, default)

  #eval (default : Nat × Bool) -- (0, false)

  instance [Inhabited β] : Inhabited (α → β) where
    default := fun _ => default

  instance [Inhabited α] : Inhabited (List α) where
    default := [default]

  #eval (default : List Nat) -- [0]

  instance [Inhabited α] : Inhabited (Sum α β) where
    default := Sum.inl default

  #print inferInstance

end ci

/- ToString -/

namespace ts

  structure Person where
    name : String
    age : Nat

  instance : ToString Person where
    toString p := p.name ++ "@" ++ toString p.age

  #eval toString ({name := "Leo", age := 25 : Person}, 10) -- "(Leo@25, 10)"
end ts

/- Numerals -/

namespace num

  structure Rational where
    num : Int
    den : Nat
    inv : den ≠ 0

  instance : OfNat Rational n where
    ofNat := {num := n, den := 1, inv := by decide}

  instance : ToString Rational where
    toString r := s!"{r.num}/{r.den}"

  #eval (2 : Rational) -- 2/1

  class Monoid (α : Type u) where
    unit : α
    op : α → α → α

  instance [s : Monoid α] : OfNat α (nat_lit 1) where
    ofNat := s.unit

  def getUnit [Monoid α] : α :=
    1

end num

/- Output Parameters -/

namespace op

  class HMul (α : Type u) (β : Type v) (γ : outParam (Type w)) where
    hMul : α → β → γ

  export HMul (hMul)

  instance : HMul Nat Nat Nat where
    hMul := Nat.mul

  instance [HMul α β γ]: HMul α (Array β) (Array γ) where
    hMul a bs := bs.map (fun b => hMul a b)

  #eval hMul 3 #[1, 2] -- #[3, 6]

  #eval hMul 3 #[#[1, 2], #[3]] -- #[#[3, 6], #[9]]

end op

/- Defalut instances -/

namespace di

  class HMul (α : Type u) (β : Type v) (γ : outParam (Type w)) where
    hMul : α → β → γ

  export HMul (hMul)

  @[defaultInstance]
  instance : HMul Int Int Int where
    hMul := Int.mul

  #check (fun y => [1, 2].map (fun x => hMul y x)) -- Int → List Int

  class Mul (α : Type u) where
    mul : α → α → α

  @[defaultInstance 10]
  instance [Mul α] : HMul α α α  where
    hMul := Mul.mul

end di

/- Local Instances -/

namespace li

  structure Point where
    x : Nat
    y : Nat

  section
    local instance addPoint : Add Point where
      add p q := {x := p.x + q.x, y:= p.y + q.y}

    attribute [-instance] addPoint
  end
end li

/- Scoped Instances -/

namespace si

  structure Point where
    x : Nat
    y : Nat

  namespace Point
    scoped instance addPoint : Add Point where
      add p q := {x := p.x + q.x, y:= p.y + q.y}
  end Point

end si

/- Decidable Propositions -/

namespace dp

  class inductive Decidable (p : Prop) where
  | isFalse (h : ¬ p) : Decidable p
  | isTrue (h : p) : Decidable p

  def ite {α : Sort u} (c : Prop) [h : Decidable c] (t e : α) : α :=
    match h with
    | Decidable.isTrue _  => t
    | Decidable.isFalse _ => e

  def dite {α : Sort u} (c : Prop) [h : Decidable c] (t : c → α) (e : ¬ c → α) : α :=
    match h with
    | Decidable.isTrue c => t c
    | Decidable.isFalse nc => e nc

  example : ¬ (True ∧ False) := by decide

end dp

/- Managing Type Class Inference -/

namespace mtci

  def foo : Inhabited (Nat → Nat) := inferInstance

  def Set (α : Type u) := α → Prop

  example : Inhabited (Set α) :=
    inferInstanceAs (Inhabited (α → Prop))

end mtci

/- Coercions using Type Classes-/

namespace coer

  instance : Coe Bool Prop where
    coe b := b = true

  #eval if true then 5 else 3 -- 5

  def Set (α : Type u) := α → Prop
  def Set.empty {α : Type u} : Set α := fun _ => False
  def Set.mem (a : α) (s : Set α) : Prop := s a
  def Set.singleton (a : α) : Set α := fun x => x = a
  def Set.union (a b : Set α) : Set α := fun x => a x ∨ b x
  notation "{" a "}" => Set.singleton a
  infix:55 " ∪ " => Set.union

  def List.toSet : List α → Set α
    | []    => Set.empty
    | a::as => {a} ∪ toSet as

  instance : Coe (List α) (Set α) where
    coe as := List.toSet as

  /-
  {1} ∪ List.toSet [1, 2] : Set Nat
  -/
  #check {1} ∪ ↑[1, 2]

  instance (p : Prop) [Decidable p] : CoeDep Prop p Bool where
    coe := decide p

  structure Semigroup where
    carrier : Type u
    mul : carrier → carrier → carrier
    mul_assoc (a b c : carrier) : mul (mul a b) c = mul a (mul b c)

  instance (S : Semigroup) : Mul S.carrier where
    mul := S.mul

  instance : CoeSort Semigroup (Type u) where
    coe s := s.carrier

  example (S : Semigroup) (a b c : S) : (a * b) * c = a * (b * c) :=
    S.mul_assoc a b c

  structure Morphism (S1 S2 : Semigroup) where
    mor : S1 → S2
    resp_mul : ∀ a b : S1, mor (a * b) = mor a * mor b

  #check @Morphism.mor

  instance (S1 S2 : Semigroup) : CoeFun (Morphism S1 S2) (fun _ => S1 → S2) where
    coe m := m.mor

  theorem resp_mul {S1 S2 : Semigroup} (f : Morphism S1 S2) (a b : S1)
      : f (a * b) = f a * f b := f.resp_mul a b

  example {S1 S2 : Semigroup} (f : Morphism S1 S2) (a : S1)
      : f (a * a * a) = f a * f a * f a := by simp only [resp_mul]

end coer


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.fp.basic
! leanprover-community/mathlib commit 7b78d1776212a91ecc94cf601f83bdcc46b04213
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Semiquot
import Mathlib.Data.Rat.Floor

/-!
# Implementation of floating-point numbers (experimental).
-/

-- Porting note: TODO add docs and remove `@[nolint docBlame]`

@[nolint docBlame]
def Int.shift2 (a b : ℕ) : ℤ → ℕ × ℕ
  | Int.ofNat e => (a.shiftl e, b)
  | Int.negSucc e => (a, b.shiftl e.succ)
#align int.shift2 Int.shift2

namespace FP

@[nolint docBlame]
inductive RMode
  | NE -- round to nearest even
  deriving Inhabited
#align fp.rmode FP.RMode

@[nolint docBlame]
class FloatCfg where
  (prec emax : ℕ)
  precPos : 0 < prec
  precMax : prec ≤ emax
attribute [nolint docBlame] FloatCfg.prec FloatCfg.emax FloatCfg.precPos FloatCfg.precMax
#align fp.float_cfg FP.FloatCfg

variable [C : FloatCfg]

@[nolint docBlame]
def prec :=
  C.prec
#align fp.prec FP.prec

@[nolint docBlame]
def emax :=
  C.emax
#align fp.emax FP.emax

@[nolint docBlame]
def emin : ℤ :=
  1 - C.emax
#align fp.emin FP.emin

@[nolint docBlame]
def ValidFinite (e : ℤ) (m : ℕ) : Prop :=
  emin ≤ e + prec - 1 ∧ e + prec - 1 ≤ emax ∧ e = max (e + m.size - prec) emin
#align fp.valid_finite FP.ValidFinite

instance decValidFinite (e m) : Decidable (ValidFinite e m) := by
  (unfold ValidFinite; infer_instance)
#align fp.dec_valid_finite FP.decValidFinite

@[nolint docBlame]
inductive Float
  | inf : Bool → Float
  | nan : Float
  | finite : Bool → ∀ e m, ValidFinite e m → Float
#align fp.float FP.Float

@[nolint docBlame]
def Float.isFinite : Float → Bool
  | Float.finite _ _ _ _ => true
  | _ => false
#align fp.float.is_finite FP.Float.isFinite

@[nolint docBlame]
def toRat : ∀ f : Float, f.isFinite → ℚ
  | Float.finite s e m _, _ =>
    let (n, d) := Int.shift2 m 1 e
    let r := mkRat n d
    if s then -r else r
#align fp.to_rat FP.toRat

theorem Float.Zero.valid : ValidFinite emin 0 :=
  ⟨by
    rw [add_sub_assoc]
    apply le_add_of_nonneg_right
    apply sub_nonneg_of_le
    apply Int.ofNat_le_ofNat_of_le
    exact C.precPos,
    suffices prec ≤ 2 * emax by
      rw [← Int.ofNat_le] at this
      rw [← sub_nonneg] at *
      simp only [emin, emax] at *
      ring_nf
      rw [mul_comm]
      assumption
    le_trans C.precMax (Nat.le_mul_of_pos_left (by decide)),
    by (rw [max_eq_right]; simp [sub_eq_add_neg])⟩
#align fp.float.zero.valid FP.Float.Zero.valid

@[nolint docBlame]
def Float.zero (s : Bool) : Float :=
  Float.finite s emin 0 Float.Zero.valid
#align fp.float.zero FP.Float.zero

instance : Inhabited Float :=
  ⟨Float.zero true⟩

@[nolint docBlame]
protected def Float.sign' : Float → Semiquot Bool
  | Float.inf s => pure s
  | Float.nan => ⊤
  | Float.finite s _ _ _ => pure s
#align fp.float.sign' FP.Float.sign'

@[nolint docBlame]
protected def Float.sign : Float → Bool
  | Float.inf s => s
  | Float.nan => false
  | Float.finite s _ _ _ => s
#align fp.float.sign FP.Float.sign

@[nolint docBlame]
protected def Float.isZero : Float → Bool
  | Float.finite _ _ 0 _ => true
  | _ => false
#align fp.float.is_zero FP.Float.isZero

@[nolint docBlame]
protected def Float.neg : Float → Float
  | Float.inf s => Float.inf (not s)
  | Float.nan => Float.nan
  | Float.finite s e m f => Float.finite (not s) e m f
#align fp.float.neg FP.Float.neg

@[nolint docBlame]
def divNatLtTwoPow (n d : ℕ) : ℤ → Bool
  | Int.ofNat e => n < d.shiftl e
  | Int.negSucc e => n.shiftl e.succ < d
#align fp.div_nat_lt_two_pow FP.divNatLtTwoPowₓ -- Porting note: TC argument `[C : FP.FloatCfg]` no longer present

-- TODO(Mario): Prove these and drop 'unsafe'
@[nolint docBlame]
unsafe def ofPosRatDn (n : ℕ+) (d : ℕ+) : Float × Bool := by
  let e₁ : ℤ := n.1.size - d.1.size - prec
  cases' h₁ : Int.shift2 d.1 n.1 (e₁ + prec) with d₁ n₁
  let e₂ := if n₁ < d₁ then e₁ - 1 else e₁
  let e₃ := max e₂ emin
  cases' h₂ : Int.shift2 d.1 n.1 (e₃ + prec) with d₂ n₂
  let r := mkRat n₂ d₂
  let m := r.floor
  refine' (Float.finite Bool.false e₃ (Int.toNat m) _, r.den = 1)
  · exact lcProof
#align fp.of_pos_rat_dn FP.ofPosRatDn

-- Porting note: remove this line when you dropped 'lcProof'
set_option linter.unusedVariables false in
@[nolint docBlame]
unsafe def nextUpPos (e m) (v : ValidFinite e m) : Float :=
  let m' := m.succ
  if ss : m'.size = m.size then
    Float.finite false e m' (by unfold ValidFinite at *; rw [ss]; exact v)
  else if h : e = emax then Float.inf false else Float.finite false e.succ (Nat.div2 m') lcProof
#align fp.next_up_pos FP.nextUpPos

set_option linter.deprecated false in
-- Porting note: remove this line when you dropped 'lcProof'
set_option linter.unusedVariables false in
@[nolint docBlame]
unsafe def nextDnPos (e m) (v : ValidFinite e m) : Float :=
  match m with
  | 0 => nextUpPos _ _ Float.Zero.valid
  | Nat.succ m' =>
    -- Porting note: was `m'.size = m.size`
    if ss : m'.size = m'.succ.size then
      Float.finite false e m' (by unfold ValidFinite at *; rw [ss]; exact v)
    else
      if h : e = emin then Float.finite false emin m' lcProof
      else Float.finite false e.pred (bit1 m') lcProof
#align fp.next_dn_pos FP.nextDnPos

@[nolint docBlame]
unsafe def nextUp : Float → Float
  | Float.finite Bool.false e m f => nextUpPos e m f
  | Float.finite Bool.true e m f => Float.neg <| nextDnPos e m f
  | f => f
#align fp.next_up FP.nextUp

@[nolint docBlame]
unsafe def nextDn : Float → Float
  | Float.finite Bool.false e m f => nextDnPos e m f
  | Float.finite Bool.true e m f => Float.neg <| nextUpPos e m f
  | f => f
#align fp.next_dn FP.nextDn

@[nolint docBlame]
unsafe def ofRatUp : ℚ → Float
  | ⟨0, _, _, _⟩ => Float.zero false
  | ⟨Nat.succ n, d, h, _⟩ =>
    let (f, exact) := ofPosRatDn n.succPNat ⟨d, Nat.pos_of_ne_zero h⟩
    if exact then f else nextUp f
  | ⟨Int.negSucc n, d, h, _⟩ => Float.neg (ofPosRatDn n.succPNat ⟨d, Nat.pos_of_ne_zero h⟩).1
#align fp.of_rat_up FP.ofRatUp

@[nolint docBlame]
unsafe def ofRatDn (r : ℚ) : Float :=
  Float.neg <| ofRatUp (-r)
#align fp.of_rat_dn FP.ofRatDn

@[nolint docBlame]
unsafe def ofRat : RMode → ℚ → Float
  | RMode.NE, r =>
    let low := ofRatDn r
    let high := ofRatUp r
    if hf : high.isFinite then
      if r = toRat _ hf then high
      else
        if lf : low.isFinite then
          if r - toRat _ lf > toRat _ hf - r then high
          else
            if r - toRat _ lf < toRat _ hf - r then low
            else
              match low, lf with
              | Float.finite _ _ m _, _ => if 2 ∣ m then low else high
        else Float.inf true
    else Float.inf false
#align fp.of_rat FP.ofRat

namespace Float

instance : Neg Float :=
  ⟨Float.neg⟩

@[nolint docBlame]
unsafe def add (mode : RMode) : Float → Float → Float
  | nan, _ => nan
  | _, nan => nan
  | inf Bool.true, inf Bool.false=> nan
  | inf Bool.false, inf Bool.true => nan
  | inf s₁, _ => inf s₁
  | _, inf s₂ => inf s₂
  | finite s₁ e₁ m₁ v₁, finite s₂ e₂ m₂ v₂ =>
    let f₁ := finite s₁ e₁ m₁ v₁
    let f₂ := finite s₂ e₂ m₂ v₂
    ofRat mode (toRat f₁ rfl + toRat f₂ rfl)
#align fp.float.add FP.Float.add

unsafe instance : Add Float :=
  ⟨Float.add RMode.NE⟩

@[nolint docBlame]
unsafe def sub (mode : RMode) (f1 f2 : Float) : Float :=
  add mode f1 (-f2)
#align fp.float.sub FP.Float.sub

unsafe instance : Sub Float :=
  ⟨Float.sub RMode.NE⟩

@[nolint docBlame]
unsafe def mul (mode : RMode) : Float → Float → Float
  | nan, _ => nan
  | _, nan => nan
  | inf s₁, f₂ => if f₂.isZero then nan else inf (xor s₁ f₂.sign)
  | f₁, inf s₂ => if f₁.isZero then nan else inf (xor f₁.sign s₂)
  | finite s₁ e₁ m₁ v₁, finite s₂ e₂ m₂ v₂ =>
    let f₁ := finite s₁ e₁ m₁ v₁
    let f₂ := finite s₂ e₂ m₂ v₂
    ofRat mode (toRat f₁ rfl * toRat f₂ rfl)
#align fp.float.mul FP.Float.mul

@[nolint docBlame]
unsafe def div (mode : RMode) : Float → Float → Float
  | nan, _ => nan
  | _, nan => nan
  | inf _, inf _ => nan
  | inf s₁, f₂ => inf (xor s₁ f₂.sign)
  | f₁, inf s₂ => zero (xor f₁.sign s₂)
  | finite s₁ e₁ m₁ v₁, finite s₂ e₂ m₂ v₂ =>
    let f₁ := finite s₁ e₁ m₁ v₁
    let f₂ := finite s₂ e₂ m₂ v₂
    if f₂.isZero then inf (xor s₁ s₂) else ofRat mode (toRat f₁ rfl / toRat f₂ rfl)
#align fp.float.div FP.Float.div

end Float

end FP


def Set (α : Type u) := α → Prop

def setOf {α : Type u} (p : α → Prop) : Set α :=
p

namespace Set

protected def mem (a : α) (s : Set α) :=
s a

instance : Membership α (Set α) :=
⟨Set.mem⟩

theorem ext {a b : Set α} (h : ∀ (x : α), x ∈ a ↔ x ∈ b) : a = b :=
funext (fun x => propext (h x))

protected def subset (s₁ s₂ : Set α) :=
∀ {a}, a ∈ s₁ → a ∈ s₂

class Subset (α : Type u) where
  /-- Subset relation: `a ⊆ b`  -/
  subset : α → α → Prop

/-- Subset relation: `a ⊆ b`  -/
infix:50 " ⊆ " => Subset.subset

instance : Subset (Set α) :=
⟨Set.subset⟩

instance : EmptyCollection (Set α) :=
⟨λ _ => False⟩

example (U : Type) (A B : Set U) : A ⊆ B → A = A :=
  fun h =>
  match @h with | (h : A ⊆ B) => sorry

example (U : Type) (A B : Set U) : A ⊆ B → A = A := by
  intro (h : A ⊆ B)
  sorry


macro_rules | `(tactic| rfl) => `(tactic| exact Iff.rfl)

theorem r (A : Prop) : A ↔ A := by rfl

theorem s (A B : Prop) (h : A ↔ B) : B ↔ A := by
  rw [h]


/-
Copyright (c) 2015 Nathaniel Thomas. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.big_operators.basic
import Mathlib.algebra.group.hom
import Mathlib.algebra.ring.basic
import Mathlib.data.rat.cast
import Mathlib.group_theory.group_action.group
import Mathlib.tactic.nth_rewrite.default
import Mathlib.PostPort

universes u v l w x z u_1 u_2 u_3

namespace Mathlib

/-!
# Modules over a ring

In this file we define

* `semimodule R M` : an additive commutative monoid `M` is a `semimodule` over a
  `semiring` `R` if for `r : R` and `x : M` their "scalar multiplication `r • x : M` is defined, and
  the operation `•` satisfies some natural associativity and distributivity axioms similar to those
  on a ring.

* `module R M` : same as `semimodule R M` but assumes that `R` is a `ring` and `M` is an
  additive commutative group.

* `vector_space k M` : same as `semimodule k M` and `module k M` but assumes that `k` is a `field`
  and `M` is an additive commutative group.

* `linear_map R M M₂`, `M →ₗ[R] M₂` : a linear map between two R-`semimodule`s.

## Implementation notes

* `vector_space` and `module` are abbreviations for `semimodule R M`.

## Tags

semimodule, module, vector space
-/

/-- A semimodule is a generalization of vector spaces to a scalar semiring.
  It consists of a scalar semiring `R` and an additive monoid of "vectors" `M`,
  connected by a "scalar multiplication" operation `r • x : M`
  (where `r : R` and `x : M`) with some natural associativity and
  distributivity axioms similar to those on a ring. -/
class semimodule (R : Type u) (M : Type v) [semiring R] [add_comm_monoid M]
    extends distrib_mul_action R M where
  add_smul : ∀ (r s : R) (x : M), (r + s) • x = r • x + s • x
  zero_smul : ∀ (x : M), 0 • x = 0

theorem add_smul {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] (r : R)
    (s : R) (x : M) : (r + s) • x = r • x + s • x :=
  semimodule.add_smul r s x

@[simp] theorem zero_smul (R : Type u) {M : Type w} [semiring R] [add_comm_monoid M]
    [semimodule R M] (x : M) : 0 • x = 0 :=
  semimodule.zero_smul x

theorem two_smul (R : Type u) {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M]
    (x : M) : bit0 1 • x = x + x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (bit0 1 • x = x + x)) (bit0.equations._eqn_1 1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((1 + 1) • x = x + x)) (add_smul 1 1 x)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 • x + 1 • x = x + x)) (one_smul R x))) (Eq.refl (x + x))))

theorem two_smul' (R : Type u) {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M]
    (x : M) : bit0 1 • x = bit0 x :=
  two_smul R x

/-- Pullback a `semimodule` structure along an injective additive monoid homomorphism. -/
protected def function.injective.semimodule (R : Type u) {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid M₂] [has_scalar R M₂] (f : M₂ →+ M)
    (hf : function.injective ⇑f) (smul : ∀ (c : R) (x : M₂), coe_fn f (c • x) = c • coe_fn f x) :
    semimodule R M₂ :=
  semimodule.mk sorry sorry

/-- Pushforward a `semimodule` structure along a surjective additive monoid homomorphism. -/
protected def function.surjective.semimodule (R : Type u) {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid M₂] [has_scalar R M₂] (f : M →+ M₂)
    (hf : function.surjective ⇑f) (smul : ∀ (c : R) (x : M), coe_fn f (c • x) = c • coe_fn f x) :
    semimodule R M₂ :=
  semimodule.mk sorry sorry

/-- `(•)` as an `add_monoid_hom`. -/
def smul_add_hom (R : Type u) (M : Type w) [semiring R] [add_comm_monoid M] [semimodule R M] :
    R →+ M →+ M :=
  add_monoid_hom.mk (const_smul_hom M) sorry sorry

@[simp] theorem smul_add_hom_apply {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M]
    [semimodule R M] (r : R) (x : M) : coe_fn (coe_fn (smul_add_hom R M) r) x = r • x :=
  rfl

theorem semimodule.eq_zero_of_zero_eq_one {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M]
    [semimodule R M] (x : M) (zero_eq_one : 0 = 1) : x = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x = 0)) (Eq.symm (one_smul R x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 • x = 0)) (Eq.symm zero_eq_one)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 • x = 0)) (zero_smul R x))) (Eq.refl 0)))

theorem list.sum_smul {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M]
    {l : List R} {x : M} : list.sum l • x = list.sum (list.map (fun (r : R) => r • x) l) :=
  add_monoid_hom.map_list_sum (coe_fn (add_monoid_hom.flip (smul_add_hom R M)) x) l

theorem multiset.sum_smul {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M]
    [semimodule R M] {l : multiset R} {x : M} :
    multiset.sum l • x = multiset.sum (multiset.map (fun (r : R) => r • x) l) :=
  add_monoid_hom.map_multiset_sum (coe_fn (add_monoid_hom.flip (smul_add_hom R M)) x) l

theorem finset.sum_smul {R : Type u} {M : Type w} {ι : Type z} [semiring R] [add_comm_monoid M]
    [semimodule R M] {f : ι → R} {s : finset ι} {x : M} :
    (finset.sum s fun (i : ι) => f i) • x = finset.sum s fun (i : ι) => f i • x :=
  add_monoid_hom.map_sum (coe_fn (add_monoid_hom.flip (smul_add_hom R M)) x) f s

/-- An `add_comm_monoid` that is a `semimodule` over a `ring` carries a natural `add_comm_group`
structure. -/
def semimodule.add_comm_monoid_to_add_comm_group (R : Type u) {M : Type w} [ring R]
    [add_comm_monoid M] [semimodule R M] : add_comm_group M :=
  add_comm_group.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry
    (fun (a : M) => -1 • a)
    (add_group.sub._default add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry
      fun (a : M) => -1 • a)
    sorry sorry

/-- A structure containing most informations as in a semimodule, except the fields `zero_smul`
and `smul_zero`. As these fields can be deduced from the other ones when `M` is an `add_comm_group`,
this provides a way to construct a semimodule structure by checking less properties, in
`semimodule.of_core`. -/
structure semimodule.core (R : Type u) (M : Type w) [semiring R] [add_comm_group M]
    extends has_scalar R M where
  smul_add : ∀ (r : R) (x y : M), r • (x + y) = r • x + r • y
  add_smul : ∀ (r s : R) (x : M), (r + s) • x = r • x + s • x
  mul_smul : ∀ (r s : R) (x : M), (r * s) • x = r • s • x
  one_smul : ∀ (x : M), 1 • x = x

/-- Define `semimodule` without proving `zero_smul` and `smul_zero` by using an auxiliary
structure `semimodule.core`, when the underlying space is an `add_comm_group`. -/
def semimodule.of_core {R : Type u} {M : Type w} [semiring R] [add_comm_group M]
    (H : semimodule.core R M) : semimodule R M :=
  semimodule.mk (semimodule.core.add_smul H) sorry

/--
Modules are defined as an `abbreviation` for semimodules,
if the base semiring is a ring.
(A previous definition made `module` a structure
defined to be `semimodule`.)
This has as advantage that modules are completely transparent
for type class inference, which means that all instances for semimodules
are immediately picked up for modules as well.
A cosmetic disadvantage is that one can not extend modules as such,
in definitions such as `normed_space`.
The solution is to extend `semimodule` instead.
-/
/-- A module is the same as a semimodule, except the scalar semiring is actually
  a ring.
  This is the traditional generalization of spaces like `ℤ^n`, which have a natural
  addition operation and a way to multiply them by elements of a ring, but no multiplication
  operation between vectors. -/
def module (R : Type u) (M : Type v) [ring R] [add_comm_group M] := semimodule R M

/--
To prove two semimodule structures on a fixed `add_comm_monoid` agree,
it suffices to check the scalar multiplications agree.
-/
-- We'll later use this to show `semimodule ℕ M` and `module ℤ M` are subsingletons.

theorem semimodule_ext {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    (P : semimodule R M) (Q : semimodule R M) (w : ∀ (r : R) (m : M), r • m = r • m) : P = Q :=
  sorry

@[simp] theorem neg_smul {R : Type u} {M : Type w} [ring R] [add_comm_group M] [module R M] (r : R)
    (x : M) : -r • x = -(r • x) :=
  sorry

theorem neg_one_smul (R : Type u) {M : Type w} [ring R] [add_comm_group M] [module R M] (x : M) :
    -1 • x = -x :=
  sorry

theorem sub_smul {R : Type u} {M : Type w} [ring R] [add_comm_group M] [module R M] (r : R) (s : R)
    (y : M) : (r - s) • y = r • y - s • y :=
  sorry

theorem smul_eq_zero {R : Type u_1} {E : Type u_2} [division_ring R] [add_comm_group E] [module R E]
    {c : R} {x : E} : c • x = 0 ↔ c = 0 ∨ x = 0 :=
  sorry

/-- A semimodule over a `subsingleton` semiring is a `subsingleton`. We cannot register this
as an instance because Lean has no way to guess `R`. -/
theorem semimodule.subsingleton (R : Type u_1) (M : Type u_2) [semiring R] [subsingleton R]
    [add_comm_monoid M] [semimodule R M] : subsingleton M :=
  sorry

protected instance semiring.to_semimodule {R : Type u} [semiring R] : semimodule R R :=
  semimodule.mk sorry sorry

@[simp] theorem smul_eq_mul {R : Type u} [semiring R] {a : R} {a' : R} : a • a' = a * a' := rfl

/-- A ring homomorphism `f : R →+* M` defines a module structure by `r • x = f r * x`. -/
def ring_hom.to_semimodule {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) :
    semimodule R S :=
  semimodule.mk sorry sorry

/--
Vector spaces are defined as an `abbreviation` for semimodules,
if the base ring is a field.
(A previous definition made `vector_space` a structure
defined to be `module`.)
This has as advantage that vector spaces are completely transparent
for type class inference, which means that all instances for semimodules
are immediately picked up for vector spaces as well.
A cosmetic disadvantage is that one can not extend vector spaces as such,
in definitions such as `normed_space`.
The solution is to extend `semimodule` instead.
-/
/-- A vector space is the same as a module, except the scalar ring is actually
  a field. (This adds commutativity of the multiplication and existence of inverses.)
  This is the traditional generalization of spaces like `ℝ^n`, which have a natural
  addition operation and a way to multiply them by real numbers, but no multiplication
  operation between vectors. -/
def vector_space (R : Type u) (M : Type v) [field R] [add_comm_group M] := semimodule R M

/-- The natural ℕ-semimodule structure on any `add_comm_monoid`. -/
-- We don't make this a global instance, as it results in too many instances,

-- and confusing ambiguity in the notation `n • x` when `n : ℕ`.

instance add_comm_monoid.nat_semimodule {M : Type w} [add_comm_monoid M] : semimodule ℕ M :=
  semimodule.mk sorry sorry

/-- `nsmul` is defined as the `smul` action of `add_comm_monoid.nat_semimodule`. -/
theorem nsmul_def {M : Type w} [add_comm_monoid M] (n : ℕ) (x : M) : n •ℕ x = n • x := rfl

/-- `nsmul` is equal to any other semimodule structure via a cast. -/
theorem nsmul_eq_smul_cast (R : Type u) {M : Type w} [semiring R] [add_comm_monoid M]
    [semimodule R M] (n : ℕ) (b : M) : n •ℕ b = ↑n • b :=
  sorry

/-- `nsmul` is equal to any `ℕ`-semimodule structure. -/
theorem nsmul_eq_smul {M : Type w} [add_comm_monoid M] [semimodule ℕ M] (n : ℕ) (b : M) :
    n •ℕ b = n • b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n •ℕ b = n • b)) (nsmul_eq_smul_cast ℕ n b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n • b = n • b)) (nat.cast_id n))) (Eq.refl (n • b)))

/-- All `ℕ`-semimodule structures are equal. -/
protected instance add_comm_monoid.nat_semimodule.subsingleton {M : Type w} [add_comm_monoid M] :
    subsingleton (semimodule ℕ M) :=
  subsingleton.intro
    fun (P Q : semimodule ℕ M) =>
      semimodule_ext P Q
        fun (n : ℕ) (m : M) =>
          eq.mpr (id (Eq._oldrec (Eq.refl (n • m = n • m)) (Eq.symm (nsmul_eq_smul n m))))
            (eq.mpr (id (Eq._oldrec (Eq.refl (n •ℕ m = n • m)) (Eq.symm (nsmul_eq_smul n m))))
              (Eq.refl (n •ℕ m)))

/-- Note this does not depend on the `nat_semimodule` definition above, to avoid issues when
diamonds occur in finding `semimodule ℕ M` instances. -/
protected instance add_comm_monoid.nat_is_scalar_tower {R : Type u} {M : Type w} [semiring R]
    [add_comm_monoid M] [semimodule R M] [semimodule ℕ R] [semimodule ℕ M] :
    is_scalar_tower ℕ R M :=
  sorry

protected instance add_comm_monoid.nat_smul_comm_class {R : Type u} {M : Type w} [semiring R]
    [add_comm_monoid M] [semimodule R M] [semimodule ℕ M] : smul_comm_class ℕ R M :=
  sorry

-- `smul_comm_class.symm` is not registered as an instance, as it would cause a loop

protected instance add_comm_monoid.nat_smul_comm_class' {R : Type u} {M : Type w} [semiring R]
    [add_comm_monoid M] [semimodule R M] [semimodule ℕ M] : smul_comm_class R ℕ M :=
  smul_comm_class.symm ℕ R M

/-- The natural ℤ-module structure on any `add_comm_group`. -/
-- We don't immediately make this a global instance, as it results in too many instances,

-- and confusing ambiguity in the notation `n • x` when `n : ℤ`.

-- We do turn it into a global instance, but only at the end of this file,

-- and I remain dubious whether this is a good idea.

instance add_comm_group.int_module {M : Type w} [add_comm_group M] : module ℤ M :=
  semimodule.mk sorry sorry

/-- `gsmul` is defined as the `smul` action of `add_comm_group.int_module`. -/
theorem gsmul_def {M : Type w} [add_comm_group M] (n : ℤ) (x : M) : n •ℤ x = n • x := rfl

/-- `gsmul` is equal to any other module structure via a cast. -/
theorem gsmul_eq_smul_cast (R : Type u) {M : Type w} [ring R] [add_comm_group M] [semimodule R M]
    (n : ℤ) (b : M) : n •ℤ b = ↑n • b :=
  sorry

/-- `gsmul` is equal to any `ℤ`-module structure. -/
theorem gsmul_eq_smul {M : Type w} [add_comm_group M] [semimodule ℤ M] (n : ℤ) (b : M) :
    n •ℤ b = n • b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n •ℤ b = n • b)) (gsmul_eq_smul_cast ℤ n b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n • b = n • b)) (int.cast_id n))) (Eq.refl (n • b)))

/-- All `ℤ`-module structures are equal. -/
protected instance add_comm_group.int_module.subsingleton {M : Type w} [add_comm_group M] :
    subsingleton (semimodule ℤ M) :=
  subsingleton.intro
    fun (P Q : semimodule ℤ M) =>
      semimodule_ext P Q
        fun (n : ℤ) (m : M) =>
          eq.mpr (id (Eq._oldrec (Eq.refl (n • m = n • m)) (Eq.symm (gsmul_eq_smul n m))))
            (eq.mpr (id (Eq._oldrec (Eq.refl (n •ℤ m = n • m)) (Eq.symm (gsmul_eq_smul n m))))
              (Eq.refl (n •ℤ m)))

protected instance add_comm_group.int_is_scalar_tower {R : Type u} {M : Type w} [ring R]
    [add_comm_group M] [semimodule R M] [semimodule ℤ R] [semimodule ℤ M] : is_scalar_tower ℤ R M :=
  sorry

protected instance add_comm_group.int_smul_comm_class {S : Type v} {M : Type w} [semiring S]
    [add_comm_group M] [semimodule S M] [semimodule ℤ M] : smul_comm_class ℤ S M :=
  sorry

-- `smul_comm_class.symm` is not registered as an instance, as it would cause a loop

protected instance add_comm_group.int_smul_comm_class' {S : Type v} {M : Type w} [semiring S]
    [add_comm_group M] [semimodule S M] [semimodule ℤ M] : smul_comm_class S ℤ M :=
  smul_comm_class.symm ℤ S M

namespace add_monoid_hom

-- We prove this without using the `add_comm_group.int_module` instance, so the `•`s here

-- come from whatever the local `module ℤ` structure actually is.

theorem map_int_module_smul {M : Type w} {M₂ : Type x} [add_comm_group M] [add_comm_group M₂]
    [module ℤ M] [module ℤ M₂] (f : M →+ M₂) (x : ℤ) (a : M) : coe_fn f (x • a) = x • coe_fn f a :=
  sorry

theorem map_int_cast_smul {R : Type u} {M : Type w} {M₂ : Type x} [ring R] [add_comm_group M]
    [add_comm_group M₂] [module R M] [module R M₂] (f : M →+ M₂) (x : ℤ) (a : M) :
    coe_fn f (↑x • a) = ↑x • coe_fn f a :=
  sorry

theorem map_nat_cast_smul {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : M →+ M₂) (x : ℕ) (a : M) :
    coe_fn f (↑x • a) = ↑x • coe_fn f a :=
  sorry

theorem map_rat_cast_smul {R : Type u_1} [division_ring R] [char_zero R] {E : Type u_2}
    [add_comm_group E] [module R E] {F : Type u_3} [add_comm_group F] [module R F] (f : E →+ F)
    (c : ℚ) (x : E) : coe_fn f (↑c • x) = ↑c • coe_fn f x :=
  sorry

theorem map_rat_module_smul {E : Type u_1} [add_comm_group E] [vector_space ℚ E] {F : Type u_2}
    [add_comm_group F] [module ℚ F] (f : E →+ F) (c : ℚ) (x : E) :
    coe_fn f (c • x) = c • coe_fn f x :=
  rat.cast_id c ▸ map_rat_cast_smul f c x

@[simp] theorem nat_smul_apply {M : Type w} {M₂ : Type x} [add_monoid M] [add_comm_monoid M₂]
    [semimodule ℕ (M →+ M₂)] [semimodule ℕ M₂] (n : ℕ) (f : M →+ M₂) (a : M) :
    coe_fn (n • f) a = n • coe_fn f a :=
  sorry

@[simp] theorem int_smul_apply {M : Type w} {M₂ : Type x} [add_monoid M] [add_comm_group M₂]
    [module ℤ (M →+ M₂)] [module ℤ M₂] (n : ℤ) (f : M →+ M₂) (a : M) :
    coe_fn (n • f) a = n • coe_fn f a :=
  sorry

end add_monoid_hom

/-! Some tests for the vanishing of elements in modules over division rings. -/

theorem smul_nat_eq_zero (R : Type u) {M : Type w} [division_ring R] [add_comm_group M] [module R M]
    [semimodule ℕ M] [char_zero R] {v : M} {n : ℕ} : n • v = 0 ↔ n = 0 ∨ v = 0 :=
  sorry

theorem eq_zero_of_smul_two_eq_zero (R : Type u) {M : Type w} [division_ring R] [add_comm_group M]
    [module R M] [semimodule ℕ M] [char_zero R] {v : M} (hv : bit0 1 • v = 0) : v = 0 :=
  sorry

theorem eq_zero_of_eq_neg (R : Type u) {M : Type w} [division_ring R] [add_comm_group M]
    [module R M] [char_zero R] {v : M} (hv : v = -v) : v = 0 :=
  sorry

theorem ne_neg_of_ne_zero (R : Type u) [division_ring R] [char_zero R] {v : R} (hv : v ≠ 0) :
    v ≠ -v :=
  fun (h : v = -v) =>
    (fun (this : semimodule ℕ R) => hv (eq_zero_of_eq_neg R h)) add_comm_monoid.nat_semimodule

end Mathlib


import polytime.data_structures.list

variables {α β γ : Type} [tencodable α] [tencodable β] [tencodable γ]
open_locale complexity_class

@[simp] def zip {α β : Type*} : list α → list β → list (α × β)
| (x :: xs) (y :: ys) := (x, y) :: zip xs ys
| _ _ := []

theorem zip_eq_stack_rec (l₁ : list α) (l₂ : list β) :
  zip l₁ l₂ = l₁.stack_rec (λ l₂' : list β, []) (λ x xs l₂', l₂'.tail)
    (λ ih x xs l₂', @list.cases_on _ (λ _, list (α × β)) l₂' [] (λ y ys, (x, y) :: ih)) l₂ :=
by induction l₁ generalizing l₂; cases l₂; simp [*]

example : (@zip α β) ∈ₑ PTIME :=
begin
  complexity using λ l₁ l₂, l₁.stack_rec (λ l₂' : list β, []) (λ x xs l₂', l₂'.tail)
    (λ ih x xs l₂', @list.cases_on _ (λ _, list (α × β)) l₂' [] (λ y ys, (x, y) :: ih)) l₂,
  induction l₁ generalizing l₂; cases l₂; simp [*],
end


/-
Copyright (c) 2018 Michael Jendrusch. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Jendrusch, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.products.basic
import Mathlib.PostPort

universes v u l

namespace Mathlib

/-!
# Monoidal categories

A monoidal category is a category equipped with a tensor product, unitors, and an associator.
In the definition, we provide the tensor product as a pair of functions
* `tensor_obj : C → C → C`
* `tensor_hom : (X₁ ⟶ Y₁) → (X₂ ⟶ Y₂) → ((X₁ ⊗ X₂) ⟶ (Y₁ ⊗ Y₂))`
and allow use of the overloaded notation `⊗` for both.
The unitors and associator are provided componentwise.

The tensor product can be expressed as a functor via `tensor : C × C ⥤ C`.
The unitors and associator are gathered together as natural
isomorphisms in `left_unitor_nat_iso`, `right_unitor_nat_iso` and `associator_nat_iso`.

Some consequences of the definition are proved in other files,
e.g. `(λ_ (𝟙_ C)).hom = (ρ_ (𝟙_ C)).hom` in `category_theory.monoidal.unitors_equal`.

## Implementation
Dealing with unitors and associators is painful, and at this stage we do not have a useful
implementation of coherence for monoidal categories.

In an effort to lessen the pain, we put some effort into choosing the right `simp` lemmas.
Generally, the rule is that the component index of a natural transformation "weighs more"
in considering the complexity of an expression than does a structural isomorphism (associator, etc).

As an example when we prove Proposition 2.2.4 of
<http://www-math.mit.edu/~etingof/egnobookfinal.pdf>
we state it as a `@[simp]` lemma as
```
(λ_ (X ⊗ Y)).hom = (α_ (𝟙_ C) X Y).inv ≫ (λ_ X).hom ⊗ (𝟙 Y)
```

This is far from completely effective, but seems to prove a useful principle.

## References
* Tensor categories, Etingof, Gelaki, Nikshych, Ostrik,
  http://www-math.mit.edu/~etingof/egnobookfinal.pdf
* https://stacks.math.columbia.edu/tag/0FFK.
-/

namespace category_theory

/--
In a monoidal category, we can take the tensor product of objects, `X ⊗ Y` and of morphisms `f ⊗ g`.
Tensor product does not need to be strictly associative on objects, but there is a
specified associator, `α_ X Y Z : (X ⊗ Y) ⊗ Z ≅ X ⊗ (Y ⊗ Z)`. There is a tensor unit `𝟙_ C`,
with specified left and right unitor isomorphisms `λ_ X : 𝟙_ C ⊗ X ≅ X` and `ρ_ X : X ⊗ 𝟙_ C ≅ X`.
These associators and unitors satisfy the pentagon and triangle equations.

See https://stacks.math.columbia.edu/tag/0FFK.
-/
-- curried tensor product of objects:

class monoidal_category (C : Type u) [𝒞 : category C]
where
  tensor_obj : C → C → C
  tensor_hom : {X₁ Y₁ X₂ Y₂ : C} → (X₁ ⟶ Y₁) → (X₂ ⟶ Y₂) → (tensor_obj X₁ X₂ ⟶ tensor_obj Y₁ Y₂)
  tensor_id' : autoParam (C → C → tensor_hom 𝟙 𝟙 = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  tensor_comp' : autoParam
  (∀ {X₁ Y₁ Z₁ X₂ Y₂ Z₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂),
    tensor_hom (f₁ ≫ g₁) (f₂ ≫ g₂) = tensor_hom f₁ f₂ ≫ tensor_hom g₁ g₂)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  tensor_unit : C
  associator : (X Y Z : C) → tensor_obj (tensor_obj X Y) Z ≅ tensor_obj X (tensor_obj Y Z)
  associator_naturality' : autoParam
  (∀ {X₁ X₂ X₃ Y₁ Y₂ Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃),
    tensor_hom (tensor_hom f₁ f₂) f₃ ≫ iso.hom (associator Y₁ Y₂ Y₃) =
      iso.hom (associator X₁ X₂ X₃) ≫ tensor_hom f₁ (tensor_hom f₂ f₃))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  left_unitor : (X : C) → tensor_obj tensor_unit X ≅ X
  left_unitor_naturality' : autoParam (∀ {X Y : C} (f : X ⟶ Y), tensor_hom 𝟙 f ≫ iso.hom (left_unitor Y) = iso.hom (left_unitor X) ≫ f)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  right_unitor : (X : C) → tensor_obj X tensor_unit ≅ X
  right_unitor_naturality' : autoParam (∀ {X Y : C} (f : X ⟶ Y), tensor_hom f 𝟙 ≫ iso.hom (right_unitor Y) = iso.hom (right_unitor X) ≫ f)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  pentagon' : autoParam
  (∀ (W X Y Z : C),
    tensor_hom (iso.hom (associator W X Y)) 𝟙 ≫
        iso.hom (associator W (tensor_obj X Y) Z) ≫ tensor_hom 𝟙 (iso.hom (associator X Y Z)) =
      iso.hom (associator (tensor_obj W X) Y Z) ≫ iso.hom (associator W X (tensor_obj Y Z)))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  triangle' : autoParam
  (∀ (X Y : C),
    iso.hom (associator X tensor_unit Y) ≫ tensor_hom 𝟙 (iso.hom (left_unitor Y)) =
      tensor_hom (iso.hom (right_unitor X)) 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

-- curried tensor product of morphisms:

-- tensor product laws:

-- tensor unit:

-- associator:

-- left unitor:

-- right unitor:

-- pentagon identity:

-- triangle identity:

@[simp] theorem monoidal_category.tensor_id {C : Type u} [𝒞 : category C] [c : monoidal_category C] (X₁ : C) (X₂ : C) : monoidal_category.tensor_hom 𝟙 𝟙 = 𝟙 := sorry

@[simp] theorem monoidal_category.tensor_comp {C : Type u} [𝒞 : category C] [c : monoidal_category C] {X₁ : C} {Y₁ : C} {Z₁ : C} {X₂ : C} {Y₂ : C} {Z₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂) : monoidal_category.tensor_hom (f₁ ≫ g₁) (f₂ ≫ g₂) =
  monoidal_category.tensor_hom f₁ f₂ ≫ monoidal_category.tensor_hom g₁ g₂ := sorry

theorem monoidal_category.tensor_comp_assoc {C : Type u} [𝒞 : category C] [c : monoidal_category C] {X₁ : C} {Y₁ : C} {Z₁ : C} {X₂ : C} {Y₂ : C} {Z₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂) {X' : C} (f' : monoidal_category.tensor_obj Z₁ Z₂ ⟶ X') : monoidal_category.tensor_hom (f₁ ≫ g₁) (f₂ ≫ g₂) ≫ f' =
  monoidal_category.tensor_hom f₁ f₂ ≫ monoidal_category.tensor_hom g₁ g₂ ≫ f' := sorry

theorem monoidal_category.associator_naturality {C : Type u} [𝒞 : category C] [c : monoidal_category C] {X₁ : C} {X₂ : C} {X₃ : C} {Y₁ : C} {Y₂ : C} {Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) : monoidal_category.tensor_hom (monoidal_category.tensor_hom f₁ f₂) f₃ ≫ iso.hom (monoidal_category.associator Y₁ Y₂ Y₃) =
  iso.hom (monoidal_category.associator X₁ X₂ X₃) ≫ monoidal_category.tensor_hom f₁ (monoidal_category.tensor_hom f₂ f₃) := sorry

theorem monoidal_category.associator_naturality_assoc {C : Type u} [𝒞 : category C] [c : monoidal_category C] {X₁ : C} {X₂ : C} {X₃ : C} {Y₁ : C} {Y₂ : C} {Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) {X' : C} (f' : monoidal_category.tensor_obj Y₁ (monoidal_category.tensor_obj Y₂ Y₃) ⟶ X') : monoidal_category.tensor_hom (monoidal_category.tensor_hom f₁ f₂) f₃ ≫
    iso.hom (monoidal_category.associator Y₁ Y₂ Y₃) ≫ f' =
  iso.hom (monoidal_category.associator X₁ X₂ X₃) ≫
    monoidal_category.tensor_hom f₁ (monoidal_category.tensor_hom f₂ f₃) ≫ f' := sorry

theorem monoidal_category.left_unitor_naturality {C : Type u} [𝒞 : category C] [c : monoidal_category C] {X : C} {Y : C} (f : X ⟶ Y) : monoidal_category.tensor_hom 𝟙 f ≫ iso.hom (monoidal_category.left_unitor Y) =
  iso.hom (monoidal_category.left_unitor X) ≫ f := sorry

theorem monoidal_category.left_unitor_naturality_assoc {C : Type u} [𝒞 : category C] [c : monoidal_category C] {X : C} {Y : C} (f : X ⟶ Y) {X' : C} (f' : Y ⟶ X') : monoidal_category.tensor_hom 𝟙 f ≫ iso.hom (monoidal_category.left_unitor Y) ≫ f' =
  iso.hom (monoidal_category.left_unitor X) ≫ f ≫ f' := sorry

theorem monoidal_category.right_unitor_naturality {C : Type u} [𝒞 : category C] [c : monoidal_category C] {X : C} {Y : C} (f : X ⟶ Y) : monoidal_category.tensor_hom f 𝟙 ≫ iso.hom (monoidal_category.right_unitor Y) =
  iso.hom (monoidal_category.right_unitor X) ≫ f := sorry

theorem monoidal_category.right_unitor_naturality_assoc {C : Type u} [𝒞 : category C] [c : monoidal_category C] {X : C} {Y : C} (f : X ⟶ Y) {X' : C} (f' : Y ⟶ X') : monoidal_category.tensor_hom f 𝟙 ≫ iso.hom (monoidal_category.right_unitor Y) ≫ f' =
  iso.hom (monoidal_category.right_unitor X) ≫ f ≫ f' := sorry

theorem monoidal_category.pentagon {C : Type u} [𝒞 : category C] [c : monoidal_category C] (W : C) (X : C) (Y : C) (Z : C) : monoidal_category.tensor_hom (iso.hom (monoidal_category.associator W X Y)) 𝟙 ≫
    iso.hom (monoidal_category.associator W (monoidal_category.tensor_obj X Y) Z) ≫
      monoidal_category.tensor_hom 𝟙 (iso.hom (monoidal_category.associator X Y Z)) =
  iso.hom (monoidal_category.associator (monoidal_category.tensor_obj W X) Y Z) ≫
    iso.hom (monoidal_category.associator W X (monoidal_category.tensor_obj Y Z)) := sorry

@[simp] theorem monoidal_category.triangle {C : Type u} [𝒞 : category C] [c : monoidal_category C] (X : C) (Y : C) : iso.hom (monoidal_category.associator X (monoidal_category.tensor_unit C) Y) ≫
    monoidal_category.tensor_hom 𝟙 (iso.hom (monoidal_category.left_unitor Y)) =
  monoidal_category.tensor_hom (iso.hom (monoidal_category.right_unitor X)) 𝟙 := sorry

@[simp] theorem monoidal_category.triangle_assoc {C : Type u} [𝒞 : category C] [c : monoidal_category C] (X : C) (Y : C) {X' : C} (f' : monoidal_category.tensor_obj X Y ⟶ X') : iso.hom (monoidal_category.associator X (monoidal_category.tensor_unit C) Y) ≫
    monoidal_category.tensor_hom 𝟙 (iso.hom (monoidal_category.left_unitor Y)) ≫ f' =
  monoidal_category.tensor_hom (iso.hom (monoidal_category.right_unitor X)) 𝟙 ≫ f' := sorry

infixr:70 " ⊗ " => Mathlib.category_theory.monoidal_category.tensor_obj

infixr:70 " ⊗ " => Mathlib.category_theory.monoidal_category.tensor_hom

notation:1024 "𝟙_" => Mathlib.category_theory.monoidal_category.tensor_unit

notation:1024 "α_" => Mathlib.category_theory.monoidal_category.associator

notation:1024 "λ_" => Mathlib.category_theory.monoidal_category.left_unitor

notation:1024 "ρ_" => Mathlib.category_theory.monoidal_category.right_unitor

/-- The tensor product of two isomorphisms is an isomorphism. -/
def tensor_iso {C : Type u} {X : C} {Y : C} {X' : C} {Y' : C} [category C] [monoidal_category C] (f : X ≅ Y) (g : X' ≅ Y') : X ⊗ X' ≅ Y ⊗ Y' :=
  iso.mk (iso.hom f ⊗ iso.hom g) (iso.inv f ⊗ iso.inv g)

infixr:70 " ⊗ " => Mathlib.category_theory.tensor_iso

namespace monoidal_category

protected instance tensor_is_iso {C : Type u} [category C] [monoidal_category C] {W : C} {X : C} {Y : C} {Z : C} (f : W ⟶ X) [is_iso f] (g : Y ⟶ Z) [is_iso g] : is_iso (f ⊗ g) :=
  is_iso.mk (iso.inv (as_iso f ⊗ as_iso g))

@[simp] theorem inv_tensor {C : Type u} [category C] [monoidal_category C] {W : C} {X : C} {Y : C} {Z : C} (f : W ⟶ X) [is_iso f] (g : Y ⟶ Z) [is_iso g] : inv (f ⊗ g) = inv f ⊗ inv g :=
  rfl

-- When `rewrite_search` lands, add @[search] attributes to

-- monoidal_category.tensor_id monoidal_category.tensor_comp monoidal_category.associator_naturality

-- monoidal_category.left_unitor_naturality monoidal_category.right_unitor_naturality

-- monoidal_category.pentagon monoidal_category.triangle

-- tensor_comp_id tensor_id_comp comp_id_tensor_tensor_id

-- triangle_assoc_comp_left triangle_assoc_comp_right

-- triangle_assoc_comp_left_inv triangle_assoc_comp_right_inv

-- left_unitor_tensor left_unitor_tensor_inv

-- right_unitor_tensor right_unitor_tensor_inv

-- pentagon_inv

-- associator_inv_naturality

-- left_unitor_inv_naturality

-- right_unitor_inv_naturality

@[simp] theorem comp_tensor_id {C : Type u} [category C] [monoidal_category C] {W : C} {X : C} {Y : C} {Z : C} (f : W ⟶ X) (g : X ⟶ Y) : f ≫ g ⊗ 𝟙 = (f ⊗ 𝟙) ≫ (g ⊗ 𝟙) := sorry

@[simp] theorem id_tensor_comp {C : Type u} [category C] [monoidal_category C] {W : C} {X : C} {Y : C} {Z : C} (f : W ⟶ X) (g : X ⟶ Y) : 𝟙 ⊗ f ≫ g = (𝟙 ⊗ f) ≫ (𝟙 ⊗ g) := sorry

@[simp] theorem id_tensor_comp_tensor_id {C : Type u} [category C] [monoidal_category C] {W : C} {X : C} {Y : C} {Z : C} (f : W ⟶ X) (g : Y ⟶ Z) : (𝟙 ⊗ f) ≫ (g ⊗ 𝟙) = g ⊗ f := sorry

@[simp] theorem tensor_id_comp_id_tensor_assoc {C : Type u} [category C] [monoidal_category C] {W : C} {X : C} {Y : C} {Z : C} (f : W ⟶ X) (g : Y ⟶ Z) {X' : C} (f' : Z ⊗ X ⟶ X') : (g ⊗ 𝟙) ≫ (𝟙 ⊗ f) ≫ f' = (g ⊗ f) ≫ f' := sorry

theorem left_unitor_inv_naturality {C : Type u} [category C] [monoidal_category C] {X : C} {X' : C} (f : X ⟶ X') : f ≫ iso.inv λ_ = iso.inv λ_ ≫ (𝟙 ⊗ f) := sorry

theorem right_unitor_inv_naturality {C : Type u} [category C] [monoidal_category C] {X : C} {X' : C} (f : X ⟶ X') : f ≫ iso.inv ρ_ = iso.inv ρ_ ≫ (f ⊗ 𝟙) := sorry

@[simp] theorem right_unitor_conjugation {C : Type u} [category C] [monoidal_category C] {X : C} {Y : C} (f : X ⟶ Y) : iso.inv ρ_ ≫ (f ⊗ 𝟙) ≫ iso.hom ρ_ = f := sorry

@[simp] theorem left_unitor_conjugation {C : Type u} [category C] [monoidal_category C] {X : C} {Y : C} (f : X ⟶ Y) : iso.inv λ_ ≫ (𝟙 ⊗ f) ≫ iso.hom λ_ = f := sorry

@[simp] theorem tensor_left_iff {C : Type u} [category C] [monoidal_category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) : 𝟙 ⊗ f = 𝟙 ⊗ g ↔ f = g := sorry

@[simp] theorem tensor_right_iff {C : Type u} [category C] [monoidal_category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) : f ⊗ 𝟙 = g ⊗ 𝟙 ↔ f = g := sorry

-- We now prove:

--   ((α_ (𝟙_ C) X Y).hom) ≫

--     ((λ_ (X ⊗ Y)).hom)

--   = ((λ_ X).hom ⊗ (𝟙 Y))

-- (and the corresponding fact for right unitors)

-- following the proof on nLab:

-- Lemma 2.2 at <https://ncatlab.org/nlab/revision/monoidal+category/115>

theorem left_unitor_product_aux_perimeter {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : (iso.hom α_ ⊗ 𝟙) ≫ iso.hom α_ ≫ (𝟙 ⊗ iso.hom α_) ≫ (𝟙 ⊗ iso.hom λ_) = ((iso.hom ρ_ ⊗ 𝟙) ⊗ 𝟙) ≫ iso.hom α_ := sorry

theorem left_unitor_product_aux_triangle {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : (iso.hom α_ ⊗ 𝟙) ≫ ((𝟙 ⊗ iso.hom λ_) ⊗ 𝟙) = (iso.hom ρ_ ⊗ 𝟙) ⊗ 𝟙 := sorry

theorem left_unitor_product_aux_square {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : iso.hom α_ ≫ (𝟙 ⊗ iso.hom λ_ ⊗ 𝟙) = ((𝟙 ⊗ iso.hom λ_) ⊗ 𝟙) ≫ iso.hom α_ := sorry

theorem left_unitor_product_aux {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : (𝟙 ⊗ iso.hom α_) ≫ (𝟙 ⊗ iso.hom λ_) = 𝟙 ⊗ iso.hom λ_ ⊗ 𝟙 := sorry

theorem right_unitor_product_aux_perimeter {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : (iso.hom α_ ⊗ 𝟙) ≫ iso.hom α_ ≫ (𝟙 ⊗ iso.hom α_) ≫ (𝟙 ⊗ 𝟙 ⊗ iso.hom λ_) = (iso.hom ρ_ ⊗ 𝟙) ≫ iso.hom α_ := sorry

theorem right_unitor_product_aux_triangle {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : (𝟙 ⊗ iso.hom α_) ≫ (𝟙 ⊗ 𝟙 ⊗ iso.hom λ_) = 𝟙 ⊗ iso.hom ρ_ ⊗ 𝟙 := sorry

theorem right_unitor_product_aux_square {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : iso.hom α_ ≫ (𝟙 ⊗ iso.hom ρ_ ⊗ 𝟙) = ((𝟙 ⊗ iso.hom ρ_) ⊗ 𝟙) ≫ iso.hom α_ := sorry

theorem right_unitor_product_aux {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : (iso.hom α_ ⊗ 𝟙) ≫ ((𝟙 ⊗ iso.hom ρ_) ⊗ 𝟙) = iso.hom ρ_ ⊗ 𝟙 := sorry

-- See Proposition 2.2.4 of <http://www-math.mit.edu/~etingof/egnobookfinal.pdf>

theorem left_unitor_tensor' {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : iso.hom α_ ≫ iso.hom λ_ = iso.hom λ_ ⊗ 𝟙 := sorry

@[simp] theorem left_unitor_tensor {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : iso.hom λ_ = iso.inv α_ ≫ (iso.hom λ_ ⊗ 𝟙) := sorry

theorem left_unitor_tensor_inv' {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : iso.inv λ_ ≫ iso.inv α_ = iso.inv λ_ ⊗ 𝟙 := sorry

@[simp] theorem left_unitor_tensor_inv {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : iso.inv λ_ = (iso.inv λ_ ⊗ 𝟙) ≫ iso.hom α_ := sorry

@[simp] theorem right_unitor_tensor {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : iso.hom ρ_ = iso.hom α_ ≫ (𝟙 ⊗ iso.hom ρ_) := sorry

@[simp] theorem right_unitor_tensor_inv {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : iso.inv ρ_ = (𝟙 ⊗ iso.inv ρ_) ≫ iso.inv α_ := sorry

theorem associator_inv_naturality {C : Type u} [category C] [monoidal_category C] {X : C} {Y : C} {Z : C} {X' : C} {Y' : C} {Z' : C} (f : X ⟶ X') (g : Y ⟶ Y') (h : Z ⟶ Z') : (f ⊗ g ⊗ h) ≫ iso.inv α_ = iso.inv α_ ≫ ((f ⊗ g) ⊗ h) := sorry

theorem pentagon_inv {C : Type u} [category C] [monoidal_category C] (W : C) (X : C) (Y : C) (Z : C) : (𝟙 ⊗ iso.inv α_) ≫ iso.inv α_ ≫ (iso.inv α_ ⊗ 𝟙) = iso.inv α_ ≫ iso.inv α_ := sorry

theorem triangle_assoc_comp_left {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : iso.hom α_ ≫ (𝟙 ⊗ iso.hom λ_) = iso.hom ρ_ ⊗ 𝟙 :=
  triangle X Y

@[simp] theorem triangle_assoc_comp_right {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : iso.inv α_ ≫ (iso.hom ρ_ ⊗ 𝟙) = 𝟙 ⊗ iso.hom λ_ := sorry

@[simp] theorem triangle_assoc_comp_right_inv {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : (iso.inv ρ_ ⊗ 𝟙) ≫ iso.hom α_ = 𝟙 ⊗ iso.inv λ_ := sorry

@[simp] theorem triangle_assoc_comp_left_inv {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : (𝟙 ⊗ iso.inv λ_) ≫ iso.inv α_ = iso.inv ρ_ ⊗ 𝟙 := sorry

/-- The tensor product expressed as a functor. -/
def tensor (C : Type u) [category C] [monoidal_category C] : C × C ⥤ C :=
  functor.mk (fun (X : C × C) => prod.fst X ⊗ prod.snd X) fun {X Y : C × C} (f : X ⟶ Y) => prod.fst f ⊗ prod.snd f

/-- The left-associated triple tensor product as a functor. -/
def left_assoc_tensor (C : Type u) [category C] [monoidal_category C] : C × C × C ⥤ C :=
  functor.mk (fun (X : C × C × C) => (prod.fst X ⊗ prod.fst (prod.snd X)) ⊗ prod.snd (prod.snd X))
    fun {X Y : C × C × C} (f : X ⟶ Y) => (prod.fst f ⊗ prod.fst (prod.snd f)) ⊗ prod.snd (prod.snd f)

@[simp] theorem left_assoc_tensor_obj (C : Type u) [category C] [monoidal_category C] (X : C × C × C) : functor.obj (left_assoc_tensor C) X = (prod.fst X ⊗ prod.fst (prod.snd X)) ⊗ prod.snd (prod.snd X) :=
  rfl

@[simp] theorem left_assoc_tensor_map (C : Type u) [category C] [monoidal_category C] {X : C × C × C} {Y : C × C × C} (f : X ⟶ Y) : functor.map (left_assoc_tensor C) f = (prod.fst f ⊗ prod.fst (prod.snd f)) ⊗ prod.snd (prod.snd f) :=
  rfl

/-- The right-associated triple tensor product as a functor. -/
def right_assoc_tensor (C : Type u) [category C] [monoidal_category C] : C × C × C ⥤ C :=
  functor.mk (fun (X : C × C × C) => prod.fst X ⊗ prod.fst (prod.snd X) ⊗ prod.snd (prod.snd X))
    fun {X Y : C × C × C} (f : X ⟶ Y) => prod.fst f ⊗ prod.fst (prod.snd f) ⊗ prod.snd (prod.snd f)

@[simp] theorem right_assoc_tensor_obj (C : Type u) [category C] [monoidal_category C] (X : C × C × C) : functor.obj (right_assoc_tensor C) X = prod.fst X ⊗ prod.fst (prod.snd X) ⊗ prod.snd (prod.snd X) :=
  rfl

@[simp] theorem right_assoc_tensor_map (C : Type u) [category C] [monoidal_category C] {X : C × C × C} {Y : C × C × C} (f : X ⟶ Y) : functor.map (right_assoc_tensor C) f = prod.fst f ⊗ prod.fst (prod.snd f) ⊗ prod.snd (prod.snd f) :=
  rfl

/-- The functor `λ X, 𝟙_ C ⊗ X`. -/
def tensor_unit_left (C : Type u) [category C] [monoidal_category C] : C ⥤ C :=
  functor.mk (fun (X : C) => 𝟙_ ⊗ X) fun {X Y : C} (f : X ⟶ Y) => 𝟙 ⊗ f

/-- The functor `λ X, X ⊗ 𝟙_ C`. -/
def tensor_unit_right (C : Type u) [category C] [monoidal_category C] : C ⥤ C :=
  functor.mk (fun (X : C) => X ⊗ 𝟙_) fun {X Y : C} (f : X ⟶ Y) => f ⊗ 𝟙

-- We can express the associator and the unitors, given componentwise above,

-- as natural isomorphisms.

/-- The associator as a natural isomorphism. -/
@[simp] theorem associator_nat_iso_hom_app (C : Type u) [category C] [monoidal_category C] (X : C × C × C) : nat_trans.app (iso.hom (associator_nat_iso C)) X = iso.hom α_ :=
  Eq.refl (iso.hom α_)

/-- The left unitor as a natural isomorphism. -/
@[simp] theorem left_unitor_nat_iso_inv_app (C : Type u) [category C] [monoidal_category C] (X : C) : nat_trans.app (iso.inv (left_unitor_nat_iso C)) X = iso.inv λ_ :=
  Eq.refl (iso.inv λ_)

/-- The right unitor as a natural isomorphism. -/
@[simp] theorem right_unitor_nat_iso_inv_app (C : Type u) [category C] [monoidal_category C] (X : C) : nat_trans.app (iso.inv (right_unitor_nat_iso C)) X = iso.inv ρ_ :=
  Eq.refl (iso.inv ρ_)

/-- Tensoring on the left with a fixed object, as a functor. -/
@[simp] theorem tensor_left_map {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) (Y' : C) (f : Y ⟶ Y') : functor.map (tensor_left X) f = 𝟙 ⊗ f :=
  Eq.refl (functor.map (tensor_left X) f)

/--
Tensoring on the left with `X ⊗ Y` is naturally isomorphic to
tensoring on the left with `Y`, and then again with `X`.
-/
def tensor_left_tensor {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : tensor_left (X ⊗ Y) ≅ tensor_left Y ⋙ tensor_left X :=
  nat_iso.of_components α_ sorry

@[simp] theorem tensor_left_tensor_hom_app {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) (Z : C) : nat_trans.app (iso.hom (tensor_left_tensor X Y)) Z = iso.hom α_ :=
  rfl

@[simp] theorem tensor_left_tensor_inv_app {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) (Z : C) : nat_trans.app (iso.inv (tensor_left_tensor X Y)) Z = iso.inv α_ :=
  rfl

/-- Tensoring on the right with a fixed object, as a functor. -/
@[simp] theorem tensor_right_obj {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : functor.obj (tensor_right X) Y = Y ⊗ X :=
  Eq.refl (functor.obj (tensor_right X) Y)

/--
Tensoring on the right, as a functor from `C` into endofunctors of `C`.

We later show this is a monoidal functor.
-/
def tensoring_right (C : Type u) [category C] [monoidal_category C] : C ⥤ C ⥤ C :=
  functor.mk tensor_right fun (X Y : C) (f : X ⟶ Y) => nat_trans.mk fun (Z : C) => 𝟙 ⊗ f

protected instance tensoring_right.category_theory.faithful (C : Type u) [category C] [monoidal_category C] : faithful (tensoring_right C) :=
  faithful.mk

/--
Tensoring on the right with `X ⊗ Y` is naturally isomorphic to
tensoring on the right with `X`, and then again with `Y`.
-/
def tensor_right_tensor {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) : tensor_right (X ⊗ Y) ≅ tensor_right X ⋙ tensor_right Y :=
  nat_iso.of_components (fun (Z : C) => iso.symm α_) sorry

@[simp] theorem tensor_right_tensor_hom_app {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) (Z : C) : nat_trans.app (iso.hom (tensor_right_tensor X Y)) Z = iso.inv α_ :=
  rfl

@[simp] theorem tensor_right_tensor_inv_app {C : Type u} [category C] [monoidal_category C] (X : C) (Y : C) (Z : C) : nat_trans.app (iso.inv (tensor_right_tensor X Y)) Z = iso.hom α_ :=
  rfl


theorem succ_inj' {a b : mynat} (hs : succ(a) = succ(b)) :  a = b :=
begin
apply succ_inj hs,
end


import Mathlib.Data.Int.Basic
import Mathlib.Tactic.Ring

section ring_lemmas

variable {R : Type u} [CommRing R]

lemma factorize1 (root b p : R) (q : ℕ) : root * p ^ q * (p ^ q * b) + root * p ^ q * (root * p ^ q) = p ^ q * p ^ q * ((root + b) * root) := by ring

lemma factorize2 (root a p : R) (q : ℕ) : 2 * (root * p ^ q) * (p ^ 1 * a) = p ^ q  * p ^ 1  * (2 * a * root) := by ring

lemma factorize3 (root p : R) (q : ℕ) : 3 * (root * p ^ q * (root * p ^ q)) = p ^ q * p ^ q * (3 * root * root) := by ring

lemma factorize4 (root a b c p : R) (q : ℕ) : p ^ (2 * q + 1) * c + root * p ^ q * (p ^ (q + 1) * b) + (root * p ^ q) ^ 2 * (p ^ 1 * a) = p ^ q * p ^ q * p ^ 1 * (a * root ^ 2) + p ^ q * p ^ (q + 1) * (b * root) + p ^ (2 * q + 1) * c := by ring

lemma factorize5 (b c p : R) : p ^ 1 * b * (p ^ 1 * b) + 4 * (p ^ 2 * c) = p ^ 2 * (b * b + 4 * c) := by ring

lemma factorize6 (p x b c : R) : p ^ 2 * x ^ 2 + p * x * (p ^ 1 * b) + p ^ 2 * -c = p ^ 2 * (1 * x ^ 2 + b * x + -c) := by ring

lemma factorize7 (a b r p : R) : p ^ 2 * a + 2 * (p * r) * (p ^ 1 * b) + 3 * (p * r) ^ 2 = p ^ 2 * (a + 2 * r * b + 3 * r ^ 2) := by ring

lemma factorize8 (a b c r p : R) : (p ^ 3 * a) + (p * r) * (p ^ 2 * b) + (p * r) ^ 2 * (p ^ 1 * c) + (p * r) ^ 3 = p ^ 3 * (a + r * b + r ^ 2 * c + r ^ 3) := by ring

lemma factorize9 (a1 a2 a3 a4 a6 b8 p : R) : p ^ 1 * a1 * (p ^ 1 * a1) * (p ^ 3 * a6) + p ^ 1 * a1 * (p ^ 2 * a3) * -a4 + 4 * a2 * (p ^ 3 * a6) + a2 * (p ^ 2 * a3) * (p ^ 2 * a3) + p ^ 3 * -b8 = p ^ 3 * (p ^ 1 * a1 * (p ^ 1 * a1) * a6 + a1 * a3 * -a4 + 4 * a2 * a6 + a2 * a3 * (p ^ 1 * a3) + -b8) := by ring

end ring_lemmas