/-
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 linear_algebra.finsupp
import algebra.non_unital_alg_hom

/-!
# 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₂)

/-! ### 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 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 }

end has_mul

section semigroup

variables [semiring k] [semigroup G]

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 [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

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 }

variables {R : Type*} [semiring R]

/-- A non-commutative version of `monoid_algebra.lift`: given a additive homomorphism `f : k →+ R`
and a multiplicative monoid homomorphism `g : G →* R`, returns the additive homomorphism from
`monoid_algebra k G` such that `lift_nc f g (single a b) = f b * g a`. If `f` is a ring homomorphism
and the range of either `f` or `g` is in center of `R`, then the result is a ring homomorphism.  If
`R` is a `k`-algebra and `f = algebra_map k R`, then the result is an algebra homomorphism called
`monoid_algebra.lift`. -/
def lift_nc (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 _ _ _

@[simp] lemma lift_nc_one (f : k →+* R) (g : G →* R) : lift_nc (f : k →+ R) g 1 = 1 :=
by simp [one_def]

lemma lift_nc_mul (f : k →+* R) (g : G →* R)
  (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 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 {R : Type*} [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_group (monoid_algebra k G) :=
finsupp.add_group

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

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

variables {R 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 comap_distrib_mul_action_self [group G] [semiring k] :
  distrib_mul_action G (monoid_algebra k G) :=
finsupp.comap_distrib_mul_action_self

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

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) :
  -- different `decidable` instances make it not trivial
  by { simp only [mul_apply, A, H], congr, funext, split_ifs; refl }
... = 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], congr' with g s, split_ifs; refl }
... = 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 {R : Type*} (k) [semiring 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 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 }

end has_mul

section has_one

variables [semiring k] [has_zero G]

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

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 }

variables {R : Type*} [semiring R]

/-- A non-commutative version of `add_monoid_algebra.lift`: given a additive homomorphism `f : k →+
R` and a multiplicative monoid homomorphism `g : multiplicative G →* R`, returns the additive
homomorphism from `add_monoid_algebra k G` such that `lift_nc f g (single a b) = f b * g a`. If `f`
is a ring homomorphism and the range of either `f` or `g` is in center of `R`, then the result is a
ring homomorphism.  If `R` is a `k`-algebra and `f = algebra_map k R`, then the result is an algebra
homomorphism called `add_monoid_algebra.lift`. -/
def lift_nc (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 _ _ _

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

lemma lift_nc_mul (f : k →+* R) (g : multiplicative G →* R) (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 k (multiplicative G) _ _ _ _ f g a b @h_comm

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 {R : Type*} [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_group (add_monoid_algebra k G) :=
finsupp.add_group

instance [ring k] [add_monoid G] : ring (add_monoid_algebra k G) :=
{ neg := has_neg.neg,
  add_left_neg := add_left_neg,
  sub := has_sub.sub,
  sub_eq_add_neg := finsupp.add_group.sub_eq_add_neg,
  .. 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 {R 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

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

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 {R : Type*} (k) [semiring 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

variables {R : Type*}
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 {R : Type*} [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 }


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.ring.pi
import Mathlib.algebra.big_operators.basic
import Mathlib.data.fintype.basic
import Mathlib.algebra.group.prod
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Big operators for Pi Types

This file contains theorems relevant to big operators in binary and arbitrary product
of monoids and groups
-/

namespace pi

theorem list_sum_apply {α : Type u_1} {β : α → Type u_2} [(a : α) → add_monoid (β a)] (a : α) (l : List ((a : α) → β a)) : list.sum l a = list.sum (list.map (fun (f : (a : α) → β a) => f a) l) :=
  add_monoid_hom.map_list_sum (add_monoid_hom.apply β a) l

theorem multiset_sum_apply {α : Type u_1} {β : α → Type u_2} [(a : α) → add_comm_monoid (β a)] (a : α) (s : multiset ((a : α) → β a)) : multiset.sum s a = multiset.sum (multiset.map (fun (f : (a : α) → β a) => f a) s) :=
  add_monoid_hom.map_multiset_sum (add_monoid_hom.apply β a) s

end pi

@[simp] theorem finset.sum_apply {α : Type u_1} {β : α → Type u_2} {γ : Type u_3} [(a : α) → add_comm_monoid (β a)] (a : α) (s : finset γ) (g : γ → (a : α) → β a) : finset.sum s (fun (c : γ) => g c) a = finset.sum s fun (c : γ) => g c a :=
  add_monoid_hom.map_sum (add_monoid_hom.apply β a) (fun (c : γ) => g c) s

@[simp] theorem fintype.prod_apply {α : Type u_1} {β : α → Type u_2} {γ : Type u_3} [fintype γ] [(a : α) → comm_monoid (β a)] (a : α) (g : γ → (a : α) → β a) : finset.prod finset.univ (fun (c : γ) => g c) a = finset.prod finset.univ fun (c : γ) => g c a :=
  finset.prod_apply a finset.univ g

theorem prod_mk_prod {α : Type u_1} {β : Type u_2} {γ : Type u_3} [comm_monoid α] [comm_monoid β] (s : finset γ) (f : γ → α) (g : γ → β) : (finset.prod s fun (x : γ) => f x, finset.prod s fun (x : γ) => g x) = finset.prod s fun (x : γ) => (f x, g x) := sorry

-- As we only defined `single` into `add_monoid`, we only prove the `finset.sum` version here.

theorem finset.univ_sum_single {I : Type u_1} [DecidableEq I] {Z : I → Type u_2} [(i : I) → add_comm_monoid (Z i)] [fintype I] (f : (i : I) → Z i) : (finset.sum finset.univ fun (i : I) => pi.single i (f i)) = f := sorry

theorem add_monoid_hom.functions_ext {I : Type u_1} [DecidableEq I] {Z : I → Type u_2} [(i : I) → add_comm_monoid (Z i)] [fintype I] (G : Type u_3) [add_comm_monoid G] (g : ((i : I) → Z i) →+ G) (h : ((i : I) → Z i) →+ G) (w : ∀ (i : I) (x : Z i), coe_fn g (pi.single i x) = coe_fn h (pi.single i x)) : g = h := sorry

-- we need `apply`+`convert` because Lean fails to unify different `add_monoid` instances

-- on `Π i, f i`

theorem ring_hom.functions_ext {I : Type u_1} [DecidableEq I] {f : I → Type u_2} [(i : I) → semiring (f i)] [fintype I] (G : Type u_3) [semiring G] (g : ((i : I) → f i) →+* G) (h : ((i : I) → f i) →+* G) (w : ∀ (i : I) (x : f i), coe_fn g (pi.single i x) = coe_fn h (pi.single i x)) : g = h := sorry

namespace prod

theorem fst_prod {α : Type u_1} {β : Type u_2} {γ : Type u_3} [comm_monoid α] [comm_monoid β] {s : finset γ} {f : γ → α × β} : fst (finset.prod s fun (c : γ) => f c) = finset.prod s fun (c : γ) => fst (f c) :=
  monoid_hom.map_prod (monoid_hom.fst α β) f s

theorem snd_prod {α : Type u_1} {β : Type u_2} {γ : Type u_3} [comm_monoid α] [comm_monoid β] {s : finset γ} {f : γ → α × β} : snd (finset.prod s fun (c : γ) => f c) = finset.prod s fun (c : γ) => snd (f c) :=
  monoid_hom.map_prod (monoid_hom.snd α β) f s


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Yury Kudryashov

! This file was ported from Lean 3 source module algebra.algebra.hom
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Basic

/-!
# Homomorphisms of `R`-algebras

This file defines bundled homomorphisms of `R`-algebras.

## Main definitions

* `AlgHom R A B`: the type of `R`-algebra morphisms from `A` to `B`.
* `Algebra.ofId R A : R →ₐ[R] A`: the canonical map from `R` to `A`, as an `AlgHom`.

## Notations

* `A →ₐ[R] B` : `R`-algebra homomorphism from `A` to `B`.
-/

open BigOperators

universe u v w u₁ v₁

/-- Defining the homomorphism in the category R-Alg. -/
-- @[nolint has_nonempty_instance] -- Porting note: This linter does not exist yet.
structure AlgHom (R : Type u) (A : Type v) (B : Type w) [CommSemiring R] [Semiring A] [Semiring B]
  [Algebra R A] [Algebra R B] extends RingHom A B where
  commutes' : ∀ r : R, toFun (algebraMap R A r) = algebraMap R B r
#align alg_hom AlgHom

/-- Reinterpret an `AlgHom` as a `RingHom` -/
add_decl_doc AlgHom.toRingHom

@[inherit_doc AlgHom]
infixr:25 " →ₐ " => AlgHom _

@[inherit_doc]
notation:25 A " →ₐ[" R "] " B => AlgHom R A B

/-- `AlgHomClass F R A B` asserts `F` is a type of bundled algebra homomorphisms
from `A` to `B`.  -/
class AlgHomClass (F : Type _) (R : outParam (Type _)) (A : outParam (Type _))
  (B : outParam (Type _)) [CommSemiring R] [Semiring A] [Semiring B] [Algebra R A]
  [Algebra R B] extends RingHomClass F A B where
  commutes : ∀ (f : F) (r : R), f (algebraMap R A r) = algebraMap R B r
#align alg_hom_class AlgHomClass

-- Porting note: `dangerousInstance` linter has become smarter about `outParam`s
-- attribute [nolint dangerousInstance] AlgHomClass.toRingHomClass

-- Porting note: simp can prove this
-- attribute [simp] AlgHomClass.commutes

namespace AlgHomClass

variable {R : Type _} {A : Type _} {B : Type _} [CommSemiring R] [Semiring A] [Semiring B]
  [Algebra R A] [Algebra R B]

-- Porting note: marked `{}` rather than `[]` to prevent dangerous instances
-- see Note [lower instance priority]
instance (priority := 100) linearMapClass {_ : CommSemiring R} {_ : Semiring A} {_ : Semiring B}
    {_ : Algebra R A} {_ : Algebra R B} {F : Type _} [AlgHomClass F R A B] :
    LinearMapClass F R A B :=
  { ‹AlgHomClass F R A B› with
    map_smulₛₗ := fun f r x => by
      simp only [Algebra.smul_def, map_mul, commutes, RingHom.id_apply] }
#align alg_hom_class.linear_map_class AlgHomClass.linearMapClass

-- Porting note: A new definition underlying a coercion `↑`.
/-- Turn an element of a type `F` satisfying `AlgHomClass F α β` into an actual
`AlgHom`. This is declared as the default coercion from `F` to `α →+* β`. -/
@[coe]
def toAlgHom {F : Type _} [AlgHomClass F R A B] (f : F) : A →ₐ[R] B :=
{ (f : A →+* B) with
    toFun := f
    commutes' := AlgHomClass.commutes f }

instance coeTC {F : Type _} [AlgHomClass F R A B] : CoeTC F (A →ₐ[R] B) :=
  ⟨AlgHomClass.toAlgHom⟩
#align alg_hom_class.alg_hom.has_coe_t AlgHomClass.coeTC

end AlgHomClass

namespace AlgHom

variable {R : Type u} {A : Type v} {B : Type w} {C : Type u₁} {D : Type v₁}

section Semiring

variable [CommSemiring R] [Semiring A] [Semiring B] [Semiring C] [Semiring D]

variable [Algebra R A] [Algebra R B] [Algebra R C] [Algebra R D]

-- Porting note: we don't port specialized `CoeFun` instances if there is `FunLike` instead
#noalign alg_hom.has_coe_to_fun

-- Porting note: This instance is moved.
instance algHomClass : AlgHomClass (A →ₐ[R] B) R A B where
  coe f := f.toFun
  coe_injective' f g h := by
    rcases f with ⟨⟨⟨⟨_, _⟩, _⟩, _, _⟩, _⟩
    rcases g with ⟨⟨⟨⟨_, _⟩, _⟩, _, _⟩, _⟩
    congr
  map_add f := f.map_add'
  map_zero f := f.map_zero'
  map_mul f := f.map_mul'
  map_one f := f.map_one'
  commutes f := f.commutes'
#align alg_hom.alg_hom_class AlgHom.algHomClass

/-- See Note [custom simps projection] -/
def Simps.apply {R α β : Type _} [CommSemiring R]
    [Semiring α] [Semiring β] [Algebra R α] [Algebra R β] (f : α →ₐ[R] β) : α → β := f

initialize_simps_projections AlgHom (toFun → apply)

@[simp]
protected theorem coe_coe {F : Type _} [AlgHomClass F R A B] (f : F) : ⇑(f : A →ₐ[R] B) = f :=
  rfl
#align alg_hom.coe_coe AlgHom.coe_coe

@[simp]
theorem toFun_eq_coe (f : A →ₐ[R] B) : f.toFun = f :=
  rfl
#align alg_hom.to_fun_eq_coe AlgHom.toFun_eq_coe

attribute [coe] AlgHom.toRingHom

instance coeOutRingHom : CoeOut (A →ₐ[R] B) (A →+* B) :=
  ⟨AlgHom.toRingHom⟩
#align alg_hom.coe_ring_hom AlgHom.coeOutRingHom

-- Porting note: A new definition underlying a coercion `↑`.
@[coe]
def toMonoidHom' (f : A →ₐ[R] B) : A →* B := (f : A →+* B)

instance coeOutMonoidHom : CoeOut (A →ₐ[R] B) (A →* B) :=
  ⟨AlgHom.toMonoidHom'⟩
#align alg_hom.coe_monoid_hom AlgHom.coeOutMonoidHom

-- Porting note: A new definition underlying a coercion `↑`.
@[coe]
def toAddMonoidHom' (f : A →ₐ[R] B) : A →+ B := (f : A →+* B)

instance coeOutAddMonoidHom : CoeOut (A →ₐ[R] B) (A →+ B) :=
  ⟨AlgHom.toAddMonoidHom'⟩
#align alg_hom.coe_add_monoid_hom AlgHom.coeOutAddMonoidHom

-- Porting note: Lean 3: `@[simp, norm_cast] coe_mk`
--               Lean 4: `@[simp] coe_mk` & `@[norm_cast] coe_mks`
@[simp]
theorem coe_mk {f : A →+* B} (h) : ((⟨f, h⟩ : A →ₐ[R] B) : A → B) = f :=
  rfl

@[norm_cast]
theorem coe_mks {f : A → B} (h₁ h₂ h₃ h₄ h₅) : ⇑(⟨⟨⟨⟨f, h₁⟩, h₂⟩, h₃, h₄⟩, h₅⟩ : A →ₐ[R] B) = f :=
  rfl
#align alg_hom.coe_mk AlgHom.coe_mks

-- Porting note: This theorem is new.
@[simp, norm_cast]
theorem coe_ringHom_mk {f : A →+* B} (h) : ((⟨f, h⟩ : A →ₐ[R] B) : A →+* B) = f :=
  rfl

-- make the coercion the simp-normal form
@[simp]
theorem toRingHom_eq_coe (f : A →ₐ[R] B) : f.toRingHom = f :=
  rfl
#align alg_hom.to_ring_hom_eq_coe AlgHom.toRingHom_eq_coe

@[simp, norm_cast]
theorem coe_toRingHom (f : A →ₐ[R] B) : ⇑(f : A →+* B) = f :=
  rfl
#align alg_hom.coe_to_ring_hom AlgHom.coe_toRingHom

@[simp, norm_cast]
theorem coe_toMonoidHom (f : A →ₐ[R] B) : ⇑(f : A →* B) = f :=
  rfl
#align alg_hom.coe_to_monoid_hom AlgHom.coe_toMonoidHom

@[simp, norm_cast]
theorem coe_toAddMonoidHom (f : A →ₐ[R] B) : ⇑(f : A →+ B) = f :=
  rfl
#align alg_hom.coe_to_add_monoid_hom AlgHom.coe_toAddMonoidHom

variable (φ : A →ₐ[R] B)

theorem coe_fn_injective : @Function.Injective (A →ₐ[R] B) (A → B) (↑) :=
  FunLike.coe_injective
#align alg_hom.coe_fn_injective AlgHom.coe_fn_injective

theorem coe_fn_inj {φ₁ φ₂ : A →ₐ[R] B} : (φ₁ : A → B) = φ₂ ↔ φ₁ = φ₂ :=
  FunLike.coe_fn_eq
#align alg_hom.coe_fn_inj AlgHom.coe_fn_inj

theorem coe_ringHom_injective : Function.Injective ((↑) : (A →ₐ[R] B) → A →+* B) := fun φ₁ φ₂ H =>
  coe_fn_injective <| show ((φ₁ : A →+* B) : A → B) = ((φ₂ : A →+* B) : A → B) from congr_arg _ H
#align alg_hom.coe_ring_hom_injective AlgHom.coe_ringHom_injective

theorem coe_monoidHom_injective : Function.Injective ((↑) : (A →ₐ[R] B) → A →* B) :=
  RingHom.coe_monoidHom_injective.comp coe_ringHom_injective
#align alg_hom.coe_monoid_hom_injective AlgHom.coe_monoidHom_injective

theorem coe_addMonoidHom_injective : Function.Injective ((↑) : (A →ₐ[R] B) → A →+ B) :=
  RingHom.coe_addMonoidHom_injective.comp coe_ringHom_injective
#align alg_hom.coe_add_monoid_hom_injective AlgHom.coe_addMonoidHom_injective

protected theorem congr_fun {φ₁ φ₂ : A →ₐ[R] B} (H : φ₁ = φ₂) (x : A) : φ₁ x = φ₂ x :=
  FunLike.congr_fun H x
#align alg_hom.congr_fun AlgHom.congr_fun

protected theorem congr_arg (φ : A →ₐ[R] B) {x y : A} (h : x = y) : φ x = φ y :=
  FunLike.congr_arg φ h
#align alg_hom.congr_arg AlgHom.congr_arg

@[ext]
theorem ext {φ₁ φ₂ : A →ₐ[R] B} (H : ∀ x, φ₁ x = φ₂ x) : φ₁ = φ₂ :=
  FunLike.ext _ _ H
#align alg_hom.ext AlgHom.ext

theorem ext_iff {φ₁ φ₂ : A →ₐ[R] B} : φ₁ = φ₂ ↔ ∀ x, φ₁ x = φ₂ x :=
  FunLike.ext_iff
#align alg_hom.ext_iff AlgHom.ext_iff

@[simp]
theorem mk_coe {f : A →ₐ[R] B} (h₁ h₂ h₃ h₄ h₅) : (⟨⟨⟨⟨f, h₁⟩, h₂⟩, h₃, h₄⟩, h₅⟩ : A →ₐ[R] B) = f :=
  ext fun _ => rfl
#align alg_hom.mk_coe AlgHom.mk_coe

@[simp]
theorem commutes (r : R) : φ (algebraMap R A r) = algebraMap R B r :=
  φ.commutes' r
#align alg_hom.commutes AlgHom.commutes

theorem comp_algebraMap : (φ : A →+* B).comp (algebraMap R A) = algebraMap R B :=
  RingHom.ext <| φ.commutes
#align alg_hom.comp_algebra_map AlgHom.comp_algebraMap

protected theorem map_add (r s : A) : φ (r + s) = φ r + φ s :=
  map_add _ _ _
#align alg_hom.map_add AlgHom.map_add

protected theorem map_zero : φ 0 = 0 :=
  map_zero _
#align alg_hom.map_zero AlgHom.map_zero

protected theorem map_mul (x y) : φ (x * y) = φ x * φ y :=
  map_mul _ _ _
#align alg_hom.map_mul AlgHom.map_mul

protected theorem map_one : φ 1 = 1 :=
  map_one _
#align alg_hom.map_one AlgHom.map_one

protected theorem map_pow (x : A) (n : ℕ) : φ (x ^ n) = φ x ^ n :=
  map_pow _ _ _
#align alg_hom.map_pow AlgHom.map_pow

-- @[simp] -- Porting note: simp can prove this
protected theorem map_smul (r : R) (x : A) : φ (r • x) = r • φ x :=
  map_smul _ _ _
#align alg_hom.map_smul AlgHom.map_smul

protected theorem map_sum {ι : Type _} (f : ι → A) (s : Finset ι) :
    φ (∑ x in s, f x) = ∑ x in s, φ (f x) :=
  map_sum _ _ _
#align alg_hom.map_sum AlgHom.map_sum

protected theorem map_finsupp_sum {α : Type _} [Zero α] {ι : Type _} (f : ι →₀ α) (g : ι → α → A) :
    φ (f.sum g) = f.sum fun i a => φ (g i a) :=
  map_finsupp_sum _ _ _
#align alg_hom.map_finsupp_sum AlgHom.map_finsupp_sum

set_option linter.deprecated false in
protected theorem map_bit0 (x) : φ (bit0 x) = bit0 (φ x) :=
  map_bit0 _ _
#align alg_hom.map_bit0 AlgHom.map_bit0

set_option linter.deprecated false in
protected theorem map_bit1 (x) : φ (bit1 x) = bit1 (φ x) :=
  map_bit1 _ _
#align alg_hom.map_bit1 AlgHom.map_bit1

/-- If a `RingHom` is `R`-linear, then it is an `AlgHom`. -/
def mk' (f : A →+* B) (h : ∀ (c : R) (x), f (c • x) = c • f x) : A →ₐ[R] B :=
  { f with
    toFun := f
    commutes' := fun c => by simp only [Algebra.algebraMap_eq_smul_one, h, f.map_one] }
#align alg_hom.mk' AlgHom.mk'

@[simp]
theorem coe_mk' (f : A →+* B) (h : ∀ (c : R) (x), f (c • x) = c • f x) : ⇑(mk' f h) = f :=
  rfl
#align alg_hom.coe_mk' AlgHom.coe_mk'

section

variable (R A)

/-- Identity map as an `AlgHom`. -/
protected def id : A →ₐ[R] A :=
  { RingHom.id A with commutes' := fun _ => rfl }
#align alg_hom.id AlgHom.id

@[simp]
theorem coe_id : ⇑(AlgHom.id R A) = id :=
  rfl
#align alg_hom.coe_id AlgHom.coe_id

@[simp]
theorem id_toRingHom : (AlgHom.id R A : A →+* A) = RingHom.id _ :=
  rfl
#align alg_hom.id_to_ring_hom AlgHom.id_toRingHom

end

theorem id_apply (p : A) : AlgHom.id R A p = p :=
  rfl
#align alg_hom.id_apply AlgHom.id_apply

/-- Composition of algebra homeomorphisms. -/
def comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : A →ₐ[R] C :=
  { φ₁.toRingHom.comp ↑φ₂ with
    commutes' := fun r : R => by rw [← φ₁.commutes, ← φ₂.commutes]; rfl }
#align alg_hom.comp AlgHom.comp

@[simp]
theorem coe_comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : ⇑(φ₁.comp φ₂) = φ₁ ∘ φ₂ :=
  rfl
#align alg_hom.coe_comp AlgHom.coe_comp

theorem comp_apply (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) (p : A) : φ₁.comp φ₂ p = φ₁ (φ₂ p) :=
  rfl
#align alg_hom.comp_apply AlgHom.comp_apply

theorem comp_toRingHom (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) :
    (φ₁.comp φ₂ : A →+* C) = (φ₁ : B →+* C).comp ↑φ₂ :=
  rfl
#align alg_hom.comp_to_ring_hom AlgHom.comp_toRingHom

@[simp]
theorem comp_id : φ.comp (AlgHom.id R A) = φ :=
  ext fun _x => rfl
#align alg_hom.comp_id AlgHom.comp_id

@[simp]
theorem id_comp : (AlgHom.id R B).comp φ = φ :=
  ext fun _x => rfl
#align alg_hom.id_comp AlgHom.id_comp

theorem comp_assoc (φ₁ : C →ₐ[R] D) (φ₂ : B →ₐ[R] C) (φ₃ : A →ₐ[R] B) :
    (φ₁.comp φ₂).comp φ₃ = φ₁.comp (φ₂.comp φ₃) :=
  ext fun _x => rfl
#align alg_hom.comp_assoc AlgHom.comp_assoc

/-- R-Alg ⥤ R-Mod -/
def toLinearMap : A →ₗ[R] B where
  toFun := φ
  map_add' := map_add _
  map_smul' := map_smul _
#align alg_hom.to_linear_map AlgHom.toLinearMap

@[simp]
theorem toLinearMap_apply (p : A) : φ.toLinearMap p = φ p :=
  rfl
#align alg_hom.to_linear_map_apply AlgHom.toLinearMap_apply

theorem toLinearMap_injective :
    Function.Injective (toLinearMap : _ → A →ₗ[R] B) := fun _φ₁ _φ₂ h =>
  ext <| LinearMap.congr_fun h
#align alg_hom.to_linear_map_injective AlgHom.toLinearMap_injective

@[simp]
theorem comp_toLinearMap (f : A →ₐ[R] B) (g : B →ₐ[R] C) :
    (g.comp f).toLinearMap = g.toLinearMap.comp f.toLinearMap :=
  rfl
#align alg_hom.comp_to_linear_map AlgHom.comp_toLinearMap

@[simp]
theorem toLinearMap_id : toLinearMap (AlgHom.id R A) = LinearMap.id :=
  LinearMap.ext fun _ => rfl
#align alg_hom.to_linear_map_id AlgHom.toLinearMap_id

/-- Promote a `LinearMap` to an `AlgHom` by supplying proofs about the behavior on `1` and `*`. -/
@[simps]
def ofLinearMap (f : A →ₗ[R] B) (map_one : f 1 = 1) (map_mul : ∀ x y, f (x * y) = f x * f y) :
    A →ₐ[R] B :=
  { f.toAddMonoidHom with
    toFun := f
    map_one' := map_one
    map_mul' := map_mul
    commutes' := fun c => by simp only [Algebra.algebraMap_eq_smul_one, f.map_smul, map_one] }
#align alg_hom.of_linear_map AlgHom.ofLinearMap

@[simp]
theorem ofLinearMap_toLinearMap (map_one) (map_mul) :
    ofLinearMap φ.toLinearMap map_one map_mul = φ := by
  ext
  rfl
#align alg_hom.of_linear_map_to_linear_map AlgHom.ofLinearMap_toLinearMap

@[simp]
theorem toLinearMap_ofLinearMap (f : A →ₗ[R] B) (map_one) (map_mul) :
    toLinearMap (ofLinearMap f map_one map_mul) = f := by
  ext
  rfl
#align alg_hom.to_linear_map_of_linear_map AlgHom.toLinearMap_ofLinearMap

@[simp]
theorem ofLinearMap_id (map_one) (map_mul) :
    ofLinearMap LinearMap.id map_one map_mul = AlgHom.id R A :=
  ext fun _ => rfl
#align alg_hom.of_linear_map_id AlgHom.ofLinearMap_id

theorem map_smul_of_tower {R'} [SMul R' A] [SMul R' B] [LinearMap.CompatibleSMul A B R' R] (r : R')
    (x : A) : φ (r • x) = r • φ x :=
  φ.toLinearMap.map_smul_of_tower r x
#align alg_hom.map_smul_of_tower AlgHom.map_smul_of_tower

theorem map_list_prod (s : List A) : φ s.prod = (s.map φ).prod :=
  φ.toRingHom.map_list_prod s
#align alg_hom.map_list_prod AlgHom.map_list_prod

@[simps (config := .lemmasOnly) toSemigroup_toMul_mul toOne_one]
instance End : Monoid (A →ₐ[R] A) where
  mul := comp
  mul_assoc ϕ ψ χ := rfl
  one := AlgHom.id R A
  one_mul ϕ := ext fun x => rfl
  mul_one ϕ := ext fun x => rfl
#align alg_hom.End AlgHom.End

@[simp]
theorem one_apply (x : A) : (1 : A →ₐ[R] A) x = x :=
  rfl
#align alg_hom.one_apply AlgHom.one_apply

@[simp]
theorem mul_apply (φ ψ : A →ₐ[R] A) (x : A) : (φ * ψ) x = φ (ψ x) :=
  rfl
#align alg_hom.mul_apply AlgHom.mul_apply

theorem algebraMap_eq_apply (f : A →ₐ[R] B) {y : R} {x : A} (h : algebraMap R A y = x) :
    algebraMap R B y = f x :=
  h ▸ (f.commutes _).symm
#align alg_hom.algebra_map_eq_apply AlgHom.algebraMap_eq_apply

end Semiring

section CommSemiring

variable [CommSemiring R] [CommSemiring A] [CommSemiring B]

variable [Algebra R A] [Algebra R B] (φ : A →ₐ[R] B)

protected theorem map_multiset_prod (s : Multiset A) : φ s.prod = (s.map φ).prod :=
  map_multiset_prod _ _
#align alg_hom.map_multiset_prod AlgHom.map_multiset_prod

protected theorem map_prod {ι : Type _} (f : ι → A) (s : Finset ι) :
    φ (∏ x in s, f x) = ∏ x in s, φ (f x) :=
  map_prod _ _ _
#align alg_hom.map_prod AlgHom.map_prod

protected

end CommSemiring

section Ring

variable [CommSemiring R] [Ring A] [Ring B]

variable [Algebra R A] [Algebra R B] (φ : A →ₐ[R] B)

protected theorem map_neg (x) : φ (-x) = -φ x :=
  map_neg _ _
#align alg_hom.map_neg AlgHom.map_neg

protected theorem map_sub (x y) : φ (x - y) = φ x - φ y :=
  map_sub _ _ _
#align alg_hom.map_sub AlgHom.map_sub

end Ring

end AlgHom

namespace RingHom

-- Porting note: TODO Erase this line. Needed because we don't have η for classes. (lean4#2074)
attribute [-instance] Ring.toNonAssocRing

variable {R S : Type _}

/-- Reinterpret a `RingHom` as an `ℕ`-algebra homomorphism. -/
def toNatAlgHom [Semiring R] [Semiring S] (f : R →+* S) : R →ₐ[ℕ] S :=
  { f with
    toFun := f
    commutes' := fun n => by simp }
#align ring_hom.to_nat_alg_hom RingHom.toNatAlgHom

/-- Reinterpret a `RingHom` as a `ℤ`-algebra homomorphism. -/
def toIntAlgHom [Ring R] [Ring S] [Algebra ℤ R] [Algebra ℤ S] (f : R →+* S) : R →ₐ[ℤ] S :=
  { f with
    commutes' := fun n => by
      -- Porting note: TODO Erase these `have`s.
      --               Needed because we don't have η for classes. (lean4#2074)
      have e₁ : algebraMap ℤ R n = n :=
        @eq_intCast _ R Ring.toNonAssocRing RingHom.instRingHomClassRingHom (algebraMap ℤ R) n
      have e₂ : algebraMap ℤ S n = n :=
        @eq_intCast _ S Ring.toNonAssocRing RingHom.instRingHomClassRingHom (algebraMap ℤ S) n
      have e₃ : f n = n :=
        @map_intCast _ R S Ring.toNonAssocRing Ring.toNonAssocRing RingHom.instRingHomClassRingHom
          f n
      simp [e₁, e₂, e₃] }
#align ring_hom.to_int_alg_hom RingHom.toIntAlgHom

/-- Reinterpret a `RingHom` as a `ℚ`-algebra homomorphism. This actually yields an equivalence,
see `RingHom.equivRatAlgHom`. -/
def toRatAlgHom [Ring R] [Ring S] [Algebra ℚ R] [Algebra ℚ S] (f : R →+* S) : R →ₐ[ℚ] S :=
  { f with commutes' := f.map_rat_algebraMap }
#align ring_hom.to_rat_alg_hom RingHom.toRatAlgHom

@[simp]
theorem toRatAlgHom_toRingHom [Ring R] [Ring S] [Algebra ℚ R] [Algebra ℚ S] (f : R →+* S) :
    ↑f.toRatAlgHom = f :=
  RingHom.ext fun _x => rfl
#align ring_hom.to_rat_alg_hom_to_ring_hom RingHom.toRatAlgHom_toRingHom

end RingHom

section

-- Porting note: TODO Erase this line. Needed because we don't have η for classes. (lean4#2074)
attribute [-instance] Ring.toNonAssocRing

variable {R S : Type _}

@[simp]
theorem AlgHom.toRingHom_toRatAlgHom [Ring R] [Ring S] [Algebra ℚ R] [Algebra ℚ S]
    (f : R →ₐ[ℚ] S) : (f : R →+* S).toRatAlgHom = f :=
  AlgHom.ext fun _x => rfl
#align alg_hom.to_ring_hom_to_rat_alg_hom AlgHom.toRingHom_toRatAlgHom

/-- The equivalence between `RingHom` and `ℚ`-algebra homomorphisms. -/
@[simps]
def RingHom.equivRatAlgHom [Ring R] [Ring S] [Algebra ℚ R] [Algebra ℚ S] : (R →+* S) ≃ (R →ₐ[ℚ] S)
    where
  toFun := RingHom.toRatAlgHom
  invFun := AlgHom.toRingHom
  left_inv f := RingHom.toRatAlgHom_toRingHom f
  right_inv f := AlgHom.toRingHom_toRatAlgHom f
#align ring_hom.equiv_rat_alg_hom RingHom.equivRatAlgHom

end

namespace Algebra

variable (R : Type u) (A : Type v)

variable [CommSemiring R] [Semiring A] [Algebra R A]

/-- `AlgebraMap` as an `AlgHom`. -/
def ofId : R →ₐ[R] A :=
  { algebraMap R A with commutes' := fun _ => rfl }
#align algebra.of_id Algebra.ofId

variable {R}

theorem ofId_apply (r) : ofId R A r = algebraMap R A r :=
  rfl
#align algebra.of_id_apply Algebra.ofId_apply

end Algebra

namespace MulSemiringAction

variable {M G : Type _} (R A : Type _) [CommSemiring R] [Semiring A] [Algebra R A]

variable [Monoid M] [MulSemiringAction M A] [SMulCommClass M R A]

/-- Each element of the monoid defines a algebra homomorphism.

This is a stronger version of `MulSemiringAction.toRingHom` and
`DistribMulAction.toLinearMap`. -/
@[simps]
def toAlgHom (m : M) : A →ₐ[R] A :=
  { MulSemiringAction.toRingHom _ _ m with
    toFun := fun a => m • a
    commutes' := smul_algebraMap _ }
#align mul_semiring_action.to_alg_hom MulSemiringAction.toAlgHom

theorem toAlgHom_injective [FaithfulSMul M A] :
    Function.Injective (MulSemiringAction.toAlgHom R A : M → A →ₐ[R] A) := fun _m₁ _m₂ h =>
  eq_of_smul_eq_smul fun r => AlgHom.ext_iff.1 h r
#align mul_semiring_action.to_alg_hom_injective MulSemiringAction.toAlgHom_injective

end MulSemiringAction