/-
Copyright (c) 2020 Zhangir Azerbayev. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser, Zhangir Azerbayev
-/

import group_theory.group_action.quotient
import group_theory.perm.sign
import group_theory.perm.subgroup
import linear_algebra.linear_independent
import linear_algebra.multilinear.basis
import linear_algebra.multilinear.tensor_product
import logic.equiv.fin

/-!
# Alternating Maps

We construct the bundled function `alternating_map`, which extends `multilinear_map` with all the
arguments of the same type.

## Main definitions
* `alternating_map R M N ι` is the space of `R`-linear alternating maps from `ι → M` to `N`.
* `f.map_eq_zero_of_eq` expresses that `f` is zero when two inputs are equal.
* `f.map_swap` expresses that `f` is negated when two inputs are swapped.
* `f.map_perm` expresses how `f` varies by a sign change under a permutation of its inputs.
* An `add_comm_monoid`, `add_comm_group`, and `module` structure over `alternating_map`s that
  matches the definitions over `multilinear_map`s.
* `multilinear_map.dom_dom_congr`, for permutating the elements within a family.
* `multilinear_map.alternatization`, which makes an alternating map out of a non-alternating one.
* `alternating_map.dom_coprod`, which behaves as a product between two alternating maps.
* `alternating_map.curry_left`, for binding the leftmost argument of an alternating map indexed
  by `fin n.succ`.

## Implementation notes
`alternating_map` is defined in terms of `map_eq_zero_of_eq`, as this is easier to work with than
using `map_swap` as a definition, and does not require `has_neg N`.

`alternating_map`s are provided with a coercion to `multilinear_map`, along with a set of
`norm_cast` lemmas that act on the algebraic structure:

* `alternating_map.coe_add`
* `alternating_map.coe_zero`
* `alternating_map.coe_sub`
* `alternating_map.coe_neg`
* `alternating_map.coe_smul`
-/

-- semiring / add_comm_monoid
variables {R : Type*} [semiring R]
variables {M : Type*} [add_comm_monoid M] [module R M]
variables {N : Type*} [add_comm_monoid N] [module R N]

-- semiring / add_comm_group
variables {M' : Type*} [add_comm_group M'] [module R M']
variables {N' : Type*} [add_comm_group N'] [module R N']

variables {ι ι' ι'' : Type*} [decidable_eq ι] [decidable_eq ι'] [decidable_eq ι'']

set_option old_structure_cmd true

section
variables (R M N ι)
/--
An alternating map is a multilinear map that vanishes when two of its arguments are equal.
-/
structure alternating_map extends multilinear_map R (λ i : ι, M) N :=
(map_eq_zero_of_eq' : ∀ (v : ι → M) (i j : ι) (h : v i = v j) (hij : i ≠ j), to_fun v = 0)
end

/-- The multilinear map associated to an alternating map -/
add_decl_doc alternating_map.to_multilinear_map

namespace alternating_map

variables (f f' : alternating_map R M N ι)
variables (g g₂ : alternating_map R M N' ι)
variables (g' : alternating_map R M' N' ι)
variables (v : ι → M) (v' : ι → M')
open function

/-! Basic coercion simp lemmas, largely copied from `ring_hom` and `multilinear_map` -/
section coercions

instance : has_coe_to_fun (alternating_map R M N ι) (λ _, (ι → M) → N) := ⟨λ x, x.to_fun⟩

initialize_simps_projections alternating_map (to_fun → apply)

@[simp] lemma to_fun_eq_coe : f.to_fun = f := rfl

@[simp] lemma coe_mk (f : (ι → M) → N) (h₁ h₂ h₃) : ⇑(⟨f, h₁, h₂, h₃⟩ :
  alternating_map R M N ι) = f := rfl

theorem congr_fun {f g : alternating_map R M N ι} (h : f = g) (x : ι → M) : f x = g x :=
congr_arg (λ h : alternating_map R M N ι, h x) h

theorem congr_arg (f : alternating_map R M N ι) {x y : ι → M} (h : x = y) : f x = f y :=
congr_arg (λ x : ι → M, f x) h

theorem coe_injective : injective (coe_fn : alternating_map R M N ι → ((ι → M) → N)) :=
λ f g h, by { cases f, cases g, cases h, refl }

@[simp, norm_cast] theorem coe_inj {f g : alternating_map R M N ι} :
  (f : (ι → M) → N) = g ↔ f = g :=
coe_injective.eq_iff

@[ext] theorem ext {f f' : alternating_map R M N ι} (H : ∀ x, f x = f' x) : f = f' :=
coe_injective (funext H)

theorem ext_iff {f g : alternating_map R M N ι} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, ext h⟩

instance : has_coe (alternating_map R M N ι) (multilinear_map R (λ i : ι, M) N) :=
⟨λ x, x.to_multilinear_map⟩

@[simp, norm_cast] lemma coe_multilinear_map : ⇑(f : multilinear_map R (λ i : ι, M) N) = f := rfl

lemma coe_multilinear_map_injective :
  function.injective (coe : alternating_map R M N ι → multilinear_map R (λ i : ι, M) N) :=
λ x y h, ext $ multilinear_map.congr_fun h

@[simp] lemma to_multilinear_map_eq_coe : f.to_multilinear_map = f := rfl

@[simp] lemma coe_multilinear_map_mk (f : (ι → M) → N) (h₁ h₂ h₃) :
  ((⟨f, h₁, h₂, h₃⟩ : alternating_map R M N ι) :  multilinear_map R (λ i : ι, M) N) = ⟨f, h₁, h₂⟩ :=
rfl

end coercions

/-!
### Simp-normal forms of the structure fields

These are expressed in terms of `⇑f` instead of `f.to_fun`.
-/
@[simp] lemma map_add (i : ι) (x y : M) :
  f (update v i (x + y)) = f (update v i x) + f (update v i y) :=
f.to_multilinear_map.map_add' v i x y

@[simp] lemma map_sub (i : ι) (x y : M') :
  g' (update v' i (x - y)) = g' (update v' i x) - g' (update v' i y) :=
g'.to_multilinear_map.map_sub v' i x y

@[simp] lemma map_neg (i : ι) (x : M') :
  g' (update v' i (-x)) = -g' (update v' i x) :=
g'.to_multilinear_map.map_neg v' i x

@[simp] lemma map_smul (i : ι) (r : R) (x : M) :
  f (update v i (r • x)) = r • f (update v i x) :=
f.to_multilinear_map.map_smul' v i r x

@[simp] lemma map_eq_zero_of_eq (v : ι → M) {i j : ι} (h : v i = v j) (hij : i ≠ j) :
  f v = 0 :=
f.map_eq_zero_of_eq' v i j h hij

lemma map_coord_zero {m : ι → M} (i : ι) (h : m i = 0) : f m = 0 :=
f.to_multilinear_map.map_coord_zero i h

@[simp] lemma map_update_zero (m : ι → M) (i : ι) : f (update m i 0) = 0 :=
f.to_multilinear_map.map_update_zero m i

@[simp] lemma map_zero [nonempty ι] : f 0 = 0 :=
f.to_multilinear_map.map_zero

lemma map_eq_zero_of_not_injective (v : ι → M) (hv : ¬function.injective v) : f v = 0 :=
begin
  rw function.injective at hv,
  push_neg at hv,
  rcases hv with ⟨i₁, i₂, heq, hne⟩,
  exact f.map_eq_zero_of_eq v heq hne
end

/-!
### Algebraic structure inherited from `multilinear_map`

`alternating_map` carries the same `add_comm_monoid`, `add_comm_group`, and `module` structure
as `multilinear_map`
-/

section has_smul

variables {S : Type*} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N]

instance : has_smul S (alternating_map R M N ι) :=
⟨λ c f,
  { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
    ..((c • f : multilinear_map R (λ i : ι, M) N)) }⟩

@[simp] lemma smul_apply (c : S) (m : ι → M) :
  (c • f) m = c • f m := rfl

@[norm_cast] lemma coe_smul (c : S):
  ((c • f : alternating_map R M N ι) : multilinear_map R (λ i : ι, M) N) = c • f := rfl

lemma coe_fn_smul (c : S) (f : alternating_map R M N ι) : ⇑(c • f) = c • f :=
rfl

end has_smul

instance : has_add (alternating_map R M N ι) :=
⟨λ a b,
  { map_eq_zero_of_eq' :=
      λ v i j h hij, by simp [a.map_eq_zero_of_eq v h hij, b.map_eq_zero_of_eq v h hij],
    ..(a + b : multilinear_map R (λ i : ι, M) N)}⟩

@[simp] lemma add_apply : (f + f') v = f v + f' v := rfl

@[norm_cast] lemma coe_add : (↑(f  + f') : multilinear_map R (λ i : ι, M) N) = f + f' := rfl

instance : has_zero (alternating_map R M N ι) :=
⟨{map_eq_zero_of_eq' := λ v i j h hij, by simp,
  ..(0 : multilinear_map R (λ i : ι, M) N)}⟩

@[simp] lemma zero_apply : (0 : alternating_map R M N ι) v = 0 := rfl

@[norm_cast] lemma coe_zero :
  ((0 : alternating_map R M N ι) : multilinear_map R (λ i : ι, M) N) = 0 := rfl

instance : inhabited (alternating_map R M N ι) := ⟨0⟩

instance : add_comm_monoid (alternating_map R M N ι) :=
coe_injective.add_comm_monoid _ rfl (λ _ _, rfl) (λ _ _, coe_fn_smul _ _)

instance : has_neg (alternating_map R M N' ι) :=
⟨λ f,
  { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
    ..(-(f : multilinear_map R (λ i : ι, M) N')) }⟩

@[simp] lemma neg_apply (m : ι → M) : (-g) m = -(g m) := rfl

@[norm_cast] lemma coe_neg :
  ((-g : alternating_map R M N' ι) : multilinear_map R (λ i : ι, M) N') = -g := rfl

instance : has_sub (alternating_map R M N' ι) :=
⟨λ f g,
  { map_eq_zero_of_eq' :=
      λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij, g.map_eq_zero_of_eq v h hij],
    ..(f - g : multilinear_map R (λ i : ι, M) N') }⟩

@[simp] lemma sub_apply (m : ι → M) : (g - g₂) m = g m - g₂ m := rfl

@[norm_cast] lemma coe_sub : (↑(g - g₂) : multilinear_map R (λ i : ι, M) N') = g - g₂ := rfl

instance : add_comm_group (alternating_map R M N' ι) :=
coe_injective.add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
  (λ _ _, coe_fn_smul _ _) (λ _ _, coe_fn_smul _ _)

section distrib_mul_action

variables {S : Type*} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N]

instance : distrib_mul_action S (alternating_map R M N ι) :=
{ one_smul := λ f, ext $ λ x, one_smul _ _,
  mul_smul := λ c₁ c₂ f, ext $ λ x, mul_smul _ _ _,
  smul_zero := λ r, ext $ λ x, smul_zero _,
  smul_add := λ r f₁ f₂, ext $ λ x, smul_add _ _ _ }

end distrib_mul_action

section module

variables {S : Type*} [semiring S] [module S N] [smul_comm_class R S N]

/-- The space of multilinear maps over an algebra over `R` is a module over `R`, for the pointwise
addition and scalar multiplication. -/
instance : module S (alternating_map R M N ι) :=
{ add_smul := λ r₁ r₂ f, ext $ λ x, add_smul _ _ _,
  zero_smul := λ f, ext $ λ x, zero_smul _ _ }

instance [no_zero_smul_divisors S N] : no_zero_smul_divisors S (alternating_map R M N ι) :=
coe_injective.no_zero_smul_divisors _ rfl coe_fn_smul

end module

section
variables (R M)

/-- The evaluation map from `ι → M` to `M` at a given `i` is alternating when `ι` is subsingleton.
-/
@[simps]
def of_subsingleton [subsingleton ι] (i : ι) : alternating_map R M M ι :=
{ to_fun := function.eval i,
  map_eq_zero_of_eq' := λ v i j hv hij, (hij $ subsingleton.elim _ _).elim,
  ..multilinear_map.of_subsingleton R M i }

/-- The constant map is alternating when `ι` is empty. -/
@[simps {fully_applied := ff}]
def const_of_is_empty [is_empty ι] (m : N) : alternating_map R M N ι :=
{ to_fun := function.const _ m,
  map_eq_zero_of_eq' := λ v, is_empty_elim,
  ..multilinear_map.const_of_is_empty R m }

end

/-- Restrict the codomain of an alternating map to a submodule. -/
@[simps]
def cod_restrict (f : alternating_map R M N ι) (p : submodule R N) (h : ∀ v, f v ∈ p) :
  alternating_map R M p ι :=
{ to_fun := λ v, ⟨f v, h v⟩,
  map_eq_zero_of_eq' := λ v i j hv hij, subtype.ext $ map_eq_zero_of_eq _ _ hv hij,
  ..f.to_multilinear_map.cod_restrict p h }

end alternating_map

/-!
### Composition with linear maps
-/

namespace linear_map

variables {N₂ : Type*} [add_comm_monoid N₂] [module R N₂]

/-- Composing a alternating map with a linear map on the left gives again an alternating map. -/
def comp_alternating_map (g : N →ₗ[R] N₂) : alternating_map R M N ι →+ alternating_map R M N₂ ι :=
{ to_fun := λ f,
  { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
              ..(g.comp_multilinear_map (f : multilinear_map R (λ _ : ι, M) N)) },
  map_zero' := by { ext, simp },
  map_add' := λ a b, by { ext, simp } }

@[simp] lemma coe_comp_alternating_map (g : N →ₗ[R] N₂) (f : alternating_map R M N ι) :
  ⇑(g.comp_alternating_map f) = g ∘ f := rfl

@[simp]
lemma comp_alternating_map_apply (g : N →ₗ[R] N₂) (f : alternating_map R M N ι) (m : ι → M) :
  g.comp_alternating_map f m = g (f m) := rfl

@[simp]
lemma subtype_comp_alternating_map_cod_restrict (f : alternating_map R M N ι) (p : submodule R N)
  (h) :
  p.subtype.comp_alternating_map (f.cod_restrict p h) = f :=
alternating_map.ext $ λ v, rfl

@[simp]
lemma comp_alternating_map_cod_restrict (g : N →ₗ[R] N₂) (f : alternating_map R M N ι)
  (p : submodule R N₂) (h) :
  (g.cod_restrict p h).comp_alternating_map f =
    (g.comp_alternating_map f).cod_restrict p (λ v, h (f v)):=
alternating_map.ext $ λ v, rfl

end linear_map

namespace alternating_map

variables {M₂ : Type*} [add_comm_monoid M₂] [module R M₂]
variables {M₃ : Type*} [add_comm_monoid M₃] [module R M₃]

/-- Composing a alternating map with the same linear map on each argument gives again an
alternating map. -/
def comp_linear_map (f : alternating_map R M N ι) (g : M₂ →ₗ[R] M) : alternating_map R M₂ N ι :=
{ map_eq_zero_of_eq' := λ v i j h hij, f.map_eq_zero_of_eq _ (linear_map.congr_arg h) hij,
  .. (f : multilinear_map R (λ _ : ι, M) N).comp_linear_map (λ _, g) }

lemma coe_comp_linear_map (f : alternating_map R M N ι) (g : M₂ →ₗ[R] M) :
  ⇑(f.comp_linear_map g) = f ∘ ((∘) g) := rfl

@[simp] lemma comp_linear_map_apply (f : alternating_map R M N ι) (g : M₂ →ₗ[R] M) (v : ι → M₂) :
  f.comp_linear_map g v = f (λ i, g (v i)) := rfl

/-- Composing an alternating map twice with the same linear map in each argument is
the same as composing with their composition. -/
lemma comp_linear_map_assoc (f : alternating_map R M N ι) (g₁ : M₂ →ₗ[R] M) (g₂ : M₃ →ₗ[R] M₂) :
  (f.comp_linear_map g₁).comp_linear_map g₂ = f.comp_linear_map (g₁ ∘ₗ g₂) :=
rfl

@[simp] lemma zero_comp_linear_map (g : M₂ →ₗ[R] M) :
  (0 : alternating_map R M N ι).comp_linear_map g = 0 :=
by { ext, simp only [comp_linear_map_apply, zero_apply] }

@[simp] lemma add_comp_linear_map (f₁ f₂ : alternating_map R M N ι) (g : M₂ →ₗ[R] M) :
  (f₁ + f₂).comp_linear_map g = f₁.comp_linear_map g + f₂.comp_linear_map g :=
by { ext, simp only [comp_linear_map_apply, add_apply] }

@[simp] lemma comp_linear_map_zero [nonempty ι] (f : alternating_map R M N ι) :
  f.comp_linear_map (0 : M₂ →ₗ[R] M) = 0 :=
begin
  ext,
  simp_rw [comp_linear_map_apply, linear_map.zero_apply, ←pi.zero_def, map_zero, zero_apply],
end

/-- Composing an alternating map with the identity linear map in each argument. -/
@[simp] lemma comp_linear_map_id (f : alternating_map R M N ι) :
  f.comp_linear_map linear_map.id = f :=
ext $ λ _, rfl

/-- Composing with a surjective linear map is injective. -/
lemma comp_linear_map_injective (f : M₂ →ₗ[R] M) (hf : function.surjective f) :
  function.injective (λ g : alternating_map R M N ι, g.comp_linear_map f) :=
λ g₁ g₂ h, ext $ λ x,
by simpa [function.surj_inv_eq hf] using ext_iff.mp h (function.surj_inv hf ∘ x)

lemma comp_linear_map_inj (f : M₂ →ₗ[R] M) (hf : function.surjective f)
  (g₁ g₂ : alternating_map R M N ι) : g₁.comp_linear_map f = g₂.comp_linear_map f ↔ g₁ = g₂ :=
(comp_linear_map_injective _ hf).eq_iff

section dom_lcongr

variables (ι R N) (S : Type*) [semiring S] [module S N] [smul_comm_class R S N]

/-- Construct a linear equivalence between maps from a linear equivalence between domains. -/
@[simps apply]
def dom_lcongr (e : M ≃ₗ[R] M₂) : alternating_map R M N ι ≃ₗ[S] alternating_map R M₂ N ι :=
{ to_fun := λ f, f.comp_linear_map e.symm,
  inv_fun := λ g, g.comp_linear_map e,
  map_add' := λ _ _, rfl,
  map_smul' := λ _ _, rfl,
  left_inv := λ f, alternating_map.ext $ λ v, f.congr_arg $ funext $ λ i, e.symm_apply_apply _,
  right_inv := λ f, alternating_map.ext $ λ v, f.congr_arg $ funext $ λ i, e.apply_symm_apply _ }

@[simp] lemma dom_lcongr_refl :
  dom_lcongr R N ι S (linear_equiv.refl R M) = linear_equiv.refl S _ :=
linear_equiv.ext $ λ _, alternating_map.ext $ λ v, rfl

@[simp] lemma dom_lcongr_symm (e : M ≃ₗ[R] M₂) :
  (dom_lcongr R N ι S e).symm = dom_lcongr R N ι S e.symm :=
rfl

lemma dom_lcongr_trans (e : M ≃ₗ[R] M₂) (f : M₂ ≃ₗ[R] M₃):
  (dom_lcongr R N ι S e).trans (dom_lcongr R N ι S f) = dom_lcongr R N ι S (e.trans f) :=
rfl

end dom_lcongr

/-- Composing an alternating map with the same linear equiv on each argument gives the zero map
if and only if the alternating map is the zero map. -/
@[simp] lemma comp_linear_equiv_eq_zero_iff (f : alternating_map R M N ι) (g : M₂ ≃ₗ[R] M) :
  f.comp_linear_map (g : M₂ →ₗ[R] M) = 0 ↔ f = 0 :=
(dom_lcongr R N ι ℕ g.symm).map_eq_zero_iff

variables (f f' : alternating_map R M N ι)
variables (g g₂ : alternating_map R M N' ι)
variables (g' : alternating_map R M' N' ι)
variables (v : ι → M) (v' : ι → M')
open function

/-!
### Other lemmas from `multilinear_map`
-/
section

open_locale big_operators

lemma map_update_sum {α : Type*} (t : finset α) (i : ι) (g : α → M) (m : ι → M):
  f (update m i (∑ a in t, g a)) = ∑ a in t, f (update m i (g a)) :=
f.to_multilinear_map.map_update_sum t i g m

end

/-!
### Theorems specific to alternating maps

Various properties of reordered and repeated inputs which follow from
`alternating_map.map_eq_zero_of_eq`.
-/

lemma map_update_self {i j : ι} (hij : i ≠ j) :
  f (function.update v i (v j)) = 0 :=
f.map_eq_zero_of_eq _ (by rw [function.update_same, function.update_noteq hij.symm]) hij

lemma map_update_update {i j : ι} (hij : i ≠ j) (m : M) :
  f (function.update (function.update v i m) j m) = 0 :=
f.map_eq_zero_of_eq _
  (by rw [function.update_same, function.update_noteq hij, function.update_same]) hij

lemma map_swap_add {i j : ι} (hij : i ≠ j) :
  f (v ∘ equiv.swap i j) + f v = 0 :=
begin
  rw equiv.comp_swap_eq_update,
  convert f.map_update_update v hij (v i + v j),
  simp [f.map_update_self _ hij,
        f.map_update_self _ hij.symm,
        function.update_comm hij (v i + v j) (v _) v,
        function.update_comm hij.symm (v i) (v i) v],
end

lemma map_add_swap {i j : ι} (hij : i ≠ j) :
  f v + f (v ∘ equiv.swap i j) = 0 :=
by { rw add_comm, exact f.map_swap_add v hij }

lemma map_swap {i j : ι} (hij : i ≠ j) : g (v ∘ equiv.swap i j) = - g v :=
eq_neg_of_add_eq_zero_left $ g.map_swap_add v hij

lemma map_perm [fintype ι] (v : ι → M) (σ : equiv.perm ι) :
  g (v ∘ σ) = σ.sign • g v :=
begin
  apply equiv.perm.swap_induction_on' σ,
  { simp },
  { intros s x y hxy hI,
    simpa [g.map_swap (v ∘ s) hxy, equiv.perm.sign_swap hxy] using hI, }
end

lemma map_congr_perm [fintype ι] (σ : equiv.perm ι) :
  g v = σ.sign • g (v ∘ σ) :=
by { rw [g.map_perm, smul_smul], simp }

section dom_dom_congr

/-- Transfer the arguments to a map along an equivalence between argument indices.

This is the alternating version of `multilinear_map.dom_dom_congr`. -/
@[simps]
def dom_dom_congr (σ : ι ≃ ι') (f : alternating_map R M N ι) : alternating_map R M N ι' :=
{ to_fun := λ v, f (v ∘ σ),
  map_eq_zero_of_eq' := λ v i j hv hij,
    f.map_eq_zero_of_eq (v ∘ σ) (by simpa using hv) (σ.symm.injective.ne hij),
  .. f.to_multilinear_map.dom_dom_congr σ }

@[simp] lemma dom_dom_congr_refl (f : alternating_map R M N ι) :
  f.dom_dom_congr (equiv.refl ι) = f := ext $ λ v, rfl

lemma dom_dom_congr_trans (σ₁ : ι ≃ ι') (σ₂ : ι' ≃ ι'') (f : alternating_map R M N ι) :
  f.dom_dom_congr (σ₁.trans σ₂) = (f.dom_dom_congr σ₁).dom_dom_congr σ₂ := rfl

@[simp] lemma dom_dom_congr_zero (σ : ι ≃ ι') :
  (0 : alternating_map R M N ι).dom_dom_congr σ = 0 :=
rfl

@[simp] lemma dom_dom_congr_add (σ : ι ≃ ι') (f g : alternating_map R M N ι) :
  (f + g).dom_dom_congr σ = f.dom_dom_congr σ + g.dom_dom_congr σ :=
rfl

/-- `alternating_map.dom_dom_congr` as an equivalence.

This is declared separately because it does not work with dot notation. -/
@[simps apply symm_apply]
def dom_dom_congr_equiv (σ : ι ≃ ι') :
  alternating_map R M N ι ≃+ alternating_map R M N ι' :=
{ to_fun := dom_dom_congr σ,
  inv_fun := dom_dom_congr σ.symm,
  left_inv := λ f, by { ext, simp [function.comp] },
  right_inv := λ m, by { ext, simp [function.comp] },
  map_add' := dom_dom_congr_add σ }

/-- The results of applying `dom_dom_congr` to two maps are equal if and only if those maps are. -/
@[simp] lemma dom_dom_congr_eq_iff (σ : ι ≃ ι') (f g : alternating_map R M N ι) :
  f.dom_dom_congr σ = g.dom_dom_congr σ ↔ f = g :=
(dom_dom_congr_equiv σ : _ ≃+ alternating_map R M N ι').apply_eq_iff_eq

@[simp] lemma dom_dom_congr_eq_zero_iff (σ : ι ≃ ι') (f : alternating_map R M N ι) :
  f.dom_dom_congr σ = 0 ↔ f = 0 :=
(dom_dom_congr_equiv σ : alternating_map R M N ι ≃+ alternating_map R M N ι').map_eq_zero_iff

lemma dom_dom_congr_perm [fintype ι] (σ : equiv.perm ι) :
  g.dom_dom_congr σ = σ.sign • g :=
alternating_map.ext $ λ v, g.map_perm v σ

@[norm_cast] lemma coe_dom_dom_congr (σ : ι ≃ ι') :
  ↑(f.dom_dom_congr σ) = (f : multilinear_map R (λ _ : ι, M) N).dom_dom_congr σ :=
multilinear_map.ext $ λ v, rfl

end dom_dom_congr

/-- If the arguments are linearly dependent then the result is `0`. -/
lemma map_linear_dependent
  {K : Type*} [ring K]
  {M : Type*} [add_comm_group M] [module K M]
  {N : Type*} [add_comm_group N] [module K N] [no_zero_smul_divisors K N]
  (f : alternating_map K M N ι) (v : ι → M)
  (h : ¬linear_independent K v) :
  f v = 0 :=
begin
  obtain ⟨s, g, h, i, hi, hz⟩ := not_linear_independent_iff.mp h,
  suffices : f (update v i (g i • v i)) = 0,
  { rw [f.map_smul, function.update_eq_self, smul_eq_zero] at this,
    exact or.resolve_left this hz, },
  conv at h in (g _ • v _) { rw ←if_t_t (i = x) (g _ • v _), },
  rw [finset.sum_ite, finset.filter_eq, finset.filter_ne, if_pos hi, finset.sum_singleton,
    add_eq_zero_iff_eq_neg] at h,
  rw [h, f.map_neg, f.map_update_sum, neg_eq_zero, finset.sum_eq_zero],
  intros j hj,
  obtain ⟨hij, _⟩ := finset.mem_erase.mp hj,
  rw [f.map_smul, f.map_update_self _ hij.symm, smul_zero],
end

section fin
open fin

/-- A version of `multilinear_map.cons_add` for `alternating_map`. -/
lemma map_vec_cons_add {n : ℕ} (f : alternating_map R M N (fin n.succ)) (m : fin n → M) (x y : M) :
  f (matrix.vec_cons (x+y) m) = f (matrix.vec_cons x m) + f (matrix.vec_cons y m) :=
f.to_multilinear_map.cons_add _ _ _

/-- A version of `multilinear_map.cons_smul` for `alternating_map`. -/
lemma map_vec_cons_smul {n : ℕ} (f : alternating_map R M N (fin n.succ)) (m : fin n → M)
  (c : R) (x : M) :
  f (matrix.vec_cons (c • x) m) = c • f (matrix.vec_cons x m) :=
f.to_multilinear_map.cons_smul _ _ _

end fin

end alternating_map

open_locale big_operators

namespace multilinear_map

open equiv

variables [fintype ι]

private lemma alternization_map_eq_zero_of_eq_aux
  (m : multilinear_map R (λ i : ι, M) N')
  (v : ι → M) (i j : ι) (i_ne_j : i ≠ j) (hv : v i = v j) :
  (∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ) v = 0 :=
begin
  rw sum_apply,
  exact finset.sum_involution
    (λ σ _, swap i j * σ)
    (λ σ _, by simp [perm.sign_swap i_ne_j, apply_swap_eq_self hv])
    (λ σ _ _, (not_congr swap_mul_eq_iff).mpr i_ne_j)
    (λ σ _, finset.mem_univ _)
    (λ σ _, swap_mul_involutive i j σ)
end

/-- Produce an `alternating_map` out of a `multilinear_map`, by summing over all argument
permutations. -/
def alternatization : multilinear_map R (λ i : ι, M) N' →+ alternating_map R M N' ι :=
{ to_fun := λ m,
  { to_fun := ⇑(∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ),
    map_eq_zero_of_eq' := λ v i j hvij hij, alternization_map_eq_zero_of_eq_aux m v i j hij hvij,
    .. (∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ)},
  map_add' := λ a b, begin
    ext,
    simp only [
      finset.sum_add_distrib, smul_add, add_apply, dom_dom_congr_apply, alternating_map.add_apply,
      alternating_map.coe_mk, smul_apply, sum_apply],
  end,
  map_zero' := begin
    ext,
    simp only [
      finset.sum_const_zero, smul_zero, zero_apply, dom_dom_congr_apply, alternating_map.zero_apply,
      alternating_map.coe_mk, smul_apply, sum_apply],
  end }

lemma alternatization_def (m : multilinear_map R (λ i : ι, M) N') :
  ⇑(alternatization m) = (∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ : _) :=
rfl

lemma alternatization_coe (m : multilinear_map R (λ i : ι, M) N') :
  ↑m.alternatization = (∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ : _) :=
coe_injective rfl

lemma alternatization_apply (m : multilinear_map R (λ i : ι, M) N') (v : ι → M) :
  alternatization m v = ∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ v :=
by simp only [alternatization_def, smul_apply, sum_apply]

end multilinear_map

namespace alternating_map

/-- Alternatizing a multilinear map that is already alternating results in a scale factor of `n!`,
where `n` is the number of inputs. -/
lemma coe_alternatization [fintype ι] (a : alternating_map R M N' ι) :
  (↑a : multilinear_map R (λ ι, M) N').alternatization = nat.factorial (fintype.card ι) • a :=
begin
  apply alternating_map.coe_injective,
  simp_rw [multilinear_map.alternatization_def, ←coe_dom_dom_congr, dom_dom_congr_perm, coe_smul,
    smul_smul, int.units_mul_self, one_smul, finset.sum_const, finset.card_univ, fintype.card_perm,
    ←coe_multilinear_map, coe_smul],
end

end alternating_map

namespace linear_map

variables {N'₂ : Type*} [add_comm_group N'₂] [module R N'₂] [fintype ι]

/-- Composition with a linear map before and after alternatization are equivalent. -/
lemma comp_multilinear_map_alternatization (g : N' →ₗ[R] N'₂)
  (f : multilinear_map R (λ _ : ι, M) N') :
  (g.comp_multilinear_map f).alternatization = g.comp_alternating_map (f.alternatization) :=
by { ext, simp [multilinear_map.alternatization_def] }

end linear_map

section coprod

open_locale big_operators
open_locale tensor_product

variables {ιa ιb : Type*} [decidable_eq ιa] [decidable_eq ιb] [fintype ιa] [fintype ιb]

variables
  {R' : Type*} {Mᵢ N₁ N₂ : Type*}
  [comm_semiring R']
  [add_comm_group N₁] [module R' N₁]
  [add_comm_group N₂] [module R' N₂]
  [add_comm_monoid Mᵢ] [module R' Mᵢ]

namespace equiv.perm

/-- Elements which are considered equivalent if they differ only by swaps within α or β  -/
abbreviation mod_sum_congr (α β : Type*) :=
_ ⧸ (equiv.perm.sum_congr_hom α β).range

lemma mod_sum_congr.swap_smul_involutive {α β : Type*} [decidable_eq (α ⊕ β)] (i j : α ⊕ β) :
  function.involutive (has_smul.smul (equiv.swap i j) : mod_sum_congr α β → mod_sum_congr α β) :=
λ σ, begin
  apply σ.induction_on' (λ σ, _),
  exact _root_.congr_arg quotient.mk' (equiv.swap_mul_involutive i j σ)
end

end equiv.perm

namespace alternating_map
open equiv

/-- summand used in `alternating_map.dom_coprod` -/
def dom_coprod.summand
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : perm.mod_sum_congr ιa ιb) :
  multilinear_map R' (λ _ : ιa ⊕ ιb, Mᵢ) (N₁ ⊗[R'] N₂) :=
quotient.lift_on' σ
  (λ σ,
    σ.sign •
      (multilinear_map.dom_coprod ↑a ↑b : multilinear_map R' (λ _, Mᵢ) (N₁ ⊗ N₂)).dom_dom_congr σ)
  (λ σ₁ σ₂ H, begin
    rw quotient_group.left_rel_apply at H,
    obtain ⟨⟨sl, sr⟩, h⟩ := H,
    ext v,
    simp only [multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply,
      coe_multilinear_map, multilinear_map.smul_apply],
    replace h := inv_mul_eq_iff_eq_mul.mp (h.symm),
    have : (σ₁ * perm.sum_congr_hom _ _ (sl, sr)).sign = σ₁.sign * (sl.sign * sr.sign) :=
      by simp,
    rw [h, this, mul_smul, mul_smul, smul_left_cancel_iff,
      ←tensor_product.tmul_smul, tensor_product.smul_tmul'],
    simp only [sum.map_inr, perm.sum_congr_hom_apply, perm.sum_congr_apply, sum.map_inl,
              function.comp_app, perm.coe_mul],
    rw [←a.map_congr_perm (λ i, v (σ₁ _)), ←b.map_congr_perm (λ i, v (σ₁ _))],
  end)

lemma dom_coprod.summand_mk'
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : equiv.perm (ιa ⊕ ιb)) :
  dom_coprod.summand a b (quotient.mk' σ) = σ.sign •
    (multilinear_map.dom_coprod ↑a ↑b : multilinear_map R' (λ _, Mᵢ) (N₁ ⊗ N₂)).dom_dom_congr σ :=
rfl

/-- Swapping elements in `σ` with equal values in `v` results in an addition that cancels -/
lemma dom_coprod.summand_add_swap_smul_eq_zero
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : perm.mod_sum_congr ιa ιb)
  {v : ιa ⊕ ιb → Mᵢ} {i j : ιa ⊕ ιb} (hv : v i = v j) (hij : i ≠ j) :
  dom_coprod.summand a b σ v + dom_coprod.summand a b (swap i j • σ) v = 0 :=
begin
  apply σ.induction_on' (λ σ, _),
  dsimp only [quotient.lift_on'_mk', quotient.map'_mk', mul_action.quotient.smul_mk,
    dom_coprod.summand],
  rw [smul_eq_mul, perm.sign_mul, perm.sign_swap hij],
  simp only [one_mul, neg_mul, function.comp_app, units.neg_smul, perm.coe_mul,
    units.coe_neg, multilinear_map.smul_apply, multilinear_map.neg_apply,
    multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply],
  convert add_right_neg _;
  { ext k, rw equiv.apply_swap_eq_self hv },
end

/-- Swapping elements in `σ` with equal values in `v` result in zero if the swap has no effect
on the quotient. -/
lemma dom_coprod.summand_eq_zero_of_smul_invariant
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : perm.mod_sum_congr ιa ιb)
  {v : ιa ⊕ ιb → Mᵢ} {i j : ιa ⊕ ιb} (hv : v i = v j) (hij : i ≠ j) :
  swap i j • σ = σ → dom_coprod.summand a b σ v = 0 :=
begin
  apply σ.induction_on' (λ σ, _),
  dsimp only [quotient.lift_on'_mk', quotient.map'_mk', multilinear_map.smul_apply,
    multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply, dom_coprod.summand],
  intro hσ,
  with_cases
  { cases hi : σ⁻¹ i;
      cases hj : σ⁻¹ j;
      rw perm.inv_eq_iff_eq at hi hj;
      substs hi hj, },
  case [sum.inl sum.inr : i' j', sum.inr sum.inl : i' j']
  { -- the term pairs with and cancels another term
    all_goals { obtain ⟨⟨sl, sr⟩, hσ⟩ := quotient_group.left_rel_apply.mp (quotient.exact' hσ), },
    work_on_goal 1 { replace hσ := equiv.congr_fun hσ (sum.inl i'), },
    work_on_goal 2 { replace hσ := equiv.congr_fun hσ (sum.inr i'), },
    all_goals
    { rw [smul_eq_mul, ←mul_swap_eq_swap_mul, mul_inv_rev, swap_inv, inv_mul_cancel_right] at hσ,
      simpa using hσ, }, },
  case [sum.inr sum.inr : i' j', sum.inl sum.inl : i' j']
  { -- the term does not pair but is zero
    all_goals { convert smul_zero _, },
    work_on_goal 1 { convert tensor_product.tmul_zero _ _, },
    work_on_goal 2 { convert tensor_product.zero_tmul _ _, },
    all_goals { exact alternating_map.map_eq_zero_of_eq _ _ hv (λ hij', hij (hij' ▸ rfl)), } },
end

/-- Like `multilinear_map.dom_coprod`, but ensures the result is also alternating.

Note that this is usually defined (for instance, as used in Proposition 22.24 in [Gallier2011Notes])
over integer indices `ιa = fin n` and `ιb = fin m`, as
$$
(f \wedge g)(u_1, \ldots, u_{m+n}) =
  \sum_{\operatorname{shuffle}(m, n)} \operatorname{sign}(\sigma)
    f(u_{\sigma(1)}, \ldots, u_{\sigma(m)}) g(u_{\sigma(m+1)}, \ldots, u_{\sigma(m+n)}),
$$
where $\operatorname{shuffle}(m, n)$ consists of all permutations of $[1, m+n]$ such that
$\sigma(1) < \cdots < \sigma(m)$ and $\sigma(m+1) < \cdots < \sigma(m+n)$.

Here, we generalize this by replacing:
* the product in the sum with a tensor product
* the filtering of $[1, m+n]$ to shuffles with an isomorphic quotient
* the additions in the subscripts of $\sigma$ with an index of type `sum`

The specialized version can be obtained by combining this definition with `fin_sum_fin_equiv` and
`algebra.lmul'`.
-/
@[simps]
def dom_coprod
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  alternating_map R' Mᵢ (N₁ ⊗[R'] N₂) (ιa ⊕ ιb) :=
{ to_fun := λ v, ⇑(∑ σ : perm.mod_sum_congr ιa ιb, dom_coprod.summand a b σ) v,
  map_eq_zero_of_eq' := λ v i j hv hij, begin
    dsimp only,
    rw multilinear_map.sum_apply,
    exact finset.sum_involution
      (λ σ _, equiv.swap i j • σ)
      (λ σ _, dom_coprod.summand_add_swap_smul_eq_zero a b σ hv hij)
      (λ σ _, mt $ dom_coprod.summand_eq_zero_of_smul_invariant a b σ hv hij)
      (λ σ _, finset.mem_univ _)
      (λ σ _, equiv.perm.mod_sum_congr.swap_smul_involutive i j σ),
  end,
  ..(∑ σ : perm.mod_sum_congr ιa ιb, dom_coprod.summand a b σ) }

lemma dom_coprod_coe (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  (↑(a.dom_coprod b) : multilinear_map R' (λ _, Mᵢ) _) =
    ∑ σ : perm.mod_sum_congr ιa ιb, dom_coprod.summand a b σ :=
multilinear_map.ext $ λ _, rfl

/-- A more bundled version of `alternating_map.dom_coprod` that maps
`((ι₁ → N) → N₁) ⊗ ((ι₂ → N) → N₂)` to `(ι₁ ⊕ ι₂ → N) → N₁ ⊗ N₂`. -/
def dom_coprod' :
  (alternating_map R' Mᵢ N₁ ιa ⊗[R'] alternating_map R' Mᵢ N₂ ιb) →ₗ[R']
    alternating_map R' Mᵢ (N₁ ⊗[R'] N₂) (ιa ⊕ ιb) :=
tensor_product.lift $ by
  refine linear_map.mk₂ R' (dom_coprod)
    (λ m₁ m₂ n, _)
    (λ c m n, _)
    (λ m n₁ n₂, _)
    (λ c m n, _);
  { ext,
    simp only [dom_coprod_apply, add_apply, smul_apply, ←finset.sum_add_distrib,
      finset.smul_sum, multilinear_map.sum_apply, dom_coprod.summand],
    congr,
    ext σ,
    apply σ.induction_on' (λ σ, _),
    simp only [quotient.lift_on'_mk', coe_add, coe_smul, multilinear_map.smul_apply,
      ←multilinear_map.dom_coprod'_apply],
    simp only [tensor_product.add_tmul, ←tensor_product.smul_tmul',
      tensor_product.tmul_add, tensor_product.tmul_smul, linear_map.map_add, linear_map.map_smul],
    rw ←smul_add <|> rw smul_comm,
    congr }

@[simp]
lemma dom_coprod'_apply
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  dom_coprod' (a ⊗ₜ[R'] b) = dom_coprod a b :=
by simp only [dom_coprod', tensor_product.lift.tmul, linear_map.mk₂_apply]

end alternating_map

open equiv

/-- A helper lemma for `multilinear_map.dom_coprod_alternization`. -/
lemma multilinear_map.dom_coprod_alternization_coe
  (a : multilinear_map R' (λ _ : ιa, Mᵢ) N₁) (b : multilinear_map R' (λ _ : ιb, Mᵢ) N₂) :
  multilinear_map.dom_coprod ↑a.alternatization ↑b.alternatization =
    ∑ (σa : perm ιa) (σb : perm ιb), σa.sign • σb.sign •
      multilinear_map.dom_coprod (a.dom_dom_congr σa) (b.dom_dom_congr σb) :=
begin
  simp_rw [←multilinear_map.dom_coprod'_apply, multilinear_map.alternatization_coe],
  simp_rw [tensor_product.sum_tmul, tensor_product.tmul_sum, linear_map.map_sum,
    ←tensor_product.smul_tmul', tensor_product.tmul_smul, linear_map.map_smul_of_tower],
end

open alternating_map

/-- Computing the `multilinear_map.alternatization` of the `multilinear_map.dom_coprod` is the same
as computing the `alternating_map.dom_coprod` of the `multilinear_map.alternatization`s.
-/
lemma multilinear_map.dom_coprod_alternization
  (a : multilinear_map R' (λ _ : ιa, Mᵢ) N₁) (b : multilinear_map R' (λ _ : ιb, Mᵢ) N₂) :
  (multilinear_map.dom_coprod a b).alternatization =
    a.alternatization.dom_coprod b.alternatization :=
begin
  apply coe_multilinear_map_injective,
  rw [dom_coprod_coe, multilinear_map.alternatization_coe,
    finset.sum_partition (quotient_group.left_rel (perm.sum_congr_hom ιa ιb).range)],
  congr' 1,
  ext1 σ,
  apply σ.induction_on' (λ σ, _),

  -- unfold the quotient mess left by `finset.sum_partition`
  conv in (_ = quotient.mk' _)
  { change quotient.mk' _ = quotient.mk' _,
    rw quotient_group.eq' },

  -- eliminate a multiplication
  have : @finset.univ (perm (ιa ⊕ ιb)) _ = finset.univ.image ((*) σ) :=
    (finset.eq_univ_iff_forall.mpr $ λ a, let ⟨a', ha'⟩ := mul_left_surjective σ a in
      finset.mem_image.mpr ⟨a', finset.mem_univ _, ha'⟩).symm,
  rw [this, finset.image_filter],
  simp only [function.comp, mul_inv_rev, inv_mul_cancel_right, subgroup.inv_mem_iff],
  simp only [monoid_hom.mem_range], -- needs to be separate from the above `simp only`
  rw [finset.filter_congr_decidable,
    finset.univ_filter_exists (perm.sum_congr_hom ιa ιb),
    finset.sum_image (λ x _ y _ (h : _ = _), mul_right_injective _ h),
    finset.sum_image (λ x _ y _ (h : _ = _), perm.sum_congr_hom_injective h)],
  dsimp only,

  -- now we're ready to clean up the RHS, pulling out the summation
  rw [dom_coprod.summand_mk', multilinear_map.dom_coprod_alternization_coe,
    ←finset.sum_product', finset.univ_product_univ,
    ←multilinear_map.dom_dom_congr_equiv_apply, add_equiv.map_sum, finset.smul_sum],
  congr' 1,
  ext1 ⟨al, ar⟩,
  dsimp only,

  -- pull out the pair of smuls on the RHS, by rewriting to `_ →ₗ[ℤ] _` and back
  rw [←add_equiv.coe_to_add_monoid_hom, ←add_monoid_hom.coe_to_int_linear_map,
    linear_map.map_smul_of_tower,
    linear_map.map_smul_of_tower,
    add_monoid_hom.coe_to_int_linear_map, add_equiv.coe_to_add_monoid_hom,
    multilinear_map.dom_dom_congr_equiv_apply],

  -- pick up the pieces
  rw [multilinear_map.dom_dom_congr_mul, perm.sign_mul,
    perm.sum_congr_hom_apply, multilinear_map.dom_coprod_dom_dom_congr_sum_congr,
    perm.sign_sum_congr, mul_smul, mul_smul],
end

/-- Taking the `multilinear_map.alternatization` of the `multilinear_map.dom_coprod` of two
`alternating_map`s gives a scaled version of the `alternating_map.coprod` of those maps.
-/
lemma multilinear_map.dom_coprod_alternization_eq
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  (multilinear_map.dom_coprod a b : multilinear_map R' (λ _ : ιa ⊕ ιb, Mᵢ) (N₁ ⊗ N₂))
    .alternatization =
    ((fintype.card ιa).factorial * (fintype.card ιb).factorial) • a.dom_coprod b :=
begin
  rw [multilinear_map.dom_coprod_alternization, coe_alternatization, coe_alternatization, mul_smul,
    ←dom_coprod'_apply, ←dom_coprod'_apply, ←tensor_product.smul_tmul', tensor_product.tmul_smul,
    linear_map.map_smul_of_tower dom_coprod', linear_map.map_smul_of_tower dom_coprod'],
  -- typeclass resolution is a little confused here
  apply_instance, apply_instance,
end

end coprod

section basis

open alternating_map

variables {ι₁ : Type*} [fintype ι]
variables {R' : Type*} {N₁ N₂ : Type*} [comm_semiring R'] [add_comm_monoid N₁] [add_comm_monoid N₂]
variables [module R' N₁] [module R' N₂]

/-- Two alternating maps indexed by a `fintype` are equal if they are equal when all arguments
are distinct basis vectors. -/
lemma basis.ext_alternating {f g : alternating_map R' N₁ N₂ ι} (e : basis ι₁ R' N₁)
  (h : ∀ v : ι → ι₁, function.injective v → f (λ i, e (v i)) = g (λ i, e (v i))) : f = g :=
begin
  refine alternating_map.coe_multilinear_map_injective (basis.ext_multilinear e $ λ v, _),
  by_cases hi : function.injective v,
  { exact h v hi },
  { have : ¬function.injective (λ i, e (v i)) := hi.imp function.injective.of_comp,
    rw [coe_multilinear_map, coe_multilinear_map,
        f.map_eq_zero_of_not_injective _ this, g.map_eq_zero_of_not_injective _ this], }
end

end basis

/-! ### Currying -/

section currying

variables
  {R' : Type*} {M'' M₂'' N'' N₂'': Type*}
  [comm_semiring R']
  [add_comm_monoid M''] [add_comm_monoid M₂''] [add_comm_monoid N''] [add_comm_monoid N₂'']
  [module R' M''] [module R' M₂''] [module R' N''] [module R' N₂'']

namespace alternating_map

/-- Given an alternating map `f` in `n+1` variables, split the first variable to obtain
a linear map into alternating maps in `n` variables, given by `x ↦ (m ↦ f (matrix.vec_cons x m))`.
It can be thought of as a map $Hom(\bigwedge^{n+1} M, N) \to Hom(M, Hom(\bigwedge^n M, N))$.

This is `multilinear_map.curry_left` for `alternating_map`. See also
`alternating_map.curry_left_linear_map`. -/
@[simps]
def curry_left {n : ℕ} (f : alternating_map R' M'' N'' (fin n.succ)) :
  M'' →ₗ[R'] alternating_map R' M'' N'' (fin n) :=
{ to_fun := λ m,
  { to_fun    := λ v, f (matrix.vec_cons m v),
    map_eq_zero_of_eq' := λ v i j hv hij, f.map_eq_zero_of_eq _
      (by rwa [matrix.cons_val_succ, matrix.cons_val_succ]) ((fin.succ_injective _).ne hij),
    .. f.to_multilinear_map.curry_left m },
  map_add' := λ m₁ m₂, ext $ λ v, f.map_vec_cons_add _ _ _,
  map_smul' := λ r m, ext $ λ v, f.map_vec_cons_smul _ _ _ }

@[simp] lemma curry_left_zero {n : ℕ} :
  curry_left (0 : alternating_map R' M'' N'' (fin n.succ)) = 0 := rfl

@[simp] lemma curry_left_add {n : ℕ} (f g : alternating_map R' M'' N'' (fin n.succ)) :
  curry_left (f + g) = curry_left f + curry_left g := rfl

@[simp] lemma curry_left_smul {n : ℕ} (r : R') (f : alternating_map R' M'' N'' (fin n.succ)) :
  curry_left (r • f) = r • curry_left f := rfl

/-- `alternating_map.curry_left` as a `linear_map`. This is a separate definition as dot notation
does not work for this version. -/
@[simps]
def curry_left_linear_map {n : ℕ} :
  alternating_map R' M'' N'' (fin n.succ) →ₗ[R'] M'' →ₗ[R'] alternating_map R' M'' N'' (fin n) :=
{ to_fun := λ f, f.curry_left,
  map_add' := curry_left_add,
  map_smul' := curry_left_smul }

/-- Currying with the same element twice gives the zero map. -/
@[simp] lemma curry_left_same {n : ℕ} (f : alternating_map R' M'' N'' (fin n.succ.succ)) (m : M'') :
  (f.curry_left m).curry_left m = 0 :=
ext $ λ x, f.map_eq_zero_of_eq _ (by simp) fin.zero_ne_one

@[simp] lemma curry_left_comp_alternating_map {n : ℕ} (g : N'' →ₗ[R'] N₂'')
  (f : alternating_map R' M'' N'' (fin n.succ)) (m : M'') :
  (g.comp_alternating_map f).curry_left m = g.comp_alternating_map (f.curry_left m) :=
rfl

@[simp] lemma curry_left_comp_linear_map {n : ℕ} (g : M₂'' →ₗ[R'] M'')
  (f : alternating_map R' M'' N'' (fin n.succ)) (m : M₂'') :
  (f.comp_linear_map g).curry_left m = (f.curry_left (g m)).comp_linear_map g :=
ext $ λ v, congr_arg f $ funext $ begin
  refine fin.cases _ _,
  { refl },
  { simp }
end

/-- The space of constant maps is equivalent to the space of maps that are alternating with respect
to an empty family. -/
@[simps] def const_linear_equiv_of_is_empty [is_empty ι] :
  N'' ≃ₗ[R'] alternating_map R' M'' N'' ι :=
{ to_fun    := alternating_map.const_of_is_empty R' M'',
  map_add'  := λ x y, rfl,
  map_smul' := λ t x, rfl,
  inv_fun   := λ f, f 0,
  left_inv  := λ _, rfl,
  right_inv := λ f, ext $ λ x, alternating_map.congr_arg f $ subsingleton.elim _ _ }

end alternating_map

end currying


/-
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 algebra.big_operators.finsupp
import algebra.hom.non_unital_alg
import linear_algebra.finsupp

/-!
# 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 fact the construction of the "monoid algebra" makes sense when `G` is not even a monoid, but
merely a magma, i.e., when `G` carries a multiplication which is not required to satisfy any
conditions at all. In this case the construction yields a not-necessarily-unital,
not-necessarily-associative algebra but it is still adjoint to the forgetful functor from such
algebras to magmas, and we prove this as `monoid_algebra.lift_magma`.

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.
-/

noncomputable theory
open_locale classical big_operators

open finset finsupp

universes u₁ u₂ u₃
variables (k : Type u₁) (G : Type u₂) {R : Type*}

/-! ### Multiplicative monoids -/
section
variables [semiring k]

/--
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.
-/
@[derive [inhabited, add_comm_monoid]]
def monoid_algebra : Type (max u₁ u₂) := G →₀ k

instance : has_coe_to_fun (monoid_algebra k G) (λ _, G → k) :=
finsupp.has_coe_to_fun

end

namespace monoid_algebra

variables {k G}

section
variables [semiring k] [non_unital_non_assoc_semiring R]

/-- A non-commutative version of `monoid_algebra.lift`: given a additive homomorphism `f : k →+ R`
and a 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 (f : k →+ R) (g : G → R) : monoid_algebra k G →+ R :=
lift_add_hom (λ x : G, (add_monoid_hom.mul_right (g x)).comp f)

@[simp] lemma lift_nc_single (f : k →+ R) (g : G → R) (a : G) (b : k) :
  lift_nc f g (single a b) = f b * g a :=
lift_add_hom_apply_single _ _ _

end

section has_mul

variables [semiring k] [has_mul G]

/-- 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.) -/
instance : has_mul (monoid_algebra k G) :=
⟨λf g, f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, single (a₁ * a₂) (b₁ * b₂)⟩

lemma mul_def {f g : monoid_algebra k G} :
  f * g = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, single (a₁ * a₂) (b₁ * b₂)) :=
rfl

instance : non_unital_non_assoc_semiring (monoid_algebra k G) :=
{ zero          := 0,
  mul           := (*),
  add           := (+),
  left_distrib  := assume f g h, by simp only [mul_def, sum_add_index, mul_add, mul_zero,
    single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_add],
  right_distrib := assume f g h, by simp only [mul_def, sum_add_index, add_mul, zero_mul,
    single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_zero,
    sum_add],
  zero_mul  := assume f, by simp only [mul_def, sum_zero_index],
  mul_zero  := assume f, by simp only [mul_def, sum_zero_index, sum_zero],
  .. finsupp.add_comm_monoid }

variables [semiring R]

lemma lift_nc_mul {g_hom : Type*} [mul_hom_class g_hom G R] (f : k →+* R) (g : g_hom)
  (a b : monoid_algebra k G) (h_comm : ∀ {x y}, y ∈ a.support → commute (f (b x)) (g y)) :
  lift_nc (f : k →+ R) g (a * b) = lift_nc (f : k →+ R) g a * lift_nc (f : k →+ R) g b :=
begin
  conv_rhs { rw [← sum_single a, ← sum_single b] },
  simp_rw [mul_def, (lift_nc _ g).map_finsupp_sum, lift_nc_single, finsupp.sum_mul,
    finsupp.mul_sum],
  refine finset.sum_congr rfl (λ y hy, finset.sum_congr rfl (λ x hx, _)),
  simp [mul_assoc, (h_comm hy).left_comm]
end

end has_mul

section semigroup

variables [semiring k] [semigroup G] [semiring R]

instance : non_unital_semiring (monoid_algebra k G) :=
{ zero          := 0,
  mul           := (*),
  add           := (+),
  mul_assoc := assume f g h, by simp only [mul_def, sum_sum_index, sum_zero_index, sum_add_index,
    sum_single_index, single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff,
    add_mul, mul_add, add_assoc, mul_assoc, zero_mul, mul_zero, sum_zero, sum_add],
  .. monoid_algebra.non_unital_non_assoc_semiring}

end semigroup

section has_one

variables [non_assoc_semiring R] [semiring k] [has_one G]

/-- The unit of the multiplication is `single 1 1`, i.e. the function
  that is `1` at `1` and zero elsewhere. -/
instance : has_one (monoid_algebra k G) :=
⟨single 1 1⟩

lemma one_def : (1 : monoid_algebra k G) = single 1 1 :=
rfl

@[simp] lemma lift_nc_one {g_hom : Type*} [one_hom_class g_hom G R] (f : k →+* R) (g : g_hom) :
  lift_nc (f : k →+ R) g 1 = 1 :=

by simp [one_def]

end has_one

section mul_one_class

variables [semiring k] [mul_one_class G]

instance : non_assoc_semiring (monoid_algebra k G) :=
{ one       := 1,
  mul       := (*),
  zero      := 0,
  add       := (+),
  one_mul   := assume f, by simp only [mul_def, one_def, sum_single_index, zero_mul,
    single_zero, sum_zero, zero_add, one_mul, sum_single],
  mul_one   := assume f, by simp only [mul_def, one_def, sum_single_index, mul_zero,
    single_zero, sum_zero, add_zero, mul_one, sum_single],
  ..monoid_algebra.non_unital_non_assoc_semiring }

end mul_one_class

/-! #### Semiring structure -/
section semiring

variables [semiring k] [monoid G]

instance : semiring (monoid_algebra k G) :=
{ one       := 1,
  mul       := (*),
  zero      := 0,
  add       := (+),
  .. monoid_algebra.non_unital_semiring,
  .. monoid_algebra.non_assoc_semiring }

variables [semiring R]

/-- `lift_nc` as a `ring_hom`, for when `f x` and `g y` commute -/
def lift_nc_ring_hom (f : k →+* R) (g : G →* R) (h_comm : ∀ x y, commute (f x) (g y)) :
  monoid_algebra k G →+* R :=
{ to_fun := lift_nc (f : k →+ R) g,
  map_one' := lift_nc_one _ _,
  map_mul' := λ a b, lift_nc_mul _ _ _ _ $ λ _ _ _, h_comm _ _,
  ..(lift_nc (f : k →+ R) g)}

end semiring

instance [comm_semiring k] [comm_monoid G] : comm_semiring (monoid_algebra k G) :=
{ mul_comm := assume f g,
  begin
    simp only [mul_def, finsupp.sum, mul_comm],
    rw [finset.sum_comm],
    simp only [mul_comm]
  end,
  .. monoid_algebra.semiring }

instance [semiring k] [nontrivial k] [nonempty G]: nontrivial (monoid_algebra k G) :=
finsupp.nontrivial

/-! #### Derived instances -/
section derived_instances

instance [semiring k] [subsingleton k] : unique (monoid_algebra k G) :=
finsupp.unique_of_right

instance [ring k] : add_comm_group (monoid_algebra k G) :=
finsupp.add_comm_group

instance [ring k] [has_mul G] : non_unital_non_assoc_ring (monoid_algebra k G) :=
{ .. monoid_algebra.add_comm_group,
  .. monoid_algebra.non_unital_non_assoc_semiring }

instance [ring k] [semigroup G] : non_unital_ring (monoid_algebra k G) :=
{ .. monoid_algebra.add_comm_group,
  .. monoid_algebra.non_unital_semiring }

instance [ring k] [mul_one_class G] : non_assoc_ring (monoid_algebra k G) :=
{ .. monoid_algebra.add_comm_group,
  .. monoid_algebra.non_assoc_semiring }

instance [ring k] [monoid G] : ring (monoid_algebra k G) :=
{ .. monoid_algebra.non_unital_non_assoc_ring,
  .. monoid_algebra.semiring }

instance [comm_ring k] [comm_monoid G] : comm_ring (monoid_algebra k G) :=
{ mul_comm := mul_comm, .. monoid_algebra.ring}

variables {S : Type*}

instance [monoid R] [semiring k] [distrib_mul_action R k] :
  has_scalar R (monoid_algebra k G) :=
finsupp.has_scalar

instance [monoid R] [semiring k] [distrib_mul_action R k] :
  distrib_mul_action R (monoid_algebra k G) :=
finsupp.distrib_mul_action G k

instance [semiring R] [semiring k] [module R k] :
  module R (monoid_algebra k G) :=
finsupp.module G k

instance [monoid R] [semiring k] [distrib_mul_action R k] [has_faithful_scalar R k] [nonempty G] :
  has_faithful_scalar R (monoid_algebra k G) :=
finsupp.has_faithful_scalar

instance [monoid R] [monoid S] [semiring k] [distrib_mul_action R k] [distrib_mul_action S k]
  [has_scalar R S] [is_scalar_tower R S k] :
  is_scalar_tower R S (monoid_algebra k G) :=
finsupp.is_scalar_tower G k

instance [monoid R] [monoid S] [semiring k] [distrib_mul_action R k] [distrib_mul_action S k]
  [smul_comm_class R S k] :
  smul_comm_class R S (monoid_algebra k G) :=
finsupp.smul_comm_class G k

instance [monoid R] [semiring k] [distrib_mul_action R k] [distrib_mul_action Rᵐᵒᵖ k]
  [is_central_scalar R k] :
  is_central_scalar R (monoid_algebra k G) :=
finsupp.is_central_scalar G k

/-- This is not an instance as it conflicts with `monoid_algebra.distrib_mul_action` when `G = kˣ`.
-/
def comap_distrib_mul_action_self [group G] [semiring k] :
  distrib_mul_action G (monoid_algebra k G) :=
finsupp.comap_distrib_mul_action

end derived_instances

section misc_theorems

variables [semiring k]
local attribute [reducible] monoid_algebra

lemma mul_apply [has_mul G] (f g : monoid_algebra k G) (x : G) :
  (f * g) x = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, if a₁ * a₂ = x then b₁ * b₂ else 0) :=
begin
  rw [mul_def],
  simp only [finsupp.sum_apply, single_apply],
end

lemma mul_apply_antidiagonal [has_mul G] (f g : monoid_algebra k G) (x : G) (s : finset (G × G))
  (hs : ∀ {p : G × G}, p ∈ s ↔ p.1 * p.2 = x) :
  (f * g) x = ∑ p in s, (f p.1 * g p.2) :=
let F : G × G → k := λ p, if p.1 * p.2 = x then f p.1 * g p.2 else 0 in
calc (f * g) x = (∑ a₁ in f.support, ∑ a₂ in g.support, F (a₁, a₂)) :
  mul_apply f g x
... = ∑ p in f.support.product g.support, F p : finset.sum_product.symm
... = ∑ p in (f.support.product g.support).filter (λ p : G × G, p.1 * p.2 = x), f p.1 * g p.2 :
  (finset.sum_filter _ _).symm
... = ∑ p in s.filter (λ p : G × G, p.1 ∈ f.support ∧ p.2 ∈ g.support), f p.1 * g p.2 :
  sum_congr (by { ext, simp only [mem_filter, mem_product, hs, and_comm] }) (λ _ _, rfl)
... = ∑ p in s, f p.1 * g p.2 : sum_subset (filter_subset _ _) $ λ p hps hp,
  begin
    simp only [mem_filter, mem_support_iff, not_and, not_not] at hp ⊢,
    by_cases h1 : f p.1 = 0,
    { rw [h1, zero_mul] },
    { rw [hp hps h1, mul_zero] }
  end

lemma support_mul [has_mul G] (a b : monoid_algebra k G) :
  (a * b).support ⊆ a.support.bUnion (λa₁, b.support.bUnion $ λa₂, {a₁ * a₂}) :=
subset.trans support_sum $ bUnion_mono $ assume a₁ _,
  subset.trans support_sum $ bUnion_mono $ assume a₂ _, support_single_subset

@[simp] lemma single_mul_single [has_mul G] {a₁ a₂ : G} {b₁ b₂ : k} :
  (single a₁ b₁ : monoid_algebra k G) * single a₂ b₂ = single (a₁ * a₂) (b₁ * b₂) :=
(sum_single_index (by simp only [zero_mul, single_zero, sum_zero])).trans
  (sum_single_index (by rw [mul_zero, single_zero]))

@[simp] lemma single_pow [monoid G] {a : G} {b : k} :
  ∀ n : ℕ, (single a b : monoid_algebra k G)^n = single (a^n) (b ^ n)
| 0 := by { simp only [pow_zero], refl }
| (n+1) := by simp only [pow_succ, single_pow n, single_mul_single]

section

/-- Like `finsupp.map_domain_add`, but for the convolutive multiplication we define in this file -/
lemma map_domain_mul {α : Type*} {β : Type*} {α₂ : Type*} [semiring β] [has_mul α] [has_mul α₂]
  {x y : monoid_algebra β α} (f : mul_hom α α₂) :
  (map_domain f (x * y : monoid_algebra β α) : monoid_algebra β α₂) =
    (map_domain f x * map_domain f y : monoid_algebra β α₂) :=
begin
  simp_rw [mul_def, map_domain_sum, map_domain_single, f.map_mul],
  rw finsupp.sum_map_domain_index,
  { congr,
    ext a b,
    rw finsupp.sum_map_domain_index,
    { simp },
    { simp [mul_add] } },
  { simp },
  { simp [add_mul] }
end

variables (k G)

/-- The embedding of a magma into its magma algebra. -/
@[simps] def of_magma [has_mul G] : mul_hom G (monoid_algebra k G) :=
{ to_fun   := λ a, single a 1,
  map_mul' := λ a b, by simp only [mul_def, mul_one, sum_single_index, single_eq_zero, mul_zero], }

/-- The embedding of a unital magma into its magma algebra. -/
@[simps] def of [mul_one_class G] : G →* monoid_algebra k G :=
{ to_fun := λ a, single a 1,
  map_one' := rfl,
  .. of_magma k G }

end

lemma of_injective [mul_one_class G] [nontrivial k] : function.injective (of k G) :=
λ a b h, by simpa using (single_eq_single_iff _ _ _ _).mp h

/--
`finsupp.single` as a `monoid_hom` from the product type into the monoid algebra.

Note the order of the elements of the product are reversed compared to the arguments of
`finsupp.single`.
-/
@[simps] def single_hom [mul_one_class G] : k × G →* monoid_algebra k G :=
{ to_fun := λ a, single a.2 a.1,
  map_one' := rfl,
  map_mul' := λ a b, single_mul_single.symm }

lemma mul_single_apply_aux [has_mul G] (f : monoid_algebra k G) {r : k}
  {x y z : G} (H : ∀ a, a * x = z ↔ a = y) :
  (f * single x r) z = f y * r :=
have A : ∀ a₁ b₁, (single x r).sum (λ a₂ b₂, ite (a₁ * a₂ = z) (b₁ * b₂) 0) =
  ite (a₁ * x = z) (b₁ * r) 0,
from λ a₁ b₁, sum_single_index $ by simp,
calc (f * single x r) z = sum f (λ a b, if (a = y) then (b * r) else 0) :
  by simp only [mul_apply, A, H]
... = if y ∈ f.support then f y * r else 0 : f.support.sum_ite_eq' _ _
... = f y * r : by split_ifs with h; simp at h; simp [h]

lemma mul_single_one_apply [mul_one_class G] (f : monoid_algebra k G) (r : k) (x : G) :
  (f * single 1 r) x = f x * r :=
f.mul_single_apply_aux $ λ a, by rw [mul_one]

lemma support_mul_single [right_cancel_semigroup G]
  (f : monoid_algebra k G) (r : k) (hr : ∀ y, y * r = 0 ↔ y = 0) (x : G) :
  (f * single x r).support = f.support.map (mul_right_embedding x) :=
begin
  ext y, simp only [mem_support_iff, mem_map, exists_prop, mul_right_embedding_apply],
  by_cases H : ∃ a, a * x = y,
  { rcases H with ⟨a, rfl⟩,
    rw [mul_single_apply_aux f (λ _, mul_left_inj x)],
    simp [hr] },
  { push_neg at H,
    simp [mul_apply, H] }
end

lemma single_mul_apply_aux [has_mul G] (f : monoid_algebra k G) {r : k} {x y z : G}
  (H : ∀ a, x * a = y ↔ a = z) :
  (single x r * f) y = r * f z :=
have f.sum (λ a b, ite (x * a = y) (0 * b) 0) = 0, by simp,
calc (single x r * f) y = sum f (λ a b, ite (x * a = y) (r * b) 0) :
  (mul_apply _ _ _).trans $ sum_single_index this
... = f.sum (λ a b, ite (a = z) (r * b) 0) : by simp only [H]
... = if z ∈ f.support then (r * f z) else 0 : f.support.sum_ite_eq' _ _
... = _ : by split_ifs with h; simp at h; simp [h]

lemma single_one_mul_apply [mul_one_class G] (f : monoid_algebra k G) (r : k) (x : G) :
  (single 1 r * f) x = r * f x :=
f.single_mul_apply_aux $ λ a, by rw [one_mul]

lemma support_single_mul [left_cancel_semigroup G]
  (f : monoid_algebra k G) (r : k) (hr : ∀ y, r * y = 0 ↔ y = 0) (x : G) :
  (single x r * f).support = f.support.map (mul_left_embedding x) :=
begin
  ext y, simp only [mem_support_iff, mem_map, exists_prop, mul_left_embedding_apply],
  by_cases H : ∃ a, x * a = y,
  { rcases H with ⟨a, rfl⟩,
    rw [single_mul_apply_aux f (λ _, mul_right_inj x)],
    simp [hr] },
  { push_neg at H,
    simp [mul_apply, H] }
end

lemma lift_nc_smul [mul_one_class G] {R : Type*} [semiring R] (f : k →+* R) (g : G →* R) (c : k)
  (φ : monoid_algebra k G) :
  lift_nc (f : k →+ R) g (c • φ) = f c * lift_nc (f : k →+ R) g φ :=
begin
  suffices : (lift_nc ↑f g).comp (smul_add_hom k (monoid_algebra k G) c) =
    (add_monoid_hom.mul_left (f c)).comp (lift_nc ↑f g),
    from add_monoid_hom.congr_fun this φ,
  ext a b, simp [mul_assoc]
end

end misc_theorems

/-! #### Non-unital, non-associative algebra structure -/
section non_unital_non_assoc_algebra

variables (k) [monoid R] [semiring k] [distrib_mul_action R k] [has_mul G]

instance is_scalar_tower_self [is_scalar_tower R k k] :
  is_scalar_tower R (monoid_algebra k G) (monoid_algebra k G) :=
⟨λ t a b,
begin
  ext m,
  simp only [mul_apply, finsupp.smul_sum, smul_ite, smul_mul_assoc, sum_smul_index', zero_mul,
     if_t_t, implies_true_iff, eq_self_iff_true, sum_zero, coe_smul, smul_eq_mul, pi.smul_apply,
     smul_zero],
end⟩

/-- Note that if `k` is a `comm_semiring` then we have `smul_comm_class k k k` and so we can take
`R = k` in the below. In other words, if the coefficients are commutative amongst themselves, they
also commute with the algebra multiplication. -/
instance smul_comm_class_self [smul_comm_class R k k] :
  smul_comm_class R (monoid_algebra k G) (monoid_algebra k G) :=
⟨λ t a b,
begin
  ext m,
  simp only [mul_apply, finsupp.sum, finset.smul_sum, smul_ite, mul_smul_comm, sum_smul_index',
    implies_true_iff, eq_self_iff_true, coe_smul, ite_eq_right_iff, smul_eq_mul, pi.smul_apply,
    mul_zero, smul_zero],
end⟩

instance smul_comm_class_symm_self [smul_comm_class k R k] :
  smul_comm_class (monoid_algebra k G) R (monoid_algebra k G) :=
⟨λ t a b, by { haveI := smul_comm_class.symm k R k, rw ← smul_comm, } ⟩

variables {A : Type u₃} [non_unital_non_assoc_semiring A]

/-- A non_unital `k`-algebra homomorphism from `monoid_algebra k G` is uniquely defined by its
values on the functions `single a 1`. -/
lemma non_unital_alg_hom_ext [distrib_mul_action k A]
  {φ₁ φ₂ : non_unital_alg_hom k (monoid_algebra k G) A}
  (h : ∀ x, φ₁ (single x 1) = φ₂ (single x 1)) : φ₁ = φ₂ :=
non_unital_alg_hom.to_distrib_mul_action_hom_injective $
  finsupp.distrib_mul_action_hom_ext' $
  λ a, distrib_mul_action_hom.ext_ring (h a)

/-- See note [partially-applied ext lemmas]. -/
@[ext] lemma non_unital_alg_hom_ext' [distrib_mul_action k A]
  {φ₁ φ₂ : non_unital_alg_hom k (monoid_algebra k G) A}
  (h : φ₁.to_mul_hom.comp (of_magma k G) = φ₂.to_mul_hom.comp (of_magma k G)) : φ₁ = φ₂ :=
non_unital_alg_hom_ext k $ mul_hom.congr_fun h

/-- The functor `G ↦ monoid_algebra k G`, from the category of magmas to the category of non-unital,
non-associative algebras over `k` is adjoint to the forgetful functor in the other direction. -/
@[simps] def lift_magma [module k A] [is_scalar_tower k A A] [smul_comm_class k A A] :
  mul_hom G A ≃ non_unital_alg_hom k (monoid_algebra k G) A :=
{ to_fun    := λ f,
    { to_fun    := λ a, a.sum (λ m t, t • f m),
      map_smul' :=  λ t' a,
        begin
          rw [finsupp.smul_sum, sum_smul_index'],
          { simp_rw smul_assoc, },
          { intros m, exact zero_smul k (f m), },
        end,
      map_mul'  := λ a₁ a₂,
        begin
          let g : G → k → A := λ m t, t • f m,
          have h₁ : ∀ m, g m 0 = 0, { intros, exact zero_smul k (f m), },
          have h₂ : ∀ m (t₁ t₂ : k), g m (t₁ + t₂) = g m t₁ + g m t₂, { intros, rw ← add_smul, },
          simp_rw [finsupp.mul_sum, finsupp.sum_mul, smul_mul_smul, ← f.map_mul, mul_def,
            sum_comm a₂ a₁, sum_sum_index h₁ h₂, sum_single_index (h₁ _)],
        end,
      .. lift_add_hom (λ x, (smul_add_hom k A).flip (f x)) },
  inv_fun   := λ F, F.to_mul_hom.comp (of_magma k G),
  left_inv  := λ f, by { ext m, simp only [non_unital_alg_hom.coe_mk, of_magma_apply,
    non_unital_alg_hom.to_mul_hom_eq_coe, sum_single_index, function.comp_app, one_smul, zero_smul,
    mul_hom.coe_comp, non_unital_alg_hom.coe_to_mul_hom], },
  right_inv := λ F, by { ext m, simp only [non_unital_alg_hom.coe_mk, of_magma_apply,
    non_unital_alg_hom.to_mul_hom_eq_coe, sum_single_index, function.comp_app, one_smul, zero_smul,
    mul_hom.coe_comp, non_unital_alg_hom.coe_to_mul_hom], }, }

end non_unital_non_assoc_algebra

/-! #### Algebra structure -/
section algebra

local attribute [reducible] monoid_algebra

lemma single_one_comm [comm_semiring k] [mul_one_class G] (r : k) (f : monoid_algebra k G) :
  single 1 r * f = f * single 1 r :=
by { ext, rw [single_one_mul_apply, mul_single_one_apply, mul_comm] }

/-- `finsupp.single 1` as a `ring_hom` -/
@[simps] def single_one_ring_hom [semiring k] [monoid G] : k →+* monoid_algebra k G :=
{ map_one' := rfl,
  map_mul' := λ x y, by rw [single_add_hom, single_mul_single, one_mul],
  ..finsupp.single_add_hom 1}

/-- If two ring homomorphisms from `monoid_algebra k G` are equal on all `single a 1`
and `single 1 b`, then they are equal. -/
lemma ring_hom_ext {R} [semiring k] [monoid G] [semiring R]
  {f g : monoid_algebra k G →+* R} (h₁ : ∀ b, f (single 1 b) = g (single 1 b))
  (h_of : ∀ a, f (single a 1) = g (single a 1)) : f = g :=
ring_hom.coe_add_monoid_hom_injective $ add_hom_ext $ λ a b,
  by rw [← one_mul a, ← mul_one b, ← single_mul_single, f.coe_add_monoid_hom,
    g.coe_add_monoid_hom, f.map_mul, g.map_mul, h₁, h_of]

/-- 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]. -/
@[ext] lemma ring_hom_ext' {R} [semiring k] [monoid G] [semiring R]
  {f g : monoid_algebra k G →+* R} (h₁ : f.comp single_one_ring_hom = g.comp single_one_ring_hom)
  (h_of : (f : monoid_algebra k G →* R).comp (of k G) =
    (g : monoid_algebra k G →* R).comp (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)`.
-/
instance {A : Type*} [comm_semiring k] [semiring A] [algebra k A] [monoid G] :
  algebra k (monoid_algebra A G) :=
{ smul_def' := λ r a, by { ext, simp [single_one_mul_apply, algebra.smul_def, pi.smul_apply], },
  commutes' := λ r f, by { ext, simp [single_one_mul_apply, mul_single_one_apply,
    algebra.commutes], },
  ..single_one_ring_hom.comp (algebra_map k A) }

/-- `finsupp.single 1` as a `alg_hom` -/
@[simps]
def single_one_alg_hom {A : Type*} [comm_semiring k] [semiring A] [algebra k A] [monoid G] :
  A →ₐ[k] monoid_algebra A G :=
{ commutes' := λ r, by { ext, simp, refl, }, ..single_one_ring_hom}

@[simp] lemma coe_algebra_map {A : Type*} [comm_semiring k] [semiring A] [algebra k A] [monoid G] :
  ⇑(algebra_map k (monoid_algebra A G)) = single 1 ∘ (algebra_map k A) :=
rfl

lemma single_eq_algebra_map_mul_of [comm_semiring k] [monoid G] (a : G) (b : k) :
  single a b = algebra_map k (monoid_algebra k G) b * of k G a :=
by simp

lemma single_algebra_map_eq_algebra_map_mul_of {A : Type*} [comm_semiring k] [semiring A]
  [algebra k A] [monoid G] (a : G) (b : k) :
  single a (algebra_map k A b) = algebra_map k (monoid_algebra A G) b * of A G a :=
by simp

lemma induction_on [semiring k] [monoid G] {p : monoid_algebra k G → Prop} (f : monoid_algebra k G)
  (hM : ∀ g, p (of k G g)) (hadd : ∀ f g : monoid_algebra k G, p f → p g → p (f + g))
  (hsmul : ∀ (r : k) f, p f → p (r • f)) : p f :=
begin
  refine finsupp.induction_linear f _ (λ f g hf hg, hadd f g hf hg) (λ g r, _),
  { simpa using hsmul 0 (of k G 1) (hM 1) },
  { convert hsmul r (of k G g) (hM g),
    simp only [mul_one, smul_single', of_apply] },
end

end algebra

section lift

variables {k G} [comm_semiring k] [monoid G]
variables {A : Type u₃} [semiring A] [algebra k A] {B : Type*} [semiring B] [algebra k B]

/-- `lift_nc_ring_hom` as a `alg_hom`, for when `f` is an `alg_hom` -/
def lift_nc_alg_hom (f : A →ₐ[k] B) (g : G →* B) (h_comm : ∀ x y, commute (f x) (g y)) :
  monoid_algebra A G →ₐ[k] B :=
{ to_fun := lift_nc_ring_hom (f : A →+* B) g h_comm,
  commutes' := by simp [lift_nc_ring_hom],
  ..(lift_nc_ring_hom (f : A →+* B) g h_comm)}

/-- A `k`-algebra homomorphism from `monoid_algebra k G` is uniquely defined by its
values on the functions `single a 1`. -/
lemma alg_hom_ext ⦃φ₁ φ₂ : monoid_algebra k G →ₐ[k] A⦄
  (h : ∀ x, φ₁ (single x 1) = φ₂ (single x 1)) : φ₁ = φ₂ :=
alg_hom.to_linear_map_injective $ finsupp.lhom_ext' $ λ a, linear_map.ext_ring (h a)

/-- See note [partially-applied ext lemmas]. -/
@[ext] lemma alg_hom_ext' ⦃φ₁ φ₂ : monoid_algebra k G →ₐ[k] A⦄
  (h : (φ₁ : monoid_algebra k G →* A).comp (of k G) =
    (φ₂ : monoid_algebra k G →* A).comp (of k G)) : φ₁ = φ₂ :=
alg_hom_ext $ monoid_hom.congr_fun h

variables (k G A)

/-- Any monoid homomorphism `G →* A` can be lifted to an algebra homomorphism
`monoid_algebra k G →ₐ[k] A`. -/
def lift : (G →* A) ≃ (monoid_algebra k G →ₐ[k] A) :=
{ inv_fun := λ f, (f : monoid_algebra k G →* A).comp (of k G),
  to_fun := λ F, lift_nc_alg_hom (algebra.of_id k A) F $ λ _ _, algebra.commutes _ _,
  left_inv := λ f, by { ext, simp [lift_nc_alg_hom, lift_nc_ring_hom] },
  right_inv := λ F, by { ext, simp [lift_nc_alg_hom, lift_nc_ring_hom] } }

variables {k G A}

lemma lift_apply' (F : G →* A) (f : monoid_algebra k G) :
  lift k G A F f = f.sum (λ a b, (algebra_map k A b) * F a) := rfl

lemma lift_apply (F : G →* A) (f : monoid_algebra k G) :
  lift k G A F f = f.sum (λ a b, b • F a) :=
by simp only [lift_apply', algebra.smul_def]

lemma lift_def (F : G →* A) :
  ⇑(lift k G A F) = lift_nc ((algebra_map k A : k →+* A) : k →+ A) F :=
rfl

@[simp] lemma lift_symm_apply (F : monoid_algebra k G →ₐ[k] A) (x : G) :
  (lift k G A).symm F x = F (single x 1) := rfl

lemma lift_of (F : G →* A) (x) :
  lift k G A F (of k G x) = F x :=
by rw [of_apply, ← lift_symm_apply, equiv.symm_apply_apply]

@[simp] lemma lift_single (F : G →* A) (a b) :
  lift k G A F (single a b) = b • F a :=
by rw [lift_def, lift_nc_single, algebra.smul_def, ring_hom.coe_add_monoid_hom]

/-- Decomposition of a `k`-algebra homomorphism from `monoid_algebra k G` by
its values on `F (single a 1)`. -/
lemma lift_unique (F : monoid_algebra k G →ₐ[k] A) (f : monoid_algebra k G) :
  F f = f.sum (λ a b, b • F (single a 1)) :=
by conv_lhs { rw lift_unique' F, simp [lift_apply] }

end lift

section
local attribute [reducible] monoid_algebra

variables (k)
/-- When `V` is a `k[G]`-module, multiplication by a group element `g` is a `k`-linear map. -/
def group_smul.linear_map [monoid G] [comm_semiring k]
  (V : Type u₃) [add_comm_monoid V] [module k V] [module (monoid_algebra k G) V]
  [is_scalar_tower k (monoid_algebra k G) V] (g : G) :
  V →ₗ[k] V :=
{ to_fun    := λ v, (single g (1 : k) • v : V),
  map_add'  := λ x y, smul_add (single g (1 : k)) x y,
  map_smul' := λ c x, smul_algebra_smul_comm _ _ _ }

@[simp]
lemma group_smul.linear_map_apply [monoid G] [comm_semiring k]
  (V : Type u₃) [add_comm_monoid V] [module k V] [module (monoid_algebra k G) V]
  [is_scalar_tower k (monoid_algebra k G) V] (g : G) (v : V) :
  (group_smul.linear_map k V g) v = (single g (1 : k) • v : V) :=
rfl

section
variables {k}
variables [monoid G] [comm_semiring k] {V W : Type u₃}
  [add_comm_monoid V] [module k V] [module (monoid_algebra k G) V]
  [is_scalar_tower k (monoid_algebra k G) V]
  [add_comm_monoid W] [module k W] [module (monoid_algebra k G) W]
  [is_scalar_tower k (monoid_algebra k G) W]
  (f : V →ₗ[k] W)
  (h : ∀ (g : G) (v : V), f (single g (1 : k) • v : V) = (single g (1 : k) • (f v) : W))
include h

/-- Build a `k[G]`-linear map from a `k`-linear map and evidence that it is `G`-equivariant. -/
def equivariant_of_linear_of_comm : V →ₗ[monoid_algebra k G] W :=
{ to_fun := f,
  map_add' := λ v v', by simp,
  map_smul' := λ c v,
  begin
  apply finsupp.induction c,
  { simp, },
  { intros g r c' nm nz w,
    dsimp at *,
    simp only [add_smul, f.map_add, w, add_left_inj, single_eq_algebra_map_mul_of, ← smul_smul],
    erw [algebra_map_smul (monoid_algebra k G) r, algebra_map_smul (monoid_algebra k G) r,
      f.map_smul, h g v, of_apply],
    all_goals { apply_instance } }
  end, }

@[simp]
lemma equivariant_of_linear_of_comm_apply (v : V) : (equivariant_of_linear_of_comm f h) v = f v :=
rfl

end
end

section
universe ui
variable {ι : Type ui}
local attribute [reducible] monoid_algebra

lemma prod_single [comm_semiring k] [comm_monoid G]
  {s : finset ι} {a : ι → G} {b : ι → k} :
  (∏ i in s, single (a i) (b i)) = single (∏ i in s, a i) (∏ i in s, b i) :=
finset.induction_on s rfl $ λ a s has ih, by rw [prod_insert has, ih,
  single_mul_single, prod_insert has, prod_insert has]

end

section -- We now prove some additional statements that hold for group algebras.
variables [semiring k] [group G]
local attribute [reducible] monoid_algebra

@[simp]
lemma mul_single_apply (f : monoid_algebra k G) (r : k) (x y : G) :
  (f * single x r) y = f (y * x⁻¹) * r :=
f.mul_single_apply_aux $ λ a, eq_mul_inv_iff_mul_eq.symm

@[simp]
lemma single_mul_apply (r : k) (x : G) (f : monoid_algebra k G) (y : G) :
  (single x r * f) y = r * f (x⁻¹ * y) :=
f.single_mul_apply_aux $ λ z, eq_inv_mul_iff_mul_eq.symm

lemma mul_apply_left (f g : monoid_algebra k G) (x : G) :
  (f * g) x = (f.sum $ λ a b, b * (g (a⁻¹ * x))) :=
calc (f * g) x = sum f (λ a b, (single a b * g) x) :
  by rw [← finsupp.sum_apply, ← finsupp.sum_mul, f.sum_single]
... = _ : by simp only [single_mul_apply, finsupp.sum]

-- If we'd assumed `comm_semiring`, we could deduce this from `mul_apply_left`.
lemma mul_apply_right (f g : monoid_algebra k G) (x : G) :
  (f * g) x = (g.sum $ λa b, (f (x * a⁻¹)) * b) :=
calc (f * g) x = sum g (λ a b, (f * single a b) x) :
  by rw [← finsupp.sum_apply, ← finsupp.mul_sum, g.sum_single]
... = _ : by simp only [mul_single_apply, finsupp.sum]

end

section span

variables [semiring k] [mul_one_class G]

/-- An element of `monoid_algebra R M` is in the subalgebra generated by its support. -/
lemma mem_span_support (f : monoid_algebra k G) :
  f ∈ submodule.span k (of k G '' (f.support : set G)) :=
by rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported]

end span

section opposite

open finsupp mul_opposite

variables [semiring k]

/-- The opposite of an `monoid_algebra R I` equivalent as a ring to
the `monoid_algebra Rᵐᵒᵖ Iᵐᵒᵖ` over the opposite ring, taking elements to their opposite. -/
@[simps {simp_rhs := tt}] protected noncomputable def op_ring_equiv [monoid G] :
  (monoid_algebra k G)ᵐᵒᵖ ≃+* monoid_algebra kᵐᵒᵖ Gᵐᵒᵖ :=
{ map_mul' := begin
    dsimp only [add_equiv.to_fun_eq_coe, ←add_equiv.coe_to_add_monoid_hom],
    rw add_monoid_hom.map_mul_iff,
    ext i₁ r₁ i₂ r₂ : 6,
    simp
  end,
  ..op_add_equiv.symm.trans $ (finsupp.map_range.add_equiv (op_add_equiv : k ≃+ kᵐᵒᵖ)).trans $
    finsupp.dom_congr op_equiv }

@[simp] lemma op_ring_equiv_single [monoid G] (r : k) (x : G) :
  monoid_algebra.op_ring_equiv (op (single x r)) = single (op x) (op r) :=
by simp

@[simp] lemma op_ring_equiv_symm_single [monoid G] (r : kᵐᵒᵖ) (x : Gᵐᵒᵖ) :
  monoid_algebra.op_ring_equiv.symm (single x r) = op (single x.unop r.unop) :=
by simp

end opposite

end monoid_algebra

/-! ### Additive monoids -/
section
variables [semiring k]

/--
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.
-/
@[derive [inhabited, add_comm_monoid]]
def add_monoid_algebra := G →₀ k

instance : has_coe_to_fun (add_monoid_algebra k G) (λ _, G → k) :=
finsupp.has_coe_to_fun

end

namespace add_monoid_algebra

variables {k G}

section
variables [semiring k] [non_unital_non_assoc_semiring R]

/-- A non-commutative version of `add_monoid_algebra.lift`: given a additive homomorphism `f : k →+
R` and a map `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 (f : k →+ R) (g : multiplicative G → R) : add_monoid_algebra k G →+ R :=
lift_add_hom (λ x : G, (add_monoid_hom.mul_right (g $ multiplicative.of_add x)).comp f)

@[simp] lemma lift_nc_single (f : k →+ R) (g : multiplicative G → R) (a : G) (b : k) :
  lift_nc f g (single a b) = f b * g (multiplicative.of_add a) :=
lift_add_hom_apply_single _ _ _
end

section has_mul

variables [semiring k] [has_add G]

/-- 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.) -/
instance : has_mul (add_monoid_algebra k G) :=
⟨λf g, f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, single (a₁ + a₂) (b₁ * b₂)⟩

lemma mul_def {f g : add_monoid_algebra k G} :
  f * g = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, single (a₁ + a₂) (b₁ * b₂)) :=
rfl

instance : non_unital_non_assoc_semiring (add_monoid_algebra k G) :=
{ zero          := 0,
  mul           := (*),
  add           := (+),
  left_distrib  := assume f g h, by simp only [mul_def, sum_add_index, mul_add, mul_zero,
    single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_add],
  right_distrib := assume f g h, by simp only [mul_def, sum_add_index, add_mul, mul_zero, zero_mul,
    single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_zero,
    sum_add],
  zero_mul  := assume f, by simp only [mul_def, sum_zero_index],
  mul_zero  := assume f, by simp only [mul_def, sum_zero_index, sum_zero],
  nsmul     := λ n f, n • f,
  nsmul_zero' := by { intros, ext, simp [-nsmul_eq_mul, add_smul] },
  nsmul_succ' := by { intros, ext, simp [-nsmul_eq_mul, nat.succ_eq_one_add, add_smul] },
  .. finsupp.add_comm_monoid }

variables [semiring R]

lemma lift_nc_mul {g_hom : Type*} [mul_hom_class g_hom (multiplicative G) R] (f : k →+* R)
  (g : g_hom) (a b : add_monoid_algebra k G)
  (h_comm : ∀ {x y}, y ∈ a.support → commute (f (b x)) (g $ multiplicative.of_add y)) :
  lift_nc (f : k →+ R) g (a * b) = lift_nc (f : k →+ R) g a * lift_nc (f : k →+ R) g b :=
(monoid_algebra.lift_nc_mul f g _ _ @h_comm : _)

end has_mul

section has_one

variables [semiring k] [has_zero G] [non_assoc_semiring R]

/-- The unit of the multiplication is `single 1 1`, i.e. the function
  that is `1` at `0` and zero elsewhere. -/
instance : has_one (add_monoid_algebra k G) :=
⟨single 0 1⟩

lemma one_def : (1 : add_monoid_algebra k G) = single 0 1 :=
rfl

@[simp] lemma lift_nc_one {g_hom : Type*} [one_hom_class g_hom (multiplicative G) R]
  (f : k →+* R) (g : g_hom) :
  lift_nc (f : k →+ R) g 1 = 1 :=
(monoid_algebra.lift_nc_one f g : _)

end has_one

section semigroup

variables [semiring k] [add_semigroup G]

instance : non_unital_semiring (add_monoid_algebra k G) :=
{ zero      := 0,
  mul       := (*),
  add       := (+),
  mul_assoc := assume f g h, by simp only [mul_def, sum_sum_index, sum_zero_index, sum_add_index,
    sum_single_index, single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff,
    add_mul, mul_add, add_assoc, mul_assoc, zero_mul, mul_zero, sum_zero, sum_add],
  .. add_monoid_algebra.non_unital_non_assoc_semiring }

end semigroup

section mul_one_class

variables [semiring k] [add_zero_class G]

instance : non_assoc_semiring (add_monoid_algebra k G) :=
{ one       := 1,
  mul       := (*),
  zero      := 0,
  add       := (+),
  one_mul   := assume f, by simp only [mul_def, one_def, sum_single_index, zero_mul,
    single_zero, sum_zero, zero_add, one_mul, sum_single],
  mul_one   := assume f, by simp only [mul_def, one_def, sum_single_index, mul_zero,
    single_zero, sum_zero, add_zero, mul_one, sum_single],
  .. add_monoid_algebra.non_unital_non_assoc_semiring }

end mul_one_class

/-! #### Semiring structure -/
section semiring

instance {R : Type*} [monoid R] [semiring k] [distrib_mul_action R k] :
  has_scalar R (add_monoid_algebra k G) :=
finsupp.has_scalar

variables [semiring k] [add_monoid G]

instance : semiring (add_monoid_algebra k G) :=
{ one       := 1,
  mul       := (*),
  zero      := 0,
  add       := (+),
  .. add_monoid_algebra.non_unital_semiring,
  .. add_monoid_algebra.non_assoc_semiring, }

variables [semiring R]

/-- `lift_nc` as a `ring_hom`, for when `f` and `g` commute -/
def lift_nc_ring_hom (f : k →+* R) (g : multiplicative G →* R)
  (h_comm : ∀ x y, commute (f x) (g y)) :
  add_monoid_algebra k G →+* R :=
{ to_fun := lift_nc (f : k →+ R) g,
  map_one' := lift_nc_one _ _,
  map_mul' := λ a b, lift_nc_mul _ _ _ _ $ λ _ _ _, h_comm _ _,
  ..(lift_nc (f : k →+ R) g)}

end semiring

instance [comm_semiring k] [add_comm_monoid G] : comm_semiring (add_monoid_algebra k G) :=
{ mul_comm := @mul_comm (monoid_algebra k $ multiplicative G) _,
  .. add_monoid_algebra.semiring }

instance [semiring k] [nontrivial k] [nonempty G] : nontrivial (add_monoid_algebra k G) :=
finsupp.nontrivial

/-! #### Derived instances -/
section derived_instances

instance [semiring k] [subsingleton k] : unique (add_monoid_algebra k G) :=
finsupp.unique_of_right

instance [ring k] : add_comm_group (add_monoid_algebra k G) :=
finsupp.add_comm_group

instance [ring k] [has_add G] : non_unital_non_assoc_ring (add_monoid_algebra k G) :=
{ .. add_monoid_algebra.add_comm_group,
  .. add_monoid_algebra.non_unital_non_assoc_semiring }

instance [ring k] [add_semigroup G] : non_unital_ring (add_monoid_algebra k G) :=
{ .. add_monoid_algebra.add_comm_group,
  .. add_monoid_algebra.non_unital_semiring }

instance [ring k] [add_zero_class G] : non_assoc_ring (add_monoid_algebra k G) :=
{ .. add_monoid_algebra.add_comm_group,
  .. add_monoid_algebra.non_assoc_semiring }

instance [ring k] [add_monoid G] : ring (add_monoid_algebra k G) :=
{ .. add_monoid_algebra.non_unital_non_assoc_ring,
  .. add_monoid_algebra.semiring }

instance [comm_ring k] [add_comm_monoid G] : comm_ring (add_monoid_algebra k G) :=
{ mul_comm := mul_comm, .. add_monoid_algebra.ring}

variables {S : Type*}

instance [monoid R] [semiring k] [distrib_mul_action R k] :
  distrib_mul_action R (add_monoid_algebra k G) :=
finsupp.distrib_mul_action G k

instance [monoid R] [semiring k] [distrib_mul_action R k] [has_faithful_scalar R k] [nonempty G] :
  has_faithful_scalar R (add_monoid_algebra k G) :=
finsupp.has_faithful_scalar

instance [semiring R] [semiring k] [module R k] : module R (add_monoid_algebra k G) :=
finsupp.module G k

instance [monoid R] [monoid S] [semiring k] [distrib_mul_action R k] [distrib_mul_action S k]
  [has_scalar R S] [is_scalar_tower R S k] :
  is_scalar_tower R S (add_monoid_algebra k G) :=
finsupp.is_scalar_tower G k

instance [monoid R] [monoid S] [semiring k] [distrib_mul_action R k] [distrib_mul_action S k]
  [smul_comm_class R S k] :
  smul_comm_class R S (add_monoid_algebra k G) :=
finsupp.smul_comm_class G k

instance [monoid R] [semiring k] [distrib_mul_action R k] [distrib_mul_action Rᵐᵒᵖ k]
  [is_central_scalar R k] :
  is_central_scalar R (add_monoid_algebra k G) :=
finsupp.is_central_scalar 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. -/

end derived_instances

section misc_theorems

variables [semiring k]

lemma mul_apply [has_add G] (f g : add_monoid_algebra k G) (x : G) :
  (f * g) x = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, if a₁ + a₂ = x then b₁ * b₂ else 0) :=
@monoid_algebra.mul_apply k (multiplicative G) _ _ _ _ _

lemma mul_apply_antidiagonal [has_add G] (f g : add_monoid_algebra k G) (x : G) (s : finset (G × G))
  (hs : ∀ {p : G × G}, p ∈ s ↔ p.1 + p.2 = x) :
  (f * g) x = ∑ p in s, (f p.1 * g p.2) :=
@monoid_algebra.mul_apply_antidiagonal k (multiplicative G) _ _ _ _ _ s @hs

lemma support_mul [has_add G] (a b : add_monoid_algebra k G) :
  (a * b).support ⊆ a.support.bUnion (λa₁, b.support.bUnion $ λa₂, {a₁ + a₂}) :=
@monoid_algebra.support_mul k (multiplicative G) _ _ _ _

lemma single_mul_single [has_add G] {a₁ a₂ : G} {b₁ b₂ : k} :
  (single a₁ b₁ * single a₂ b₂ : add_monoid_algebra k G) = single (a₁ + a₂) (b₁ * b₂) :=
@monoid_algebra.single_mul_single k (multiplicative G) _ _ _ _ _ _

-- This should be a `@[simp]` lemma, but the simp_nf linter times out if we add this.
-- Probably the correct fix is to make a `[add_]monoid_algebra.single` with the correct type,
-- instead of relying on `finsupp.single`.
lemma single_pow [add_monoid G] {a : G} {b : k} :
  ∀ n : ℕ, ((single a b)^n : add_monoid_algebra k G) = single (n • a) (b ^ n)
| 0 := by { simp only [pow_zero, zero_nsmul], refl }
| (n+1) :=
by rw [pow_succ, pow_succ, single_pow n, single_mul_single, add_comm, add_nsmul, one_nsmul]

/-- Like `finsupp.map_domain_add`, but for the convolutive multiplication we define in this file -/
lemma map_domain_mul {α : Type*} {β : Type*} {α₂ : Type*}
  [semiring β] [has_add α] [has_add α₂]
  {x y : add_monoid_algebra β α} (f : add_hom α α₂) :
  (map_domain f (x * y : add_monoid_algebra β α) : add_monoid_algebra β α₂) =
    (map_domain f x * map_domain f y : add_monoid_algebra β α₂) :=
begin
  simp_rw [mul_def, map_domain_sum, map_domain_single, f.map_add],
  rw finsupp.sum_map_domain_index,
  { congr,
    ext a b,
    rw finsupp.sum_map_domain_index,
    { simp },
    { simp [mul_add] } },
  { simp },
  { simp [add_mul] }
end

section

variables (k G)

/-- The embedding of an additive magma into its additive magma algebra. -/
@[simps] def of_magma [has_add G] : mul_hom (multiplicative G) (add_monoid_algebra k G) :=
{ to_fun   := λ a, single a 1,
  map_mul' := λ a b, by simpa only [mul_def, mul_one, sum_single_index, single_eq_zero, mul_zero], }

/-- Embedding of a magma with zero into its magma algebra. -/
def of [add_zero_class G] : multiplicative G →* add_monoid_algebra k G :=
{ to_fun := λ a, single a 1,
  map_one' := rfl,
  .. of_magma k G }

/-- Embedding of a magma with zero `G`, into its magma algebra, having `G` as source. -/
def of' : G → add_monoid_algebra k G := λ a, single a 1

end

@[simp] lemma of_apply [add_zero_class G] (a : multiplicative G) : of k G a = single a.to_add 1 :=
rfl

@[simp] lemma of'_apply (a : G) : of' k G a = single a 1 := rfl

lemma of'_eq_of [add_zero_class G] (a : G) : of' k G a = of k G a := rfl

lemma of_injective [nontrivial k] [add_zero_class G] : function.injective (of k G) :=
λ a b h, by simpa using (single_eq_single_iff _ _ _ _).mp h

/--
`finsupp.single` as a `monoid_hom` from the product type into the additive monoid algebra.

Note the order of the elements of the product are reversed compared to the arguments of
`finsupp.single`.
-/
@[simps] def single_hom [add_zero_class G] : k × multiplicative G →* add_monoid_algebra k G :=
{ to_fun := λ a, single a.2.to_add a.1,
  map_one' := rfl,
  map_mul' := λ a b, single_mul_single.symm }

lemma mul_single_apply_aux [has_add G] (f : add_monoid_algebra k G) (r : k)
  (x y z : G) (H : ∀ a, a + x = z ↔ a = y) :
  (f * single x r) z = f y * r :=
@monoid_algebra.mul_single_apply_aux k (multiplicative G) _ _ _ _ _ _ _ H

lemma mul_single_zero_apply [add_zero_class G] (f : add_monoid_algebra k G) (r : k) (x : G) :
  (f * single 0 r) x = f x * r :=
f.mul_single_apply_aux r _ _ _ $ λ a, by rw [add_zero]

lemma single_mul_apply_aux [has_add G] (f : add_monoid_algebra k G) (r : k) (x y z : G)
  (H : ∀ a, x + a = y ↔ a = z) :
  (single x r * f : add_monoid_algebra k G) y = r * f z :=
@monoid_algebra.single_mul_apply_aux k (multiplicative G) _ _ _ _ _ _ _ H

lemma single_zero_mul_apply [add_zero_class G] (f : add_monoid_algebra k G) (r : k) (x : G) :
  (single 0 r * f : add_monoid_algebra k G) x = r * f x :=
f.single_mul_apply_aux r _ _ _ $ λ a, by rw [zero_add]

lemma mul_single_apply [add_group G] (f : add_monoid_algebra k G) (r : k) (x y : G) :
  (f * single x r) y = f (y - x) * r :=
(sub_eq_add_neg y x).symm ▸
  @monoid_algebra.mul_single_apply k (multiplicative G) _ _ _ _ _ _

lemma single_mul_apply [add_group G] (r : k) (x : G) (f : add_monoid_algebra k G) (y : G) :
  (single x r * f : add_monoid_algebra k G) y = r * f (- x + y) :=
@monoid_algebra.single_mul_apply k (multiplicative G) _ _ _ _ _ _

lemma support_mul_single [add_right_cancel_semigroup G]
  (f : add_monoid_algebra k G) (r : k) (hr : ∀ y, y * r = 0 ↔ y = 0) (x : G) :
  (f * single x r : add_monoid_algebra k G).support = f.support.map (add_right_embedding x) :=
@monoid_algebra.support_mul_single k (multiplicative G) _ _ _ _ hr _

lemma support_single_mul [add_left_cancel_semigroup G]
  (f : add_monoid_algebra k G) (r : k) (hr : ∀ y, r * y = 0 ↔ y = 0) (x : G) :
  (single x r * f : add_monoid_algebra k G).support = f.support.map (add_left_embedding x) :=
@monoid_algebra.support_single_mul k (multiplicative G) _ _ _ _ hr _

lemma lift_nc_smul {R : Type*} [add_zero_class G] [semiring R] (f : k →+* R)
  (g : multiplicative G →* R) (c : k) (φ : monoid_algebra k G) :
  lift_nc (f : k →+ R) g (c • φ) = f c * lift_nc (f : k →+ R) g φ :=
@monoid_algebra.lift_nc_smul k (multiplicative G) _ _ _ _ f g c φ

variables {k G}

lemma induction_on [add_monoid G] {p : add_monoid_algebra k G → Prop} (f : add_monoid_algebra k G)
  (hM : ∀ g, p (of k G (multiplicative.of_add g)))
  (hadd : ∀ f g : add_monoid_algebra k G, p f → p g → p (f + g))
  (hsmul : ∀ (r : k) f, p f → p (r • f)) : p f :=
begin
  refine finsupp.induction_linear f _ (λ f g hf hg, hadd f g hf hg) (λ g r, _),
  { simpa using hsmul 0 (of k G (multiplicative.of_add 0)) (hM 0) },
  { convert hsmul r (of k G (multiplicative.of_add g)) (hM g),
    simp only [mul_one, to_add_of_add, smul_single', of_apply] },
end

end misc_theorems

section span

variables [semiring k]

/-- An element of `add_monoid_algebra R M` is in the submodule generated by its support. -/
lemma mem_span_support [add_zero_class G] (f : add_monoid_algebra k G) :
  f ∈ submodule.span k (of k G '' (f.support : set G)) :=
by rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported]

/-- An element of `add_monoid_algebra R M` is in the subalgebra generated by its support, using
unbundled inclusion. -/
lemma mem_span_support' (f : add_monoid_algebra k G) :
  f ∈ submodule.span k (of' k G '' (f.support : set G)) :=
by rw [of', ← finsupp.supported_eq_span_single, finsupp.mem_supported]

end span

end add_monoid_algebra

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

We have not defined `add_monoid_algebra k G = monoid_algebra k (multiplicative G)`
because historically this caused problems;
since the changes that have made `nsmul` definitional, this would be possible,
but for now we just contruct the ring isomorphisms using `ring_equiv.refl _`.
-/

/-- The equivalence between `add_monoid_algebra` and `monoid_algebra` in terms of
`multiplicative` -/
protected def add_monoid_algebra.to_multiplicative [semiring k] [has_add G] :
  add_monoid_algebra k G ≃+* monoid_algebra k (multiplicative G) :=
{ to_fun := equiv_map_domain multiplicative.of_add,
  map_mul' := λ x y, begin
    repeat {rw equiv_map_domain_eq_map_domain},
    dsimp [multiplicative.of_add],
    convert monoid_algebra.map_domain_mul (mul_hom.id (multiplicative G)),
  end,
  ..finsupp.dom_congr multiplicative.of_add }

/-- The equivalence between `monoid_algebra` and `add_monoid_algebra` in terms of `additive` -/
protected def monoid_algebra.to_additive [semiring k] [has_mul G] :
  monoid_algebra k G ≃+* add_monoid_algebra k (additive G) :=
{ to_fun := equiv_map_domain additive.of_mul,
  map_mul' := λ x y, begin
    repeat {rw equiv_map_domain_eq_map_domain},
    dsimp [additive.of_mul],
    convert monoid_algebra.map_domain_mul (mul_hom.id G),
  end,
  ..finsupp.dom_congr additive.of_mul }

namespace add_monoid_algebra

variables {k G}

/-! #### Non-unital, non-associative algebra structure -/

section non_unital_non_assoc_algebra

variables (k) [monoid R] [semiring k] [distrib_mul_action R k] [has_add G]

instance is_scalar_tower_self [is_scalar_tower R k k] :
  is_scalar_tower R (add_monoid_algebra k G) (add_monoid_algebra k G) :=
@monoid_algebra.is_scalar_tower_self k (multiplicative G) R _ _ _ _ _

/-- Note that if `k` is a `comm_semiring` then we have `smul_comm_class k k k` and so we can take
`R = k` in the below. In other words, if the coefficients are commutative amongst themselves, they
also commute with the algebra multiplication. -/
instance smul_comm_class_self [smul_comm_class R k k] :
  smul_comm_class R (add_monoid_algebra k G) (add_monoid_algebra k G) :=
@monoid_algebra.smul_comm_class_self k (multiplicative G) R _ _ _ _ _

instance smul_comm_class_symm_self [smul_comm_class k R k] :
  smul_comm_class (add_monoid_algebra k G) R (add_monoid_algebra k G) :=
@monoid_algebra.smul_comm_class_symm_self k (multiplicative G) R _ _ _ _ _

variables {A : Type u₃} [non_unital_non_assoc_semiring A]

/-- A non_unital `k`-algebra homomorphism from `add_monoid_algebra k G` is uniquely defined by its
values on the functions `single a 1`. -/
lemma non_unital_alg_hom_ext [distrib_mul_action k A]
  {φ₁ φ₂ : non_unital_alg_hom k (add_monoid_algebra k G) A}
  (h : ∀ x, φ₁ (single x 1) = φ₂ (single x 1)) : φ₁ = φ₂ :=
@monoid_algebra.non_unital_alg_hom_ext k (multiplicative G) _ _ _ _ _ φ₁ φ₂ h

/-- See note [partially-applied ext lemmas]. -/
@[ext] lemma non_unital_alg_hom_ext' [distrib_mul_action k A]
  {φ₁ φ₂ : non_unital_alg_hom k (add_monoid_algebra k G) A}
  (h : φ₁.to_mul_hom.comp (of_magma k G) = φ₂.to_mul_hom.comp (of_magma k G)) : φ₁ = φ₂ :=
@monoid_algebra.non_unital_alg_hom_ext' k (multiplicative G) _ _ _ _ _ φ₁ φ₂ h

/-- The functor `G ↦ add_monoid_algebra k G`, from the category of magmas to the category of
non-unital, non-associative algebras over `k` is adjoint to the forgetful functor in the other
direction. -/
@[simps] def lift_magma [module k A] [is_scalar_tower k A A] [smul_comm_class k A A] :
  mul_hom (multiplicative G) A ≃ non_unital_alg_hom k (add_monoid_algebra k G) A :=
{ to_fun := λ f, { to_fun := λ a, sum a (λ m t, t • f (multiplicative.of_add m)),
                   .. (monoid_algebra.lift_magma k f : _)},
  inv_fun := λ F, F.to_mul_hom.comp (of_magma k G),
  .. (monoid_algebra.lift_magma k : mul_hom (multiplicative G) A ≃ non_unital_alg_hom k _ A) }

end non_unital_non_assoc_algebra

/-! #### Algebra structure -/
section algebra

local attribute [reducible] add_monoid_algebra

/-- `finsupp.single 0` as a `ring_hom` -/
@[simps] def single_zero_ring_hom [semiring k] [add_monoid G] : k →+* add_monoid_algebra k G :=
{ map_one' := rfl,
  map_mul' := λ x y, by rw [single_add_hom, single_mul_single, zero_add],
  ..finsupp.single_add_hom 0}

/-- 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. -/
lemma ring_hom_ext {R} [semiring k] [add_monoid G] [semiring R]
  {f g : add_monoid_algebra k G →+* R} (h₀ : ∀ b, f (single 0 b) = g (single 0 b))
  (h_of : ∀ a, f (single a 1) = g (single a 1)) : f = g :=
@monoid_algebra.ring_hom_ext k (multiplicative G) R _ _ _ _ _ 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]. -/
@[ext] lemma ring_hom_ext' {R} [semiring k] [add_monoid G] [semiring R]
  {f g : add_monoid_algebra k G →+* R}
  (h₁ : f.comp single_zero_ring_hom = g.comp single_zero_ring_hom)
  (h_of : (f : add_monoid_algebra k G →* R).comp (of k G) =
    (g : add_monoid_algebra k G →* R).comp (of k G)) :
  f = g :=
ring_hom_ext (ring_hom.congr_fun h₁) (monoid_hom.congr_fun h_of)

section opposite

open finsupp mul_opposite

variables [semiring k]

/-- The opposite of an `add_monoid_algebra R I` is ring equivalent to
the `add_monoid_algebra Rᵐᵒᵖ I` over the opposite ring, taking elements to their opposite. -/
@[simps {simp_rhs := tt}] protected noncomputable def op_ring_equiv [add_comm_monoid G] :
  (add_monoid_algebra k G)ᵐᵒᵖ ≃+* add_monoid_algebra kᵐᵒᵖ G :=
{ map_mul' := begin
    dsimp only [add_equiv.to_fun_eq_coe, ←add_equiv.coe_to_add_monoid_hom],
    rw add_monoid_hom.map_mul_iff,
    ext i r i' r' : 6,
    dsimp,
    simp only [map_range_single, single_mul_single, ←op_mul, add_comm]
  end,
  ..mul_opposite.op_add_equiv.symm.trans
    (finsupp.map_range.add_equiv (mul_opposite.op_add_equiv : k ≃+ kᵐᵒᵖ))}

@[simp] lemma op_ring_equiv_single [add_comm_monoid G] (r : k) (x : G) :
  add_monoid_algebra.op_ring_equiv (op (single x r)) = single x (op r) :=
by simp

@[simp] lemma op_ring_equiv_symm_single [add_comm_monoid G] (r : kᵐᵒᵖ) (x : Gᵐᵒᵖ) :
  add_monoid_algebra.op_ring_equiv.symm (single x r) = op (single x r.unop) :=
by simp

end opposite

/--
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)`.
-/
instance [comm_semiring R] [semiring k] [algebra R k] [add_monoid G] :
  algebra R (add_monoid_algebra k G) :=
{ smul_def' := λ r a, by { ext, simp [single_zero_mul_apply, algebra.smul_def, pi.smul_apply], },
  commutes' := λ r f, by { ext, simp [single_zero_mul_apply, mul_single_zero_apply,
                                      algebra.commutes], },
  ..single_zero_ring_hom.comp (algebra_map R k) }

/-- `finsupp.single 0` as a `alg_hom` -/
@[simps] def single_zero_alg_hom [comm_semiring R] [semiring k] [algebra R k] [add_monoid G] :
  k →ₐ[R] add_monoid_algebra k G :=
{ commutes' := λ r, by { ext, simp, refl, }, ..single_zero_ring_hom}

@[simp] lemma coe_algebra_map [comm_semiring R] [semiring k] [algebra R k] [add_monoid G] :
  (algebra_map R (add_monoid_algebra k G) : R → add_monoid_algebra k G) =
    single 0 ∘ (algebra_map R k) :=
rfl

end algebra

section lift

variables {k G} [comm_semiring k] [add_monoid G]
variables {A : Type u₃} [semiring A] [algebra k A] {B : Type*} [semiring B] [algebra k B]

/-- `lift_nc_ring_hom` as a `alg_hom`, for when `f` is an `alg_hom` -/
def lift_nc_alg_hom (f : A →ₐ[k] B) (g : multiplicative G →* B)
  (h_comm : ∀ x y, commute (f x) (g y)) :
  add_monoid_algebra A G →ₐ[k] B :=
{ to_fun := lift_nc_ring_hom (f : A →+* B) g h_comm,
  commutes' := by simp [lift_nc_ring_hom],
  ..(lift_nc_ring_hom (f : A →+* B) g h_comm)}

/-- A `k`-algebra homomorphism from `monoid_algebra k G` is uniquely defined by its
values on the functions `single a 1`. -/
lemma alg_hom_ext ⦃φ₁ φ₂ : add_monoid_algebra k G →ₐ[k] A⦄
  (h : ∀ x, φ₁ (single x 1) = φ₂ (single x 1)) : φ₁ = φ₂ :=
@monoid_algebra.alg_hom_ext k (multiplicative G) _ _ _ _ _ _ _ h

/-- See note [partially-applied ext lemmas]. -/
@[ext] lemma alg_hom_ext' ⦃φ₁ φ₂ : add_monoid_algebra k G →ₐ[k] A⦄
  (h : (φ₁ : add_monoid_algebra k G →* A).comp (of k G) =
    (φ₂ : add_monoid_algebra k G →* A).comp (of k G)) : φ₁ = φ₂ :=
alg_hom_ext $ monoid_hom.congr_fun h

variables (k G A)

/-- Any monoid homomorphism `G →* A` can be lifted to an algebra homomorphism
`monoid_algebra k G →ₐ[k] A`. -/
def lift : (multiplicative G →* A) ≃ (add_monoid_algebra k G →ₐ[k] A) :=
{ inv_fun := λ f, (f : add_monoid_algebra k G →* A).comp (of k G),
  to_fun := λ F,
  { to_fun := lift_nc_alg_hom (algebra.of_id k A) F $ λ _ _, algebra.commutes _ _,
    .. @monoid_algebra.lift k (multiplicative G) _ _ A _ _ F},
  .. @monoid_algebra.lift k (multiplicative G) _ _ A _ _ }

variables {k G A}

lemma lift_apply' (F : multiplicative G →* A) (f : monoid_algebra k G) :
  lift k G A F f = f.sum (λ a b, (algebra_map k A b) * F (multiplicative.of_add a)) := rfl

lemma lift_apply (F : multiplicative G →* A) (f : monoid_algebra k G) :
  lift k G A F f = f.sum (λ a b, b • F (multiplicative.of_add a)) :=
by simp only [lift_apply', algebra.smul_def]

lemma lift_def (F : multiplicative G →* A) :
  ⇑(lift k G A F) = lift_nc ((algebra_map k A : k →+* A) : k →+ A) F :=
rfl

@[simp] lemma lift_symm_apply (F : add_monoid_algebra k G →ₐ[k] A) (x : multiplicative G) :
  (lift k G A).symm F x = F (single x.to_add 1) := rfl

lemma lift_of (F : multiplicative G →* A) (x : multiplicative G) :
  lift k G A F (of k G x) = F x :=
by rw [of_apply, ← lift_symm_apply, equiv.symm_apply_apply]

@[simp] lemma lift_single (F : multiplicative G →* A) (a b) :
  lift k G A F (single a b) = b • F (multiplicative.of_add a) :=
by rw [lift_def, lift_nc_single, algebra.smul_def, ring_hom.coe_add_monoid_hom]

lemma lift_unique' (F : add_monoid_algebra k G →ₐ[k] A) :
  F = lift k G A ((F : add_monoid_algebra k G →* A).comp (of k G)) :=
((lift k G A).apply_symm_apply F).symm

/-- Decomposition of a `k`-algebra homomorphism from `monoid_algebra k G` by
its values on `F (single a 1)`. -/
lemma lift_unique (F : add_monoid_algebra k G →ₐ[k] A) (f : monoid_algebra k G) :
  F f = f.sum (λ a b, b • F (single a 1)) :=
by conv_lhs { rw lift_unique' F, simp [lift_apply] }

lemma alg_hom_ext_iff {φ₁ φ₂ : add_monoid_algebra k G →ₐ[k] A} :
  (∀ x, φ₁ (finsupp.single x 1) = φ₂ (finsupp.single x 1)) ↔ φ₁ = φ₂ :=
⟨λ h, alg_hom_ext h, by rintro rfl _; refl⟩

end lift

section
local attribute [reducible] add_monoid_algebra

universe ui
variable {ι : Type ui}

lemma prod_single [comm_semiring k] [add_comm_monoid G]
  {s : finset ι} {a : ι → G} {b : ι → k} :
  (∏ i in s, single (a i) (b i)) = single (∑ i in s, a i) (∏ i in s, b i) :=
finset.induction_on s rfl $ λ a s has ih, by rw [prod_insert has, ih,
  single_mul_single, sum_insert has, prod_insert has]

end

end add_monoid_algebra

variables [comm_semiring R] (k G)

/-- The algebra equivalence between `add_monoid_algebra` and `monoid_algebra` in terms of
`multiplicative`. -/
def add_monoid_algebra.to_multiplicative_alg_equiv [semiring k] [algebra R k] [add_monoid G] :
  add_monoid_algebra k G ≃ₐ[R] monoid_algebra k (multiplicative G) :=
{ commutes' := λ r, by simp [add_monoid_algebra.to_multiplicative],
  ..add_monoid_algebra.to_multiplicative k G }

/-- The algebra equivalence between `monoid_algebra` and `add_monoid_algebra` in terms of
`additive`. -/
def monoid_algebra.to_additive_alg_equiv [semiring k] [algebra R k] [monoid G] :
  monoid_algebra k G ≃ₐ[R] add_monoid_algebra k (additive G) :=
{ commutes' := λ r, by simp [monoid_algebra.to_additive],
  ..monoid_algebra.to_additive k G }