/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro, Simon Hudon

! This file was ported from Lean 3 source module data.typevec
! leanprover-community/mathlib commit 4fcbc82dc2257986c03e113f87bc5ce021243a44
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fin.Fin2
import Mathlib.Data.TypeVec.Attr
import Mathlib.Logic.Function.Basic
import Mathlib.Tactic.Basic
import Mathlib.Tactic.ScopedNS
import Mathlib.Tactic.Replace
import Mathlib.Tactic.SolveByElim

/-!

# Tuples of types, and their categorical structure.

## Features

* `TypeVec n` - n-tuples of types
* `α ⟹ β`    - n-tuples of maps
* `f ⊚ g`     - composition

Also, support functions for operating with n-tuples of types, such as:

* `append1 α β`    - append type `β` to n-tuple `α` to obtain an (n+1)-tuple
* `drop α`         - drops the last element of an (n+1)-tuple
* `last α`         - returns the last element of an (n+1)-tuple
* `appendFun f g` - appends a function g to an n-tuple of functions
* `dropFun f`     - drops the last function from an n+1-tuple
* `lastFun f`     - returns the last function of a tuple.

Since e.g. `append1 α.drop α.last` is propositionally equal to `α` but not definitionally equal
to it, we need support functions and lemmas to mediate between constructions.
-/

universe u v w

/-- n-tuples of types, as a category -/
def TypeVec (n : ℕ) :=
  Fin2 n → Type _
#align typevec TypeVec

instance {n} : Inhabited (TypeVec.{u} n) :=
  ⟨fun _ => PUnit⟩

namespace TypeVec

variable {n : ℕ}

/-- arrow in the category of `TypeVec` -/
def Arrow (α β : TypeVec n) :=
  ∀ i : Fin2 n, α i → β i
#align typevec.arrow TypeVec.Arrow

@[inherit_doc] scoped[MvFunctor] infixl:40 " ⟹ " => TypeVec.Arrow
open MvFunctor

/-- Extensionality for arrows -/
@[ext]
theorem Arrow.ext {α β : TypeVec n} (f g : α ⟹ β) :
  (∀ i, f i = g i) → f = g :=
by
  intro h; funext i; apply h;

instance Arrow.inhabited (α β : TypeVec n) [∀ i, Inhabited (β i)] : Inhabited (α ⟹ β) :=
  ⟨fun _ _ => default⟩
#align typevec.arrow.inhabited TypeVec.Arrow.inhabited

/-- identity of arrow composition -/
def id {α : TypeVec n} : α ⟹ α := fun _ x => x
#align typevec.id TypeVec.id

/-- arrow composition in the category of `TypeVec` -/
def comp {α β γ : TypeVec n} (g : β ⟹ γ) (f : α ⟹ β) : α ⟹ γ := fun i x => g i (f i x)
#align typevec.comp TypeVec.comp

@[inherit_doc] scoped[MvFunctor] infixr:80 " ⊚ " => TypeVec.comp -- type as \oo

@[simp]
theorem id_comp {α β : TypeVec n} (f : α ⟹ β) : id ⊚ f = f :=
  rfl
#align typevec.id_comp TypeVec.id_comp

@[simp]
theorem comp_id {α β : TypeVec n} (f : α ⟹ β) : f ⊚ id = f :=
  rfl
#align typevec.comp_id TypeVec.comp_id

/-- Support for extending a `TypeVec` by one element. -/
def append1 (α : TypeVec n) (β : Type _) : TypeVec (n + 1)
  | Fin2.fs i => α i
  | Fin2.fz => β
#align typevec.append1 TypeVec.append1

@[inherit_doc] infixl:67 " ::: " => append1

/-- retain only a `n-length` prefix of the argument -/
def drop (α : TypeVec.{u} (n + 1)) : TypeVec n := fun i => α i.fs
#align typevec.drop TypeVec.drop

/-- take the last value of a `(n+1)-length` vector -/
def last (α : TypeVec.{u} (n + 1)) : Type _ :=
  α Fin2.fz
#align typevec.last TypeVec.last

instance last.inhabited (α : TypeVec (n + 1)) [Inhabited (α Fin2.fz)] : Inhabited (last α) :=
  ⟨show α Fin2.fz from default⟩
#align typevec.last.inhabited TypeVec.last.inhabited

theorem drop_append1 {α : TypeVec n} {β : Type _} {i : Fin2 n} : drop (append1 α β) i = α i :=
  rfl
#align typevec.drop_append1 TypeVec.drop_append1

theorem drop_append1' {α : TypeVec n} {β : Type _} : drop (append1 α β) = α :=
  funext <| fun _ => drop_append1
#align typevec.drop_append1' TypeVec.drop_append1'

theorem last_append1 {α : TypeVec n} {β : Type _} : last (append1 α β) = β :=
  rfl
#align typevec.last_append1 TypeVec.last_append1

@[simp]
theorem append1_drop_last (α : TypeVec (n + 1)) : append1 (drop α) (last α) = α :=
  funext fun i => by cases i <;> rfl
#align typevec.append1_drop_last TypeVec.append1_drop_last

/-- cases on `(n+1)-length` vectors -/
@[elab_as_elim]
def append1Cases {C : TypeVec (n + 1) → Sort u} (H : ∀ α β, C (append1 α β)) (γ) : C γ := by
  rw [← @append1_drop_last _ γ]; apply H
#align typevec.append1_cases TypeVec.append1Cases

@[simp]
theorem append1_cases_append1 {C : TypeVec (n + 1) → Sort u} (H : ∀ α β, C (append1 α β)) (α β) :
    @append1Cases _ C H (append1 α β) = H α β :=
  rfl
#align typevec.append1_cases_append1 TypeVec.append1_cases_append1

/-- append an arrow and a function for arbitrary source and target type vectors -/
def splitFun {α α' : TypeVec (n + 1)} (f : drop α ⟹ drop α') (g : last α → last α') : α ⟹ α'
  | Fin2.fs i => f i
  | Fin2.fz => g
#align typevec.split_fun TypeVec.splitFun

/-- append an arrow and a function as well as their respective source and target types / typevecs -/
def appendFun {α α' : TypeVec n} {β β' : Type _} (f : α ⟹ α') (g : β → β') :
    append1 α β ⟹ append1 α' β' :=
  splitFun f g
#align typevec.append_fun TypeVec.appendFun

@[inherit_doc] infixl:0 " ::: " => appendFun

/-- split off the prefix of an arrow -/
def dropFun {α β : TypeVec (n + 1)} (f : α ⟹ β) : drop α ⟹ drop β := fun i => f i.fs
#align typevec.drop_fun TypeVec.dropFun

/-- split off the last function of an arrow -/
def lastFun {α β : TypeVec (n + 1)} (f : α ⟹ β) : last α → last β :=
  f Fin2.fz
#align typevec.last_fun TypeVec.lastFun

-- porting note: Lean wasn't able to infer the motive in term mode
/-- arrow in the category of `0-length` vectors -/
def nilFun {α : TypeVec 0} {β : TypeVec 0} : α ⟹ β := fun i => by apply Fin2.elim0 i
#align typevec.nil_fun TypeVec.nilFun

theorem eq_of_drop_last_eq {α β : TypeVec (n + 1)} {f g : α ⟹ β} (h₀ : dropFun f = dropFun g)
    (h₁ : lastFun f = lastFun g) : f = g := by
  -- porting note: FIXME: congr_fun h₀ <;> ext1 ⟨⟩ <;> apply_assumption
  refine funext (fun x => ?_)
  cases x
  . apply h₁
  . apply congr_fun h₀
#align typevec.eq_of_drop_last_eq TypeVec.eq_of_drop_last_eq

@[simp]
theorem dropFun_splitFun {α α' : TypeVec (n + 1)} (f : drop α ⟹ drop α') (g : last α → last α') :
    dropFun (splitFun f g) = f :=
  rfl
#align typevec.drop_fun_split_fun TypeVec.dropFun_splitFun

/-- turn an equality into an arrow -/
def Arrow.mp {α β : TypeVec n} (h : α = β) : α ⟹ β
  | _ => Eq.mp (congr_fun h _)
#align typevec.arrow.mp TypeVec.Arrow.mp

/-- turn an equality into an arrow, with reverse direction -/
def Arrow.mpr {α β : TypeVec n} (h : α = β) : β ⟹ α
  | _ => Eq.mpr (congr_fun h _)
#align typevec.arrow.mpr TypeVec.Arrow.mpr

/-- decompose a vector into its prefix appended with its last element -/
def toAppend1DropLast {α : TypeVec (n + 1)} : α ⟹ (drop α ::: last α) :=
  Arrow.mpr (append1_drop_last _)
#align typevec.to_append1_drop_last TypeVec.toAppend1DropLast

/-- stitch two bits of a vector back together -/
def fromAppend1DropLast {α : TypeVec (n + 1)} : (drop α ::: last α) ⟹ α :=
  Arrow.mp (append1_drop_last _)
#align typevec.from_append1_drop_last TypeVec.fromAppend1DropLast

@[simp]
theorem lastFun_splitFun {α α' : TypeVec (n + 1)} (f : drop α ⟹ drop α') (g : last α → last α') :
    lastFun (splitFun f g) = g :=
  rfl
#align typevec.last_fun_split_fun TypeVec.lastFun_splitFun

@[simp]
theorem dropFun_appendFun {α α' : TypeVec n} {β β' : Type _} (f : α ⟹ α') (g : β → β') :
    dropFun (f ::: g) = f :=
  rfl
#align typevec.drop_fun_append_fun TypeVec.dropFun_appendFun

@[simp]
theorem lastFun_appendFun {α α' : TypeVec n} {β β' : Type _} (f : α ⟹ α') (g : β → β') :
    lastFun (f ::: g) = g :=
  rfl
#align typevec.last_fun_append_fun TypeVec.lastFun_appendFun

theorem split_dropFun_lastFun {α α' : TypeVec (n + 1)} (f : α ⟹ α') :
    splitFun (dropFun f) (lastFun f) = f :=
  eq_of_drop_last_eq rfl rfl
#align typevec.split_drop_fun_last_fun TypeVec.split_dropFun_lastFun

theorem splitFun_inj {α α' : TypeVec (n + 1)} {f f' : drop α ⟹ drop α'} {g g' : last α → last α'}
    (H : splitFun f g = splitFun f' g') : f = f' ∧ g = g' := by
  rw [← dropFun_splitFun f g, H, ← lastFun_splitFun f g, H]; simp
#align typevec.split_fun_inj TypeVec.splitFun_inj

theorem appendFun_inj {α α' : TypeVec n} {β β' : Type _} {f f' : α ⟹ α'} {g g' : β → β'} :
    (f ::: g : (α ::: β) ⟹ _) = (f' ::: g' : (α ::: β) ⟹ _)
    → f = f' ∧ g = g' :=
  splitFun_inj
#align typevec.append_fun_inj TypeVec.appendFun_inj

theorem splitFun_comp {α₀ α₁ α₂ : TypeVec (n + 1)} (f₀ : drop α₀ ⟹ drop α₁)
    (f₁ : drop α₁ ⟹ drop α₂) (g₀ : last α₀ → last α₁) (g₁ : last α₁ → last α₂) :
    splitFun (f₁ ⊚ f₀) (g₁ ∘ g₀) = splitFun f₁ g₁ ⊚ splitFun f₀ g₀ :=
  eq_of_drop_last_eq rfl rfl
#align typevec.split_fun_comp TypeVec.splitFun_comp

theorem appendFun_comp_splitFun {α γ : TypeVec n} {β δ : Type _} {ε : TypeVec (n + 1)}
          (f₀ : drop ε ⟹ α)
          (f₁ : α ⟹ γ)
          (g₀ : last ε → β)
          (g₁ : β → δ) :
   appendFun f₁ g₁ ⊚ splitFun f₀ g₀
      = splitFun (α':=γ.append1 δ) (f₁ ⊚ f₀) (g₁ ∘ g₀)
  :=
  (splitFun_comp _ _ _ _).symm
#align typevec.append_fun_comp_split_fun TypeVec.appendFun_comp_splitFun

theorem appendFun_comp  {α₀ α₁ α₂ : TypeVec n}
                        {β₀ β₁ β₂ : Type _}
                        (f₀ : α₀ ⟹ α₁) (f₁ : α₁ ⟹ α₂)
                        (g₀ : β₀ → β₁) (g₁ : β₁ → β₂) :
    (f₁ ⊚ f₀ ::: g₁ ∘ g₀) = (f₁ ::: g₁) ⊚ (f₀ ::: g₀) :=
  eq_of_drop_last_eq rfl rfl
#align typevec.append_fun_comp TypeVec.appendFun_comp

theorem appendFun_comp' {α₀ α₁ α₂ : TypeVec n} {β₀ β₁ β₂ : Type _}
                        (f₀ : α₀ ⟹ α₁) (f₁ : α₁ ⟹ α₂)
                        (g₀ : β₀ → β₁) (g₁ : β₁ → β₂) :
    (f₁ ::: g₁) ⊚ (f₀ ::: g₀) = (f₁ ⊚ f₀ ::: g₁ ∘ g₀) :=
  eq_of_drop_last_eq rfl rfl
#align typevec.append_fun_comp' TypeVec.appendFun_comp'

theorem nilFun_comp {α₀ : TypeVec 0} (f₀ : α₀ ⟹ Fin2.elim0) : nilFun ⊚ f₀ = f₀ :=
  funext fun x => by apply Fin2.elim0 x -- porting note: `by apply` is necessary?
#align typevec.nil_fun_comp TypeVec.nilFun_comp

theorem appendFun_comp_id {α : TypeVec n} {β₀ β₁ β₂ : Type _} (g₀ : β₀ → β₁) (g₁ : β₁ → β₂) :
    (@id _ α ::: g₁ ∘ g₀) = (id ::: g₁) ⊚ (id ::: g₀) :=
  eq_of_drop_last_eq rfl rfl
#align typevec.append_fun_comp_id TypeVec.appendFun_comp_id

@[simp]
theorem dropFun_comp {α₀ α₁ α₂ : TypeVec (n + 1)} (f₀ : α₀ ⟹ α₁) (f₁ : α₁ ⟹ α₂) :
    dropFun (f₁ ⊚ f₀) = dropFun f₁ ⊚ dropFun f₀ :=
  rfl
#align typevec.drop_fun_comp TypeVec.dropFun_comp

@[simp]
theorem lastFun_comp {α₀ α₁ α₂ : TypeVec (n + 1)} (f₀ : α₀ ⟹ α₁) (f₁ : α₁ ⟹ α₂) :
    lastFun (f₁ ⊚ f₀) = lastFun f₁ ∘ lastFun f₀ :=
  rfl
#align typevec.last_fun_comp TypeVec.lastFun_comp

theorem appendFun_aux {α α' : TypeVec n} {β β' : Type _} (f : (α ::: β) ⟹ (α' ::: β')) :
    (dropFun f ::: lastFun f) = f :=
  eq_of_drop_last_eq rfl rfl
#align typevec.append_fun_aux TypeVec.appendFun_aux

theorem appendFun_id_id {α : TypeVec n} {β : Type _} :
    (@TypeVec.id n α ::: @_root_.id β) = TypeVec.id :=
  eq_of_drop_last_eq rfl rfl
#align typevec.append_fun_id_id TypeVec.appendFun_id_id

instance subsingleton0 : Subsingleton (TypeVec 0) :=
  ⟨fun a b => funext fun a => by apply Fin2.elim0 a⟩ -- porting note: `by apply` necessary?
#align typevec.subsingleton0 TypeVec.subsingleton0

-- Porting note: `simp` attribute `typevec` moved to file `Data/TypeVec/Attr.lean`

/-- cases distinction for 0-length type vector -/
protected def casesNil {β : TypeVec 0 → Sort _} (f : β Fin2.elim0) : ∀ v, β v
  := fun v => cast (by congr; funext i; cases i) f
#align typevec.cases_nil TypeVec.casesNil

/-- cases distinction for (n+1)-length type vector -/
protected def casesCons (n : ℕ) {β : TypeVec (n + 1) → Sort _}
                        (f : ∀ (t) (v : TypeVec n), β (v ::: t)) :
    ∀ v, β v :=
  fun v : TypeVec (n + 1) => cast (by simp) (f v.last v.drop)
#align typevec.cases_cons TypeVec.casesCons

protected theorem casesNil_append1 {β : TypeVec 0 → Sort _} (f : β Fin2.elim0) :
    TypeVec.casesNil f Fin2.elim0 = f :=
  rfl
#align typevec.cases_nil_append1 TypeVec.casesNil_append1

protected theorem casesCons_append1  (n : ℕ) {β : TypeVec (n + 1) → Sort _}
                                      (f : ∀ (t) (v : TypeVec n), β (v ::: t))
    (v : TypeVec n) (α) : TypeVec.casesCons n f (v ::: α) = f α v :=
  rfl
#align typevec.cases_cons_append1 TypeVec.casesCons_append1

/-- cases distinction for an arrow in the category of 0-length type vectors -/
def typevecCasesNil₃  {β : ∀ v v' : TypeVec 0, v ⟹ v' → Sort _}
                      (f : β Fin2.elim0 Fin2.elim0 nilFun) :
    ∀ v v' fs, β v v' fs := fun v v' fs => by
  refine' cast _ f;
  have eq₁ : v = Fin2.elim0 := by funext i; contradiction
  have eq₂ : v' = Fin2.elim0 := by funext i; contradiction
  have eq₃ : fs = nilFun := by funext i; contradiction;
  cases eq₁; cases eq₂; cases eq₃;
  rfl
#align typevec.typevec_cases_nil₃ TypeVec.typevecCasesNil₃

/-- cases distinction for an arrow in the category of (n+1)-length type vectors -/
def typevecCasesCons₃ (n : ℕ) {β : ∀ v v' : TypeVec (n + 1), v ⟹ v' → Sort _}
                      (F : ∀ (t t') (f : t → t')  (v v' : TypeVec n) (fs : v ⟹ v'),
                              β (v ::: t) (v' ::: t') (fs ::: f)) :
    ∀ v v' fs, β v v' fs := by
  intro v v'
  rw [← append1_drop_last v, ← append1_drop_last v']
  intro fs
  rw [← split_dropFun_lastFun fs]
  apply F
#align typevec.typevec_cases_cons₃ TypeVec.typevecCasesCons₃

/-- specialized cases distinction for an arrow in the category of 0-length type vectors -/
def typevecCasesNil₂ {β : Fin2.elim0 ⟹ Fin2.elim0 → Sort _} (f : β nilFun) : ∀ f, β f := by
  intro g
  have : g = nilFun
  ext ⟨⟩
  rw [this]
  exact f
#align typevec.typevec_cases_nil₂ TypeVec.typevecCasesNil₂

/-- specialized cases distinction for an arrow in the category of (n+1)-length type vectors -/
def typevecCasesCons₂ (n : ℕ) (t t' : Type _) (v v' : TypeVec n)
                      {β : (v ::: t) ⟹ (v' ::: t') → Sort _}
    (F : ∀ (f : t → t') (fs : v ⟹ v'), β (fs ::: f)) : ∀ fs, β fs := by
  intro fs
  rw [← split_dropFun_lastFun fs]
  apply F
#align typevec.typevec_cases_cons₂ TypeVec.typevecCasesCons₂

theorem typevecCasesNil₂_appendFun {β : Fin2.elim0 ⟹ Fin2.elim0 → Sort _} (f : β nilFun) :
    typevecCasesNil₂ f nilFun = f :=
  rfl
#align typevec.typevec_cases_nil₂_append_fun TypeVec.typevecCasesNil₂_appendFun

theorem typevecCasesCons₂_appendFun (n : ℕ) (t t' : Type _) (v v' : TypeVec n)
                                      {β : (v ::: t) ⟹ (v' ::: t') → Sort _}
                                      (F : ∀ (f : t → t') (fs : v ⟹ v'), β (fs ::: f))
                                      (f fs) :
    typevecCasesCons₂ n t t' v v' F (fs ::: f) = F f fs :=
  rfl
#align typevec.typevec_cases_cons₂_append_fun TypeVec.typevecCasesCons₂_appendFun

-- for lifting predicates and relations
/-- `PredLast α p x` predicates `p` of the last element of `x : α.append1 β`. -/
def PredLast (α : TypeVec n) {β : Type _} (p : β → Prop) : ∀ ⦃i⦄, (α.append1 β) i → Prop
  | Fin2.fs _ => fun _ => True
  | Fin2.fz => p
#align typevec.pred_last TypeVec.PredLast

/-- `RelLast α r x y` says that `p` the last elements of `x y : α.append1 β` are related by `r` and
all the other elements are equal. -/
def RelLast (α : TypeVec n) {β γ : Type _} (r : β → γ → Prop) :
      ∀ ⦃i⦄, (α.append1 β) i → (α.append1 γ) i → Prop
  | Fin2.fs _ => Eq
  | Fin2.fz => r
#align typevec.rel_last TypeVec.RelLast

section Liftp'

open Nat

/-- `repeat n t` is a `n-length` type vector that contains `n` occurences of `t` -/
def «repeat» : ∀ (n : ℕ), Sort _ → TypeVec n
  | 0, _ => Fin2.elim0
  | Nat.succ i, t => append1 («repeat» i t) t
#align typevec.repeat TypeVec.repeat

/-- `prod α β` is the pointwise product of the components of `α` and `β` -/
def prod : ∀ {n}, TypeVec.{u} n → TypeVec.{u} n → TypeVec n
  | 0,     _, _ => Fin2.elim0
  | n + 1, α, β => (@prod n (drop α) (drop β)) ::: (last α × last β)
#align typevec.prod TypeVec.prod

@[inherit_doc] scoped[MvFunctor] infixl:45 " ⊗ " => TypeVec.prod

/- porting note: the order of universes in `const` is reversed w.r.t. mathlib3 -/
/-- `const x α` is an arrow that ignores its source and constructs a `TypeVec` that
contains nothing but `x` -/
protected def const {β} (x : β) : ∀ {n} (α : TypeVec n), α ⟹ «repeat» _ β
  | succ _, α, Fin2.fs _  => TypeVec.const x (drop α) _
  | succ _, _, Fin2.fz    => fun _ => x
#align typevec.const TypeVec.const

open Function (uncurry)

/-- vector of equality on a product of vectors -/
def repeatEq : ∀ {n} (α : TypeVec n), (α ⊗ α) ⟹ «repeat» _ Prop
  | 0, _ => nilFun
  | succ _, α => repeatEq (drop α) ::: uncurry Eq
#align typevec.repeat_eq TypeVec.repeatEq

theorem const_append1 {β γ} (x : γ) {n} (α : TypeVec n) :
    TypeVec.const x (α ::: β) = appendFun (TypeVec.const x α) fun _ => x :=
  by ext i : 1; cases i <;> rfl
#align typevec.const_append1 TypeVec.const_append1

theorem eq_nilFun {α β : TypeVec 0} (f : α ⟹ β) : f = nilFun :=
  by ext x; cases x
#align typevec.eq_nil_fun TypeVec.eq_nilFun

theorem id_eq_nilFun {α : TypeVec 0} : @id _ α = nilFun :=
  by ext x; cases x
#align typevec.id_eq_nil_fun TypeVec.id_eq_nilFun

theorem const_nil {β} (x : β) (α : TypeVec 0) : TypeVec.const x α = nilFun :=
  by ext i : 1; cases i
#align typevec.const_nil TypeVec.const_nil

@[typevec]
theorem repeat_eq_append1 {β} {n} (α : TypeVec n) :
  repeatEq (α ::: β) = splitFun (α := (α ⊗ α) ::: _ )
                                (α' := («repeat» n Prop) ::: _)
                                (repeatEq α)
                                (uncurry Eq) :=
by
  induction n <;> rfl
#align typevec.repeat_eq_append1 TypeVec.repeat_eq_append1

@[typevec]
theorem repeat_eq_nil (α : TypeVec 0) : repeatEq α = nilFun := by ext i; cases i
#align typevec.repeat_eq_nil TypeVec.repeat_eq_nil

/-- predicate on a type vector to constrain only the last object -/
def PredLast' (α : TypeVec n) {β : Type _} (p : β → Prop) :
    (α ::: β) ⟹ «repeat» (n + 1) Prop :=
  splitFun (TypeVec.const True α) p
#align typevec.pred_last' TypeVec.PredLast'

/-- predicate on the product of two type vectors to constrain only their last object -/
def RelLast' (α : TypeVec n) {β : Type _} (p : β → β → Prop) :
    (α ::: β) ⊗ (α ::: β) ⟹ «repeat» (n + 1) Prop :=
  splitFun (repeatEq α) (uncurry p)
#align typevec.rel_last' TypeVec.RelLast'

/-- given `F : TypeVec.{u} (n+1) → Type u`, `curry F : Type u → TypeVec.{u} → Type u`,
i.e. its first argument can be fed in separately from the rest of the vector of arguments -/
def Curry (F : TypeVec.{u} (n + 1) → Type _) (α : Type u) (β : TypeVec.{u} n) : Type _ :=
  F (β ::: α)
#align typevec.curry TypeVec.Curry

instance Curry.inhabited (F : TypeVec.{u} (n + 1) → Type _) (α : Type u) (β : TypeVec.{u} n)
    [I : Inhabited (F <| (β ::: α))] : Inhabited (Curry F α β) :=
  I
#align typevec.curry.inhabited TypeVec.Curry.inhabited

/-- arrow to remove one element of a `repeat` vector -/
def dropRepeat (α : Type _) : ∀ {n}, drop («repeat» (succ n) α) ⟹ «repeat» n α
  | succ _, Fin2.fs i => dropRepeat α i
  | succ _, Fin2.fz   => fun (a : α) => a
#align typevec.drop_repeat TypeVec.dropRepeat

/-- projection for a repeat vector -/
def ofRepeat {α : Sort _} : ∀ {n i}, «repeat» n α i → α
  | _, Fin2.fz   => fun (a : α) => a
  | _, Fin2.fs i => @ofRepeat _ _ i
#align typevec.of_repeat TypeVec.ofRepeat

theorem const_iff_true {α : TypeVec n} {i x p} : ofRepeat (TypeVec.const p α i x) ↔ p := by
  induction i
  case fz       => rfl
  case fs _ ih  => erw [TypeVec.const, @ih (drop α) x]
#align typevec.const_iff_true TypeVec.const_iff_true

section
variable {α β γ : TypeVec.{u} n}

variable (p : α ⟹ «repeat» n Prop) (r : α ⊗ α ⟹ «repeat» n Prop)

/-- left projection of a `prod` vector -/
def prod.fst : ∀ {n} {α β : TypeVec.{u} n}, α ⊗ β ⟹ α
  | succ _, α, β, Fin2.fs i => @prod.fst _ (drop α) (drop β) i
  | succ _, _, _, Fin2.fz => Prod.fst
#align typevec.prod.fst TypeVec.prod.fst

/-- right projection of a `prod` vector -/
def prod.snd : ∀ {n} {α β : TypeVec.{u} n}, α ⊗ β ⟹ β
  | succ _, α, β, Fin2.fs i => @prod.snd _ (drop α) (drop β) i
  | succ _, _, _, Fin2.fz => Prod.snd
#align typevec.prod.snd TypeVec.prod.snd

/-- introduce a product where both components are the same -/
def prod.diag : ∀ {n} {α : TypeVec.{u} n}, α ⟹ α ⊗ α
  | succ _, α, Fin2.fs _, x => @prod.diag _ (drop α) _ x
  | succ _, _, Fin2.fz, x => (x, x)
#align typevec.prod.diag TypeVec.prod.diag

/-- constructor for `prod` -/
def prod.mk : ∀ {n} {α β : TypeVec.{u} n} (i : Fin2 n), α i → β i → (α ⊗ β) i
  | succ _, α, β, Fin2.fs i => mk (α := fun i => α i.fs) (β := fun i => β i.fs) i
  | succ _, _, _, Fin2.fz   => Prod.mk
#align typevec.prod.mk TypeVec.prod.mk

end

@[simp]
theorem prod_fst_mk {α β : TypeVec n} (i : Fin2 n) (a : α i) (b : β i) :
  TypeVec.prod.fst i (prod.mk i a b) = a :=
by
  induction' i with _ _ _ i_ih
  simp_all only [prod.fst, prod.mk]
  apply i_ih
#align typevec.prod_fst_mk TypeVec.prod_fst_mk

@[simp]
theorem prod_snd_mk {α β : TypeVec n} (i : Fin2 n) (a : α i) (b : β i) :
  TypeVec.prod.snd i (prod.mk i a b) = b :=
by
  induction' i with _ _ _ i_ih
  simp_all [prod.snd, prod.mk]
  apply i_ih
#align typevec.prod_snd_mk TypeVec.prod_snd_mk

/-- `prod` is functorial -/
protected def prod.map : ∀ {n} {α α' β β' : TypeVec.{u} n}, α ⟹ β → α' ⟹ β' → α ⊗ α' ⟹ β ⊗ β'
  | succ _, α, α', β, β', x, y, Fin2.fs _, a =>
    @prod.map _ (drop α) (drop α') (drop β) (drop β') (dropFun x) (dropFun y) _ a
  | succ _, _, _, _, _, x, y, Fin2.fz, a => (x _ a.1, y _ a.2)
#align typevec.prod.map TypeVec.prod.map

@[inherit_doc] scoped[MvFunctor] infixl:45 " ⊗' " => TypeVec.prod.map

theorem fst_prod_mk {α α' β β' : TypeVec n} (f : α ⟹ β) (g : α' ⟹ β') :
    TypeVec.prod.fst ⊚ (f ⊗' g) = f ⊚ TypeVec.prod.fst :=
  by
    funext i; induction i;
    case fz => rfl
    case fs _ _ i_ih => apply i_ih
#align typevec.fst_prod_mk TypeVec.fst_prod_mk

theorem snd_prod_mk {α α' β β' : TypeVec n} (f : α ⟹ β) (g : α' ⟹ β') :
    TypeVec.prod.snd ⊚ (f ⊗' g) = g ⊚ TypeVec.prod.snd :=
  by
    funext i; induction i;
    case fz => rfl
    case fs _ _ i_ih => apply i_ih
#align typevec.snd_prod_mk TypeVec.snd_prod_mk

theorem fst_diag {α : TypeVec n} : TypeVec.prod.fst ⊚ (prod.diag : α ⟹ _) = id :=
  by
    funext i; induction i;
    case fz => rfl
    case fs _ _ i_ih => apply i_ih
#align typevec.fst_diag TypeVec.fst_diag

theorem snd_diag {α : TypeVec n} : TypeVec.prod.snd ⊚ (prod.diag : α ⟹ _) = id :=
  by
    funext i; induction i;
    case fz => rfl
    case fs _ _ i_ih => apply i_ih
#align typevec.snd_diag TypeVec.snd_diag

theorem repeatEq_iff_eq {α : TypeVec n} {i x y} :
  ofRepeat (repeatEq α i (prod.mk _ x y)) ↔ x = y :=
by
  induction' i with _ _ _ i_ih
  rfl
  erw [repeatEq, i_ih]
#align typevec.repeat_eq_iff_eq TypeVec.repeatEq_iff_eq

/-- given a predicate vector `p` over vector `α`, `Subtype_ p` is the type of vectors
that contain an `α` that satisfies `p` -/
def Subtype_ : ∀ {n} {α : TypeVec.{u} n}, (α ⟹ «repeat» n Prop) → TypeVec n
  | _, _, p, Fin2.fz => Subtype fun x => p Fin2.fz x
  | _, _, p, Fin2.fs i => Subtype_ (dropFun p) i
#align typevec.subtype_ TypeVec.Subtype_

/-- projection on `Subtype_` -/
def subtypeVal : ∀ {n} {α : TypeVec.{u} n} (p : α ⟹ «repeat» n Prop), Subtype_ p ⟹ α
  | succ n, _, _, Fin2.fs i => @subtypeVal n _ _ i
  | succ _, _, _, Fin2.fz => Subtype.val
#align typevec.subtype_val TypeVec.subtypeVal

/-- arrow that rearranges the type of `Subtype_` to turn a subtype of vector into
a vector of subtypes -/
def toSubtype :
    ∀ {n} {α : TypeVec.{u} n} (p : α ⟹ «repeat» n Prop),
      (fun i : Fin2 n => { x // ofRepeat <| p i x }) ⟹ Subtype_ p
  | succ _, _, p, Fin2.fs i, x => toSubtype (dropFun p) i x
  | succ _, _, _, Fin2.fz, x => x
#align typevec.to_subtype TypeVec.toSubtype

/-- arrow that rearranges the type of `Subtype_` to turn a vector of subtypes
into a subtype of vector -/
def ofSubtype {n} {α : TypeVec.{u} n} (p : α ⟹ «repeat» n Prop) :
      Subtype_ p ⟹ fun i : Fin2 n => { x // ofRepeat <| p i x }
  | Fin2.fs i,  x => ofSubtype _ i x
  | Fin2.fz,    x => x
#align typevec.of_subtype TypeVec.ofSubtype

/-- similar to `toSubtype` adapted to relations (i.e. predicate on product) -/
def toSubtype' {n} {α : TypeVec.{u} n} (p : α ⊗ α ⟹ «repeat» n Prop) :
      (fun i : Fin2 n => { x : α i × α i // ofRepeat <| p i (prod.mk _ x.1 x.2) }) ⟹ Subtype_ p
  | Fin2.fs i, x => toSubtype' (dropFun p) i x
  | Fin2.fz, x => ⟨x.val, cast (by congr) x.property⟩
#align typevec.to_subtype' TypeVec.toSubtype'

/-- similar to `of_subtype` adapted to relations (i.e. predicate on product) -/
def ofSubtype' {n} {α : TypeVec.{u} n} (p : α ⊗ α ⟹ «repeat» n Prop) :
      Subtype_ p ⟹ fun i : Fin2 n => { x : α i × α i // ofRepeat <| p i (prod.mk _ x.1 x.2) }
  | Fin2.fs i, x => ofSubtype' _ i x
  | Fin2.fz, x => ⟨x.val, cast (by congr) x.property⟩
#align typevec.of_subtype' TypeVec.ofSubtype'

/-- similar to `diag` but the target vector is a `Subtype_`
guaranteeing the equality of the components -/
def diagSub {n} {α : TypeVec.{u} n} : α ⟹ Subtype_ (repeatEq α)
  | Fin2.fs _, x => @diagSub _ (drop α) _ x
  | Fin2.fz, x => ⟨(x, x), rfl⟩
#align typevec.diag_sub TypeVec.diagSub

theorem subtypeVal_nil {α : TypeVec.{u} 0} (ps : α ⟹ «repeat» 0 Prop) :
    TypeVec.subtypeVal ps = nilFun :=
  funext <| by rintro ⟨⟩
#align typevec.subtype_val_nil TypeVec.subtypeVal_nil

theorem diag_sub_val {n} {α : TypeVec.{u} n} : subtypeVal (repeatEq α) ⊚ diagSub = prod.diag :=
by
  ext i x
  induction' i with _ _ _ i_ih
  simp [prod.diag, diagSub, repeatEq, subtypeVal, comp]
  apply @i_ih (drop α)
#align typevec.diag_sub_val TypeVec.diag_sub_val

theorem prod_id : ∀ {n} {α β : TypeVec.{u} n}, (id ⊗' id) = (id : α ⊗ β ⟹ _) := by
  intros
  ext (i a)
  induction' i with _ _ _ i_ih
  · cases a
    rfl
  · apply i_ih

#align typevec.prod_id TypeVec.prod_id

theorem append_prod_appendFun  {n}
                                {α α' β β' : TypeVec.{u} n}
                                {φ φ' ψ ψ' : Type u}
                                {f₀ : α ⟹ α'}
                                {g₀ : β ⟹ β'}
                                {f₁ : φ → φ'}
                                {g₁ : ψ → ψ'} :
        ((f₀ ⊗' g₀) ::: (_root_.Prod.map f₁ g₁)) = ((f₀ ::: f₁) ⊗' (g₀ ::: g₁)) :=
by
  ext (i a)
  cases i
  . cases a
    rfl
  . rfl
#align typevec.append_prod_append_fun TypeVec.append_prod_appendFun

end Liftp'

@[simp]
theorem dropFun_diag {α} : dropFun (@prod.diag (n + 1) α) = prod.diag := by
  ext i : 2
  induction i <;> simp [dropFun, *] <;> rfl
#align typevec.drop_fun_diag TypeVec.dropFun_diag

@[simp]
theorem dropFun_subtypeVal {α} (p : α ⟹ «repeat» (n + 1) Prop) :
    dropFun (subtypeVal p) = subtypeVal _ :=
  rfl
#align typevec.drop_fun_subtype_val TypeVec.dropFun_subtypeVal

@[simp]
theorem lastFun_subtypeVal {α} (p : α ⟹ «repeat» (n + 1) Prop) :
    lastFun (subtypeVal p) = Subtype.val :=
  rfl
#align typevec.last_fun_subtype_val TypeVec.lastFun_subtypeVal

@[simp]
theorem dropFun_toSubtype {α} (p : α ⟹ «repeat» (n + 1) Prop) :
  dropFun (toSubtype p) = toSubtype _ :=
by
  ext i
  induction i <;> simp [dropFun, *] <;> rfl
#align typevec.drop_fun_to_subtype TypeVec.dropFun_toSubtype

@[simp]
theorem lastFun_toSubtype {α} (p : α ⟹ «repeat» (n + 1) Prop) :
    lastFun (toSubtype p) = _root_.id := by
  ext i : 2
  induction i; simp [dropFun, *]; rfl
#align typevec.last_fun_to_subtype TypeVec.lastFun_toSubtype

@[simp]
theorem dropFun_of_subtype {α} (p : α ⟹ «repeat» (n + 1) Prop) :
    dropFun (ofSubtype p) = ofSubtype _ := by
  ext i : 2
  induction i <;> simp [dropFun, *] <;> rfl
#align typevec.drop_fun_of_subtype TypeVec.dropFun_of_subtype

@[simp]
theorem lastFun_of_subtype {α} (p : α ⟹ «repeat» (n + 1) Prop) :
    lastFun (ofSubtype p) = _root_.id := by
  ext i : 2
  induction i; simp [dropFun, *]; rfl
#align typevec.last_fun_of_subtype TypeVec.lastFun_of_subtype

@[simp]
theorem dropFun_RelLast' {α : TypeVec n} {β} (R : β → β → Prop) :
    dropFun (RelLast' α R) = repeatEq α :=
  rfl
#align typevec.drop_fun_rel_last TypeVec.dropFun_RelLast'

attribute [simp] drop_append1'

open MvFunctor

@[simp]
theorem dropFun_prod {α α' β β' : TypeVec (n + 1)} (f : α ⟹ β) (f' : α' ⟹ β') :
    dropFun (f ⊗' f') = (dropFun f ⊗' dropFun f') := by
  ext i : 2
  induction i <;> simp [dropFun, *] <;> rfl
#align typevec.drop_fun_prod TypeVec.dropFun_prod

@[simp]
theorem lastFun_prod {α α' β β' : TypeVec (n + 1)} (f : α ⟹ β) (f' : α' ⟹ β') :
    lastFun (f ⊗' f') = Prod.map (lastFun f) (lastFun f') := by
  ext i : 1
  induction i; simp [lastFun, *]; rfl
#align typevec.last_fun_prod TypeVec.lastFun_prod

@[simp]
theorem dropFun_from_append1_drop_last {α : TypeVec (n + 1)} :
    dropFun (@fromAppend1DropLast _ α) = id :=
  rfl
#align typevec.drop_fun_from_append1_drop_last TypeVec.dropFun_from_append1_drop_last

@[simp]
theorem lastFun_from_append1_drop_last {α : TypeVec (n + 1)} :
    lastFun (@fromAppend1DropLast _ α) = _root_.id :=
  rfl
#align typevec.last_fun_from_append1_drop_last TypeVec.lastFun_from_append1_drop_last

@[simp]
theorem dropFun_id {α : TypeVec (n + 1)} : dropFun (@TypeVec.id _ α) = id :=
  rfl
#align typevec.drop_fun_id TypeVec.dropFun_id

@[simp]
theorem prod_map_id {α β : TypeVec n} : (@TypeVec.id _ α ⊗' @TypeVec.id _ β) = id := by
  ext i x : 2
  induction i <;> simp only [TypeVec.prod.map, *, dropFun_id]
  cases x
  rfl
  rfl
#align typevec.prod_map_id TypeVec.prod_map_id

@[simp]
theorem subtypeVal_diagSub {α : TypeVec n} : subtypeVal (repeatEq α) ⊚ diagSub = prod.diag := by
  ext i x
  induction' i with _ _ _ i_ih
  . simp [comp, diagSub, subtypeVal, prod.diag]
  . simp [prod.diag]
    simp [comp, diagSub, subtypeVal, prod.diag] at *
    apply @i_ih (drop _)
#align typevec.subtype_val_diag_sub TypeVec.subtypeVal_diagSub

@[simp]
theorem toSubtype_of_subtype {α : TypeVec n} (p : α ⟹ «repeat» n Prop) :
    toSubtype p ⊚ ofSubtype p = id := by
  ext (i x)
  induction i <;> dsimp only [id, toSubtype, comp, ofSubtype] at *
  simp [*]
#align typevec.to_subtype_of_subtype TypeVec.toSubtype_of_subtype

@[simp]
theorem subtypeVal_toSubtype {α : TypeVec n} (p : α ⟹ «repeat» n Prop) :
    subtypeVal p ⊚ toSubtype p = fun _ => Subtype.val := by
  ext (i x)
  induction i <;> dsimp only [toSubtype, comp, subtypeVal] at *
  simp [*]
#align typevec.subtype_val_to_subtype TypeVec.subtypeVal_toSubtype

@[simp]
theorem toSubtype_of_subtype_assoc  {α β : TypeVec n}
                                    (p : α ⟹ «repeat» n Prop)
                                    (f : β ⟹ Subtype_ p) :
    @toSubtype n _ p ⊚ ofSubtype _ ⊚ f = f :=
  by rw [← comp_assoc, toSubtype_of_subtype]; simp
#align typevec.to_subtype_of_subtype_assoc TypeVec.toSubtype_of_subtype_assoc

@[simp]
theorem toSubtype'_of_subtype' {α : TypeVec n} (r : α ⊗ α ⟹ «repeat» n Prop) :
    toSubtype' r ⊚ ofSubtype' r = id :=
by
  ext (i x)
  induction i
  <;> dsimp only [id, toSubtype', comp, ofSubtype'] at *
  <;> simp [Subtype.eta, *]
#align typevec.to_subtype'_of_subtype' TypeVec.toSubtype'_of_subtype'

theorem subtypeVal_toSubtype' {α : TypeVec n} (r : α ⊗ α ⟹ «repeat» n Prop) :
    subtypeVal r ⊚ toSubtype' r = fun i x => prod.mk i x.1.fst x.1.snd := by
  ext (i x); induction i <;> dsimp only [id, toSubtype', comp, subtypeVal, prod.mk] at *; simp [*]
#align typevec.subtype_val_to_subtype' TypeVec.subtypeVal_toSubtype'

end TypeVec


/-
Copyright (c) 2020 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

! This file was ported from Lean 3 source module data.qpf.multivariate.constructions.const
! leanprover-community/mathlib commit 23aa88e32dcc9d2a24cca7bc23268567ed4cd7d6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Functor.Multivariate
import Mathbin.Data.Qpf.Multivariate.Basic

/-!
# Constant functors are QPFs

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

Constant functors map every type vectors to the same target type. This
is a useful device for constructing data types from more basic types
that are not actually functorial. For instance `const n nat` makes
`nat` into a functor that can be used in a functor-based data type
specification.
-/

universe u

namespace MvQPF

open MvFunctor

variable (n : ℕ)

#print MvQPF.Const /-
/-- Constant multivariate functor -/
@[nolint unused_arguments]
def Const (A : Type _) (v : TypeVec.{u} n) : Type _ :=
  A
#align mvqpf.const MvQPF.Const
-/

#print MvQPF.Const.inhabited /-
instance Const.inhabited {A α} [Inhabited A] : Inhabited (Const n A α) :=
  ⟨(default : A)⟩
#align mvqpf.const.inhabited MvQPF.Const.inhabited
-/

namespace Const

open MvFunctor MvPFunctor

variable {n} {A : Type u} {α β : TypeVec.{u} n} (f : α ⟹ β)

#print MvQPF.Const.mk /-
/-- Constructor for constant functor -/
protected def mk (x : A) : (Const n A) α :=
  x
#align mvqpf.const.mk MvQPF.Const.mk
-/

#print MvQPF.Const.get /-
/-- Destructor for constant functor -/
protected def get (x : (Const n A) α) : A :=
  x
#align mvqpf.const.get MvQPF.Const.get
-/

#print MvQPF.Const.mk_get /-
@[simp]
protected theorem mk_get (x : (Const n A) α) : Const.mk (Const.get x) = x :=
  rfl
#align mvqpf.const.mk_get MvQPF.Const.mk_get
-/

#print MvQPF.Const.get_mk /-
@[simp]
protected theorem get_mk (x : A) : Const.get (Const.mk x : Const n A α) = x :=
  rfl
#align mvqpf.const.get_mk MvQPF.Const.get_mk
-/

#print MvQPF.Const.map /-
/-- `map` for constant functor -/
protected def map : (Const n A) α → (Const n A) β := fun x => x
#align mvqpf.const.map MvQPF.Const.map
-/

instance : MvFunctor (Const n A) where map α β f := Const.map

#print MvQPF.Const.map_mk /-
theorem map_mk (x : A) : f <$$> Const.mk x = Const.mk x :=
  rfl
#align mvqpf.const.map_mk MvQPF.Const.map_mk
-/

#print MvQPF.Const.get_map /-
theorem get_map (x : (Const n A) α) : Const.get (f <$$> x) = Const.get x :=
  rfl
#align mvqpf.const.get_map MvQPF.Const.get_map
-/

#print MvQPF.Const.mvqpf /-
instance mvqpf : @MvQPF _ (Const n A) MvQPF.Const.mvfunctor
    where
  p := MvPFunctor.const n A
  abs α x := MvPFunctor.const.get x
  repr α x := MvPFunctor.const.mk n x
  abs_repr := by intros <;> simp
  abs_map := by intros <;> simp <;> rfl
#align mvqpf.const.mvqpf MvQPF.Const.mvqpf
-/

end Const

end MvQPF


/-
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
-/
import data.list.perm
import 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
variables {α : Type u}

open nat function

namespace list

lemma rotate_mod (l : list α) (n : ℕ) : l.rotate (n % l.length) = l.rotate n :=
by simp [rotate]

@[simp] lemma rotate_nil (n : ℕ) : ([] : list α).rotate n = [] := by simp [rotate]

@[simp] lemma rotate_zero (l : list α) : l.rotate 0 = l := by simp [rotate]

@[simp] lemma rotate'_nil (n : ℕ) : ([] : list α).rotate' n = [] := by cases n; refl

@[simp] lemma rotate'_zero (l : list α) : l.rotate' 0 = l := by cases l; refl

lemma rotate'_cons_succ (l : list α) (a : α) (n : ℕ) :
  (a :: l : list α).rotate' n.succ = (l ++ [a]).rotate' n := by simp [rotate']

@[simp] lemma 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

lemma 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 :=
have hnl : n ≤ l.length, from 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),
by 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

lemma 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]

@[simp] lemma rotate'_length (l : list α) : rotate' l l.length = l :=
by rw rotate'_eq_drop_append_take le_rfl; simp

@[simp] lemma 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]

lemma 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]

lemma rotate_eq_rotate' (l : list α) (n : ℕ) : l.rotate n = l.rotate' n :=
if h : l.length = 0 then by simp [length_eq_zero, *] at *
else by
  rw [← rotate'_mod, rotate'_eq_drop_append_take (le_of_lt (nat.mod_lt _ (nat.pos_of_ne_zero h)))];
  simp [rotate]

lemma 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]

@[simp] lemma 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]

@[simp] lemma length_rotate (l : list α) (n : ℕ) : (l.rotate n).length = l.length :=
by rw [rotate_eq_rotate', length_rotate']

lemma rotate_replicate (a : α) (n : ℕ) (k : ℕ) : (replicate n a).rotate k = replicate n a :=
eq_replicate.2 ⟨by rw [length_rotate, length_replicate],
  λ b hb, eq_of_mem_replicate $ mem_rotate.1 hb⟩

lemma 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

lemma rotate_eq_drop_append_take_mod {l : list α} {n : ℕ} :
  l.rotate n = l.drop (n % l.length) ++ l.take (n % l.length) :=
begin
  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]
end

@[simp] lemma rotate_append_length_eq (l l' : list α) : (l ++ l').rotate l.length = l' ++ l :=
begin
  rw rotate_eq_rotate',
  induction l generalizing l',
  { simp, },
  { simp [rotate', l_ih] },
end

lemma 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']

@[simp] lemma rotate_length (l : list α) : rotate l l.length = l :=
by rw [rotate_eq_rotate', rotate'_length]

@[simp] lemma rotate_length_mul (l : list α) (n : ℕ) : l.rotate (l.length * n) = l :=
by rw [rotate_eq_rotate', rotate'_length_mul]

lemma 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 :=
have n % list.length (a :: l) ≤ list.length (a :: l), from le_of_lt (nat.mod_lt _ dec_trivial),
by 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]

lemma rotate_perm (l : list α) (n : ℕ) : l.rotate n ~ l :=
begin
  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 _ _) } }
end

@[simp] lemma nodup_rotate {l : list α} {n : ℕ} : nodup (l.rotate n) ↔ nodup l :=
(rotate_perm l n).nodup_iff

@[simp] lemma rotate_eq_nil_iff {l : list α} {n : ℕ} : l.rotate n = [] ↔ l = [] :=
begin
  induction n with n hn generalizing l,
  { simp },
  { cases l with hd tl,
    { simp },
    { simp [rotate_cons_succ, hn] } }
end

@[simp] lemma nil_eq_rotate_iff {l : list α} {n : ℕ} : [] = l.rotate n ↔ [] = l :=
by rw [eq_comm, rotate_eq_nil_iff, eq_comm]

@[simp] lemma rotate_singleton (x : α) (n : ℕ) :
  [x].rotate n = [x] :=
rotate_replicate x 1 n

lemma zip_with_rotate_distrib {α β γ : Type*} (f : α → β → γ) (l : list α) (l' : list β) (n : ℕ)
  (h : l.length = l'.length) :
  (zip_with f l l').rotate n = zip_with f (l.rotate n) (l'.rotate n) :=
begin
  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_zip_with, h, min_self],
  rw [length_drop, length_drop, h]
end

local attribute [simp] rotate_cons_succ

@[simp] lemma zip_with_rotate_one {β : Type*} (f : α → α → β) (x y : α) (l : list α) :
  zip_with f (x :: y :: l) ((x :: y :: l).rotate 1) =
  f x y :: zip_with f (y :: l) (l ++ [x]) :=
by simp

lemma nth_le_rotate_one (l : list α) (k : ℕ) (hk : k < (l.rotate 1).length) :
  (l.rotate 1).nth_le k hk = l.nth_le ((k + 1) % l.length)
    (mod_lt _ (length_rotate l 1 ▸ k.zero_le.trans_lt hk)) :=
begin
  cases l with hd tl,
  { simp },
  { have : k ≤ tl.length,
    { 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')] } }
end

lemma nth_le_rotate (l : list α) (n k : ℕ) (hk : k < (l.rotate n).length) :
  (l.rotate n).nth_le k hk = l.nth_le ((k + n) % l.length)
    (mod_lt _ (length_rotate l n ▸ k.zero_le.trans_lt hk)) :=
begin
  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] }
end

/-- A variant of `nth_le_rotate` useful for rewrites. -/
lemma nth_le_rotate' (l : list α) (n k : ℕ) (hk : k < l.length) :
  (l.rotate n).nth_le ((l.length - n % l.length + k) % l.length)
      ((nat.mod_lt _ (k.zero_le.trans_lt hk)).trans_le (length_rotate _ _).ge) = l.nth_le k hk :=
begin
  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 }
end

lemma nth_rotate {l : list α} {n m : ℕ} (hml : m < l.length) :
  (l.rotate n).nth m = l.nth ((m + n) % l.length) :=
begin
  rw [nth_le_nth, nth_le_nth (nat.mod_lt _ _), nth_le_rotate],
  rwa [length_rotate]
end

lemma head'_rotate {l : list α} {n : ℕ} (h : n < l.length) :
  head' (l.rotate n) = l.nth n :=
by rw [← nth_zero, nth_rotate (n.zero_le.trans_lt h), zero_add, nat.mod_eq_of_lt h]

lemma 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) := ⟨λ h, ⟨a, ext_le (length_replicate _ _).symm $ λ n h₁ h₂,
  begin
    inhabit α,
    rw [nth_le_replicate, ← option.some_inj, ← nth_le_nth, ← head'_rotate h₁, h, head']
  end⟩, λ ⟨b, hb⟩ n, by rw [hb, rotate_replicate]⟩

lemma rotate_one_eq_self_iff_eq_replicate [nonempty α] {l : list α} :
  l.rotate 1 = l ↔ ∃ a : α, l = list.replicate l.length a :=
⟨λ h, rotate_eq_self_iff_eq_replicate.mp (λ n, nat.rec l.rotate_zero
  (λ n hn, by rwa [nat.succ_eq_add_one, ←l.rotate_rotate, hn]) n),
    λ h, rotate_eq_self_iff_eq_replicate.mpr h 1⟩

lemma rotate_injective (n : ℕ) : function.injective (λ l : list α, l.rotate n) :=
begin
  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 (λ k h₁ h₂, _),
  rw [← nth_le_rotate' l₁ n, ← nth_le_rotate' l₂ n],
  congr' 1; simp only [h, this]
end

@[simp] lemma rotate_eq_rotate {l l' : list α} {n : ℕ} :
  l.rotate n = l'.rotate n ↔ l = l' :=
(rotate_injective n).eq_iff

lemma rotate_eq_iff {l l' : list α} {n : ℕ} :
  l.rotate n = l' ↔ l = l'.rotate (l'.length - n % l'.length) :=
begin
  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 } }
end

@[simp] lemma rotate_eq_singleton_iff {l : list α} {n : ℕ} {x : α} : l.rotate n = [x] ↔ l = [x] :=
by rw [rotate_eq_iff, rotate_singleton]

@[simp] lemma singleton_eq_rotate_iff {l : list α} {n : ℕ} {x : α} : [x] = l.rotate n ↔ [x] = l :=
by rw [eq_comm, rotate_eq_singleton_iff, eq_comm]

lemma reverse_rotate (l : list α) (n : ℕ) :
  (l.rotate n).reverse = l.reverse.rotate (l.length - (n % l.length)) :=
begin
  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 } }
end

lemma rotate_reverse (l : list α) (n : ℕ) :
  l.reverse.rotate n = (l.rotate (l.length - (n % l.length))).reverse :=
begin
  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,
      { 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' } } }
end

lemma map_rotate {β : Type*} (f : α → β) (l : list α) (n : ℕ) :
  map f (l.rotate n) = (map f l).rotate n :=
begin
  induction n with n hn IH generalizing l,
  { simp },
  { cases l with hd tl,
    { simp },
    { simp [hn] } }
end

theorem nodup.rotate_eq_self_iff {l : list α} (hl : l.nodup) {n : ℕ} :
  l.rotate n = l ↔ n % l.length = 0 ∨ l = [] :=
begin
  split,
  { 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] } }
end

section is_rotated

variables (l l' : list α)

/-- `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 is_rotated : Prop := ∃ n, l.rotate n = l'

infixr ` ~r `:1000 := is_rotated

variables {l l'}

@[refl] lemma is_rotated.refl (l : list α) : l ~r l :=
⟨0, by simp⟩

@[symm] lemma is_rotated.symm (h : l ~r l') : l' ~r l :=
begin
  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) }
end

lemma is_rotated_comm : l ~r l' ↔ l' ~r l :=
⟨is_rotated.symm, is_rotated.symm⟩

@[simp] protected lemma is_rotated.forall (l : list α) (n : ℕ) : l.rotate n ~r l :=
is_rotated.symm ⟨n, rfl⟩

@[trans] lemma is_rotated.trans : ∀ {l l' l'' : list α}, l ~r l' → l' ~r l'' → l ~r l''
| _ _ _ ⟨n, rfl⟩ ⟨m, rfl⟩ := ⟨n + m, by rw [rotate_rotate]⟩

lemma is_rotated.eqv : equivalence (@is_rotated α) :=
mk_equivalence _ is_rotated.refl (λ _ _, is_rotated.symm) (λ _ _ _, is_rotated.trans)

/-- The relation `list.is_rotated l l'` forms a `setoid` of cycles. -/
def is_rotated.setoid (α : Type*) : setoid (list α) :=
{ r := is_rotated, iseqv := is_rotated.eqv }

lemma is_rotated.perm (h : l ~r l') : l ~ l' :=
exists.elim h (λ _ hl, hl ▸ (rotate_perm _ _).symm)

lemma is_rotated.nodup_iff (h : l ~r l') : nodup l ↔ nodup l' :=
h.perm.nodup_iff

lemma is_rotated.mem_iff (h : l ~r l') {a : α} : a ∈ l ↔ a ∈ l' :=
h.perm.mem_iff

@[simp] lemma is_rotated_nil_iff : l ~r [] ↔ l = [] :=
⟨λ ⟨n, hn⟩, by simpa using hn, λ h, h ▸ by refl⟩

@[simp] lemma is_rotated_nil_iff' : [] ~r l ↔ [] = l :=
by rw [is_rotated_comm, is_rotated_nil_iff, eq_comm]

@[simp] lemma is_rotated_singleton_iff {x : α} : l ~r [x] ↔ l = [x] :=
⟨λ ⟨n, hn⟩, by simpa using hn, λ h, h ▸ by refl⟩

@[simp] lemma is_rotated_singleton_iff' {x : α} : [x] ~r l ↔ [x] = l :=
by rw [is_rotated_comm, is_rotated_singleton_iff, eq_comm]

lemma is_rotated_concat (hd : α) (tl : list α) :
  (tl ++ [hd]) ~r (hd :: tl) :=
is_rotated.symm ⟨1, by simp⟩

lemma is_rotated_append : (l ++ l') ~r (l' ++ l) :=
⟨l.length, by simp⟩

lemma is_rotated.reverse (h : l ~r l') : l.reverse ~r l'.reverse :=
begin
  obtain ⟨n, rfl⟩ := h,
  exact ⟨_, (reverse_rotate _ _).symm⟩
end

lemma is_rotated_reverse_comm_iff :
  l.reverse ~r l' ↔ l ~r l'.reverse :=
begin
  split;
  { intro h,
    simpa using h.reverse }
end

@[simp] lemma is_rotated_reverse_iff :
  l.reverse ~r l'.reverse ↔ l ~r l' :=
by simp [is_rotated_reverse_comm_iff]

lemma is_rotated_iff_mod : l ~r l' ↔ ∃ n ≤ l.length, l.rotate n = l' :=
begin
  refine ⟨λ h, _, λ ⟨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 }
end

lemma is_rotated_iff_mem_map_range : l ~r l' ↔ l' ∈ (list.range (l.length + 1)).map l.rotate :=
begin
  simp_rw [mem_map, mem_range, is_rotated_iff_mod],
  exact ⟨λ ⟨n, hn, h⟩, ⟨n, nat.lt_succ_of_le hn, h⟩, λ ⟨n, hn, h⟩, ⟨n, nat.le_of_lt_succ hn, h⟩⟩
end

@[congr] theorem is_rotated.map {β : Type*} {l₁ l₂ : list α} (h : l₁ ~r l₂) (f : α → β) :
  map f l₁ ~r map f l₂ :=
begin
  obtain ⟨n, rfl⟩ := h,
  rw map_rotate,
  use n
end

/-- 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 cyclic_permutations : list α → list (list α)
| []         := [[]]
| l@(_ :: _) := init (zip_with (++) (tails l) (inits l))

@[simp] lemma cyclic_permutations_nil : cyclic_permutations ([] : list α) = [[]] := rfl

lemma cyclic_permutations_cons (x : α) (l : list α) :
  cyclic_permutations (x :: l) = init (zip_with (++) (tails (x :: l)) (inits (x :: l))) := rfl

lemma cyclic_permutations_of_ne_nil (l : list α) (h : l ≠ []) :
  cyclic_permutations l = init (zip_with (++) (tails l) (inits l)) :=
begin
  obtain ⟨hd, tl, rfl⟩ := exists_cons_of_ne_nil h,
  exact cyclic_permutations_cons _ _,
end

lemma length_cyclic_permutations_cons (x : α) (l : list α) :
  length (cyclic_permutations (x :: l)) = length l + 1 :=
by simp [cyclic_permutations_of_ne_nil]

@[simp] lemma length_cyclic_permutations_of_ne_nil (l : list α) (h : l ≠ []) :
  length (cyclic_permutations l) = length l :=
by simp [cyclic_permutations_of_ne_nil _ h]

@[simp] lemma nth_le_cyclic_permutations (l : list α) (n : ℕ)
  (hn : n < length (cyclic_permutations l)) :
  nth_le (cyclic_permutations l) n hn = l.rotate n :=
begin
  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] }
end

lemma mem_cyclic_permutations_self (l : list α) :
  l ∈ cyclic_permutations l :=
begin
  cases l with x l,
  { simp },
  { rw mem_iff_nth_le,
    refine ⟨0, by simp, _⟩,
    simp }
end

lemma length_mem_cyclic_permutations (l : list α) (h : l' ∈ cyclic_permutations l) :
  length l' = length l :=
begin
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem h,
  simp
end

@[simp] lemma mem_cyclic_permutations_iff {l l' : list α} :
  l ∈ cyclic_permutations l' ↔ l ~r l' :=
begin
  split,
  { 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 _) } }
end

@[simp] lemma cyclic_permutations_eq_nil_iff {l : list α} :
  cyclic_permutations l = [[]] ↔ l = [] :=
begin
  refine ⟨λ h, _, λ h, by simp [h]⟩,
  rw [eq_comm, ←is_rotated_nil_iff', ←mem_cyclic_permutations_iff, h, mem_singleton]
end

@[simp] lemma cyclic_permutations_eq_singleton_iff {l : list α} {x : α} :
  cyclic_permutations l = [[x]] ↔ l = [x] :=
begin
  refine ⟨λ h, _, λ h, by simp [cyclic_permutations, h, init_eq_take]⟩,
  rw [eq_comm, ←is_rotated_singleton_iff', ←mem_cyclic_permutations_iff, h, mem_singleton]
end

/-- If a `l : list α` is `nodup l`, then all of its cyclic permutants are distinct. -/
lemma nodup.cyclic_permutations {l : list α} (hn : nodup l) :
  nodup (cyclic_permutations l) :=
begin
  cases l with x l,
  { simp },
  rw nodup_iff_nth_le_inj,
  intros 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 }
end

@[simp] lemma cyclic_permutations_rotate (l : list α) (k : ℕ) :
  (l.rotate k).cyclic_permutations = l.cyclic_permutations.rotate k :=
begin
  have : (l.rotate k).cyclic_permutations.length = length (l.cyclic_permutations.rotate k),
  { cases l,
    { simp },
    { rw length_cyclic_permutations_of_ne_nil;
      simp } },
  refine ext_le this (λ n hn hn', _),
  rw [nth_le_cyclic_permutations, nth_le_rotate, nth_le_cyclic_permutations,
      rotate_rotate, ←rotate_mod, add_comm],
  cases l;
  simp
end

lemma is_rotated.cyclic_permutations {l l' : list α} (h : l ~r l') :
  l.cyclic_permutations ~r l'.cyclic_permutations :=
begin
  obtain ⟨k, rfl⟩ := h,
  exact ⟨k, by simp⟩
end

@[simp] lemma is_rotated_cyclic_permutations_iff {l l' : list α} :
  l.cyclic_permutations ~r l'.cyclic_permutations ↔ l ~r l' :=
begin
  by_cases hl : l = [],
  { simp [hl, eq_comm] },
  have hl' : l.cyclic_permutations.length = l.length := length_cyclic_permutations_of_ne_nil _ hl,
  refine ⟨λ 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]
end

section decidable

variables [decidable_eq α]

instance is_rotated_decidable (l l' : list α) : decidable (l ~r l') :=
decidable_of_iff' _ is_rotated_iff_mem_map_range

instance {l l' : list α} : decidable (@setoid.r _ (is_rotated.setoid α) l l') :=
list.is_rotated_decidable _ _

end decidable

end is_rotated

end list


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury G. Kudryashov, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.algebra.basic
import Mathlib.linear_algebra.finsupp
import Mathlib.PostPort

universes u₁ u₂ u_1 u_2 u_3 u₃ ui

namespace Mathlib

/-!
# Monoid algebras

When the domain of a `finsupp` has a multiplicative or additive structure, we can define
a convolution product. To mathematicians this structure is known as the "monoid algebra",
i.e. the finite formal linear combinations over a given semiring of elements of the monoid.
The "group ring" ℤ[G] or the "group algebra" k[G] are typical uses.

In this file we define `monoid_algebra k G := G →₀ k`, and `add_monoid_algebra k G`
in the same way, and then define the convolution product on these.

When the domain is additive, this is used to define polynomials:
```
polynomial α := add_monoid_algebra ℕ α
mv_polynomial σ α := add_monoid_algebra (σ →₀ ℕ) α
```

When the domain is multiplicative, e.g. a group, this will be used to define the group ring.

## Implementation note
Unfortunately because additive and multiplicative structures both appear in both cases,
it doesn't appear to be possible to make much use of `to_additive`, and we just settle for
saying everything twice.

Similarly, I attempted to just define
`add_monoid_algebra k G := monoid_algebra k (multiplicative G)`, but the definitional equality
`multiplicative G = G` leaks through everywhere, and seems impossible to use.
-/

/-! ### Multiplicative monoids -/

/--
The monoid algebra over a semiring `k` generated by the monoid `G`.
It is the type of finite formal `k`-linear combinations of terms of `G`,
endowed with the convolution product.
-/
def monoid_algebra (k : Type u₁) (G : Type u₂) [semiring k] :=
  G →₀ k

namespace monoid_algebra

/-! #### Semiring structure -/

/-- The product of `f g : monoid_algebra k G` is the finitely supported function
  whose value at `a` is the sum of `f x * g y` over all pairs `x, y`
  such that `x * y = a`. (Think of the group ring of a group.) -/
protected instance has_mul {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] : Mul (monoid_algebra k G) :=
  { mul :=
      fun (f g : monoid_algebra k G) =>
        finsupp.sum f fun (a₁ : G) (b₁ : k) => finsupp.sum g fun (a₂ : G) (b₂ : k) => finsupp.single (a₁ * a₂) (b₁ * b₂) }

theorem mul_def {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] {f : monoid_algebra k G} {g : monoid_algebra k G} : f * g = finsupp.sum f fun (a₁ : G) (b₁ : k) => finsupp.sum g fun (a₂ : G) (b₂ : k) => finsupp.single (a₁ * a₂) (b₁ * b₂) :=
  rfl

/-- The unit of the multiplication is `single 1 1`, i.e. the function
  that is `1` at `1` and zero elsewhere. -/
protected instance has_one {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] : HasOne (monoid_algebra k G) :=
  { one := finsupp.single 1 1 }

theorem one_def {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] : 1 = finsupp.single 1 1 :=
  rfl

protected instance semiring {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] : semiring (monoid_algebra k G) :=
  semiring.mk Add.add sorry 0 sorry sorry sorry Mul.mul sorry 1 sorry sorry sorry sorry sorry sorry

/-- A non-commutative version of `monoid_algebra.lift`: given a additive homomorphism `f : k →+ R`
and a multiplicative monoid homomorphism `g : G →* R`, returns the additive homomorphism from
`monoid_algebra k G` such that `lift_nc f g (single a b) = f b * g a`. If `f` is a ring homomorphism
and the range of either `f` or `g` is in center of `R`, then the result is a ring homomorphism.  If
`R` is a `k`-algebra and `f = algebra_map k R`, then the result is an algebra homomorphism called
`monoid_algebra.lift`. -/
def lift_nc {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] {R : Type u_1} [semiring R] (f : k →+ R) (g : G →* R) : monoid_algebra k G →+ R :=
  coe_fn finsupp.lift_add_hom fun (x : G) => add_monoid_hom.comp (add_monoid_hom.mul_right (coe_fn g x)) f

@[simp] theorem lift_nc_single {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] {R : Type u_1} [semiring R] (f : k →+ R) (g : G →* R) (a : G) (b : k) : coe_fn (lift_nc f g) (finsupp.single a b) = coe_fn f b * coe_fn g a :=
  finsupp.lift_add_hom_apply_single (fun (x : G) => add_monoid_hom.comp (add_monoid_hom.mul_right (coe_fn g x)) f) a b

@[simp] theorem lift_nc_one {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] {R : Type u_1} [semiring R] (f : k →+* R) (g : G →* R) : coe_fn (lift_nc (↑f) g) 1 = 1 := sorry

theorem lift_nc_mul {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] {R : Type u_1} [semiring R] (f : k →+* R) (g : G →* R) (a : monoid_algebra k G) (b : monoid_algebra k G) (h_comm : ∀ {x y : G}, y ∈ finsupp.support a → commute (coe_fn f (coe_fn b x)) (coe_fn g y)) : coe_fn (lift_nc (↑f) g) (a * b) = coe_fn (lift_nc (↑f) g) a * coe_fn (lift_nc (↑f) g) b := sorry

/-- `lift_nc` as a `ring_hom`, for when `f x` and `g y` commute -/
def lift_nc_ring_hom {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] {R : Type u_1} [semiring R] (f : k →+* R) (g : G →* R) (h_comm : ∀ (x : k) (y : G), commute (coe_fn f x) (coe_fn g y)) : monoid_algebra k G →+* R :=
  ring_hom.mk (⇑(lift_nc (↑f) g)) (lift_nc_one f g) sorry sorry sorry

protected instance comm_semiring {k : Type u₁} {G : Type u₂} [comm_semiring k] [comm_monoid G] : comm_semiring (monoid_algebra k G) :=
  comm_semiring.mk semiring.add sorry semiring.zero sorry sorry sorry semiring.mul sorry semiring.one sorry sorry sorry
    sorry sorry sorry sorry

protected instance nontrivial {k : Type u₁} {G : Type u₂} [semiring k] [nontrivial k] [monoid G] : nontrivial (monoid_algebra k G) :=
  finsupp.nontrivial

/-! #### Derived instances -/

protected instance unique {k : Type u₁} {G : Type u₂} [semiring k] [subsingleton k] : unique (monoid_algebra k G) :=
  finsupp.unique_of_right

protected instance add_group {k : Type u₁} {G : Type u₂} [ring k] : add_group (monoid_algebra k G) :=
  finsupp.add_group

protected instance ring {k : Type u₁} {G : Type u₂} [ring k] [monoid G] : ring (monoid_algebra k G) :=
  ring.mk semiring.add sorry semiring.zero sorry sorry Neg.neg
    (add_comm_group.sub._default semiring.add sorry semiring.zero sorry sorry Neg.neg) sorry sorry semiring.mul sorry
    semiring.one sorry sorry sorry sorry

protected instance comm_ring {k : Type u₁} {G : Type u₂} [comm_ring k] [comm_monoid G] : comm_ring (monoid_algebra k G) :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry
    sorry sorry sorry

protected instance has_scalar {k : Type u₁} {G : Type u₂} {R : Type u_1} [semiring R] [semiring k] [semimodule R k] : has_scalar R (monoid_algebra k G) :=
  finsupp.has_scalar

protected instance semimodule {k : Type u₁} {G : Type u₂} {R : Type u_1} [semiring R] [semiring k] [semimodule R k] : semimodule R (monoid_algebra k G) :=
  finsupp.semimodule G k

protected instance distrib_mul_action {k : Type u₁} {G : Type u₂} [group G] [semiring k] : distrib_mul_action G (monoid_algebra k G) :=
  finsupp.comap_distrib_mul_action_self

theorem mul_apply {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] (f : monoid_algebra k G) (g : monoid_algebra k G) (x : G) : coe_fn (f * g) x =
  finsupp.sum f fun (a₁ : G) (b₁ : k) => finsupp.sum g fun (a₂ : G) (b₂ : k) => ite (a₁ * a₂ = x) (b₁ * b₂) 0 := sorry

theorem mul_apply_antidiagonal {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] (f : monoid_algebra k G) (g : monoid_algebra k G) (x : G) (s : finset (G × G)) (hs : ∀ {p : G × G}, p ∈ s ↔ prod.fst p * prod.snd p = x) : coe_fn (f * g) x = finset.sum s fun (p : G × G) => coe_fn f (prod.fst p) * coe_fn g (prod.snd p) := sorry

theorem support_mul {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] (a : monoid_algebra k G) (b : monoid_algebra k G) : finsupp.support (a * b) ⊆
  finset.bUnion (finsupp.support a)
    fun (a₁ : G) => finset.bUnion (finsupp.support b) fun (a₂ : G) => singleton (a₁ * a₂) := sorry

@[simp] theorem single_mul_single {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] {a₁ : G} {a₂ : G} {b₁ : k} {b₂ : k} : finsupp.single a₁ b₁ * finsupp.single a₂ b₂ = finsupp.single (a₁ * a₂) (b₁ * b₂) := sorry

@[simp] theorem single_pow {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] {a : G} {b : k} (n : ℕ) : finsupp.single a b ^ n = finsupp.single (a ^ n) (b ^ n) := sorry

/-- Like `finsupp.map_domain_add`, but for the convolutive multiplication we define in this file -/
theorem map_domain_mul {α : Type u_1} {β : Type u_2} {α₂ : Type u_3} [semiring β] [monoid α] [monoid α₂] {x : monoid_algebra β α} {y : monoid_algebra β α} (f : mul_hom α α₂) : finsupp.map_domain (⇑f) (x * y) = finsupp.map_domain (⇑f) x * finsupp.map_domain (⇑f) y := sorry

/-- Embedding of a monoid into its monoid algebra. -/
def of (k : Type u₁) (G : Type u₂) [semiring k] [monoid G] : G →* monoid_algebra k G :=
  monoid_hom.mk (fun (a : G) => finsupp.single a 1) sorry sorry

@[simp] theorem of_apply {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] (a : G) : coe_fn (of k G) a = finsupp.single a 1 :=
  rfl

theorem of_injective {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] [nontrivial k] : function.injective ⇑(of k G) := sorry

theorem mul_single_apply_aux {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] (f : monoid_algebra k G) {r : k} {x : G} {y : G} {z : G} (H : ∀ (a : G), a * x = z ↔ a = y) : coe_fn (f * finsupp.single x r) z = coe_fn f y * r := sorry

theorem mul_single_one_apply {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] (f : monoid_algebra k G) (r : k) (x : G) : coe_fn (f * finsupp.single 1 r) x = coe_fn f x * r :=
  mul_single_apply_aux f
    fun (a : G) => eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = x ↔ a = x)) (mul_one a))) (iff.refl (a = x))

theorem single_mul_apply_aux {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] (f : monoid_algebra k G) {r : k} {x : G} {y : G} {z : G} (H : ∀ (a : G), x * a = y ↔ a = z) : coe_fn (finsupp.single x r * f) y = r * coe_fn f z := sorry

theorem single_one_mul_apply {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] (f : monoid_algebra k G) (r : k) (x : G) : coe_fn (finsupp.single 1 r * f) x = r * coe_fn f x :=
  single_mul_apply_aux f
    fun (a : G) => eq.mpr (id (Eq._oldrec (Eq.refl (1 * a = x ↔ a = x)) (one_mul a))) (iff.refl (a = x))

theorem lift_nc_smul {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] {R : Type u_1} [semiring R] (f : k →+* R) (g : G →* R) (c : k) (φ : monoid_algebra k G) : coe_fn (lift_nc (↑f) g) (c • φ) = coe_fn f c * coe_fn (lift_nc (↑f) g) φ := sorry

/-! #### Algebra structure -/

theorem single_one_comm {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] (r : k) (f : monoid_algebra k G) : finsupp.single 1 r * f = f * finsupp.single 1 r := sorry

/-- `finsupp.single 1` as a `ring_hom` -/
def single_one_ring_hom {k : Type u₁} {G : Type u₂} [semiring k] [monoid G] : k →+* monoid_algebra k G :=
  ring_hom.mk (add_monoid_hom.to_fun (finsupp.single_add_hom 1)) sorry sorry sorry sorry

/-- If two ring homomorphisms from `monoid_algebra k G` are equal on all `single a 1`
and `single 1 b`, then they are equal. -/
theorem ring_hom_ext {k : Type u₁} {G : Type u₂} {R : Type u_1} [semiring k] [monoid G] [semiring R] {f : monoid_algebra k G →+* R} {g : monoid_algebra k G →+* R} (h₁ : ∀ (b : k), coe_fn f (finsupp.single 1 b) = coe_fn g (finsupp.single 1 b)) (h_of : ∀ (a : G), coe_fn f (finsupp.single a 1) = coe_fn g (finsupp.single a 1)) : f = g := sorry

/-- If two ring homomorphisms from `monoid_algebra k G` are equal on all `single a 1`
and `single 1 b`, then they are equal.

See note [partially-applied ext lemmas]. -/
theorem ring_hom_ext' {k : Type u₁} {G : Type u₂} {R : Type u_1} [semiring k] [monoid G] [semiring R] {f : monoid_algebra k G →+* R} {g : monoid_algebra k G →+* R} (h₁ : ring_hom.comp f single_one_ring_hom = ring_hom.comp g single_one_ring_hom) (h_of : monoid_hom.comp (↑f) (of k G) = monoid_hom.comp (↑g) (of k G)) : f = g :=
  ring_hom_ext (ring_hom.congr_fun h₁) (monoid_hom.congr_fun h_of)

/--
The instance `algebra k (monoid_algebra A G)` whenever we have `algebra k A`.

In particular this provides the instance `algebra k (monoid_algebra k G)`.
-/
protected instance algebra {k : Type u₁} {G : Type u₂} {A : Type u_1} [comm_semiring k] [semiring A] [algebra k A] [monoid G] : algebra k (monoid_algebra A G) :=
  algebra.mk (ring_hom.mk (ring_hom.to_fun (ring_hom.comp single_one_ring_hom (algebra_map k A))) sorry sorry sorry sorry)
    sorry sorry

/-- `finsupp.single 1` as a `alg_hom` -/
def single_one_alg_hom {k : Type u₁} {G : Type u₂} {A : Type u_1} [comm_semiring k] [semiring A] [algebra k A] [monoid G] : alg_hom k A (monoid_algebra A G) :=
  alg_hom.mk (ring_hom.to_fun single_one_ring_hom) sorry sorry sorry sorry sorry

@[simp] theorem coe_algebra_map {k : Type u₁} {G : Type u₂} {A : Type u_1} [comm_semiring k] [semiring A] [algebra k A] [monoid G] : ⇑(algebra_map k (monoid_algebra A G)) = finsupp.single 1 ∘ ⇑(algebra_map k A) :=
  rfl

theorem single_eq_algebra_map_mul_of {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] (a : G) (b : k) : finsupp.single a b = coe_fn (algebra_map k (monoid_algebra k G)) b * coe_fn (of k G) a := sorry

theorem single_algebra_map_eq_algebra_map_mul_of {k : Type u₁} {G : Type u₂} {A : Type u_1} [comm_semiring k] [semiring A] [algebra k A] [monoid G] (a : G) (b : k) : finsupp.single a (coe_fn (algebra_map k A) b) = coe_fn (algebra_map k (monoid_algebra A G)) b * coe_fn (of A G) a := sorry

/-- `lift_nc_ring_hom` as a `alg_hom`, for when `f` is an `alg_hom` -/
def lift_nc_alg_hom {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] {B : Type u_1} [semiring B] [algebra k B] (f : alg_hom k A B) (g : G →* B) (h_comm : ∀ (x : A) (y : G), commute (coe_fn f x) (coe_fn g y)) : alg_hom k (monoid_algebra A G) B :=
  alg_hom.mk ⇑(lift_nc_ring_hom (↑f) g h_comm) sorry sorry sorry sorry sorry

/-- A `k`-algebra homomorphism from `monoid_algebra k G` is uniquely defined by its
values on the functions `single a 1`. -/
theorem alg_hom_ext {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] {φ₁ : alg_hom k (monoid_algebra k G) A} {φ₂ : alg_hom k (monoid_algebra k G) A} (h : ∀ (x : G), coe_fn φ₁ (finsupp.single x 1) = coe_fn φ₂ (finsupp.single x 1)) : φ₁ = φ₂ :=
  alg_hom.to_linear_map_inj (finsupp.lhom_ext' fun (a : G) => linear_map.ext_ring (h a))

/-- See note [partially-applied ext lemmas]. -/
theorem alg_hom_ext' {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] {φ₁ : alg_hom k (monoid_algebra k G) A} {φ₂ : alg_hom k (monoid_algebra k G) A} (h : monoid_hom.comp (↑φ₁) (of k G) = monoid_hom.comp (↑φ₂) (of k G)) : φ₁ = φ₂ :=
  alg_hom_ext (monoid_hom.congr_fun h)

/-- Any monoid homomorphism `G →* A` can be lifted to an algebra homomorphism
`monoid_algebra k G →ₐ[k] A`. -/
def lift (k : Type u₁) (G : Type u₂) [comm_semiring k] [monoid G] (A : Type u₃) [semiring A] [algebra k A] : (G →* A) ≃ alg_hom k (monoid_algebra k G) A :=
  equiv.mk (fun (F : G →* A) => lift_nc_alg_hom (algebra.of_id k A) F sorry)
    (fun (f : alg_hom k (monoid_algebra k G) A) => monoid_hom.comp (↑f) (of k G)) sorry sorry

theorem lift_apply' {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : G →* A) (f : monoid_algebra k G) : coe_fn (coe_fn (lift k G A) F) f = finsupp.sum f fun (a : G) (b : k) => coe_fn (algebra_map k A) b * coe_fn F a :=
  rfl

theorem lift_apply {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : G →* A) (f : monoid_algebra k G) : coe_fn (coe_fn (lift k G A) F) f = finsupp.sum f fun (a : G) (b : k) => b • coe_fn F a := sorry

theorem lift_def {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : G →* A) : ⇑(coe_fn (lift k G A) F) = ⇑(lift_nc (↑(algebra_map k A)) F) :=
  rfl

@[simp] theorem lift_symm_apply {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : alg_hom k (monoid_algebra k G) A) (x : G) : coe_fn (coe_fn (equiv.symm (lift k G A)) F) x = coe_fn F (finsupp.single x 1) :=
  rfl

theorem lift_of {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : G →* A) (x : G) : coe_fn (coe_fn (lift k G A) F) (coe_fn (of k G) x) = coe_fn F x := sorry

@[simp] theorem lift_single {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : G →* A) (a : G) (b : k) : coe_fn (coe_fn (lift k G A) F) (finsupp.single a b) = b • coe_fn F a := sorry

theorem lift_unique' {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : alg_hom k (monoid_algebra k G) A) : F = coe_fn (lift k G A) (monoid_hom.comp (↑F) (of k G)) :=
  Eq.symm (equiv.apply_symm_apply (lift k G A) F)

/-- Decomposition of a `k`-algebra homomorphism from `monoid_algebra k G` by
its values on `F (single a 1)`. -/
theorem lift_unique {k : Type u₁} {G : Type u₂} [comm_semiring k] [monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : alg_hom k (monoid_algebra k G) A) (f : monoid_algebra k G) : coe_fn F f = finsupp.sum f fun (a : G) (b : k) => b • coe_fn F (finsupp.single a 1) := sorry

/-- When `V` is a `k[G]`-module, multiplication by a group element `g` is a `k`-linear map. -/
def group_smul.linear_map (k : Type u₁) {G : Type u₂} [monoid G] [comm_semiring k] (V : Type u₃) [add_comm_monoid V] [semimodule k V] [semimodule (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] (g : G) : linear_map k V V :=
  linear_map.mk (fun (v : V) => finsupp.single g 1 • v) sorry sorry

@[simp] theorem group_smul.linear_map_apply (k : Type u₁) {G : Type u₂} [monoid G] [comm_semiring k] (V : Type u₃) [add_comm_monoid V] [semimodule k V] [semimodule (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] (g : G) (v : V) : coe_fn (group_smul.linear_map k V g) v = finsupp.single g 1 • v :=
  rfl

/-- Build a `k[G]`-linear map from a `k`-linear map and evidence that it is `G`-equivariant. -/
def equivariant_of_linear_of_comm {k : Type u₁} {G : Type u₂} [monoid G] [comm_semiring k] {V : Type u₃} {W : Type u₃} [add_comm_monoid V] [semimodule k V] [semimodule (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] [add_comm_monoid W] [semimodule k W] [semimodule (monoid_algebra k G) W] [is_scalar_tower k (monoid_algebra k G) W] (f : linear_map k V W) (h : ∀ (g : G) (v : V), coe_fn f (finsupp.single g 1 • v) = finsupp.single g 1 • coe_fn f v) : linear_map (monoid_algebra k G) V W :=
  linear_map.mk ⇑f sorry sorry

@[simp] theorem equivariant_of_linear_of_comm_apply {k : Type u₁} {G : Type u₂} [monoid G] [comm_semiring k] {V : Type u₃} {W : Type u₃} [add_comm_monoid V] [semimodule k V] [semimodule (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] [add_comm_monoid W] [semimodule k W] [semimodule (monoid_algebra k G) W] [is_scalar_tower k (monoid_algebra k G) W] (f : linear_map k V W) (h : ∀ (g : G) (v : V), coe_fn f (finsupp.single g 1 • v) = finsupp.single g 1 • coe_fn f v) (v : V) : coe_fn (equivariant_of_linear_of_comm f h) v = coe_fn f v :=
  rfl

theorem prod_single {k : Type u₁} {G : Type u₂} {ι : Type ui} [comm_semiring k] [comm_monoid G] {s : finset ι} {a : ι → G} {b : ι → k} : (finset.prod s fun (i : ι) => finsupp.single (a i) (b i)) =
  finsupp.single (finset.prod s fun (i : ι) => a i) (finset.prod s fun (i : ι) => b i) := sorry

@[simp] theorem mul_single_apply {k : Type u₁} {G : Type u₂} [semiring k] [group G] (f : monoid_algebra k G) (r : k) (x : G) (y : G) : coe_fn (f * finsupp.single x r) y = coe_fn f (y * (x⁻¹)) * r :=
  mul_single_apply_aux f fun (a : G) => iff.symm eq_mul_inv_iff_mul_eq

@[simp] theorem single_mul_apply {k : Type u₁} {G : Type u₂} [semiring k] [group G] (r : k) (x : G) (f : monoid_algebra k G) (y : G) : coe_fn (finsupp.single x r * f) y = r * coe_fn f (x⁻¹ * y) :=
  single_mul_apply_aux f fun (z : G) => iff.symm eq_inv_mul_iff_mul_eq

theorem mul_apply_left {k : Type u₁} {G : Type u₂} [semiring k] [group G] (f : monoid_algebra k G) (g : monoid_algebra k G) (x : G) : coe_fn (f * g) x = finsupp.sum f fun (a : G) (b : k) => b * coe_fn g (a⁻¹ * x) := sorry

-- If we'd assumed `comm_semiring`, we could deduce this from `mul_apply_left`.

theorem mul_apply_right {k : Type u₁} {G : Type u₂} [semiring k] [group G] (f : monoid_algebra k G) (g : monoid_algebra k G) (x : G) : coe_fn (f * g) x = finsupp.sum g fun (a : G) (b : k) => coe_fn f (x * (a⁻¹)) * b := sorry

end monoid_algebra

/-! ### Additive monoids -/

/--
The monoid algebra over a semiring `k` generated by the additive monoid `G`.
It is the type of finite formal `k`-linear combinations of terms of `G`,
endowed with the convolution product.
-/
def add_monoid_algebra (k : Type u₁) (G : Type u₂) [semiring k] :=
  G →₀ k

namespace add_monoid_algebra

/-! #### Semiring structure -/

/-- The product of `f g : add_monoid_algebra k G` is the finitely supported function
  whose value at `a` is the sum of `f x * g y` over all pairs `x, y`
  such that `x + y = a`. (Think of the product of multivariate
  polynomials where `α` is the additive monoid of monomial exponents.) -/
protected instance has_mul {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] : Mul (add_monoid_algebra k G) :=
  { mul :=
      fun (f g : add_monoid_algebra k G) =>
        finsupp.sum f fun (a₁ : G) (b₁ : k) => finsupp.sum g fun (a₂ : G) (b₂ : k) => finsupp.single (a₁ + a₂) (b₁ * b₂) }

theorem mul_def {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] {f : add_monoid_algebra k G} {g : add_monoid_algebra k G} : f * g = finsupp.sum f fun (a₁ : G) (b₁ : k) => finsupp.sum g fun (a₂ : G) (b₂ : k) => finsupp.single (a₁ + a₂) (b₁ * b₂) :=
  rfl

/-- The unit of the multiplication is `single 1 1`, i.e. the function
  that is `1` at `0` and zero elsewhere. -/
protected instance has_one {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] : HasOne (add_monoid_algebra k G) :=
  { one := finsupp.single 0 1 }

theorem one_def {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] : 1 = finsupp.single 0 1 :=
  rfl

protected instance semiring {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] : semiring (add_monoid_algebra k G) :=
  semiring.mk Add.add sorry 0 sorry sorry sorry Mul.mul sorry 1 sorry sorry sorry sorry sorry sorry

/-- A non-commutative version of `add_monoid_algebra.lift`: given a additive homomorphism `f : k →+
R` and a multiplicative monoid homomorphism `g : multiplicative G →* R`, returns the additive
homomorphism from `add_monoid_algebra k G` such that `lift_nc f g (single a b) = f b * g a`. If `f`
is a ring homomorphism and the range of either `f` or `g` is in center of `R`, then the result is a
ring homomorphism.  If `R` is a `k`-algebra and `f = algebra_map k R`, then the result is an algebra
homomorphism called `add_monoid_algebra.lift`. -/
def lift_nc {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] {R : Type u_1} [semiring R] (f : k →+ R) (g : multiplicative G →* R) : add_monoid_algebra k G →+ R :=
  coe_fn finsupp.lift_add_hom
    fun (x : G) => add_monoid_hom.comp (add_monoid_hom.mul_right (coe_fn g (coe_fn multiplicative.of_add x))) f

@[simp] theorem lift_nc_single {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] {R : Type u_1} [semiring R] (f : k →+ R) (g : multiplicative G →* R) (a : G) (b : k) : coe_fn (lift_nc f g) (finsupp.single a b) = coe_fn f b * coe_fn g (coe_fn multiplicative.of_add a) :=
  finsupp.lift_add_hom_apply_single
    (fun (x : G) => add_monoid_hom.comp (add_monoid_hom.mul_right (coe_fn g (coe_fn multiplicative.of_add x))) f) a b

@[simp] theorem lift_nc_one {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] {R : Type u_1} [semiring R] (f : k →+* R) (g : multiplicative G →* R) : coe_fn (lift_nc (↑f) g) 1 = 1 :=
  monoid_algebra.lift_nc_one f g

theorem lift_nc_mul {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] {R : Type u_1} [semiring R] (f : k →+* R) (g : multiplicative G →* R) (a : add_monoid_algebra k G) (b : add_monoid_algebra k G) (h_comm : ∀ {x y : G}, y ∈ finsupp.support a → commute (coe_fn f (coe_fn b x)) (coe_fn g (coe_fn multiplicative.of_add y))) : coe_fn (lift_nc (↑f) g) (a * b) = coe_fn (lift_nc (↑f) g) a * coe_fn (lift_nc (↑f) g) b :=
  monoid_algebra.lift_nc_mul f g a b h_comm

/-- `lift_nc` as a `ring_hom`, for when `f` and `g` commute -/
def lift_nc_ring_hom {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] {R : Type u_1} [semiring R] (f : k →+* R) (g : multiplicative G →* R) (h_comm : ∀ (x : k) (y : multiplicative G), commute (coe_fn f x) (coe_fn g y)) : add_monoid_algebra k G →+* R :=
  ring_hom.mk (⇑(lift_nc (↑f) g)) (lift_nc_one f g) sorry sorry sorry

protected instance comm_semiring {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_comm_monoid G] : comm_semiring (add_monoid_algebra k G) :=
  comm_semiring.mk semiring.add sorry semiring.zero sorry sorry sorry semiring.mul sorry semiring.one sorry sorry sorry
    sorry sorry sorry sorry

protected instance nontrivial {k : Type u₁} {G : Type u₂} [semiring k] [nontrivial k] [add_monoid G] : nontrivial (add_monoid_algebra k G) :=
  finsupp.nontrivial

/-! #### Derived instances -/

protected instance unique {k : Type u₁} {G : Type u₂} [semiring k] [subsingleton k] : unique (add_monoid_algebra k G) :=
  finsupp.unique_of_right

protected instance add_group {k : Type u₁} {G : Type u₂} [ring k] : add_group (add_monoid_algebra k G) :=
  finsupp.add_group

protected instance ring {k : Type u₁} {G : Type u₂} [ring k] [add_monoid G] : ring (add_monoid_algebra k G) :=
  ring.mk semiring.add sorry semiring.zero sorry sorry Neg.neg Sub.sub sorry sorry semiring.mul sorry semiring.one sorry
    sorry sorry sorry

protected instance comm_ring {k : Type u₁} {G : Type u₂} [comm_ring k] [add_comm_monoid G] : comm_ring (add_monoid_algebra k G) :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry
    sorry sorry sorry

protected instance has_scalar {k : Type u₁} {G : Type u₂} {R : Type u_1} [semiring R] [semiring k] [semimodule R k] : has_scalar R (add_monoid_algebra k G) :=
  finsupp.has_scalar

protected instance semimodule {k : Type u₁} {G : Type u₂} {R : Type u_1} [semiring R] [semiring k] [semimodule R k] : semimodule R (add_monoid_algebra k G) :=
  finsupp.semimodule G k

/-! It is hard to state the equivalent of `distrib_mul_action G (add_monoid_algebra k G)`
because we've never discussed actions of additive groups. -/

theorem mul_apply {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] (f : add_monoid_algebra k G) (g : add_monoid_algebra k G) (x : G) : coe_fn (f * g) x =
  finsupp.sum f fun (a₁ : G) (b₁ : k) => finsupp.sum g fun (a₂ : G) (b₂ : k) => ite (a₁ + a₂ = x) (b₁ * b₂) 0 :=
  monoid_algebra.mul_apply f g x

theorem mul_apply_antidiagonal {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] (f : add_monoid_algebra k G) (g : add_monoid_algebra k G) (x : G) (s : finset (G × G)) (hs : ∀ {p : G × G}, p ∈ s ↔ prod.fst p + prod.snd p = x) : coe_fn (f * g) x = finset.sum s fun (p : G × G) => coe_fn f (prod.fst p) * coe_fn g (prod.snd p) :=
  monoid_algebra.mul_apply_antidiagonal f g x s hs

theorem support_mul {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] (a : add_monoid_algebra k G) (b : add_monoid_algebra k G) : finsupp.support (a * b) ⊆
  finset.bUnion (finsupp.support a)
    fun (a₁ : G) => finset.bUnion (finsupp.support b) fun (a₂ : G) => singleton (a₁ + a₂) :=
  monoid_algebra.support_mul a b

theorem single_mul_single {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] {a₁ : G} {a₂ : G} {b₁ : k} {b₂ : k} : finsupp.single a₁ b₁ * finsupp.single a₂ b₂ = finsupp.single (a₁ + a₂) (b₁ * b₂) :=
  monoid_algebra.single_mul_single

/-- Like `finsupp.map_domain_add`, but for the convolutive multiplication we define in this file -/
theorem map_domain_mul {α : Type u_1} {β : Type u_2} {α₂ : Type u_3} [semiring β] [add_monoid α] [add_monoid α₂] {x : add_monoid_algebra β α} {y : add_monoid_algebra β α} (f : add_hom α α₂) : finsupp.map_domain (⇑f) (x * y) = finsupp.map_domain (⇑f) x * finsupp.map_domain (⇑f) y := sorry

/-- Embedding of a monoid into its monoid algebra. -/
def of (k : Type u₁) (G : Type u₂) [semiring k] [add_monoid G] : multiplicative G →* add_monoid_algebra k G :=
  monoid_hom.mk (fun (a : multiplicative G) => finsupp.single a 1) sorry sorry

@[simp] theorem of_apply {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] (a : multiplicative G) : coe_fn (of k G) a = finsupp.single (coe_fn multiplicative.to_add a) 1 :=
  rfl

theorem of_injective {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] [nontrivial k] : function.injective ⇑(of k G) := sorry

theorem mul_single_apply_aux {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] (f : add_monoid_algebra k G) (r : k) (x : G) (y : G) (z : G) (H : ∀ (a : G), a + x = z ↔ a = y) : coe_fn (f * finsupp.single x r) z = coe_fn f y * r :=
  monoid_algebra.mul_single_apply_aux f H

theorem mul_single_zero_apply {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] (f : add_monoid_algebra k G) (r : k) (x : G) : coe_fn (f * finsupp.single 0 r) x = coe_fn f x * r :=
  mul_single_apply_aux f r 0 x x
    fun (a : G) => eq.mpr (id (Eq._oldrec (Eq.refl (a + 0 = x ↔ a = x)) (add_zero a))) (iff.refl (a = x))

theorem single_mul_apply_aux {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] (f : add_monoid_algebra k G) (r : k) (x : G) (y : G) (z : G) (H : ∀ (a : G), x + a = y ↔ a = z) : coe_fn (finsupp.single x r * f) y = r * coe_fn f z :=
  monoid_algebra.single_mul_apply_aux f H

theorem single_zero_mul_apply {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] (f : add_monoid_algebra k G) (r : k) (x : G) : coe_fn (finsupp.single 0 r * f) x = r * coe_fn f x :=
  single_mul_apply_aux f r 0 x x
    fun (a : G) => eq.mpr (id (Eq._oldrec (Eq.refl (0 + a = x ↔ a = x)) (zero_add a))) (iff.refl (a = x))

theorem lift_nc_smul {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] {R : Type u_1} [semiring R] (f : k →+* R) (g : multiplicative G →* R) (c : k) (φ : monoid_algebra k G) : coe_fn (lift_nc (↑f) g) (c • φ) = coe_fn f c * coe_fn (lift_nc (↑f) g) φ :=
  monoid_algebra.lift_nc_smul f g c φ

end add_monoid_algebra

/-!
#### Conversions between `add_monoid_algebra` and `monoid_algebra`

While we were not able to define `add_monoid_algebra k G = monoid_algebra k (multiplicative G)` due
to definitional inconveniences, we can still show the types are isomorphic.
-/

/-- The equivalence between `add_monoid_algebra` and `monoid_algebra` in terms of
`multiplicative` -/
protected def add_monoid_algebra.to_multiplicative (k : Type u₁) (G : Type u₂) [semiring k] [add_monoid G] : add_monoid_algebra k G ≃+* monoid_algebra k (multiplicative G) :=
  ring_equiv.mk (add_equiv.to_fun (finsupp.dom_congr multiplicative.of_add))
    (add_equiv.inv_fun (finsupp.dom_congr multiplicative.of_add)) sorry sorry sorry sorry

/-- The equivalence between `monoid_algebra` and `add_monoid_algebra` in terms of `additive` -/
protected def monoid_algebra.to_additive (k : Type u₁) (G : Type u₂) [semiring k] [monoid G] : monoid_algebra k G ≃+* add_monoid_algebra k (additive G) :=
  ring_equiv.mk (add_equiv.to_fun (finsupp.dom_congr additive.of_mul))
    (add_equiv.inv_fun (finsupp.dom_congr additive.of_mul)) sorry sorry sorry sorry

namespace add_monoid_algebra

/-! #### Algebra structure -/

/-- `finsupp.single 0` as a `ring_hom` -/
@[simp] theorem single_zero_ring_hom_apply {k : Type u₁} {G : Type u₂} [semiring k] [add_monoid G] : ∀ (ᾰ : k), coe_fn single_zero_ring_hom ᾰ = add_monoid_hom.to_fun (finsupp.single_add_hom 0) ᾰ :=
  fun (ᾰ : k) => Eq.refl (coe_fn single_zero_ring_hom ᾰ)

/-- If two ring homomorphisms from `add_monoid_algebra k G` are equal on all `single a 1`
and `single 0 b`, then they are equal. -/
theorem ring_hom_ext {k : Type u₁} {G : Type u₂} {R : Type u_1} [semiring k] [add_monoid G] [semiring R] {f : add_monoid_algebra k G →+* R} {g : add_monoid_algebra k G →+* R} (h₀ : ∀ (b : k), coe_fn f (finsupp.single 0 b) = coe_fn g (finsupp.single 0 b)) (h_of : ∀ (a : G), coe_fn f (finsupp.single a 1) = coe_fn g (finsupp.single a 1)) : f = g :=
  monoid_algebra.ring_hom_ext h₀ h_of

/-- If two ring homomorphisms from `add_monoid_algebra k G` are equal on all `single a 1`
and `single 0 b`, then they are equal.

See note [partially-applied ext lemmas]. -/
theorem ring_hom_ext' {k : Type u₁} {G : Type u₂} {R : Type u_1} [semiring k] [add_monoid G] [semiring R] {f : add_monoid_algebra k G →+* R} {g : add_monoid_algebra k G →+* R} (h₁ : ring_hom.comp f single_zero_ring_hom = ring_hom.comp g single_zero_ring_hom) (h_of : monoid_hom.comp (↑f) (of k G) = monoid_hom.comp (↑g) (of k G)) : f = g :=
  ring_hom_ext (ring_hom.congr_fun h₁) (monoid_hom.congr_fun h_of)

/--
The instance `algebra R (add_monoid_algebra k G)` whenever we have `algebra R k`.

In particular this provides the instance `algebra k (add_monoid_algebra k G)`.
-/
protected instance algebra {k : Type u₁} {G : Type u₂} {R : Type u_1} [comm_semiring R] [semiring k] [algebra R k] [add_monoid G] : algebra R (add_monoid_algebra k G) :=
  algebra.mk
    (ring_hom.mk (ring_hom.to_fun (ring_hom.comp single_zero_ring_hom (algebra_map R k))) sorry sorry sorry sorry) sorry
    sorry

/-- `finsupp.single 0` as a `alg_hom` -/
def single_zero_alg_hom {k : Type u₁} {G : Type u₂} {R : Type u_1} [comm_semiring R] [semiring k] [algebra R k] [add_monoid G] : alg_hom R k (add_monoid_algebra k G) :=
  alg_hom.mk (ring_hom.to_fun single_zero_ring_hom) sorry sorry sorry sorry sorry

@[simp] theorem coe_algebra_map {k : Type u₁} {G : Type u₂} {R : Type u_1} [comm_semiring R] [semiring k] [algebra R k] [add_monoid G] : ⇑(algebra_map R (add_monoid_algebra k G)) = finsupp.single 0 ∘ ⇑(algebra_map R k) :=
  rfl

/-- `lift_nc_ring_hom` as a `alg_hom`, for when `f` is an `alg_hom` -/
def lift_nc_alg_hom {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] {B : Type u_1} [semiring B] [algebra k B] (f : alg_hom k A B) (g : multiplicative G →* B) (h_comm : ∀ (x : A) (y : multiplicative G), commute (coe_fn f x) (coe_fn g y)) : alg_hom k (add_monoid_algebra A G) B :=
  alg_hom.mk ⇑(lift_nc_ring_hom (↑f) g h_comm) sorry sorry sorry sorry sorry

/-- A `k`-algebra homomorphism from `monoid_algebra k G` is uniquely defined by its
values on the functions `single a 1`. -/
theorem alg_hom_ext {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] {φ₁ : alg_hom k (add_monoid_algebra k G) A} {φ₂ : alg_hom k (add_monoid_algebra k G) A} (h : ∀ (x : G), coe_fn φ₁ (finsupp.single x 1) = coe_fn φ₂ (finsupp.single x 1)) : φ₁ = φ₂ :=
  monoid_algebra.alg_hom_ext h

/-- See note [partially-applied ext lemmas]. -/
theorem alg_hom_ext' {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] {φ₁ : alg_hom k (add_monoid_algebra k G) A} {φ₂ : alg_hom k (add_monoid_algebra k G) A} (h : monoid_hom.comp (↑φ₁) (of k G) = monoid_hom.comp (↑φ₂) (of k G)) : φ₁ = φ₂ :=
  alg_hom_ext (monoid_hom.congr_fun h)

/-- Any monoid homomorphism `G →* A` can be lifted to an algebra homomorphism
`monoid_algebra k G →ₐ[k] A`. -/
def lift (k : Type u₁) (G : Type u₂) [comm_semiring k] [add_monoid G] (A : Type u₃) [semiring A] [algebra k A] : (multiplicative G →* A) ≃ alg_hom k (add_monoid_algebra k G) A :=
  equiv.mk
    (fun (F : multiplicative G →* A) =>
      alg_hom.mk ⇑(lift_nc_alg_hom (algebra.of_id k A) F sorry) sorry sorry sorry sorry sorry)
    (fun (f : alg_hom k (add_monoid_algebra k G) A) => monoid_hom.comp (↑f) (of k G)) sorry sorry

theorem lift_apply' {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : multiplicative G →* A) (f : monoid_algebra k G) : coe_fn (coe_fn (lift k G A) F) f =
  finsupp.sum f fun (a : G) (b : k) => coe_fn (algebra_map k A) b * coe_fn F (coe_fn multiplicative.of_add a) :=
  rfl

theorem lift_apply {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : multiplicative G →* A) (f : monoid_algebra k G) : coe_fn (coe_fn (lift k G A) F) f = finsupp.sum f fun (a : G) (b : k) => b • coe_fn F (coe_fn multiplicative.of_add a) := sorry

theorem lift_def {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : multiplicative G →* A) : ⇑(coe_fn (lift k G A) F) = ⇑(lift_nc (↑(algebra_map k A)) F) :=
  rfl

@[simp] theorem lift_symm_apply {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : alg_hom k (add_monoid_algebra k G) A) (x : multiplicative G) : coe_fn (coe_fn (equiv.symm (lift k G A)) F) x = coe_fn F (finsupp.single (coe_fn multiplicative.to_add x) 1) :=
  rfl

theorem lift_of {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : multiplicative G →* A) (x : multiplicative G) : coe_fn (coe_fn (lift k G A) F) (coe_fn (of k G) x) = coe_fn F x := sorry

@[simp] theorem lift_single {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : multiplicative G →* A) (a : G) (b : k) : coe_fn (coe_fn (lift k G A) F) (finsupp.single a b) = b • coe_fn F (coe_fn multiplicative.of_add a) := sorry

theorem lift_unique' {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : alg_hom k (add_monoid_algebra k G) A) : F = coe_fn (lift k G A) (monoid_hom.comp (↑F) (of k G)) :=
  Eq.symm (equiv.apply_symm_apply (lift k G A) F)

/-- Decomposition of a `k`-algebra homomorphism from `monoid_algebra k G` by
its values on `F (single a 1)`. -/
theorem lift_unique {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] (F : alg_hom k (add_monoid_algebra k G) A) (f : monoid_algebra k G) : coe_fn F f = finsupp.sum f fun (a : G) (b : k) => b • coe_fn F (finsupp.single a 1) := sorry

theorem alg_hom_ext_iff {k : Type u₁} {G : Type u₂} [comm_semiring k] [add_monoid G] {A : Type u₃} [semiring A] [algebra k A] {φ₁ : alg_hom k (add_monoid_algebra k G) A} {φ₂ : alg_hom k (add_monoid_algebra k G) A} : (∀ (x : G), coe_fn φ₁ (finsupp.single x 1) = coe_fn φ₂ (finsupp.single x 1)) ↔ φ₁ = φ₂ :=
  { mp := fun (h : ∀ (x : G), coe_fn φ₁ (finsupp.single x 1) = coe_fn φ₂ (finsupp.single x 1)) => alg_hom_ext h,
    mpr := fun (ᾰ : φ₁ = φ₂) (x : G) => Eq._oldrec (Eq.refl (coe_fn φ₁ (finsupp.single x 1))) ᾰ }

theorem prod_single {k : Type u₁} {G : Type u₂} {ι : Type ui} [comm_semiring k] [add_comm_monoid G] {s : finset ι} {a : ι → G} {b : ι → k} : (finset.prod s fun (i : ι) => finsupp.single (a i) (b i)) =
  finsupp.single (finset.sum s fun (i : ι) => a i) (finset.prod s fun (i : ι) => b i) := sorry