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

! This file was ported from Lean 3 source module data.list.rotate
! leanprover-community/mathlib commit f2f413b9d4be3a02840d0663dace76e8fe3da053
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Perm
import Mathbin.Data.List.Range

/-!
# List rotation

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file proves basic results about `list.rotate`, the list rotation.

## Main declarations

* `is_rotated l₁ l₂`: States that `l₁` is a rotated version of `l₂`.
* `cyclic_permutations l`: The list of all cyclic permutants of `l`, up to the length of `l`.

## Tags

rotated, rotation, permutation, cycle
-/

universe u

variable {α : Type u}

open Nat Function

namespace List

#print List.rotate_mod /-
theorem rotate_mod (l : List α) (n : ℕ) : l.rotate (n % l.length) = l.rotate n := by simp [rotate]
#align list.rotate_mod List.rotate_mod
-/

#print List.rotate_nil /-
@[simp]
theorem rotate_nil (n : ℕ) : ([] : List α).rotate n = [] := by simp [rotate]
#align list.rotate_nil List.rotate_nil
-/

#print List.rotate_zero /-
@[simp]
theorem rotate_zero (l : List α) : l.rotate 0 = l := by simp [rotate]
#align list.rotate_zero List.rotate_zero
-/

#print List.rotate'_nil /-
@[simp]
theorem rotate'_nil (n : ℕ) : ([] : List α).rotate' n = [] := by cases n <;> rfl
#align list.rotate'_nil List.rotate'_nil
-/

#print List.rotate'_zero /-
@[simp]
theorem rotate'_zero (l : List α) : l.rotate' 0 = l := by cases l <;> rfl
#align list.rotate'_zero List.rotate'_zero
-/

#print List.rotate'_cons_succ /-
theorem rotate'_cons_succ (l : List α) (a : α) (n : ℕ) :
    (a :: l : List α).rotate' n.succ = (l ++ [a]).rotate' n := by simp [rotate']
#align list.rotate'_cons_succ List.rotate'_cons_succ
-/

#print List.length_rotate' /-
@[simp]
theorem length_rotate' : ∀ (l : List α) (n : ℕ), (l.rotate' n).length = l.length
  | [], n => rfl
  | a :: l, 0 => rfl
  | a :: l, n + 1 => by rw [List.rotate', length_rotate' (l ++ [a]) n] <;> simp
#align list.length_rotate' List.length_rotate'
-/

#print List.rotate'_eq_drop_append_take /-
theorem rotate'_eq_drop_append_take :
    ∀ {l : List α} {n : ℕ}, n ≤ l.length → l.rotate' n = l.drop n ++ l.take n
  | [], n, h => by simp [drop_append_of_le_length h]
  | l, 0, h => by simp [take_append_of_le_length h]
  | a :: l, n + 1, h => by
    have hnl : n ≤ l.length := le_of_succ_le_succ h
    have hnl' : n ≤ (l ++ [a]).length := by
      rw [length_append, length_cons, List.length, zero_add] <;> exact le_of_succ_le h
    rw [rotate'_cons_succ, rotate'_eq_drop_append_take hnl', drop, take,
        drop_append_of_le_length hnl, take_append_of_le_length hnl] <;>
      simp
#align list.rotate'_eq_drop_append_take List.rotate'_eq_drop_append_take
-/

#print List.rotate'_rotate' /-
theorem rotate'_rotate' : ∀ (l : List α) (n m : ℕ), (l.rotate' n).rotate' m = l.rotate' (n + m)
  | a :: l, 0, m => by simp
  | [], n, m => by simp
  | a :: l, n + 1, m => by
    rw [rotate'_cons_succ, rotate'_rotate', add_right_comm, rotate'_cons_succ]
#align list.rotate'_rotate' List.rotate'_rotate'
-/

#print List.rotate'_length /-
@[simp]
theorem rotate'_length (l : List α) : rotate' l l.length = l := by
  rw [rotate'_eq_drop_append_take le_rfl] <;> simp
#align list.rotate'_length List.rotate'_length
-/

#print List.rotate'_length_mul /-
@[simp]
theorem rotate'_length_mul (l : List α) : ∀ n : ℕ, l.rotate' (l.length * n) = l
  | 0 => by simp
  | n + 1 =>
    calc
      l.rotate' (l.length * (n + 1)) =
          (l.rotate' (l.length * n)).rotate' (l.rotate' (l.length * n)).length :=
        by simp [-rotate'_length, Nat.mul_succ, rotate'_rotate']
      _ = l := by rw [rotate'_length, rotate'_length_mul]

#align list.rotate'_length_mul List.rotate'_length_mul
-/

#print List.rotate'_mod /-
theorem rotate'_mod (l : List α) (n : ℕ) : l.rotate' (n % l.length) = l.rotate' n :=
  calc
    l.rotate' (n % l.length) =
        (l.rotate' (n % l.length)).rotate' ((l.rotate' (n % l.length)).length * (n / l.length)) :=
      by rw [rotate'_length_mul]
    _ = l.rotate' n := by rw [rotate'_rotate', length_rotate', Nat.mod_add_div]

#align list.rotate'_mod List.rotate'_mod
-/

#print List.rotate_eq_rotate' /-
theorem rotate_eq_rotate' (l : List α) (n : ℕ) : l.rotate n = l.rotate' n :=
  if h : l.length = 0 then by simp_all [length_eq_zero]
  else by
    rw [← rotate'_mod,
        rotate'_eq_drop_append_take (le_of_lt (Nat.mod_lt _ (Nat.pos_of_ne_zero h)))] <;>
      simp [rotate]
#align list.rotate_eq_rotate' List.rotate_eq_rotate'
-/

#print List.rotate_cons_succ /-
theorem rotate_cons_succ (l : List α) (a : α) (n : ℕ) :
    (a :: l : List α).rotate n.succ = (l ++ [a]).rotate n := by
  rw [rotate_eq_rotate', rotate_eq_rotate', rotate'_cons_succ]
#align list.rotate_cons_succ List.rotate_cons_succ
-/

#print List.mem_rotate /-
@[simp]
theorem mem_rotate : ∀ {l : List α} {a : α} {n : ℕ}, a ∈ l.rotate n ↔ a ∈ l
  | [], _, n => by simp
  | a :: l, _, 0 => by simp
  | a :: l, _, n + 1 => by simp [rotate_cons_succ, mem_rotate, or_comm]
#align list.mem_rotate List.mem_rotate
-/

#print List.length_rotate /-
@[simp]
theorem length_rotate (l : List α) (n : ℕ) : (l.rotate n).length = l.length := by
  rw [rotate_eq_rotate', length_rotate']
#align list.length_rotate List.length_rotate
-/

#print List.rotate_replicate /-
theorem rotate_replicate (a : α) (n : ℕ) (k : ℕ) : (replicate n a).rotate k = replicate n a :=
  eq_replicate.2
    ⟨by rw [length_rotate, length_replicate], fun b hb => eq_of_mem_replicate <| mem_rotate.1 hb⟩
#align list.rotate_replicate List.rotate_replicate
-/

#print List.rotate_eq_drop_append_take /-
theorem rotate_eq_drop_append_take {l : List α} {n : ℕ} :
    n ≤ l.length → l.rotate n = l.drop n ++ l.take n := by
  rw [rotate_eq_rotate'] <;> exact rotate'_eq_drop_append_take
#align list.rotate_eq_drop_append_take List.rotate_eq_drop_append_take
-/

#print List.rotate_eq_drop_append_take_mod /-
theorem rotate_eq_drop_append_take_mod {l : List α} {n : ℕ} :
    l.rotate n = l.drop (n % l.length) ++ l.take (n % l.length) :=
  by
  cases' l.length.zero_le.eq_or_lt with hl hl
  · simp [eq_nil_of_length_eq_zero hl.symm]
  rw [← rotate_eq_drop_append_take (n.mod_lt hl).le, rotate_mod]
#align list.rotate_eq_drop_append_take_mod List.rotate_eq_drop_append_take_mod
-/

#print List.rotate_append_length_eq /-
@[simp]
theorem rotate_append_length_eq (l l' : List α) : (l ++ l').rotate l.length = l' ++ l :=
  by
  rw [rotate_eq_rotate']
  induction l generalizing l'
  · simp
  · simp [rotate', l_ih]
#align list.rotate_append_length_eq List.rotate_append_length_eq
-/

#print List.rotate_rotate /-
theorem rotate_rotate (l : List α) (n m : ℕ) : (l.rotate n).rotate m = l.rotate (n + m) := by
  rw [rotate_eq_rotate', rotate_eq_rotate', rotate_eq_rotate', rotate'_rotate']
#align list.rotate_rotate List.rotate_rotate
-/

#print List.rotate_length /-
@[simp]
theorem rotate_length (l : List α) : rotate l l.length = l := by
  rw [rotate_eq_rotate', rotate'_length]
#align list.rotate_length List.rotate_length
-/

#print List.rotate_length_mul /-
@[simp]
theorem rotate_length_mul (l : List α) (n : ℕ) : l.rotate (l.length * n) = l := by
  rw [rotate_eq_rotate', rotate'_length_mul]
#align list.rotate_length_mul List.rotate_length_mul
-/

/- warning: list.prod_rotate_eq_one_of_prod_eq_one -> List.prod_rotate_eq_one_of_prod_eq_one is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Group.{u1} α] {l : List.{u1} α}, (Eq.{succ u1} α (List.prod.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))) (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))) l) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))))))) -> (forall (n : Nat), Eq.{succ u1} α (List.prod.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))) (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))) (List.rotate.{u1} α l n)) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Group.{u1} α] {l : List.{u1} α}, (Eq.{succ u1} α (List.prod.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))) (InvOneClass.toOne.{u1} α (DivInvOneMonoid.toInvOneClass.{u1} α (DivisionMonoid.toDivInvOneMonoid.{u1} α (Group.toDivisionMonoid.{u1} α _inst_1)))) l) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (InvOneClass.toOne.{u1} α (DivInvOneMonoid.toInvOneClass.{u1} α (DivisionMonoid.toDivInvOneMonoid.{u1} α (Group.toDivisionMonoid.{u1} α _inst_1))))))) -> (forall (n : Nat), Eq.{succ u1} α (List.prod.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))) (InvOneClass.toOne.{u1} α (DivInvOneMonoid.toInvOneClass.{u1} α (DivisionMonoid.toDivInvOneMonoid.{u1} α (Group.toDivisionMonoid.{u1} α _inst_1)))) (List.rotate.{u1} α l n)) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (InvOneClass.toOne.{u1} α (DivInvOneMonoid.toInvOneClass.{u1} α (DivisionMonoid.toDivInvOneMonoid.{u1} α (Group.toDivisionMonoid.{u1} α _inst_1)))))))
Case conversion may be inaccurate. Consider using '#align list.prod_rotate_eq_one_of_prod_eq_one List.prod_rotate_eq_one_of_prod_eq_oneₓ'. -/
theorem prod_rotate_eq_one_of_prod_eq_one [Group α] :
    ∀ {l : List α} (hl : l.Prod = 1) (n : ℕ), (l.rotate n).Prod = 1
  | [], _, _ => by simp
  | a :: l, hl, n =>
    by
    have : n % List.length (a :: l) ≤ List.length (a :: l) := le_of_lt (Nat.mod_lt _ (by decide))
    rw [← List.take_append_drop (n % List.length (a :: l)) (a :: l)] at hl <;>
      rw [← rotate_mod, rotate_eq_drop_append_take this, List.prod_append, mul_eq_one_iff_inv_eq, ←
        one_mul (List.prod _)⁻¹, ← hl, List.prod_append, mul_assoc, mul_inv_self, mul_one]
#align list.prod_rotate_eq_one_of_prod_eq_one List.prod_rotate_eq_one_of_prod_eq_one

#print List.rotate_perm /-
theorem rotate_perm (l : List α) (n : ℕ) : l.rotate n ~ l :=
  by
  rw [rotate_eq_rotate']
  induction' n with n hn generalizing l
  · simp
  · cases' l with hd tl
    · simp
    · rw [rotate'_cons_succ]
      exact (hn _).trans (perm_append_singleton _ _)
#align list.rotate_perm List.rotate_perm
-/

#print List.nodup_rotate /-
@[simp]
theorem nodup_rotate {l : List α} {n : ℕ} : Nodup (l.rotate n) ↔ Nodup l :=
  (rotate_perm l n).nodup_iff
#align list.nodup_rotate List.nodup_rotate
-/

#print List.rotate_eq_nil_iff /-
@[simp]
theorem rotate_eq_nil_iff {l : List α} {n : ℕ} : l.rotate n = [] ↔ l = [] :=
  by
  induction' n with n hn generalizing l
  · simp
  · cases' l with hd tl
    · simp
    · simp [rotate_cons_succ, hn]
#align list.rotate_eq_nil_iff List.rotate_eq_nil_iff
-/

#print List.nil_eq_rotate_iff /-
@[simp]
theorem nil_eq_rotate_iff {l : List α} {n : ℕ} : [] = l.rotate n ↔ [] = l := by
  rw [eq_comm, rotate_eq_nil_iff, eq_comm]
#align list.nil_eq_rotate_iff List.nil_eq_rotate_iff
-/

#print List.rotate_singleton /-
@[simp]
theorem rotate_singleton (x : α) (n : ℕ) : [x].rotate n = [x] :=
  rotate_replicate x 1 n
#align list.rotate_singleton List.rotate_singleton
-/

/- warning: list.zip_with_rotate_distrib -> List.zipWith_rotate_distrib is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} (f : α -> β -> γ) (l : List.{u1} α) (l' : List.{u2} β) (n : Nat), (Eq.{1} Nat (List.length.{u1} α l) (List.length.{u2} β l')) -> (Eq.{succ u3} (List.{u3} γ) (List.rotate.{u3} γ (List.zipWith.{u1, u2, u3} α β γ f l l') n) (List.zipWith.{u1, u2, u3} α β γ f (List.rotate.{u1} α l n) (List.rotate.{u2} β l' n)))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} (f : α -> β -> γ) (l : List.{u3} α) (l' : List.{u2} β) (n : Nat), (Eq.{1} Nat (List.length.{u3} α l) (List.length.{u2} β l')) -> (Eq.{succ u1} (List.{u1} γ) (List.rotate.{u1} γ (List.zipWith.{u3, u2, u1} α β γ f l l') n) (List.zipWith.{u3, u2, u1} α β γ f (List.rotate.{u3} α l n) (List.rotate.{u2} β l' n)))
Case conversion may be inaccurate. Consider using '#align list.zip_with_rotate_distrib List.zipWith_rotate_distribₓ'. -/
theorem zipWith_rotate_distrib {α β γ : Type _} (f : α → β → γ) (l : List α) (l' : List β) (n : ℕ)
    (h : l.length = l'.length) : (zipWith f l l').rotate n = zipWith f (l.rotate n) (l'.rotate n) :=
  by
  rw [rotate_eq_drop_append_take_mod, rotate_eq_drop_append_take_mod,
    rotate_eq_drop_append_take_mod, h, zip_with_append, ← zip_with_distrib_drop, ←
    zip_with_distrib_take, List.length_zipWith, h, min_self]
  rw [length_drop, length_drop, h]
#align list.zip_with_rotate_distrib List.zipWith_rotate_distrib

attribute [local simp] rotate_cons_succ

/- warning: list.zip_with_rotate_one -> List.zipWith_rotate_one is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> α -> β) (x : α) (y : α) (l : List.{u1} α), Eq.{succ u2} (List.{u2} β) (List.zipWith.{u1, u1, u2} α α β f (List.cons.{u1} α x (List.cons.{u1} α y l)) (List.rotate.{u1} α (List.cons.{u1} α x (List.cons.{u1} α y l)) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (List.cons.{u2} β (f x y) (List.zipWith.{u1, u1, u2} α α β f (List.cons.{u1} α y l) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α)))))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> α -> β) (x : α) (y : α) (l : List.{u2} α), Eq.{succ u1} (List.{u1} β) (List.zipWith.{u2, u2, u1} α α β f (List.cons.{u2} α x (List.cons.{u2} α y l)) (List.rotate.{u2} α (List.cons.{u2} α x (List.cons.{u2} α y l)) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (List.cons.{u1} β (f x y) (List.zipWith.{u2, u2, u1} α α β f (List.cons.{u2} α y l) (HAppend.hAppend.{u2, u2, u2} (List.{u2} α) (List.{u2} α) (List.{u2} α) (instHAppend.{u2} (List.{u2} α) (List.instAppendList.{u2} α)) l (List.cons.{u2} α x (List.nil.{u2} α)))))
Case conversion may be inaccurate. Consider using '#align list.zip_with_rotate_one List.zipWith_rotate_oneₓ'. -/
@[simp]
theorem zipWith_rotate_one {β : Type _} (f : α → α → β) (x y : α) (l : List α) :
    zipWith f (x :: y :: l) ((x :: y :: l).rotate 1) = f x y :: zipWith f (y :: l) (l ++ [x]) := by
  simp
#align list.zip_with_rotate_one List.zipWith_rotate_one

#print List.nthLe_rotate_one /-
theorem nthLe_rotate_one (l : List α) (k : ℕ) (hk : k < (l.rotate 1).length) :
    (l.rotate 1).nthLe k hk =
      l.nthLe ((k + 1) % l.length) (mod_lt _ (length_rotate l 1 ▸ k.zero_le.trans_lt hk)) :=
  by
  cases' l with hd tl
  · simp
  · have : k ≤ tl.length := by
      refine' Nat.le_of_lt_succ _
      simpa using hk
    rcases this.eq_or_lt with (rfl | hk')
    · simp [nth_le_append_right le_rfl]
    · simpa [nth_le_append _ hk', length_cons, Nat.mod_eq_of_lt (Nat.succ_lt_succ hk')]
#align list.nth_le_rotate_one List.nthLe_rotate_one
-/

#print List.nthLe_rotate /-
theorem nthLe_rotate (l : List α) (n k : ℕ) (hk : k < (l.rotate n).length) :
    (l.rotate n).nthLe k hk =
      l.nthLe ((k + n) % l.length) (mod_lt _ (length_rotate l n ▸ k.zero_le.trans_lt hk)) :=
  by
  induction' n with n hn generalizing l k
  · have hk' : k < l.length := by simpa using hk
    simp [Nat.mod_eq_of_lt hk']
  · simp [Nat.succ_eq_add_one, ← rotate_rotate, nth_le_rotate_one, hn l, add_comm, add_left_comm]
#align list.nth_le_rotate List.nthLe_rotate
-/

#print List.nthLe_rotate' /-
/-- A variant of `nth_le_rotate` useful for rewrites. -/
theorem nthLe_rotate' (l : List α) (n k : ℕ) (hk : k < l.length) :
    (l.rotate n).nthLe ((l.length - n % l.length + k) % l.length)
        ((Nat.mod_lt _ (k.zero_le.trans_lt hk)).trans_le (length_rotate _ _).ge) =
      l.nthLe k hk :=
  by
  rw [nth_le_rotate]
  congr
  set m := l.length
  rw [mod_add_mod, add_assoc, add_left_comm, add_comm, add_mod, add_mod _ n]
  cases' (n % m).zero_le.eq_or_lt with hn hn
  · simpa [← hn] using Nat.mod_eq_of_lt hk
  · have mpos : 0 < m := k.zero_le.trans_lt hk
    have hm : m - n % m < m := tsub_lt_self mpos hn
    have hn' : n % m < m := Nat.mod_lt _ mpos
    simpa [mod_eq_of_lt hm, tsub_add_cancel_of_le hn'.le] using Nat.mod_eq_of_lt hk
#align list.nth_le_rotate' List.nthLe_rotate'
-/

#print List.get?_rotate /-
theorem get?_rotate {l : List α} {n m : ℕ} (hml : m < l.length) :
    (l.rotate n).get? m = l.get? ((m + n) % l.length) :=
  by
  rw [nth_le_nth, nth_le_nth (Nat.mod_lt _ _), nth_le_rotate]
  rwa [length_rotate]
#align list.nth_rotate List.get?_rotate
-/

#print List.head?_rotate /-
theorem head?_rotate {l : List α} {n : ℕ} (h : n < l.length) : head? (l.rotate n) = l.get? n := by
  rw [← nth_zero, nth_rotate (n.zero_le.trans_lt h), zero_add, Nat.mod_eq_of_lt h]
#align list.head'_rotate List.head?_rotate
-/

#print List.rotate_eq_self_iff_eq_replicate /-
theorem rotate_eq_self_iff_eq_replicate [hα : Nonempty α] :
    ∀ {l : List α}, (∀ n, l.rotate n = l) ↔ ∃ a, l = replicate l.length a
  | [] => by simp
  | a :: l =>
    ⟨fun h =>
      ⟨a,
        ext_nthLe (length_replicate _ _).symm fun n h₁ h₂ =>
          by
          inhabit α
          rw [nth_le_replicate, ← Option.some_inj, ← nth_le_nth, ← head'_rotate h₁, h, head']⟩,
      fun ⟨b, hb⟩ n => by rw [hb, rotate_replicate]⟩
#align list.rotate_eq_self_iff_eq_replicate List.rotate_eq_self_iff_eq_replicate
-/

#print List.rotate_one_eq_self_iff_eq_replicate /-
theorem rotate_one_eq_self_iff_eq_replicate [Nonempty α] {l : List α} :
    l.rotate 1 = l ↔ ∃ a : α, l = List.replicate l.length a :=
  ⟨fun h =>
    rotate_eq_self_iff_eq_replicate.mp fun n =>
      Nat.rec l.rotate_zero (fun n hn => by rwa [Nat.succ_eq_add_one, ← l.rotate_rotate, hn]) n,
    fun h => rotate_eq_self_iff_eq_replicate.mpr h 1⟩
#align list.rotate_one_eq_self_iff_eq_replicate List.rotate_one_eq_self_iff_eq_replicate
-/

#print List.rotate_injective /-
theorem rotate_injective (n : ℕ) : Function.Injective fun l : List α => l.rotate n :=
  by
  rintro l₁ l₂ (h : l₁.rotate n = l₂.rotate n)
  have : length l₁ = length l₂ := by simpa only [length_rotate] using congr_arg length h
  refine' ext_le this fun k h₁ h₂ => _
  rw [← nth_le_rotate' l₁ n, ← nth_le_rotate' l₂ n]
  congr 1 <;> simp only [h, this]
#align list.rotate_injective List.rotate_injective
-/

#print List.rotate_eq_rotate /-
@[simp]
theorem rotate_eq_rotate {l l' : List α} {n : ℕ} : l.rotate n = l'.rotate n ↔ l = l' :=
  (rotate_injective n).eq_iff
#align list.rotate_eq_rotate List.rotate_eq_rotate
-/

#print List.rotate_eq_iff /-
theorem rotate_eq_iff {l l' : List α} {n : ℕ} :
    l.rotate n = l' ↔ l = l'.rotate (l'.length - n % l'.length) :=
  by
  rw [← @rotate_eq_rotate _ l _ n, rotate_rotate, ← rotate_mod l', add_mod]
  cases' l'.length.zero_le.eq_or_lt with hl hl
  · rw [eq_nil_of_length_eq_zero hl.symm, rotate_nil, rotate_eq_nil_iff]
  · cases' (Nat.zero_le (n % l'.length)).eq_or_lt with hn hn
    · simp [← hn]
    · rw [mod_eq_of_lt (tsub_lt_self hl hn), tsub_add_cancel_of_le, mod_self, rotate_zero]
      exact (Nat.mod_lt _ hl).le
#align list.rotate_eq_iff List.rotate_eq_iff
-/

#print List.rotate_eq_singleton_iff /-
@[simp]
theorem rotate_eq_singleton_iff {l : List α} {n : ℕ} {x : α} : l.rotate n = [x] ↔ l = [x] := by
  rw [rotate_eq_iff, rotate_singleton]
#align list.rotate_eq_singleton_iff List.rotate_eq_singleton_iff
-/

#print List.singleton_eq_rotate_iff /-
@[simp]
theorem singleton_eq_rotate_iff {l : List α} {n : ℕ} {x : α} : [x] = l.rotate n ↔ [x] = l := by
  rw [eq_comm, rotate_eq_singleton_iff, eq_comm]
#align list.singleton_eq_rotate_iff List.singleton_eq_rotate_iff
-/

#print List.reverse_rotate /-
theorem reverse_rotate (l : List α) (n : ℕ) :
    (l.rotate n).reverse = l.reverse.rotate (l.length - n % l.length) :=
  by
  rw [← length_reverse l, ← rotate_eq_iff]
  induction' n with n hn generalizing l
  · simp
  · cases' l with hd tl
    · simp
    · rw [rotate_cons_succ, Nat.succ_eq_add_one, ← rotate_rotate, hn]
      simp
#align list.reverse_rotate List.reverse_rotate
-/

#print List.rotate_reverse /-
theorem rotate_reverse (l : List α) (n : ℕ) :
    l.reverse.rotate n = (l.rotate (l.length - n % l.length)).reverse :=
  by
  rw [← reverse_reverse l]
  simp_rw [reverse_rotate, reverse_reverse, rotate_eq_iff, rotate_rotate, length_rotate,
    length_reverse]
  rw [← length_reverse l]
  set k := n % l.reverse.length with hk
  cases' hk' : k with k'
  · simp [-length_reverse, ← rotate_rotate]
  · cases' l with x l
    · simp
    · have : k'.succ < (x :: l).length := by simp [← hk', hk, Nat.mod_lt]
      rw [Nat.mod_eq_of_lt, tsub_add_cancel_of_le, rotate_length]
      · exact tsub_le_self
      · exact tsub_lt_self (by simp) Nat.succ_pos'
#align list.rotate_reverse List.rotate_reverse
-/

/- warning: list.map_rotate -> List.map_rotate is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) (l : List.{u1} α) (n : Nat), Eq.{succ u2} (List.{u2} β) (List.map.{u1, u2} α β f (List.rotate.{u1} α l n)) (List.rotate.{u2} β (List.map.{u1, u2} α β f l) n)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> β) (l : List.{u2} α) (n : Nat), Eq.{succ u1} (List.{u1} β) (List.map.{u2, u1} α β f (List.rotate.{u2} α l n)) (List.rotate.{u1} β (List.map.{u2, u1} α β f l) n)
Case conversion may be inaccurate. Consider using '#align list.map_rotate List.map_rotateₓ'. -/
theorem map_rotate {β : Type _} (f : α → β) (l : List α) (n : ℕ) :
    map f (l.rotate n) = (map f l).rotate n :=
  by
  induction' n with n hn IH generalizing l
  · simp
  · cases' l with hd tl
    · simp
    · simp [hn]
#align list.map_rotate List.map_rotate

#print List.Nodup.rotate_eq_self_iff /-
theorem Nodup.rotate_eq_self_iff {l : List α} (hl : l.Nodup) {n : ℕ} :
    l.rotate n = l ↔ n % l.length = 0 ∨ l = [] :=
  by
  constructor
  · intro h
    cases' l.length.zero_le.eq_or_lt with hl' hl'
    · simp [← length_eq_zero, ← hl']
    left
    rw [nodup_iff_nth_le_inj] at hl
    refine' hl _ _ (mod_lt _ hl') hl' _
    rw [← nth_le_rotate' _ n]
    simp_rw [h, tsub_add_cancel_of_le (mod_lt _ hl').le, mod_self]
  · rintro (h | h)
    · rw [← rotate_mod, h]
      exact rotate_zero l
    · simp [h]
#align list.nodup.rotate_eq_self_iff List.Nodup.rotate_eq_self_iff
-/

#print List.Nodup.rotate_congr /-
theorem Nodup.rotate_congr {l : List α} (hl : l.Nodup) (hn : l ≠ []) (i j : ℕ)
    (h : l.rotate i = l.rotate j) : i % l.length = j % l.length :=
  by
  have hi : i % l.length < l.length := mod_lt _ (length_pos_of_ne_nil hn)
  have hj : j % l.length < l.length := mod_lt _ (length_pos_of_ne_nil hn)
  refine' (nodup_iff_nth_le_inj.mp hl) _ _ hi hj _
  rw [← nth_le_rotate' l i, ← nth_le_rotate' l j]
  simp [tsub_add_cancel_of_le, hi.le, hj.le, h]
#align list.nodup.rotate_congr List.Nodup.rotate_congr
-/

section IsRotated

variable (l l' : List α)

#print List.IsRotated /-
/-- `is_rotated l₁ l₂` or `l₁ ~r l₂` asserts that `l₁` and `l₂` are cyclic permutations
  of each other. This is defined by claiming that `∃ n, l.rotate n = l'`. -/
def IsRotated : Prop :=
  ∃ n, l.rotate n = l'
#align list.is_rotated List.IsRotated
-/

-- mathport name: «expr ~r »
infixr:1000 " ~r " => IsRotated

variable {l l'}

#print List.IsRotated.refl /-
@[refl]
theorem IsRotated.refl (l : List α) : l ~r l :=
  ⟨0, by simp⟩
#align list.is_rotated.refl List.IsRotated.refl
-/

#print List.IsRotated.symm /-
@[symm]
theorem IsRotated.symm (h : l ~r l') : l' ~r l :=
  by
  obtain ⟨n, rfl⟩ := h
  cases' l with hd tl
  · simp
  · use (hd :: tl).length * n - n
    rw [rotate_rotate, add_tsub_cancel_of_le, rotate_length_mul]
    exact Nat.le_mul_of_pos_left (by simp)
#align list.is_rotated.symm List.IsRotated.symm
-/

#print List.isRotated_comm /-
theorem isRotated_comm : l ~r l' ↔ l' ~r l :=
  ⟨IsRotated.symm, IsRotated.symm⟩
#align list.is_rotated_comm List.isRotated_comm
-/

#print List.IsRotated.forall /-
@[simp]
protected theorem IsRotated.forall (l : List α) (n : ℕ) : l.rotate n ~r l :=
  IsRotated.symm ⟨n, rfl⟩
#align list.is_rotated.forall List.IsRotated.forall
-/

#print List.IsRotated.trans /-
@[trans]
theorem IsRotated.trans : ∀ {l l' l'' : List α}, l ~r l' → l' ~r l'' → l ~r l''
  | _, _, _, ⟨n, rfl⟩, ⟨m, rfl⟩ => ⟨n + m, by rw [rotate_rotate]⟩
#align list.is_rotated.trans List.IsRotated.trans
-/

#print List.IsRotated.eqv /-
theorem IsRotated.eqv : Equivalence (@IsRotated α) :=
  Equivalence.mk _ IsRotated.refl (fun _ _ => IsRotated.symm) fun _ _ _ => IsRotated.trans
#align list.is_rotated.eqv List.IsRotated.eqv
-/

#print List.IsRotated.setoid /-
/-- The relation `list.is_rotated l l'` forms a `setoid` of cycles. -/
def IsRotated.setoid (α : Type _) : Setoid (List α)
    where
  R := IsRotated
  iseqv := IsRotated.eqv
#align list.is_rotated.setoid List.IsRotated.setoid
-/

#print List.IsRotated.perm /-
theorem IsRotated.perm (h : l ~r l') : l ~ l' :=
  Exists.elim h fun _ hl => hl ▸ (rotate_perm _ _).symm
#align list.is_rotated.perm List.IsRotated.perm
-/

#print List.IsRotated.nodup_iff /-
theorem IsRotated.nodup_iff (h : l ~r l') : Nodup l ↔ Nodup l' :=
  h.Perm.nodup_iff
#align list.is_rotated.nodup_iff List.IsRotated.nodup_iff
-/

#print List.IsRotated.mem_iff /-
theorem IsRotated.mem_iff (h : l ~r l') {a : α} : a ∈ l ↔ a ∈ l' :=
  h.Perm.mem_iff
#align list.is_rotated.mem_iff List.IsRotated.mem_iff
-/

#print List.isRotated_nil_iff /-
@[simp]
theorem isRotated_nil_iff : l ~r [] ↔ l = [] :=
  ⟨fun ⟨n, hn⟩ => by simpa using hn, fun h => h ▸ by rfl⟩
#align list.is_rotated_nil_iff List.isRotated_nil_iff
-/

#print List.isRotated_nil_iff' /-
@[simp]
theorem isRotated_nil_iff' : [] ~r l ↔ [] = l := by
  rw [is_rotated_comm, is_rotated_nil_iff, eq_comm]
#align list.is_rotated_nil_iff' List.isRotated_nil_iff'
-/

#print List.isRotated_singleton_iff /-
@[simp]
theorem isRotated_singleton_iff {x : α} : l ~r [x] ↔ l = [x] :=
  ⟨fun ⟨n, hn⟩ => by simpa using hn, fun h => h ▸ by rfl⟩
#align list.is_rotated_singleton_iff List.isRotated_singleton_iff
-/

#print List.isRotated_singleton_iff' /-
@[simp]
theorem isRotated_singleton_iff' {x : α} : [x] ~r l ↔ [x] = l := by
  rw [is_rotated_comm, is_rotated_singleton_iff, eq_comm]
#align list.is_rotated_singleton_iff' List.isRotated_singleton_iff'
-/

#print List.isRotated_concat /-
theorem isRotated_concat (hd : α) (tl : List α) : (tl ++ [hd]) ~r (hd :: tl) :=
  IsRotated.symm ⟨1, by simp⟩
#align list.is_rotated_concat List.isRotated_concat
-/

#print List.isRotated_append /-
theorem isRotated_append : (l ++ l') ~r (l' ++ l) :=
  ⟨l.length, by simp⟩
#align list.is_rotated_append List.isRotated_append
-/

#print List.IsRotated.reverse /-
theorem IsRotated.reverse (h : l ~r l') : l.reverse ~r l'.reverse :=
  by
  obtain ⟨n, rfl⟩ := h
  exact ⟨_, (reverse_rotate _ _).symm⟩
#align list.is_rotated.reverse List.IsRotated.reverse
-/

#print List.isRotated_reverse_comm_iff /-
theorem isRotated_reverse_comm_iff : l.reverse ~r l' ↔ l ~r l'.reverse := by
  constructor <;>
    · intro h
      simpa using h.reverse
#align list.is_rotated_reverse_comm_iff List.isRotated_reverse_comm_iff
-/

#print List.isRotated_reverse_iff /-
@[simp]
theorem isRotated_reverse_iff : l.reverse ~r l'.reverse ↔ l ~r l' := by
  simp [is_rotated_reverse_comm_iff]
#align list.is_rotated_reverse_iff List.isRotated_reverse_iff
-/

/- warning: list.is_rotated_iff_mod -> List.isRotated_iff_mod is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {l : List.{u1} α} {l' : List.{u1} α}, Iff (List.IsRotated.{u1} α l l') (Exists.{1} Nat (fun (n : Nat) => Exists.{0} (LE.le.{0} Nat Nat.hasLe n (List.length.{u1} α l)) (fun (H : LE.le.{0} Nat Nat.hasLe n (List.length.{u1} α l)) => Eq.{succ u1} (List.{u1} α) (List.rotate.{u1} α l n) l')))
but is expected to have type
  forall {α : Type.{u1}} {l : List.{u1} α} {l' : List.{u1} α}, Iff (List.IsRotated.{u1} α l l') (Exists.{1} Nat (fun (n : Nat) => And (LE.le.{0} Nat instLENat n (List.length.{u1} α l)) (Eq.{succ u1} (List.{u1} α) (List.rotate.{u1} α l n) l')))
Case conversion may be inaccurate. Consider using '#align list.is_rotated_iff_mod List.isRotated_iff_modₓ'. -/
theorem isRotated_iff_mod : l ~r l' ↔ ∃ n ≤ l.length, l.rotate n = l' :=
  by
  refine' ⟨fun h => _, fun ⟨n, _, h⟩ => ⟨n, h⟩⟩
  obtain ⟨n, rfl⟩ := h
  cases' l with hd tl
  · simp
  · refine' ⟨n % (hd :: tl).length, _, rotate_mod _ _⟩
    refine' (Nat.mod_lt _ _).le
    simp
#align list.is_rotated_iff_mod List.isRotated_iff_mod

#print List.isRotated_iff_mem_map_range /-
theorem isRotated_iff_mem_map_range : l ~r l' ↔ l' ∈ (List.range (l.length + 1)).map l.rotate :=
  by
  simp_rw [mem_map, mem_range, is_rotated_iff_mod]
  exact
    ⟨fun ⟨n, hn, h⟩ => ⟨n, Nat.lt_succ_of_le hn, h⟩, fun ⟨n, hn, h⟩ => ⟨n, Nat.le_of_lt_succ hn, h⟩⟩
#align list.is_rotated_iff_mem_map_range List.isRotated_iff_mem_map_range
-/

/- warning: list.is_rotated.map -> List.IsRotated.map is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {l₁ : List.{u1} α} {l₂ : List.{u1} α}, (List.IsRotated.{u1} α l₁ l₂) -> (forall (f : α -> β), List.IsRotated.{u2} β (List.map.{u1, u2} α β f l₁) (List.map.{u1, u2} α β f l₂))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {l₁ : List.{u2} α} {l₂ : List.{u2} α}, (List.IsRotated.{u2} α l₁ l₂) -> (forall (f : α -> β), List.IsRotated.{u1} β (List.map.{u2, u1} α β f l₁) (List.map.{u2, u1} α β f l₂))
Case conversion may be inaccurate. Consider using '#align list.is_rotated.map List.IsRotated.mapₓ'. -/
@[congr]
theorem IsRotated.map {β : Type _} {l₁ l₂ : List α} (h : l₁ ~r l₂) (f : α → β) :
    map f l₁ ~r map f l₂ := by
  obtain ⟨n, rfl⟩ := h
  rw [map_rotate]
  use n
#align list.is_rotated.map List.IsRotated.map

#print List.cyclicPermutations /-
/-- List of all cyclic permutations of `l`.
The `cyclic_permutations` of a nonempty list `l` will always contain `list.length l` elements.
This implies that under certain conditions, there are duplicates in `list.cyclic_permutations l`.
The `n`th entry is equal to `l.rotate n`, proven in `list.nth_le_cyclic_permutations`.
The proof that every cyclic permutant of `l` is in the list is `list.mem_cyclic_permutations_iff`.

     cyclic_permutations [1, 2, 3, 2, 4] =
       [[1, 2, 3, 2, 4], [2, 3, 2, 4, 1], [3, 2, 4, 1, 2],
        [2, 4, 1, 2, 3], [4, 1, 2, 3, 2]] -/
def cyclicPermutations : List α → List (List α)
  | [] => [[]]
  | l@(_ :: _) => dropLast (zipWith (· ++ ·) (tails l) (inits l))
#align list.cyclic_permutations List.cyclicPermutations
-/

#print List.cyclicPermutations_nil /-
@[simp]
theorem cyclicPermutations_nil : cyclicPermutations ([] : List α) = [[]] :=
  rfl
#align list.cyclic_permutations_nil List.cyclicPermutations_nil
-/

#print List.cyclicPermutations_cons /-
theorem cyclicPermutations_cons (x : α) (l : List α) :
    cyclicPermutations (x :: l) = dropLast (zipWith (· ++ ·) (tails (x :: l)) (inits (x :: l))) :=
  rfl
#align list.cyclic_permutations_cons List.cyclicPermutations_cons
-/

#print List.cyclicPermutations_of_ne_nil /-
theorem cyclicPermutations_of_ne_nil (l : List α) (h : l ≠ []) :
    cyclicPermutations l = dropLast (zipWith (· ++ ·) (tails l) (inits l)) :=
  by
  obtain ⟨hd, tl, rfl⟩ := exists_cons_of_ne_nil h
  exact cyclic_permutations_cons _ _
#align list.cyclic_permutations_of_ne_nil List.cyclicPermutations_of_ne_nil
-/

#print List.length_cyclicPermutations_cons /-
theorem length_cyclicPermutations_cons (x : α) (l : List α) :
    length (cyclicPermutations (x :: l)) = length l + 1 := by simp [cyclic_permutations_of_ne_nil]
#align list.length_cyclic_permutations_cons List.length_cyclicPermutations_cons
-/

#print List.length_cyclicPermutations_of_ne_nil /-
@[simp]
theorem length_cyclicPermutations_of_ne_nil (l : List α) (h : l ≠ []) :
    length (cyclicPermutations l) = length l := by simp [cyclic_permutations_of_ne_nil _ h]
#align list.length_cyclic_permutations_of_ne_nil List.length_cyclicPermutations_of_ne_nil
-/

#print List.nthLe_cyclicPermutations /-
@[simp]
theorem nthLe_cyclicPermutations (l : List α) (n : ℕ) (hn : n < length (cyclicPermutations l)) :
    nthLe (cyclicPermutations l) n hn = l.rotate n :=
  by
  obtain rfl | h := eq_or_ne l []
  · simp
  · rw [length_cyclic_permutations_of_ne_nil _ h] at hn
    simp [init_eq_take, cyclic_permutations_of_ne_nil _ h, nth_le_take',
      rotate_eq_drop_append_take hn.le]
#align list.nth_le_cyclic_permutations List.nthLe_cyclicPermutations
-/

#print List.mem_cyclicPermutations_self /-
theorem mem_cyclicPermutations_self (l : List α) : l ∈ cyclicPermutations l :=
  by
  cases' l with x l
  · simp
  · rw [mem_iff_nth_le]
    refine' ⟨0, by simp, _⟩
    simp
#align list.mem_cyclic_permutations_self List.mem_cyclicPermutations_self
-/

#print List.length_mem_cyclicPermutations /-
theorem length_mem_cyclicPermutations (l : List α) (h : l' ∈ cyclicPermutations l) :
    length l' = length l := by
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem h
  simp
#align list.length_mem_cyclic_permutations List.length_mem_cyclicPermutations
-/

#print List.mem_cyclicPermutations_iff /-
@[simp]
theorem mem_cyclicPermutations_iff {l l' : List α} : l ∈ cyclicPermutations l' ↔ l ~r l' :=
  by
  constructor
  · intro h
    obtain ⟨k, hk, rfl⟩ := nth_le_of_mem h
    simp
  · intro h
    obtain ⟨k, rfl⟩ := h.symm
    rw [mem_iff_nth_le]
    simp only [exists_prop, nth_le_cyclic_permutations]
    cases' l' with x l
    · simp
    · refine' ⟨k % length (x :: l), _, rotate_mod _ _⟩
      simpa using Nat.mod_lt _ (zero_lt_succ _)
#align list.mem_cyclic_permutations_iff List.mem_cyclicPermutations_iff
-/

#print List.cyclicPermutations_eq_nil_iff /-
@[simp]
theorem cyclicPermutations_eq_nil_iff {l : List α} : cyclicPermutations l = [[]] ↔ l = [] :=
  by
  refine' ⟨fun h => _, fun h => by simp [h]⟩
  rw [eq_comm, ← is_rotated_nil_iff', ← mem_cyclic_permutations_iff, h, mem_singleton]
#align list.cyclic_permutations_eq_nil_iff List.cyclicPermutations_eq_nil_iff
-/

#print List.cyclicPermutations_eq_singleton_iff /-
@[simp]
theorem cyclicPermutations_eq_singleton_iff {l : List α} {x : α} :
    cyclicPermutations l = [[x]] ↔ l = [x] :=
  by
  refine' ⟨fun h => _, fun h => by simp [cyclic_permutations, h, init_eq_take]⟩
  rw [eq_comm, ← is_rotated_singleton_iff', ← mem_cyclic_permutations_iff, h, mem_singleton]
#align list.cyclic_permutations_eq_singleton_iff List.cyclicPermutations_eq_singleton_iff
-/

#print List.Nodup.cyclicPermutations /-
/-- If a `l : list α` is `nodup l`, then all of its cyclic permutants are distinct. -/
theorem Nodup.cyclicPermutations {l : List α} (hn : Nodup l) : Nodup (cyclicPermutations l) :=
  by
  cases' l with x l
  · simp
  rw [nodup_iff_nth_le_inj]
  intro i j hi hj h
  simp only [length_cyclic_permutations_cons] at hi hj
  rw [← mod_eq_of_lt hi, ← mod_eq_of_lt hj, ← length_cons x l]
  apply hn.rotate_congr
  · simp
  · simpa using h
#align list.nodup.cyclic_permutations List.Nodup.cyclicPermutations
-/

#print List.cyclicPermutations_rotate /-
@[simp]
theorem cyclicPermutations_rotate (l : List α) (k : ℕ) :
    (l.rotate k).cyclicPermutations = l.cyclicPermutations.rotate k :=
  by
  have : (l.rotate k).cyclicPermutations.length = length (l.cyclic_permutations.rotate k) :=
    by
    cases l
    · simp
    · rw [length_cyclic_permutations_of_ne_nil] <;> simp
  refine' ext_le this fun n hn hn' => _
  rw [nth_le_cyclic_permutations, nth_le_rotate, nth_le_cyclic_permutations, rotate_rotate, ←
    rotate_mod, add_comm]
  cases l <;> simp
#align list.cyclic_permutations_rotate List.cyclicPermutations_rotate
-/

#print List.IsRotated.cyclicPermutations /-
theorem IsRotated.cyclicPermutations {l l' : List α} (h : l ~r l') :
    l.cyclicPermutations ~r l'.cyclicPermutations :=
  by
  obtain ⟨k, rfl⟩ := h
  exact ⟨k, by simp⟩
#align list.is_rotated.cyclic_permutations List.IsRotated.cyclicPermutations
-/

#print List.isRotated_cyclicPermutations_iff /-
@[simp]
theorem isRotated_cyclicPermutations_iff {l l' : List α} :
    l.cyclicPermutations ~r l'.cyclicPermutations ↔ l ~r l' :=
  by
  by_cases hl : l = []
  · simp [hl, eq_comm]
  have hl' : l.cyclic_permutations.length = l.length := length_cyclic_permutations_of_ne_nil _ hl
  refine' ⟨fun h => _, is_rotated.cyclic_permutations⟩
  obtain ⟨k, hk⟩ := h
  refine' ⟨k % l.length, _⟩
  have hk' : k % l.length < l.length := mod_lt _ (length_pos_of_ne_nil hl)
  rw [← nth_le_cyclic_permutations _ _ (hk'.trans_le hl'.ge), ← nth_le_rotate' _ k]
  simp [hk, hl', tsub_add_cancel_of_le hk'.le]
#align list.is_rotated_cyclic_permutations_iff List.isRotated_cyclicPermutations_iff
-/

section Decidable

variable [DecidableEq α]

#print List.isRotatedDecidable /-
instance isRotatedDecidable (l l' : List α) : Decidable (l ~r l') :=
  decidable_of_iff' _ isRotated_iff_mem_map_range
#align list.is_rotated_decidable List.isRotatedDecidable
-/

instance {l l' : List α} : Decidable (@Setoid.r _ (IsRotated.setoid α) l l') :=
  List.isRotatedDecidable _ _

end Decidable

end IsRotated

end List


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.specific_limits.basic
import order.filter.countable_Inter
import topology.G_delta

/-!
# Baire theorem

In a complete metric space, a countable intersection of dense open subsets is dense.

The good concept underlying the theorem is that of a Gδ set, i.e., a countable intersection
of open sets. Then Baire theorem can also be formulated as the fact that a countable
intersection of dense Gδ sets is a dense Gδ set. We prove Baire theorem, giving several different
formulations that can be handy. We also prove the important consequence that, if the space is
covered by a countable union of closed sets, then the union of their interiors is dense.

We also define the filter `residual α` generated by dense `Gδ` sets and prove that this filter
has the countable intersection property.
-/

noncomputable theory

open_locale classical topological_space filter ennreal

open filter encodable set topological_space

variables {α : Type*} {β : Type*} {γ : Type*} {ι : Type*}

section Baire_theorem

open emetric ennreal

/-- The property `baire_space α` means that the topological space `α` has the Baire property:
any countable intersection of open dense subsets is dense.
Formulated here when the source space is ℕ (and subsumed below by `dense_Inter_of_open` working
with any encodable source space).-/
class baire_space (α : Type*) [topological_space α] : Prop :=
(baire_property : ∀ f : ℕ → set α, (∀ n, is_open (f n)) → (∀ n, dense (f n)) → dense (⋂n, f n))

/-- Baire theorems asserts that various topological spaces have the Baire property.
Two versions of these theorems are given.
The first states that complete pseudo_emetric spaces are Baire. -/
@[priority 100]
instance baire_category_theorem_emetric_complete [pseudo_emetric_space α] [complete_space α] :
  baire_space α :=
begin
  refine ⟨λ f ho hd, _⟩,
  let B : ℕ → ℝ≥0∞ := λn, 1/2^n,
  have Bpos : ∀n, 0 < B n,
  { intro n,
    simp only [B, one_div, one_mul, ennreal.inv_pos],
    exact pow_ne_top two_ne_top },
  /- Translate the density assumption into two functions `center` and `radius` associating
  to any n, x, δ, δpos a center and a positive radius such that
  `closed_ball center radius` is included both in `f n` and in `closed_ball x δ`.
  We can also require `radius ≤ (1/2)^(n+1)`, to ensure we get a Cauchy sequence later. -/
  have : ∀n x δ, δ ≠ 0 → ∃y r, 0 < r ∧ r ≤ B (n+1) ∧ closed_ball y r ⊆ (closed_ball x δ) ∩ f n,
  { assume n x δ δpos,
    have : x ∈ closure (f n) := hd n x,
    rcases emetric.mem_closure_iff.1 this (δ/2) (ennreal.half_pos δpos) with ⟨y, ys, xy⟩,
    rw edist_comm at xy,
    obtain ⟨r, rpos, hr⟩ : ∃ r > 0, closed_ball y r ⊆ f n :=
      nhds_basis_closed_eball.mem_iff.1 (is_open_iff_mem_nhds.1 (ho n) y ys),
    refine ⟨y, min (min (δ/2) r) (B (n+1)), _, _, λz hz, ⟨_, _⟩⟩,
    show 0 < min (min (δ / 2) r) (B (n+1)),
      from lt_min (lt_min (ennreal.half_pos δpos) rpos) (Bpos (n+1)),
    show min (min (δ / 2) r) (B (n+1)) ≤ B (n+1), from min_le_right _ _,
    show z ∈ closed_ball x δ, from calc
      edist z x ≤ edist z y + edist y x : edist_triangle _ _ _
      ... ≤ (min (min (δ / 2) r) (B (n+1))) + (δ/2) : add_le_add hz (le_of_lt xy)
      ... ≤ δ/2 + δ/2 : add_le_add (le_trans (min_le_left _ _) (min_le_left _ _)) le_rfl
      ... = δ : ennreal.add_halves δ,
    show z ∈ f n, from hr (calc
      edist z y ≤ min (min (δ / 2) r) (B (n+1)) : hz
      ... ≤ r : le_trans (min_le_left _ _) (min_le_right _ _)) },
  choose! center radius Hpos HB Hball using this,
  refine λ x, (mem_closure_iff_nhds_basis nhds_basis_closed_eball).2 (λ ε εpos, _),
  /- `ε` is positive. We have to find a point in the ball of radius `ε` around `x` belonging to all
  `f n`. For this, we construct inductively a sequence `F n = (c n, r n)` such that the closed ball
  `closed_ball (c n) (r n)` is included in the previous ball and in `f n`, and such that
  `r n` is small enough to ensure that `c n` is a Cauchy sequence. Then `c n` converges to a
  limit which belongs to all the `f n`. -/
  let F : ℕ → (α × ℝ≥0∞) := λn, nat.rec_on n (prod.mk x (min ε (B 0)))
                              (λn p, prod.mk (center n p.1 p.2) (radius n p.1 p.2)),
  let c : ℕ → α := λn, (F n).1,
  let r : ℕ → ℝ≥0∞ := λn, (F n).2,
  have rpos : ∀ n, 0 < r n,
  { assume n,
    induction n with n hn,
    exact lt_min εpos (Bpos 0),
    exact Hpos n (c n) (r n) hn.ne' },
  have r0 : ∀ n, r n ≠ 0 := λ n, (rpos n).ne',
  have rB : ∀n, r n ≤ B n,
  { assume n,
    induction n with n hn,
    exact min_le_right _ _,
    exact HB n (c n) (r n) (r0 n) },
  have incl : ∀n, closed_ball (c (n+1)) (r (n+1)) ⊆ (closed_ball (c n) (r n)) ∩ (f n) :=
    λ n, Hball n (c n) (r n) (r0 n),
  have cdist : ∀n, edist (c n) (c (n+1)) ≤ B n,
  { assume n,
    rw edist_comm,
    have A : c (n+1) ∈ closed_ball (c (n+1)) (r (n+1)) := mem_closed_ball_self,
    have I := calc
      closed_ball (c (n+1)) (r (n+1)) ⊆ closed_ball (c n) (r n) :
        subset.trans (incl n) (inter_subset_left _ _)
      ... ⊆ closed_ball (c n) (B n) : closed_ball_subset_closed_ball (rB n),
    exact I A },
  have : cauchy_seq c :=
    cauchy_seq_of_edist_le_geometric_two _ one_ne_top cdist,
  -- as the sequence `c n` is Cauchy in a complete space, it converges to a limit `y`.
  rcases cauchy_seq_tendsto_of_complete this with ⟨y, ylim⟩,
  -- this point `y` will be the desired point. We will check that it belongs to all
  -- `f n` and to `ball x ε`.
  use y,
  simp only [exists_prop, set.mem_Inter],
  have I : ∀n, ∀m ≥ n, closed_ball (c m) (r m) ⊆ closed_ball (c n) (r n),
  { assume n,
    refine nat.le_induction _ (λm hnm h, _),
    { exact subset.refl _ },
    { exact subset.trans (incl m) (subset.trans (inter_subset_left _ _) h) }},
  have yball : ∀n, y ∈ closed_ball (c n) (r n),
  { assume n,
    refine is_closed_ball.mem_of_tendsto ylim _,
    refine (filter.eventually_ge_at_top n).mono (λ m hm, _),
    exact I n m hm mem_closed_ball_self },
  split,
  show ∀n, y ∈ f n,
  { assume n,
    have : closed_ball (c (n+1)) (r (n+1)) ⊆ f n := subset.trans (incl n) (inter_subset_right _ _),
    exact this (yball (n+1)) },
  show edist y x ≤ ε, from le_trans (yball 0) (min_le_left _ _),
end

/-- The second theorem states that locally compact spaces are Baire. -/
@[priority 100]
instance baire_category_theorem_locally_compact [topological_space α] [t2_space α]
  [locally_compact_space α] :
  baire_space α :=
begin
  constructor,
  intros f ho hd,
  /- To prove that an intersection of open dense subsets is dense, prove that its intersection
  with any open neighbourhood `U` is dense. Define recursively a decreasing sequence `K` of
  compact neighbourhoods: start with some compact neighbourhood inside `U`, then at each step,
  take its interior, intersect with `f n`, then choose a compact neighbourhood inside the
  intersection.-/
  apply dense_iff_inter_open.2,
  intros U U_open U_nonempty,
  rcases exists_positive_compacts_subset U_open U_nonempty with ⟨K₀, hK₀⟩,
  have : ∀ n (K : positive_compacts α), ∃ K' : positive_compacts α, ↑K' ⊆ f n ∩ interior K,
  { refine λ n K, exists_positive_compacts_subset ((ho n).inter is_open_interior) _,
    rw inter_comm,
    exact (hd n).inter_open_nonempty _ is_open_interior K.interior_nonempty },
  choose K_next hK_next,
  let K : ℕ → positive_compacts α := λ n, nat.rec_on n K₀ K_next,
  /- This is a decreasing sequence of positive compacts contained in suitable open sets `f n`.-/
  have hK_decreasing : ∀ (n : ℕ), ↑(K (n + 1)) ⊆ f n ∩ K n,
    from λ n, (hK_next n (K n)).trans $ inter_subset_inter_right _ interior_subset,
  /- Prove that ̀`⋂ n : ℕ, K n` is inside `U ∩ ⋂ n : ℕ, (f n)`. -/
  have hK_subset : (⋂ n, K n : set α) ⊆ U ∩ (⋂ n, f n),
  { intros x hx,
    simp only [mem_inter_eq, mem_Inter] at hx ⊢,
    exact ⟨hK₀ $ hx 0, λ n, (hK_decreasing n (hx (n + 1))).1⟩ },
  /- Prove that `⋂ n : ℕ, K n` is not empty, as an intersection of a decreasing sequence
  of nonempty compact subsets.-/
  have hK_nonempty : (⋂ n, K n : set α).nonempty,
    from is_compact.nonempty_Inter_of_sequence_nonempty_compact_closed _
      (λ n, (hK_decreasing n).trans (inter_subset_right _ _))
      (λ n, (K n).nonempty) (K 0).compact (λ n, (K n).compact.is_closed),
  exact hK_nonempty.mono hK_subset
end

variables [topological_space α] [baire_space α]

/-- Definition of a Baire space. -/
theorem dense_Inter_of_open_nat {f : ℕ → set α} (ho : ∀ n, is_open (f n)) (hd : ∀ n, dense (f n)) :
  dense (⋂ n, f n) :=
baire_space.baire_property f ho hd

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with ⋂₀. -/
theorem dense_sInter_of_open {S : set (set α)} (ho : ∀s∈S, is_open s) (hS : S.countable)
  (hd : ∀s∈S, dense s) : dense (⋂₀S) :=
begin
  cases S.eq_empty_or_nonempty with h h,
  { simp [h] },
  { rcases hS.exists_surjective h with ⟨f, hf⟩,
    have F : ∀n, f n ∈ S := λn, by rw hf; exact mem_range_self _,
    rw [hf, sInter_range],
    exact dense_Inter_of_open_nat (λn, ho _ (F n)) (λn, hd _ (F n)) }
end

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with
an index set which is a countable set in any type. -/
theorem dense_bInter_of_open {S : set β} {f : β → set α} (ho : ∀s∈S, is_open (f s))
  (hS : S.countable) (hd : ∀s∈S, dense (f s)) : dense (⋂s∈S, f s) :=
begin
  rw ← sInter_image,
  apply dense_sInter_of_open,
  { rwa ball_image_iff },
  { exact hS.image _ },
  { rwa ball_image_iff }
end

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with
an index set which is an encodable type. -/
theorem dense_Inter_of_open [encodable β] {f : β → set α} (ho : ∀s, is_open (f s))
  (hd : ∀s, dense (f s)) : dense (⋂s, f s) :=
begin
  rw ← sInter_range,
  apply dense_sInter_of_open,
  { rwa forall_range_iff },
  { exact countable_range _ },
  { rwa forall_range_iff }
end

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with ⋂₀. -/
theorem dense_sInter_of_Gδ {S : set (set α)} (ho : ∀s∈S, is_Gδ s) (hS : S.countable)
  (hd : ∀s∈S, dense s) : dense (⋂₀S) :=
begin
  -- the result follows from the result for a countable intersection of dense open sets,
  -- by rewriting each set as a countable intersection of open sets, which are of course dense.
  choose T hTo hTc hsT using ho,
  have : ⋂₀ S = ⋂₀ (⋃ s ∈ S, T s ‹_›), -- := (sInter_bUnion (λs hs, (hT s hs).2.2)).symm,
    by simp only [sInter_Union, (hsT _ _).symm, ← sInter_eq_bInter],
  rw this,
  refine dense_sInter_of_open _ (hS.bUnion hTc) _;
    simp only [mem_Union]; rintro t ⟨s, hs, tTs⟩,
  show is_open t, from hTo s hs t tTs,
  show dense t,
  { intro x,
    have := hd s hs x,
    rw hsT s hs at this,
    exact closure_mono (sInter_subset_of_mem tTs) this }
end

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with
an index set which is an encodable type. -/
theorem dense_Inter_of_Gδ [encodable β] {f : β → set α} (ho : ∀s, is_Gδ (f s))
  (hd : ∀s, dense (f s)) : dense (⋂s, f s) :=
begin
  rw ← sInter_range,
  exact dense_sInter_of_Gδ (forall_range_iff.2 ‹_›) (countable_range _) (forall_range_iff.2 ‹_›)
end

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with
an index set which is a countable set in any type. -/
theorem dense_bInter_of_Gδ {S : set β} {f : Π x ∈ S, set α} (ho : ∀s∈S, is_Gδ (f s ‹_›))
  (hS : S.countable) (hd : ∀s∈S, dense (f s ‹_›)) : dense (⋂s∈S, f s ‹_›) :=
begin
  rw bInter_eq_Inter,
  haveI := hS.to_encodable,
  exact dense_Inter_of_Gδ (λ s, ho s s.2) (λ s, hd s s.2)
end

/-- Baire theorem: the intersection of two dense Gδ sets is dense. -/
theorem dense.inter_of_Gδ {s t : set α} (hs : is_Gδ s) (ht : is_Gδ t) (hsc : dense s)
  (htc : dense t) :
  dense (s ∩ t) :=
begin
  rw [inter_eq_Inter],
  apply dense_Inter_of_Gδ; simp [bool.forall_bool, *]
end

/-- A property holds on a residual (comeagre) set if and only if it holds on some dense `Gδ` set. -/
lemma eventually_residual {p : α → Prop} :
  (∀ᶠ x in residual α, p x) ↔ ∃ (t : set α), is_Gδ t ∧ dense t ∧ ∀ x ∈ t, p x :=
calc (∀ᶠ x in residual α, p x) ↔
  ∀ᶠ x in ⨅ (t : set α) (ht : is_Gδ t ∧ dense t), 𝓟 t, p x :
    by simp only [residual, infi_and]
... ↔ ∃ (t : set α) (ht : is_Gδ t ∧ dense t), ∀ᶠ x in 𝓟 t, p x : mem_binfi_of_directed
    (λ t₁ h₁ t₂ h₂, ⟨t₁ ∩ t₂, ⟨h₁.1.inter h₂.1, dense.inter_of_Gδ h₁.1 h₂.1 h₁.2 h₂.2⟩, by simp⟩)
    ⟨univ, is_Gδ_univ, dense_univ⟩
... ↔ _ : by simp [and_assoc]

/-- A set is residual (comeagre) if and only if it includes a dense `Gδ` set. -/
lemma mem_residual {s : set α} :
  s ∈ residual α ↔ ∃ t ⊆ s, is_Gδ t ∧ dense t :=
(@eventually_residual α _ _ (λ x, x ∈ s)).trans $ exists_congr $
λ t, by rw [exists_prop, and_comm (t ⊆ s), subset_def, and_assoc]

lemma dense_of_mem_residual {s : set α} (hs : s ∈ residual α) :
  dense s :=
let ⟨t, hts, _, hd⟩ := mem_residual.1 hs in hd.mono hts

instance : countable_Inter_filter (residual α) :=
⟨begin
  intros S hSc hS,
  simp only [mem_residual] at *,
  choose T hTs hT using hS,
  refine ⟨⋂ s ∈ S, T s ‹_›, _, _, _⟩,
  { rw [sInter_eq_bInter],
    exact Inter₂_mono hTs },
  { exact is_Gδ_bInter hSc (λ s hs, (hT s hs).1) },
  { exact dense_bInter_of_Gδ (λ s hs, (hT s hs).1) hSc (λ s hs, (hT s hs).2) }
end⟩

/-- If a countable family of closed sets cover a dense `Gδ` set, then the union of their interiors
is dense. Formulated here with `⋃`. -/
lemma is_Gδ.dense_Union_interior_of_closed [encodable ι] {s : set α} (hs : is_Gδ s)
  (hd : dense s) {f : ι → set α} (hc : ∀ i, is_closed (f i)) (hU : s ⊆ ⋃ i, f i) :
  dense (⋃ i, interior (f i)) :=
begin
  let g := λ i, (frontier (f i))ᶜ,
  have hgo : ∀ i, is_open (g i), from λ i, is_closed_frontier.is_open_compl,
  have hgd : dense (⋂ i, g i),
  { refine dense_Inter_of_open hgo (λ i x, _),
    rw [closure_compl, interior_frontier (hc _)],
    exact id },
  refine (hd.inter_of_Gδ hs (is_Gδ_Inter $ λ i, (hgo i).is_Gδ) hgd).mono _,
  rintro x ⟨hxs, hxg⟩,
  rw [mem_Inter] at hxg,
  rcases mem_Union.1 (hU hxs) with ⟨i, hi⟩,
  exact mem_Union.2 ⟨i, self_diff_frontier (f i) ▸ ⟨hi, hxg _⟩⟩,
end

/-- If a countable family of closed sets cover a dense `Gδ` set, then the union of their interiors
is dense. Formulated here with a union over a countable set in any type. -/
lemma is_Gδ.dense_bUnion_interior_of_closed {t : set ι} {s : set α} (hs : is_Gδ s)
  (hd : dense s) (ht : t.countable) {f : ι → set α} (hc : ∀ i ∈ t, is_closed (f i))
  (hU : s ⊆ ⋃ i ∈ t, f i) :
  dense (⋃ i ∈ t, interior (f i)) :=
begin
  haveI := ht.to_encodable,
  simp only [bUnion_eq_Union, set_coe.forall'] at *,
  exact hs.dense_Union_interior_of_closed hd hc hU
end

/-- If a countable family of closed sets cover a dense `Gδ` set, then the union of their interiors
is dense. Formulated here with `⋃₀`. -/
lemma is_Gδ.dense_sUnion_interior_of_closed {T : set (set α)} {s : set α} (hs : is_Gδ s)
  (hd : dense s) (hc : T.countable) (hc' : ∀ t ∈ T, is_closed t) (hU : s ⊆ ⋃₀ T) :
  dense (⋃ t ∈ T, interior t) :=
hs.dense_bUnion_interior_of_closed hd hc hc' $ by rwa [← sUnion_eq_bUnion]

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with an index set which is a countable set in any type. -/
theorem dense_bUnion_interior_of_closed {S : set β} {f : β → set α} (hc : ∀s∈S, is_closed (f s))
  (hS : S.countable) (hU : (⋃s∈S, f s) = univ) : dense (⋃s∈S, interior (f s)) :=
is_Gδ_univ.dense_bUnion_interior_of_closed dense_univ hS hc hU.ge

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with `⋃₀`. -/
theorem dense_sUnion_interior_of_closed {S : set (set α)} (hc : ∀s∈S, is_closed s)
  (hS : S.countable) (hU : (⋃₀ S) = univ) : dense (⋃s∈S, interior s) :=
is_Gδ_univ.dense_sUnion_interior_of_closed dense_univ hS hc hU.ge

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with an index set which is an encodable type. -/
theorem dense_Union_interior_of_closed [encodable β] {f : β → set α} (hc : ∀s, is_closed (f s))
  (hU : (⋃s, f s) = univ) : dense (⋃s, interior (f s)) :=
is_Gδ_univ.dense_Union_interior_of_closed dense_univ hc hU.ge

/-- One of the most useful consequences of Baire theorem: if a countable union of closed sets
covers the space, then one of the sets has nonempty interior. -/
theorem nonempty_interior_of_Union_of_closed [nonempty α] [encodable β] {f : β → set α}
  (hc : ∀s, is_closed (f s)) (hU : (⋃s, f s) = univ) :
  ∃s, (interior $ f s).nonempty :=
by simpa using (dense_Union_interior_of_closed hc hU).nonempty

end Baire_theorem


import pq_induction_principles

universe u

section pq_group_equalizer_eta_L_eta

variables {G : Type u} [group G]

lemma of_inj : function.injective (of : G → pq_group G) :=
begin
  intros x y hxy,
  have hxy1 := congr_arg counit hxy,
  simp only [counit_of] at hxy1,
  assumption,
end

lemma of_mul_eq (x y : G) : of (of x * of y) = of (of x) * of (of y) ↔ of x * of y = of (x * y) :=
begin
  split,
  {
    intro hxy,
    have hxy1 := congr_arg (L_of_morph counit (functoriality_group_to_pq counit)) hxy,
    simp only [monoid_hom.map_mul, L_of_morph_of, counit_of] at hxy1,
    symmetry,
    exact hxy1,
  },
  {
    intro hxy,
    have hxy1 := congr_arg (L_of_morph of of_is_pq_morphism) hxy,
    simp only [monoid_hom.map_mul, L_of_morph_of] at hxy1,
    rw hxy,
    rw hxy1,
  },
end

lemma of_mul_eq_three (x y z : G) : of (of x * of y * of z) = of (of x) * of (of y) * of (of z) ↔ of x * of y * of z = of (x * y * z) :=
begin
  split,
  {
    intro hxy,
    have hxy1 := congr_arg (L_of_morph counit (functoriality_group_to_pq counit)) hxy,
    simp only [monoid_hom.map_mul, L_of_morph_of, counit_of] at hxy1,
    symmetry,
    exact hxy1,
  },
  {
    intro hxy,
    have hxy1 := congr_arg (L_of_morph of of_is_pq_morphism) hxy,
    simp only [monoid_hom.map_mul, L_of_morph_of] at hxy1,
    rw hxy,
    rw hxy1,
  },
end

lemma counit_prod_map_of (x : list G) : counit (list.map of x).prod = x.prod :=
begin
  induction x,
  {
    simp only [list.prod_nil, list.map, monoid_hom.map_one],
  },
  {
    simp only [monoid_hom.map_mul, list.prod_cons, list.map, counit_of, x_ih],
  },
end

lemma L_of_prod_map_of (x : list G) : (L_of_morph of of_is_pq_morphism) ((list.map of x).prod) = (list.map (of ∘ of) x).prod :=
begin
  induction x,
  {
    simp only [list.prod_nil, list.map, monoid_hom.map_one],
  },
  {
    simp only [monoid_hom.map_mul, function.comp_app, list.prod_cons, list.map],
    simp only [x_ih, L_of_morph_of],
  },
end

lemma of_mul_eq_list (x : list G) : of ((x.map of).prod) = (x.map (of ∘ of)).prod ↔ of (x.prod) = (x.map of).prod :=
begin
  induction x with g x hx,
  {
    simp only [list.prod_nil, list.map, of_1_eq_unit, eq_self_iff_true],
  },
  {
    simp only [function.comp_app, list.prod_cons, list.map],
    split,
    {
      intro hxg,
      have hxg1 := congr_arg (L_of_morph counit (functoriality_group_to_pq counit)) hxg,
      simp only [monoid_hom.map_mul, L_of_morph_of, counit_of, counit_prod_map_of] at hxg1,
      rw hxg1,
      apply congr_arg,
      clear hxg1,
      clear hxg,
      clear hx,
      induction x,
      {
        simp only [list.prod_nil, list.map, monoid_hom.map_one],
      },
      {
        simp only [monoid_hom.map_mul, function.comp_app, list.prod_cons, list.map],
        simp only [L_of_morph_of, counit_of, x_ih],
      },
    },
    {
      intro hxg,
      have hxg1 := congr_arg (L_of_morph of of_is_pq_morphism) hxg,
      simp only [monoid_hom.map_mul, L_of_morph_of, L_of_prod_map_of] at hxg1,
      rw ←hxg1,
      rw hxg,
    },
  },
end

theorem eta_eq_L_eta (x : pq_group G) : (of x = L_of_morph of of_is_pq_morphism x) ↔ (∃ y, x = of y) :=
begin
  split,
  {
    revert x,
    refine pq_group_list _,
    intros x hx,
    rw L_of_prod_map_of at hx,
    rw of_mul_eq_list at hx,
    use x.prod,
    symmetry,
    assumption,
    /-
    revert x,
    refine pq_group_word_induction _ _,
    {
      intro h1,
      use 1,
      rw of_1_eq_unit,
      /-
      conv {
        to_rhs,
        congr,
        rw ←gpow_zero (1 : G),
      },
      rw of_pow_eq_pow_of,
      simp only [gpow_zero],
      -/
    },
    {
      intros x y hx hxy,
      simp only [monoid_hom.map_mul, L_of_morph_of] at hxy,
      --have hxy1 := congr_arg (L_of_morph counit (functoriality_group_bundled_to_pq counit)) hxy,
      --simp only [monoid_hom.map_mul, L_of_morph_of, counit_of] at hxy1,
      suffices : of x = (L_of_morph of of_is_pq_morphism) x,
      {
        specialize hx this,
        cases hx with z hz,
        use (y * z),
        rw hz,
        rw ←of_mul_eq,
        simp only [hz, L_of_morph_of] at hxy,
        assumption,
      },
      clear hx,
      revert x,
      refine pq_group_word_induction _ _,
      {
        simp only [forall_prop_of_true, mul_one, monoid_hom.map_one],
        exact of_1_eq_unit,
      },
      {
        intros x g hx hxy,
        simp only [monoid_hom.map_mul, L_of_morph_of] at *,
        sorry,
      },
      /-
      suffices : ∃ z : G, of (of y) * (L_of_morph of of_is_pq_morphism) x = of (of z),
      {
        cases this with z hz,
        use z,
        rw ←hxy at hz,
        apply of_inj,
        assumption,
      },
      sorry,
      -/
    },
    -/
  },
  {
    intro hx,
    cases hx with y hy,
    rw hy,
    rw L_of_morph_of,
  },
end

end pq_group_equalizer_eta_L_eta


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

/-!
# Comparison

This file provides basic results about orderings and comparison in linear orders.

## Definitions

* `cmp_le`: An `ordering` from `≤`.
* `ordering.compares`: Turns an `ordering` into `<` and `=` propositions.
* `linear_order_of_compares`: Constructs a `linear_order` instance from the fact that any two
  elements that are not one strictly less than the other either way are equal.
-/

variables {α : Type*}

/-- Like `cmp`, but uses a `≤` on the type instead of `<`. Given two elements `x` and `y`, returns a
three-way comparison result `ordering`. -/
def cmp_le {α} [has_le α] [@decidable_rel α (≤)] (x y : α) : ordering :=
if x ≤ y then
  if y ≤ x then ordering.eq else ordering.lt
else ordering.gt

lemma cmp_le_swap {α} [has_le α] [is_total α (≤)] [@decidable_rel α (≤)] (x y : α) :
  (cmp_le x y).swap = cmp_le y x :=
begin
  by_cases xy : x ≤ y; by_cases yx : y ≤ x; simp [cmp_le, *, ordering.swap],
  cases not_or xy yx (total_of _ _ _)
end

lemma cmp_le_eq_cmp {α} [preorder α] [is_total α (≤)]
  [@decidable_rel α (≤)] [@decidable_rel α (<)] (x y : α) : cmp_le x y = cmp x y :=
begin
  by_cases xy : x ≤ y; by_cases yx : y ≤ x;
    simp [cmp_le, lt_iff_le_not_le, *, cmp, cmp_using],
  cases not_or xy yx (total_of _ _ _)
end

namespace ordering

/-- `compares o a b` means that `a` and `b` have the ordering relation `o` between them, assuming
that the relation `a < b` is defined. -/
@[simp] def compares [has_lt α] : ordering → α → α → Prop
| lt a b := a < b
| eq a b := a = b
| gt a b := a > b

lemma compares_swap [has_lt α] {a b : α} {o : ordering} :
  o.swap.compares a b ↔ o.compares b a :=
by { cases o, exacts [iff.rfl, eq_comm, iff.rfl] }

alias compares_swap ↔ ordering.compares.of_swap ordering.compares.swap

lemma swap_eq_iff_eq_swap {o o' : ordering} : o.swap = o' ↔ o = o'.swap :=
⟨λ h, by rw [← swap_swap o, h], λ h, by rw [← swap_swap o', h]⟩

lemma compares.eq_lt [preorder α] :
  ∀ {o} {a b : α}, compares o a b → (o = lt ↔ a < b)
| lt a b h := ⟨λ _, h, λ _, rfl⟩
| eq a b h := ⟨λ h, by injection h, λ h', (ne_of_lt h' h).elim⟩
| gt a b h := ⟨λ h, by injection h, λ h', (lt_asymm h h').elim⟩

lemma compares.ne_lt [preorder α] :
  ∀ {o} {a b : α}, compares o a b → (o ≠ lt ↔ b ≤ a)
| lt a b h := ⟨absurd rfl, λ h', (not_le_of_lt h h').elim⟩
| eq a b h := ⟨λ _, ge_of_eq h, λ _ h, by injection h⟩
| gt a b h := ⟨λ _, le_of_lt h, λ _ h, by injection h⟩

lemma compares.eq_eq [preorder α] :
  ∀ {o} {a b : α}, compares o a b → (o = eq ↔ a = b)
| lt a b h := ⟨λ h, by injection h, λ h', (ne_of_lt h h').elim⟩
| eq a b h := ⟨λ _, h, λ _, rfl⟩
| gt a b h := ⟨λ h, by injection h, λ h', (ne_of_gt h h').elim⟩

lemma compares.eq_gt [preorder α] {o} {a b : α} (h : compares o a b) : (o = gt ↔ b < a) :=
swap_eq_iff_eq_swap.symm.trans h.swap.eq_lt

lemma compares.ne_gt [preorder α] {o} {a b : α} (h : compares o a b) : (o ≠ gt ↔ a ≤ b) :=
(not_congr swap_eq_iff_eq_swap.symm).trans h.swap.ne_lt

lemma compares.le_total [preorder α] {a b : α} :
  ∀ {o}, compares o a b → a ≤ b ∨ b ≤ a
| lt h := or.inl (le_of_lt h)
| eq h := or.inl (le_of_eq h)
| gt h := or.inr (le_of_lt h)

lemma compares.le_antisymm [preorder α] {a b : α} :
  ∀ {o}, compares o a b → a ≤ b → b ≤ a → a = b
| lt h _ hba := (not_le_of_lt h hba).elim
| eq h _ _   := h
| gt h hab _ := (not_le_of_lt h hab).elim

lemma compares.inj [preorder α] {o₁} :
  ∀ {o₂} {a b : α}, compares o₁ a b → compares o₂ a b → o₁ = o₂
| lt a b h₁ h₂ := h₁.eq_lt.2 h₂
| eq a b h₁ h₂ := h₁.eq_eq.2 h₂
| gt a b h₁ h₂ := h₁.eq_gt.2 h₂

lemma compares_iff_of_compares_impl {β : Type*} [linear_order α] [preorder β] {a b : α}
  {a' b' : β} (h : ∀ {o}, compares o a b → compares o a' b') (o) :
  compares o a b ↔ compares o a' b' :=
begin
  refine ⟨h, λ ho, _⟩,
  cases lt_trichotomy a b with hab hab,
  { change compares ordering.lt a b at hab,
    rwa [ho.inj (h hab)] },
  { cases hab with hab hab,
    { change compares ordering.eq a b at hab,
      rwa [ho.inj (h hab)] },
    { change compares ordering.gt a b at hab,
      rwa [ho.inj (h hab)] } }
end

lemma swap_or_else (o₁ o₂) : (or_else o₁ o₂).swap = or_else o₁.swap o₂.swap :=
by cases o₁; try {refl}; cases o₂; refl

lemma or_else_eq_lt (o₁ o₂) : or_else o₁ o₂ = lt ↔ o₁ = lt ∨ (o₁ = eq ∧ o₂ = lt) :=
by cases o₁; cases o₂; exact dec_trivial

end ordering

lemma order_dual.dual_compares [has_lt α] {a b : α} {o : ordering} :
  @ordering.compares (order_dual α) _ o a b ↔ @ordering.compares α _ o b a :=
by { cases o, exacts [iff.rfl, eq_comm, iff.rfl] }

lemma cmp_compares [linear_order α] (a b : α) : (cmp a b).compares a b :=
begin
  unfold cmp cmp_using,
  by_cases a < b; simp [h],
  by_cases h₂ : b < a; simp [h₂, gt],
  exact (decidable.lt_or_eq_of_le (le_of_not_gt h₂)).resolve_left h
end

lemma cmp_swap [preorder α] [@decidable_rel α (<)] (a b : α) : (cmp a b).swap = cmp b a :=
begin
  unfold cmp cmp_using,
  by_cases a < b; by_cases h₂ : b < a; simp [h, h₂, gt, ordering.swap],
  exact lt_asymm h h₂
end

lemma order_dual.cmp_le_flip {α} [has_le α] [@decidable_rel α (≤)] (x y : α) :
  @cmp_le (order_dual α) _ _ x y = cmp_le y x := rfl

/-- Generate a linear order structure from a preorder and `cmp` function. -/
def linear_order_of_compares [preorder α] (cmp : α → α → ordering)
  (h : ∀ a b, (cmp a b).compares a b) :
  linear_order α :=
{ le_antisymm := λ a b, (h a b).le_antisymm,
  le_total := λ a b, (h a b).le_total,
  decidable_le := λ a b, decidable_of_iff _ (h a b).ne_gt,
  decidable_lt := λ a b, decidable_of_iff _ (h a b).eq_lt,
  decidable_eq := λ a b, decidable_of_iff _ (h a b).eq_eq,
  .. ‹preorder α› }

variables [linear_order α] (x y : α)

@[simp] lemma cmp_eq_lt_iff : cmp x y = ordering.lt ↔ x < y :=
ordering.compares.eq_lt (cmp_compares x y)

@[simp] lemma cmp_eq_eq_iff : cmp x y = ordering.eq ↔ x = y :=
ordering.compares.eq_eq (cmp_compares x y)

@[simp] lemma cmp_eq_gt_iff : cmp x y = ordering.gt ↔ y < x :=
ordering.compares.eq_gt (cmp_compares x y)

@[simp] lemma cmp_self_eq_eq : cmp x x = ordering.eq :=
by rw cmp_eq_eq_iff

variables {x y} {β : Type*} [linear_order β] {x' y' : β}

lemma cmp_eq_cmp_symm : cmp x y = cmp x' y' ↔ cmp y x = cmp y' x' :=
by { split, rw [←cmp_swap _ y, ←cmp_swap _ y'], cc,
  rw [←cmp_swap _ x, ←cmp_swap _ x'], cc, }

lemma lt_iff_lt_of_cmp_eq_cmp (h : cmp x y = cmp x' y') : x < y ↔ x' < y' :=
by rw [←cmp_eq_lt_iff, ←cmp_eq_lt_iff, h]

lemma le_iff_le_of_cmp_eq_cmp (h : cmp x y = cmp x' y') : x ≤ y ↔ x' ≤ y' :=
by { rw [←not_lt, ←not_lt], apply not_congr,
  apply lt_iff_lt_of_cmp_eq_cmp, rwa cmp_eq_cmp_symm }


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.limits.has_limits
import category_theory.discrete_category

/-!
# Categorical (co)products

This file defines (co)products as special cases of (co)limits.

A product is the categorical generalization of the object `Π i, f i` where `f : ι → C`. It is a
limit cone over the diagram formed by `f`, implemented by converting `f` into a functor
`discrete ι ⥤ C`.

A coproduct is the dual concept.

## Main definitions

* a `fan` is a cone over a discrete category
* `fan.mk` constructs a fan from an indexed collection of maps
* a `pi` is a `limit (discrete.functor f)`

Each of these has a dual.

## Implementation notes
As with the other special shapes in the limits library, all the definitions here are given as
`abbreviation`s of the general statements for limits, so all the `simp` lemmas and theorems about
general limits can be used.
-/

noncomputable theory

universes w v v₂ u u₂

open category_theory

namespace category_theory.limits

variables {β : Type w}
variables {C : Type u} [category.{v} C]

-- We don't need an analogue of `pair` (for binary products), `parallel_pair` (for equalizers),
-- or `(co)span`, since we already have `discrete.functor`.

local attribute [tidy] tactic.discrete_cases

/-- A fan over `f : β → C` consists of a collection of maps from an object `P` to every `f b`. -/
abbreviation fan (f : β → C) := cone (discrete.functor f)
/-- A cofan over `f : β → C` consists of a collection of maps from every `f b` to an object `P`. -/
abbreviation cofan (f : β → C) := cocone (discrete.functor f)

/-- A fan over `f : β → C` consists of a collection of maps from an object `P` to every `f b`. -/
@[simps]
def fan.mk {f : β → C} (P : C) (p : Π b, P ⟶ f b) : fan f :=
{ X := P,
  π := { app := λ X, p X.as } }

/-- A cofan over `f : β → C` consists of a collection of maps from every `f b` to an object `P`. -/
@[simps]
def cofan.mk {f : β → C} (P : C) (p : Π b, f b ⟶ P) : cofan f :=
{ X := P,
  ι := { app := λ X, p X.as } }

-- FIXME dualize as needed below (and rename?)

/-- Get the `j`th map in the fan -/
def fan.proj  {f : β → C} (p : fan f) (j : β) : p.X ⟶ f j := p.π.app (discrete.mk j)
@[simp] lemma fan_mk_proj {f : β → C} (P : C) (p : Π b, P ⟶ f b) (j : β) :
  (fan.mk P p).proj j = p j := rfl

/-- An abbreviation for `has_limit (discrete.functor f)`. -/
abbreviation has_product (f : β → C) := has_limit (discrete.functor f)

/-- An abbreviation for `has_colimit (discrete.functor f)`. -/
abbreviation has_coproduct (f : β → C) := has_colimit (discrete.functor f)

/-- Make a fan `f` into a limit fan by providing `lift`, `fac`, and `uniq` --
  just a convenience lemma to avoid having to go through `discrete` -/
@[simps] def mk_fan_limit {f : β → C} (t : fan f)
  (lift : Π s : fan f, s.X ⟶ t.X)
  (fac : ∀ (s : fan f) (j : β), lift s ≫ (t.proj j) = s.proj j)
  (uniq : ∀ (s : fan f) (m : s.X ⟶ t.X) (w : ∀ j : β, m ≫ t.proj j = s.proj j), m = lift s) :
  is_limit t :=
{ lift := lift,
  fac' := λ s j, by convert fac s j.as; simp,
  uniq' := λ s m w, uniq s m (λ j, w (discrete.mk j)), }

section
variables (C)

/-- An abbreviation for `has_limits_of_shape (discrete f)`. -/
abbreviation has_products_of_shape (β : Type v) := has_limits_of_shape.{v} (discrete β)
/-- An abbreviation for `has_colimits_of_shape (discrete f)`. -/
abbreviation has_coproducts_of_shape (β : Type v) := has_colimits_of_shape.{v} (discrete β)
end

/-- `pi_obj f` computes the product of a family of elements `f`.
(It is defined as an abbreviation for `limit (discrete.functor f)`,
so for most facts about `pi_obj f`, you will just use general facts about limits.) -/
abbreviation pi_obj (f : β → C) [has_product f] := limit (discrete.functor f)
/-- `sigma_obj f` computes the coproduct of a family of elements `f`.
(It is defined as an abbreviation for `colimit (discrete.functor f)`,
so for most facts about `sigma_obj f`, you will just use general facts about colimits.) -/
abbreviation sigma_obj (f : β → C) [has_coproduct f] := colimit (discrete.functor f)

notation `∏ ` f:20 := pi_obj f
notation `∐ ` f:20 := sigma_obj f

/-- The `b`-th projection from the pi object over `f` has the form `∏ f ⟶ f b`. -/
abbreviation pi.π (f : β → C) [has_product f] (b : β) : ∏ f ⟶ f b :=
limit.π (discrete.functor f) (discrete.mk b)
/-- The `b`-th inclusion into the sigma object over `f` has the form `f b ⟶ ∐ f`. -/
abbreviation sigma.ι (f : β → C) [has_coproduct f] (b : β) : f b ⟶ ∐ f :=
colimit.ι (discrete.functor f) (discrete.mk b)

/-- The fan constructed of the projections from the product is limiting. -/
def product_is_product (f : β → C) [has_product f] :
  is_limit (fan.mk _ (pi.π f)) :=
is_limit.of_iso_limit (limit.is_limit (discrete.functor f)) (cones.ext (iso.refl _) (by tidy))

/-- The cofan constructed of the inclusions from the coproduct is colimiting. -/
def coproduct_is_coproduct (f : β → C) [has_coproduct f] :
  is_colimit (cofan.mk _ (sigma.ι f)) :=
is_colimit.of_iso_colimit (colimit.is_colimit (discrete.functor f)) (cocones.ext (iso.refl _)
  (by tidy))

/-- A collection of morphisms `P ⟶ f b` induces a morphism `P ⟶ ∏ f`. -/
abbreviation pi.lift {f : β → C} [has_product f] {P : C} (p : Π b, P ⟶ f b) : P ⟶ ∏ f :=
limit.lift _ (fan.mk P p)
/-- A collection of morphisms `f b ⟶ P` induces a morphism `∐ f ⟶ P`. -/
abbreviation sigma.desc {f : β → C} [has_coproduct f] {P : C} (p : Π b, f b ⟶ P) : ∐ f ⟶ P :=
colimit.desc _ (cofan.mk P p)

/--
Construct a morphism between categorical products (indexed by the same type)
from a family of morphisms between the factors.
-/
abbreviation pi.map {f g : β → C} [has_product f] [has_product g]
  (p : Π b, f b ⟶ g b) : ∏ f ⟶ ∏ g :=
lim_map (discrete.nat_trans (λ X, p X.as))
/--
Construct an isomorphism between categorical products (indexed by the same type)
from a family of isomorphisms between the factors.
-/
abbreviation pi.map_iso {f g : β → C} [has_products_of_shape β C]
  (p : Π b, f b ≅ g b) : ∏ f ≅ ∏ g :=
lim.map_iso (discrete.nat_iso (λ X, p X.as))
/--
Construct a morphism between categorical coproducts (indexed by the same type)
from a family of morphisms between the factors.
-/
abbreviation sigma.map {f g : β → C} [has_coproduct f] [has_coproduct g]
  (p : Π b, f b ⟶ g b) : ∐ f ⟶ ∐ g :=
colim_map (discrete.nat_trans (λ X, p X.as))
/--
Construct an isomorphism between categorical coproducts (indexed by the same type)
from a family of isomorphisms between the factors.
-/
abbreviation sigma.map_iso {f g : β → C} [has_coproducts_of_shape β C]
  (p : Π b, f b ≅ g b) : ∐ f ≅ ∐ g :=
colim.map_iso (discrete.nat_iso (λ X, p X.as))

section comparison

variables {D : Type u₂} [category.{v₂} D] (G : C ⥤ D)
variables (f : β → C)

/-- The comparison morphism for the product of `f`. This is an iso iff `G` preserves the product
of `f`, see `preserves_product.of_iso_comparison`. -/
def pi_comparison [has_product f] [has_product (λ b, G.obj (f b))] :
  G.obj (∏ f) ⟶ ∏ (λ b, G.obj (f b)) :=
pi.lift (λ b, G.map (pi.π f b))

@[simp, reassoc]
lemma pi_comparison_comp_π [has_product f] [has_product (λ b, G.obj (f b))] (b : β) :
  pi_comparison G f ≫ pi.π _ b = G.map (pi.π f b) :=
limit.lift_π _ (discrete.mk b)

@[simp, reassoc]
lemma map_lift_pi_comparison [has_product f] [has_product (λ b, G.obj (f b))]
  (P : C) (g : Π j, P ⟶ f j) :
  G.map (pi.lift g) ≫ pi_comparison G f = pi.lift (λ j, G.map (g j)) :=
by { ext, discrete_cases, simp [← G.map_comp] }

/-- The comparison morphism for the coproduct of `f`. This is an iso iff `G` preserves the coproduct
of `f`, see `preserves_coproduct.of_iso_comparison`. -/
def sigma_comparison [has_coproduct f] [has_coproduct (λ b, G.obj (f b))] :
  ∐ (λ b, G.obj (f b)) ⟶ G.obj (∐ f) :=
sigma.desc (λ b, G.map (sigma.ι f b))

@[simp, reassoc]
lemma ι_comp_sigma_comparison [has_coproduct f] [has_coproduct (λ b, G.obj (f b))] (b : β) :
  sigma.ι _ b ≫ sigma_comparison G f = G.map (sigma.ι f b) :=
colimit.ι_desc _ (discrete.mk b)

@[simp, reassoc]
lemma sigma_comparison_map_desc [has_coproduct f] [has_coproduct (λ b, G.obj (f b))]
  (P : C) (g : Π j, f j ⟶ P) :
  sigma_comparison G f ≫ G.map (sigma.desc g) = sigma.desc (λ j, G.map (g j)) :=
by { ext, discrete_cases, simp [← G.map_comp] }

end comparison

variables (C)

/-- An abbreviation for `Π J, has_limits_of_shape (discrete J) C` -/
abbreviation has_products := Π (J : Type w), has_limits_of_shape (discrete J) C
/-- An abbreviation for `Π J, has_colimits_of_shape (discrete J) C` -/
abbreviation has_coproducts := Π (J : Type w), has_colimits_of_shape (discrete J) C

variable {C}

lemma has_smallest_products_of_has_products [has_products.{w} C] : has_products.{0} C :=
λ J, has_limits_of_shape_of_equivalence
  (discrete.equivalence equiv.ulift : discrete (ulift.{w} J) ≌ _)

lemma has_smallest_coproducts_of_has_coproducts [has_coproducts.{w} C] : has_coproducts.{0} C :=
λ J, has_colimits_of_shape_of_equivalence
  (discrete.equivalence equiv.ulift : discrete (ulift.{w} J) ≌ _)

lemma has_products_of_limit_fans (lf : ∀ {J : Type w} (f : J → C), fan f)
  (lf_is_limit : ∀ {J : Type w} (f : J → C), is_limit (lf f)) : has_products.{w} C :=
λ (J : Type w), { has_limit := λ F, has_limit.mk
  ⟨(cones.postcompose discrete.nat_iso_functor.inv).obj (lf (λ j, F.obj ⟨j⟩)),
    (is_limit.postcompose_inv_equiv _ _).symm (lf_is_limit _)⟩ }

/-!
(Co)products over a type with a unique term.
-/
section unique
variables {C} [unique β] (f : β → C)

/-- The limit cone for the product over an index type with exactly one term. -/
@[simps]
def limit_cone_of_unique : limit_cone (discrete.functor f) :=
{ cone :=
  { X := f default,
    π := { app := λ j, eq_to_hom (by { dsimp, congr, }), }, },
  is_limit :=
  { lift := λ s, s.π.app default,
    fac' := λ s j, begin
      have w := (s.π.naturality (eq_to_hom (unique.default_eq _))).symm,
      dsimp at w,
      simpa [eq_to_hom_map] using w,
    end,
    uniq' := λ s m w, begin
      specialize w default,
      dsimp at w,
      simpa using w,
    end, }, }

@[priority 100] instance has_product_unique : has_product f :=
has_limit.mk (limit_cone_of_unique f)

/-- A product over a index type with exactly one term is just the object over that term. -/
@[simps]
def product_unique_iso : ∏ f ≅ f default :=
is_limit.cone_point_unique_up_to_iso (limit.is_limit _) (limit_cone_of_unique f).is_limit

/-- The colimit cocone for the coproduct over an index type with exactly one term. -/
@[simps]
def colimit_cocone_of_unique : colimit_cocone (discrete.functor f) :=
{ cocone :=
  { X := f default,
    ι := { app := λ j, eq_to_hom (by { discrete_cases, dsimp, congr, }), }, },
  is_colimit :=
  { desc := λ s, s.ι.app default,
    fac' := λ s j, begin
      have w := (s.ι.naturality (eq_to_hom (unique.eq_default _))),
      dsimp at w,
      simpa [eq_to_hom_map] using w,
    end,
    uniq' := λ s m w, begin
      specialize w default,
      dsimp at w,
      simpa using w,
    end, }, }

@[priority 100] instance has_coproduct_unique : has_coproduct f :=
has_colimit.mk (colimit_cocone_of_unique f)

/-- A coproduct over a index type with exactly one term is just the object over that term. -/
@[simps]
def coproduct_unique_iso : ∐ f ≅ f default :=
is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _)
  (colimit_cocone_of_unique f).is_colimit

end unique

section reindex
variables {C} {γ : Type v} (ε : β ≃ γ) (f : γ → C)

section
variables [has_product f] [has_product (f ∘ ε)]

/-- Reindex a categorical product via an equivalence of the index types. -/
def pi.reindex : pi_obj (f ∘ ε) ≅ pi_obj f :=
has_limit.iso_of_equivalence (discrete.equivalence ε) (discrete.nat_iso (λ i, iso.refl _))

@[simp, reassoc]
lemma pi.reindex_hom_π (b : β) : (pi.reindex ε f).hom ≫ pi.π f (ε b) = pi.π (f ∘ ε) b :=
begin
  dsimp [pi.reindex],
  simp only [has_limit.iso_of_equivalence_hom_π, discrete.nat_iso_inv_app,
    equivalence.equivalence_mk'_counit, discrete.equivalence_counit_iso, discrete.nat_iso_hom_app,
    eq_to_iso.hom, eq_to_hom_map],
  dsimp,
  simpa [eq_to_hom_map] using
    limit.w (discrete.functor (f ∘ ε)) (discrete.eq_to_hom' (ε.symm_apply_apply b)),
end

@[simp, reassoc]
lemma pi.reindex_inv_π (b : β) : (pi.reindex ε f).inv ≫ pi.π (f ∘ ε) b = pi.π f (ε b) :=
by simp [iso.inv_comp_eq]

end

section
variables [has_coproduct f] [has_coproduct (f ∘ ε)]

/-- Reindex a categorical coproduct via an equivalence of the index types. -/
def sigma.reindex : sigma_obj (f ∘ ε) ≅ sigma_obj f :=
has_colimit.iso_of_equivalence (discrete.equivalence ε) (discrete.nat_iso (λ i, iso.refl _))

@[simp, reassoc]
lemma sigma.ι_reindex_hom (b : β) : sigma.ι (f ∘ ε) b ≫ (sigma.reindex ε f).hom = sigma.ι f (ε b) :=
begin
  dsimp [sigma.reindex],
  simp only [has_colimit.iso_of_equivalence_hom_π, equivalence.equivalence_mk'_unit,
    discrete.equivalence_unit_iso, discrete.nat_iso_hom_app, eq_to_iso.hom, eq_to_hom_map,
    discrete.nat_iso_inv_app],
  dsimp,
  simp [eq_to_hom_map,
    ←colimit.w (discrete.functor f) (discrete.eq_to_hom' (ε.apply_symm_apply (ε b)))],
end

@[simp, reassoc]
lemma sigma.ι_reindex_inv (b : β) : sigma.ι f (ε b) ≫ (sigma.reindex ε f).inv = sigma.ι (f ∘ ε) b :=
by simp [iso.comp_inv_eq]

end

end reindex

end category_theory.limits