/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Kevin Buzzard, Scott Morrison, Johan Commelin, Chris Hughes,
  Johannes Hölzl, Yury Kudryashov
Ported by: Winston Yin

! This file was ported from Lean 3 source module algebra.hom.group
! leanprover-community/mathlib commit a148d797a1094ab554ad4183a4ad6f130358ef64
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Init.CcLemmas
import Mathlib.Algebra.NeZero
import Mathlib.Algebra.Group.Basic
import Mathlib.Algebra.GroupWithZero.Defs
import Mathlib.Data.FunLike.Basic

/-!
# Monoid and group homomorphisms

This file defines the bundled structures for monoid and group homomorphisms. Namely, we define
`MonoidHom` (resp., `AddMonoidHom`) to be bundled homomorphisms between multiplicative (resp.,
additive) monoids or groups.

We also define coercion to a function, and  usual operations: composition, identity homomorphism,
pointwise multiplication and pointwise inversion.

This file also defines the lesser-used (and notation-less) homomorphism types which are used as
building blocks for other homomorphisms:

* `ZeroHom`
* `OneHom`
* `AddHom`
* `MulHom`
* `MonoidWithZeroHom`

## Notations

* `→+`: Bundled `AddMonoid` homs. Also use for `AddGroup` homs.
* `→*`: Bundled `Monoid` homs. Also use for `Group` homs.
* `→*₀`: Bundled `MonoidWithZero` homs. Also use for `GroupWithZero` homs.
* `→ₙ*`: Bundled `Semigroup` homs.

## Implementation notes

There's a coercion from bundled homs to fun, and the canonical
notation is to use the bundled hom as a function via this coercion.

There is no `GroupHom` -- the idea is that `MonoidHom` is used.
The constructor for `MonoidHom` needs a proof of `map_one` as well
as `map_mul`; a separate constructor `MonoidHom.mk'` will construct
group homs (i.e. monoid homs between groups) given only a proof
that multiplication is preserved,

Implicit `{}` brackets are often used instead of type class `[]` brackets.  This is done when the
instances can be inferred because they are implicit arguments to the type `MonoidHom`.  When they
can be inferred from the type it is faster to use this method than to use type class inference.

Historically this file also included definitions of unbundled homomorphism classes; they were
deprecated and moved to `Deprecated/Group`.

## Tags

MonoidHom, AddMonoidHom

-/

variable {α β M N P : Type _}

-- monoids
variable {G : Type _} {H : Type _}

-- groups
variable {F : Type _}

-- homs
section Zero

/-- `ZeroHom M N` is the type of functions `M → N` that preserve zero.

When possible, instead of parametrizing results over `(f : ZeroHom M N)`,
you should parametrize over `(F : Type _) [ZeroHomClass F M N] (f : F)`.

When you extend this structure, make sure to also extend `ZeroHomClass`.
-/
structure ZeroHom (M : Type _) (N : Type _) [Zero M] [Zero N] where
  /-- The underlying function -/
  toFun : M → N
  /-- The proposition that the function preserves 0 -/
  map_zero' : toFun 0 = 0
#align zero_hom ZeroHom
#align zero_hom.map_zero' ZeroHom.map_zero'

/-- `ZeroHomClass F M N` states that `F` is a type of zero-preserving homomorphisms.

You should extend this typeclass when you extend `ZeroHom`.
-/
class ZeroHomClass (F : Type _) (M N : outParam (Type _)) [Zero M] [Zero N]
  extends FunLike F M fun _ => N where
  /-- The proposition that the function preserves 0 -/
  map_zero : ∀ f : F, f 0 = 0
#align zero_hom_class ZeroHomClass
#align zero_hom_class.map_zero ZeroHomClass.map_zero

-- Instances and lemmas are defined below through `@[to_additive]`.
end Zero

namespace NeZero

theorem of_map {R M} [Zero R] [Zero M] [ZeroHomClass F R M]
  (f : F) {r : R} [neZero : NeZero (f r)] : NeZero r :=
  ⟨fun h => ne (f r) <| by rw [h]; exact ZeroHomClass.map_zero f⟩
#align ne_zero.of_map NeZero.of_map

theorem of_injective {R M} [Zero R] {r : R} [NeZero r] [Zero M] [ZeroHomClass F R M] {f : F}
  (hf : Function.Injective f) : NeZero (f r) :=
  ⟨by
    rw [← ZeroHomClass.map_zero f]
    exact hf.ne NeZero.out⟩
#align ne_zero.of_injective NeZero.of_injective

end NeZero

section Add

/-- `AddHom M N` is the type of functions `M → N` that preserve addition.

When possible, instead of parametrizing results over `(f : AddHom M N)`,
you should parametrize over `(F : Type _) [AddHomClass F M N] (f : F)`.

When you extend this structure, make sure to extend `AddHomClass`.
-/
structure AddHom (M : Type _) (N : Type _) [Add M] [Add N] where
  /-- The underlying function -/
  toFun : M → N
  /-- The proposition that the function preserves addition -/
  map_add' : ∀ x y, toFun (x + y) = toFun x + toFun y
#align add_hom AddHom

/-- `AddHomClass F M N` states that `F` is a type of addition-preserving homomorphisms.
You should declare an instance of this typeclass when you extend `AddHom`.
-/
class AddHomClass (F : Type _) (M N : outParam (Type _)) [Add M] [Add N]
  extends FunLike F M fun _ => N where
  /-- The proposition that the function preserves addition -/
  map_add : ∀ (f : F) (x y : M), f (x + y) = f x + f y
#align add_hom_class AddHomClass

-- Instances and lemmas are defined below through `@[to_additive]`.
end Add

section add_zero

/-- `M →+ N` is the type of functions `M → N` that preserve the `AddZeroClass` structure.

`AddMonoidHom` is also used for group homomorphisms.

When possible, instead of parametrizing results over `(f : M →+ N)`,
you should parametrize over `(F : Type _) [AddMonoidHomClass F M N] (f : F)`.

When you extend this structure, make sure to extend `AddMonoidHomClass`.
-/
structure AddMonoidHom (M : Type _) (N : Type _) [AddZeroClass M] [AddZeroClass N] extends
  ZeroHom M N, AddHom M N
#align add_monoid_hom AddMonoidHom

attribute [nolint docBlame] AddMonoidHom.toAddHom
attribute [nolint docBlame] AddMonoidHom.toZeroHom

/-- `M →+ N` denotes the type of additive monoid homomorphisms from `M` to `N`. -/
infixr:25 " →+ " => AddMonoidHom

/-- `AddMonoidHomClass F M N` states that `F` is a type of `AddZeroClass`-preserving
homomorphisms.

You should also extend this typeclass when you extend `AddMonoidHom`.
-/
class AddMonoidHomClass (F : Type _) (M N : outParam (Type _)) [AddZeroClass M] [AddZeroClass N]
  extends AddHomClass F M N, ZeroHomClass F M N
#align add_monoid_hom_class AddMonoidHomClass

-- Instances and lemmas are defined below through `@[to_additive]`.
end add_zero

section One

variable [One M] [One N]

/-- `OneHom M N` is the type of functions `M → N` that preserve one.

When possible, instead of parametrizing results over `(f : OneHom M N)`,
you should parametrize over `(F : Type _) [OneHomClass F M N] (f : F)`.

When you extend this structure, make sure to also extend `OneHomClass`.
-/
@[to_additive]
structure OneHom (M : Type _) (N : Type _) [One M] [One N] where
  /-- The underlying function -/
  toFun : M → N
  /-- The proposition that the function preserves 1 -/
  map_one' : toFun 1 = 1
#align one_hom OneHom

/-- `OneHomClass F M N` states that `F` is a type of one-preserving homomorphisms.
You should extend this typeclass when you extend `OneHom`.
-/
@[to_additive]
class OneHomClass (F : Type _) (M N : outParam (Type _)) [One M] [One N]
  extends FunLike F M fun _ => N where
  /-- The proposition that the function preserves 1 -/
  map_one : ∀ f : F, f 1 = 1
#align one_hom_class OneHomClass

@[to_additive]
instance OneHom.oneHomClass : OneHomClass (OneHom M N) M N where
  coe := OneHom.toFun
  coe_injective' f g h := by cases f; cases g; congr
  map_one := OneHom.map_one'
#align one_hom.one_hom_class OneHom.oneHomClass
#align zero_hom.zero_hom_class ZeroHom.zeroHomClass

@[to_additive (attr := simp)]
theorem map_one [OneHomClass F M N] (f : F) : f 1 = 1 :=
  OneHomClass.map_one f
#align map_one map_one
#align map_zero map_zero

@[to_additive]
theorem map_eq_one_iff [OneHomClass F M N] (f : F) (hf : Function.Injective f) {x : M} :
  f x = 1 ↔ x = 1 := hf.eq_iff' (map_one f)
#align map_eq_one_iff map_eq_one_iff
#align map_eq_zero_iff map_eq_zero_iff

@[to_additive]
theorem map_ne_one_iff {R S F : Type _} [One R] [One S] [OneHomClass F R S] (f : F)
  (hf : Function.Injective f) {x : R} : f x ≠ 1 ↔ x ≠ 1 := (map_eq_one_iff f hf).not
#align map_ne_one_iff map_ne_one_iff
#align map_ne_zero_iff map_ne_zero_iff

@[to_additive]
theorem ne_one_of_map {R S F : Type _} [One R] [One S] [OneHomClass F R S] {f : F} {x : R}
  (hx : f x ≠ 1) : x ≠ 1 := ne_of_apply_ne f <| ne_of_ne_of_eq hx (map_one f).symm
#align ne_one_of_map ne_one_of_map
#align ne_zero_of_map ne_zero_of_map

/-- Turn an element of a type `F` satisfying `OneHomClass F M N` into an actual
`OneHom`. This is declared as the default coercion from `F` to `OneHom M N`. -/
@[to_additive (attr := coe)
"Turn an element of a type `F` satisfying `ZeroHomClass F M N` into an actual
`ZeroHom`. This is declared as the default coercion from `F` to `ZeroHom M N`."]
def OneHomClass.toOneHom [OneHomClass F M N] (f : F) : OneHom M N where
  toFun := f
  map_one' := map_one f

/-- Any type satisfying `OneHomClass` can be cast into `OneHom` via `OneHomClass.toOneHom`. -/
@[to_additive "Any type satisfying `ZeroHomClass` can be cast into `ZeroHom` via
`ZeroHomClass.toZeroHom`. "]
instance [OneHomClass F M N] : CoeTC F (OneHom M N) :=
  ⟨OneHomClass.toOneHom⟩

@[to_additive (attr := simp)]
theorem OneHom.coe_coe [OneHomClass F M N] (f : F) : ((f : OneHom M N) : M → N) = f := rfl
#align one_hom.coe_coe OneHom.coe_coe
#align zero_hom.coe_coe ZeroHom.coe_coe

end One

section Mul

variable [Mul M] [Mul N]

/-- `M →ₙ* N` is the type of functions `M → N` that preserve multiplication. The `ₙ` in the notation
stands for "non-unital" because it is intended to match the notation for `NonUnitalAlgHom` and
`NonUnitalRingHom`, so a `MulHom` is a non-unital monoid hom.

When possible, instead of parametrizing results over `(f : M →ₙ* N)`,
you should parametrize over `(F : Type _) [MulHomClass F M N] (f : F)`.
When you extend this structure, make sure to extend `MulHomClass`.
-/
@[to_additive]
structure MulHom (M : Type _) (N : Type _) [Mul M] [Mul N] where
  /-- The underlying function -/
  toFun : M → N
  /-- The proposition that the function preserves multiplication -/
  map_mul' : ∀ x y, toFun (x * y) = toFun x * toFun y
#align mul_hom MulHom

/-- `M →ₙ* N` denotes the type of multiplication-preserving maps from `M` to `N`. -/
infixr:25 " →ₙ* " => MulHom

/-- `MulHomClass F M N` states that `F` is a type of multiplication-preserving homomorphisms.

You should declare an instance of this typeclass when you extend `MulHom`.
-/
@[to_additive]
class MulHomClass (F : Type _) (M N : outParam (Type _)) [Mul M] [Mul N]
  extends FunLike F M fun _ => N where
  /-- The proposition that the function preserves multiplication -/
  map_mul : ∀ (f : F) (x y : M), f (x * y) = f x * f y
#align mul_hom_class MulHomClass

/-- `MulHom` is a type of multiplication-preseving homomorphisms -/
@[to_additive "`AddHom` is a type of addition-preserving homomorphisms"]
instance MulHom.mulHomClass : MulHomClass (M →ₙ* N) M N where
  coe := MulHom.toFun
  coe_injective' f g h := by cases f; cases g; congr
  map_mul := MulHom.map_mul'
#align mul_hom.mul_hom_class MulHom.mulHomClass
#align add_hom.add_hom_class AddHom.addHomClass

@[to_additive (attr := simp)]
theorem map_mul [MulHomClass F M N] (f : F) (x y : M) : f (x * y) = f x * f y :=
  MulHomClass.map_mul f x y
#align map_mul map_mul
#align map_add map_add

/-- Turn an element of a type `F` satisfying `MulHomClass F M N` into an actual
`MulHom`. This is declared as the default coercion from `F` to `M →ₙ* N`. -/
@[to_additive (attr := coe)
"Turn an element of a type `F` satisfying `AddHomClass F M N` into an actual
`AddHom`. This is declared as the default coercion from `F` to `M →ₙ+ N`."]
def MulHomClass.toMulHom [MulHomClass F M N] (f : F) : M →ₙ* N where
  toFun := f
  map_mul' := map_mul f

/-- Any type satisfying `MulHomCLass` can be cast into `MulHom` via `MulHomClass.toMulHom`. -/
@[to_additive "Any type satisfying `AddHomClass` can be cast into `AddHom` via
`AddHomClass.toAddHom`."]
instance [MulHomClass F M N] : CoeTC F (M →ₙ* N) :=
  ⟨MulHomClass.toMulHom⟩

@[to_additive (attr := simp)]
theorem MulHom.coe_coe [MulHomClass F M N] (f : F) : ((f : MulHom M N) : M → N) = f := rfl
#align mul_hom.coe_coe MulHom.coe_coe
#align add_hom.coe_coe AddHom.coe_coe

end Mul

section mul_one

variable [MulOneClass M] [MulOneClass N]

/-- `M →* N` is the type of functions `M → N` that preserve the `Monoid` structure.
`MonoidHom` is also used for group homomorphisms.

When possible, instead of parametrizing results over `(f : M →+ N)`,
you should parametrize over `(F : Type _) [MonoidHomClass F M N] (f : F)`.

When you extend this structure, make sure to extend `MonoidHomClass`.
-/
@[to_additive]
structure MonoidHom (M : Type _) (N : Type _) [MulOneClass M] [MulOneClass N] extends
  OneHom M N, M →ₙ* N
#align monoid_hom MonoidHom
-- Porting note: remove once `to_additive` is updated
-- This is waiting on https://github.com/leanprover-community/mathlib4/issues/660
attribute [to_additive existing] MonoidHom.toMulHom

attribute [nolint docBlame] MonoidHom.toMulHom
attribute [nolint docBlame] MonoidHom.toOneHom

/-- `M →* N` denotes the type of monoid homomorphisms from `M` to `N`. -/
infixr:25 " →* " => MonoidHom

/-- `MonoidHomClass F M N` states that `F` is a type of `Monoid`-preserving homomorphisms.
You should also extend this typeclass when you extend `MonoidHom`. -/
@[to_additive]
class MonoidHomClass (F : Type _) (M N : outParam (Type _)) [MulOneClass M] [MulOneClass N]
  extends MulHomClass F M N, OneHomClass F M N
#align monoid_hom_class MonoidHomClass

@[to_additive]
instance MonoidHom.monoidHomClass : MonoidHomClass (M →* N) M N where
  coe f := f.toFun
  coe_injective' f g h := by
    cases f
    cases g
    congr
    apply FunLike.coe_injective'
    exact h
  map_mul := MonoidHom.map_mul'
  map_one f := f.toOneHom.map_one'
#align monoid_hom.monoid_hom_class MonoidHom.monoidHomClass
#align add_monoid_hom.add_monoid_hom_class AddMonoidHom.addMonoidHomClass

-- Porting note: we need to add an extra `to_additive`.
-- This is waiting on https://github.com/leanprover-community/mathlib4/issues/660
attribute [to_additive existing] MonoidHomClass.toOneHomClass

/-- Turn an element of a type `F` satisfying `MonoidHomClass F M N` into an actual
`MonoidHom`. This is declared as the default coercion from `F` to `M →* N`. -/
@[to_additive (attr := coe)
"Turn an element of a type `F` satisfying `AddMonoidHomClass F M N` into an
actual `MonoidHom`. This is declared as the default coercion from `F` to `M →+ N`."]
def MonoidHomClass.toMonoidHom [MonoidHomClass F M N] (f : F) : M →* N :=
{ (f : M →ₙ* N), (f : OneHom M N) with }

/-- Any type satisfying `MonoidHomClass` can be cast into `MonoidHom` via
`MonoidHomClass.toMonoidHom`. -/
@[to_additive "Any type satisfying `AddMonoidHomClass` can be cast into `AddMonoidHom` via
`AddMonoidHomClass.toAddMonoidHom`."]
instance [MonoidHomClass F M N] : CoeTC F (M →* N) :=
  ⟨MonoidHomClass.toMonoidHom⟩

@[to_additive (attr := simp)]
theorem MonoidHom.coe_coe [MonoidHomClass F M N] (f : F) : ((f : M →* N) : M → N) = f := rfl
#align monoid_hom.coe_coe MonoidHom.coe_coe
#align add_monoid_hom.coe_coe AddMonoidHom.coe_coe

@[to_additive]
theorem map_mul_eq_one [MonoidHomClass F M N] (f : F) {a b : M} (h : a * b = 1) : f a * f b = 1 :=
  by rw [← map_mul, h, map_one]
#align map_mul_eq_one map_mul_eq_one
#align map_add_eq_zero map_add_eq_zero

@[to_additive]
theorem map_div' [DivInvMonoid G] [DivInvMonoid H] [MonoidHomClass F G H]
  (f : F) (hf : ∀ a, f a⁻¹ = (f a)⁻¹) (a b : G) : f (a / b) = f a / f b :=
  by rw [div_eq_mul_inv, div_eq_mul_inv, map_mul, hf]
#align map_div' map_div'
#align map_sub' map_sub'

/-- Group homomorphisms preserve inverse. -/
@[to_additive (attr := simp) "Additive group homomorphisms preserve negation."]
theorem map_inv [Group G] [DivisionMonoid H] [MonoidHomClass F G H]
  (f : F) (a : G) : f a⁻¹ = (f a)⁻¹ :=
  eq_inv_of_mul_eq_one_left <| map_mul_eq_one f <| inv_mul_self _
#align map_inv map_inv
#align map_neg map_neg

/-- Group homomorphisms preserve division. -/
@[to_additive "Additive group homomorphisms preserve subtraction."]
theorem map_mul_inv [Group G] [DivisionMonoid H] [MonoidHomClass F G H] (f : F) (a b : G) :
    f (a * b⁻¹) = f a * (f b)⁻¹ := by rw [map_mul, map_inv]
#align map_mul_inv map_mul_inv
#align map_add_neg map_add_neg

/-- Group homomorphisms preserve division. -/
@[to_additive (attr := simp) "Additive group homomorphisms preserve subtraction."]
theorem map_div [Group G] [DivisionMonoid H] [MonoidHomClass F G H] (f : F) :
  ∀ a b, f (a / b) = f a / f b := map_div' _ <| map_inv f
#align map_div map_div
#align map_sub map_sub

@[to_additive (attr := simp) (reorder := 8)]
theorem map_pow [Monoid G] [Monoid H] [MonoidHomClass F G H] (f : F) (a : G) :
  ∀ n : ℕ, f (a ^ n) = f a ^ n
  | 0 => by rw [pow_zero, pow_zero, map_one]
  | n + 1 => by rw [pow_succ, pow_succ, map_mul, map_pow f a n]
#align map_pow map_pow
#align map_nsmul map_nsmul

@[to_additive]
theorem map_zpow' [DivInvMonoid G] [DivInvMonoid H] [MonoidHomClass F G H]
  (f : F) (hf : ∀ x : G, f x⁻¹ = (f x)⁻¹) (a : G) : ∀ n : ℤ, f (a ^ n) = f a ^ n
  | (n : ℕ) => by rw [zpow_ofNat, map_pow, zpow_ofNat]
  | Int.negSucc n => by rw [zpow_negSucc, hf, map_pow, ← zpow_negSucc, ← zpow_negSucc]
#align map_zpow' map_zpow'
#align map_zsmul' map_zsmul'

/-- Group homomorphisms preserve integer power. -/
@[to_additive (attr := simp) (reorder := 8)
"Additive group homomorphisms preserve integer scaling."]
theorem map_zpow [Group G] [DivisionMonoid H] [MonoidHomClass F G H]
  (f : F) (g : G) (n : ℤ) : f (g ^ n) = f g ^ n := map_zpow' f (map_inv f) g n
#align map_zpow map_zpow
#align map_zsmul map_zsmul

end mul_one

section MulZeroOne

variable [MulZeroOneClass M] [MulZeroOneClass N]

/-- `M →*₀ N` is the type of functions `M → N` that preserve
the `MonoidWithZero` structure.

`MonoidWithZeroHom` is also used for group homomorphisms.

When possible, instead of parametrizing results over `(f : M →*₀ N)`,
you should parametrize over `(F : Type _) [MonoidWithZeroHomClass F M N] (f : F)`.

When you extend this structure, make sure to extend `MonoidWithZeroHomClass`.
-/
structure MonoidWithZeroHom (M : Type _) (N : Type _)
  [MulZeroOneClass M] [MulZeroOneClass N] extends ZeroHom M N, MonoidHom M N
#align monoid_with_zero_hom MonoidWithZeroHom

attribute [nolint docBlame] MonoidWithZeroHom.toMonoidHom
attribute [nolint docBlame] MonoidWithZeroHom.toZeroHom

/-- `M →*₀ N` denotes the type of zero-preserving monoid homomorphisms from `M` to `N`. -/
infixr:25 " →*₀ " => MonoidWithZeroHom

/-- `MonoidWithZeroHomClass F M N` states that `F` is a type of
`MonoidWithZero`-preserving homomorphisms.

You should also extend this typeclass when you extend `MonoidWithZeroHom`.
-/
class MonoidWithZeroHomClass (F : Type _) (M N : outParam (Type _)) [MulZeroOneClass M]
  [MulZeroOneClass N] extends MonoidHomClass F M N, ZeroHomClass F M N
#align monoid_with_zero_hom_class MonoidWithZeroHomClass

instance MonoidWithZeroHom.monoidWithZeroHomClass : MonoidWithZeroHomClass (M →*₀ N) M N where
  coe f := f.toFun
  coe_injective' f g h := by
    cases f
    cases g
    congr
    apply FunLike.coe_injective'
    exact h
  map_mul := MonoidWithZeroHom.map_mul'
  map_one := MonoidWithZeroHom.map_one'
  map_zero f := f.map_zero'
#align monoid_with_zero_hom.monoid_with_zero_hom_class MonoidWithZeroHom.monoidWithZeroHomClass

/-- Turn an element of a type `F` satisfying `MonoidWithZeroHomClass F M N` into an actual
`MonoidWithZeroHom`. This is declared as the default coercion from `F` to `M →*₀ N`. -/
@[coe]
def MonoidWithZeroHomClass.toMonoidWithZeroHom [MonoidWithZeroHomClass F M N] (f : F) : M →*₀ N :=
{ (f : M →* N), (f : ZeroHom M N) with }

/-- Any type satisfying `MonoidWithZeroHomClass` can be cast into `MonoidWithZeroHom` via
`MonoidWithZeroHomClass.toMonoidWithZeroHom`. -/
instance [MonoidWithZeroHomClass F M N] : CoeTC F (M →*₀ N) :=
  ⟨MonoidWithZeroHomClass.toMonoidWithZeroHom⟩

@[simp]
theorem MonoidWithZeroHom.coe_coe [MonoidWithZeroHomClass F M N] (f : F) :
  ((f : M →*₀ N) : M → N) = f := rfl
#align monoid_with_zero_hom.coe_coe MonoidWithZeroHom.coe_coe

end MulZeroOne

-- completely uninteresting lemmas about coercion to function, that all homs need
section Coes

/-! Bundled morphisms can be down-cast to weaker bundlings -/

attribute [coe] MonoidHom.toOneHom
attribute [coe] AddMonoidHom.toZeroHom

/-- `MonoidHom` down-cast to a `OneHom`, forgetting the multiplicative property. -/
@[to_additive "`AddMonoidHom` down-cast to a `ZeroHom`, forgetting the additive property"]
instance MonoidHom.coeToOneHom {_ : MulOneClass M} {_ : MulOneClass N} :
  Coe (M →* N) (OneHom M N) := ⟨MonoidHom.toOneHom⟩
#align monoid_hom.has_coe_to_one_hom MonoidHom.coeToOneHom
#align add_monoid_hom.has_coe_to_zero_hom AddMonoidHom.coeToZeroHom

attribute [coe] MonoidHom.toMulHom
attribute [coe] AddMonoidHom.toAddHom

/-- `MonoidHom` down-cast to a `MulHom`, forgetting the 1-preserving property. -/
@[to_additive "`AddMonoidHom` down-cast to an `AddHom`, forgetting the 0-preserving property."]
instance MonoidHom.coeToMulHom {_ : MulOneClass M} {_ : MulOneClass N} :
  Coe (M →* N) (M →ₙ* N) := ⟨MonoidHom.toMulHom⟩
#align monoid_hom.has_coe_to_mul_hom MonoidHom.coeToMulHom
#align add_monoid_hom.has_coe_to_add_hom AddMonoidHom.coeToAddHom

attribute [coe] MonoidWithZeroHom.toMonoidHom

/-- `MonoidWithZeroHom` down-cast to a `MonoidHom`, forgetting the 0-preserving property. -/
instance MonoidWithZeroHom.coeToMonoidHom {_ : MulZeroOneClass M} {_ : MulZeroOneClass N} :
  Coe (M →*₀ N) (M →* N) := ⟨MonoidWithZeroHom.toMonoidHom⟩
#align monoid_with_zero_hom.has_coe_to_monoid_hom MonoidWithZeroHom.coeToMonoidHom

attribute [coe] MonoidWithZeroHom.toZeroHom

/-- `MonoidWithZeroHom` down-cast to a `ZeroHom`, forgetting the monoidal property. -/
instance MonoidWithZeroHom.coeToZeroHom {_ : MulZeroOneClass M} {_ : MulZeroOneClass N} :
  Coe (M →*₀ N) (ZeroHom M N) := ⟨MonoidWithZeroHom.toZeroHom⟩
#align monoid_with_zero_hom.has_coe_to_zero_hom MonoidWithZeroHom.coeToZeroHom

-- these must come after the coe_toFun definitions
initialize_simps_projections ZeroHom (toFun → apply)
initialize_simps_projections AddHom (toFun → apply)
initialize_simps_projections AddMonoidHom (toFun → apply)
initialize_simps_projections OneHom (toFun → apply)
initialize_simps_projections MulHom (toFun → apply)
initialize_simps_projections MonoidHom (toFun → apply)
initialize_simps_projections MonoidWithZeroHom (toFun → apply)

@[to_additive (attr := simp)]
theorem OneHom.coe_mk [One M] [One N] (f : M → N) (h1) : (OneHom.mk f h1 : M → N) = f := rfl
#align one_hom.coe_mk OneHom.coe_mk
#align zero_hom.coe_mk ZeroHom.coe_mk

@[to_additive (attr := simp)]
theorem OneHom.toFun_eq_coe [One M] [One N] (f : OneHom M N) : f.toFun = f := rfl
#align one_hom.to_fun_eq_coe OneHom.toFun_eq_coe
#align zero_hom.to_fun_eq_coe ZeroHom.toFun_eq_coe

@[to_additive (attr := simp)]
theorem MulHom.coe_mk [Mul M] [Mul N] (f : M → N) (hmul) : (MulHom.mk f hmul : M → N) = f := rfl
#align mul_hom.coe_mk MulHom.coe_mk
#align add_hom.coe_mk AddHom.coe_mk

@[to_additive (attr := simp)]
theorem MulHom.toFun_eq_coe [Mul M] [Mul N] (f : M →ₙ* N) : f.toFun = f := rfl
#align mul_hom.to_fun_eq_coe MulHom.toFun_eq_coe
#align add_hom.to_fun_eq_coe AddHom.toFun_eq_coe

@[to_additive (attr := simp)]
theorem MonoidHom.coe_mk [MulOneClass M] [MulOneClass N] (f hmul) :
  (MonoidHom.mk f hmul : M → N) = f := rfl
#align monoid_hom.coe_mk MonoidHom.coe_mk
#align add_monoid_hom.coe_mk AddMonoidHom.coe_mk

@[to_additive (attr := simp)]
theorem MonoidHom.toOneHom_coe [MulOneClass M] [MulOneClass N] (f : M →* N) :
  (f.toOneHom : M → N) = f := rfl
#align monoid_hom.to_one_hom_coe MonoidHom.toOneHom_coe
#align add_monoid_hom.to_zero_hom_coe AddMonoidHom.toZeroHom_coe

@[to_additive (attr := simp)]
theorem MonoidHom.toMulHom_coe [MulOneClass M] [MulOneClass N] (f : M →* N) :
  f.toMulHom.toFun = f := rfl
#align monoid_hom.to_mul_hom_coe MonoidHom.toMulHom_coe
#align add_monoid_hom.to_add_hom_coe AddMonoidHom.toAddHom_coe

@[to_additive]
theorem MonoidHom.toFun_eq_coe [MulOneClass M] [MulOneClass N] (f : M →* N) : f.toFun = f := rfl
#align monoid_hom.to_fun_eq_coe MonoidHom.toFun_eq_coe
#align add_monoid_hom.to_fun_eq_coe AddMonoidHom.toFun_eq_coe

@[simp]
theorem MonoidWithZeroHom.coe_mk [MulZeroOneClass M] [MulZeroOneClass N] (f h1 hmul) :
  (MonoidWithZeroHom.mk f h1 hmul : M → N) = (f : M → N) := rfl
#align monoid_with_zero_hom.coe_mk MonoidWithZeroHom.coe_mk

@[simp]
theorem MonoidWithZeroHom.toZeroHom_coe [MulZeroOneClass M] [MulZeroOneClass N] (f : M →*₀ N) :
  (f.toZeroHom : M → N) = f := rfl
#align monoid_with_zero_hom.to_zero_hom_coe MonoidWithZeroHom.toZeroHom_coe

theorem MonoidWithZeroHom.toMonoidHom_coe [MulZeroOneClass M] [MulZeroOneClass N] (f : M →*₀ N) :
  f.toMonoidHom.toFun = f := rfl
#align monoid_with_zero_hom.to_monoid_hom_coe MonoidWithZeroHom.toMonoidHom_coe

@[to_additive (attr := ext)]
theorem OneHom.ext [One M] [One N] ⦃f g : OneHom M N⦄ (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext _ _ h
#align one_hom.ext OneHom.ext
#align zero_hom.ext ZeroHom.ext

@[to_additive (attr := ext)]
theorem MulHom.ext [Mul M] [Mul N] ⦃f g : M →ₙ* N⦄ (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext _ _ h
#align mul_hom.ext MulHom.ext
#align add_hom.ext AddHom.ext

@[to_additive (attr := ext)]
theorem MonoidHom.ext [MulOneClass M] [MulOneClass N] ⦃f g : M →* N⦄ (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext _ _ h
#align monoid_hom.ext MonoidHom.ext
#align add_monoid_hom.ext AddMonoidHom.ext

@[ext]
theorem MonoidWithZeroHom.ext [MulZeroOneClass M] [MulZeroOneClass N] ⦃f g : M →*₀ N⦄
  (h : ∀ x, f x = g x) : f = g := FunLike.ext _ _ h
#align monoid_with_zero_hom.ext MonoidWithZeroHom.ext

section Deprecated

/-- Deprecated: use `FunLike.congr_fun` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.congr_fun` instead."]
theorem OneHom.congr_fun [One M] [One N] {f g : OneHom M N} (h : f = g) (x : M) : f x = g x :=
  FunLike.congr_fun h x
#align one_hom.congr_fun OneHom.congr_fun
#align zero_hom.congr_fun ZeroHom.congr_fun

/-- Deprecated: use `FunLike.congr_fun` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.congr_fun` instead."]
theorem MulHom.congr_fun [Mul M] [Mul N] {f g : M →ₙ* N} (h : f = g) (x : M) : f x = g x :=
  FunLike.congr_fun h x
#align mul_hom.congr_fun MulHom.congr_fun
#align add_hom.congr_fun AddHom.congr_fun

/-- Deprecated: use `FunLike.congr_fun` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.congr_fun` instead."]
theorem MonoidHom.congr_fun [MulOneClass M] [MulOneClass N] {f g : M →* N} (h : f = g) (x : M) :
  f x = g x := FunLike.congr_fun h x
#align monoid_hom.congr_fun MonoidHom.congr_fun
#align add_monoid_hom.congr_fun AddMonoidHom.congr_fun

/-- Deprecated: use `FunLike.congr_fun` instead. -/
@[deprecated]
theorem MonoidWithZeroHom.congr_fun [MulZeroOneClass M] [MulZeroOneClass N] {f g : M →*₀ N}
  (h : f = g) (x : M) : f x = g x := FunLike.congr_fun h x
#align monoid_with_zero_hom.congr_fun MonoidWithZeroHom.congr_fun

/-- Deprecated: use `FunLike.congr_arg` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.congr_arg` instead."]
theorem OneHom.congr_arg [One M] [One N] (f : OneHom M N) {x y : M} (h : x = y) : f x = f y :=
  FunLike.congr_arg f h
#align one_hom.congr_arg OneHom.congr_arg
#align zero_hom.congr_arg ZeroHom.congr_arg

/-- Deprecated: use `FunLike.congr_arg` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.congr_arg` instead."]
theorem MulHom.congr_arg [Mul M] [Mul N] (f : M →ₙ* N) {x y : M} (h : x = y) : f x = f y :=
  FunLike.congr_arg f h
#align mul_hom.congr_arg MulHom.congr_arg
#align add_hom.congr_arg AddHom.congr_arg

/-- Deprecated: use `FunLike.congr_arg` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.congr_arg` instead."]
theorem MonoidHom.congr_arg [MulOneClass M] [MulOneClass N] (f : M →* N) {x y : M} (h : x = y) :
  f x = f y := FunLike.congr_arg f h
#align monoid_hom.congr_arg MonoidHom.congr_arg
#align add_monoid_hom.congr_arg AddMonoidHom.congr_arg

/-- Deprecated: use `FunLike.congr_arg` instead. -/
@[deprecated]
theorem MonoidWithZeroHom.congr_arg [MulZeroOneClass M] [MulZeroOneClass N] (f : M →*₀ N) {x y : M}
  (h : x = y) : f x = f y := FunLike.congr_arg f h
#align monoid_with_zero_hom.congr_arg MonoidWithZeroHom.congr_arg

/-- Deprecated: use `FunLike.coe_injective` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.coe_injective` instead."]
theorem OneHom.coe_inj [One M] [One N] ⦃f g : OneHom M N⦄ (h : (f : M → N) = g) : f = g :=
  FunLike.coe_injective h
#align one_hom.coe_inj OneHom.coe_inj
#align zero_hom.coe_inj ZeroHom.coe_inj

/-- Deprecated: use `FunLike.coe_injective` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.coe_injective` instead."]
theorem MulHom.coe_inj [Mul M] [Mul N] ⦃f g : M →ₙ* N⦄ (h : (f : M → N) = g) : f = g :=
  FunLike.coe_injective h
#align mul_hom.coe_inj MulHom.coe_inj
#align add_hom.coe_inj AddHom.coe_inj

/-- Deprecated: use `FunLike.coe_injective` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.coe_injective` instead."]
theorem MonoidHom.coe_inj [MulOneClass M] [MulOneClass N] ⦃f g : M →* N⦄ (h : (f : M → N) = g) :
  f = g := FunLike.coe_injective h
#align monoid_hom.coe_inj MonoidHom.coe_inj
#align add_monoid_hom.coe_inj AddMonoidHom.coe_inj

/-- Deprecated: use `FunLike.coe_injective` instead. -/
@[deprecated]
theorem MonoidWithZeroHom.coe_inj [MulZeroOneClass M] [MulZeroOneClass N] ⦃f g : M →*₀ N⦄
  (h : (f : M → N) = g) : f = g := FunLike.coe_injective h
#align monoid_with_zero_hom.coe_inj MonoidWithZeroHom.coe_inj

/-- Deprecated: use `FunLike.ext_iff` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.ext_iff` instead."]
theorem OneHom.ext_iff [One M] [One N] {f g : OneHom M N} : f = g ↔ ∀ x, f x = g x :=
  FunLike.ext_iff
#align one_hom.ext_iff OneHom.ext_iff
#align zero_hom.ext_iff ZeroHom.ext_iff

/-- Deprecated: use `FunLike.ext_iff` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.ext_iff` instead."]
theorem MulHom.ext_iff [Mul M] [Mul N] {f g : M →ₙ* N} : f = g ↔ ∀ x, f x = g x :=
  FunLike.ext_iff
#align mul_hom.ext_iff MulHom.ext_iff
#align add_hom.ext_iff AddHom.ext_iff

/-- Deprecated: use `FunLike.ext_iff` instead. -/
@[to_additive (attr := deprecated) "Deprecated: use `FunLike.ext_iff` instead."]
theorem MonoidHom.ext_iff [MulOneClass M] [MulOneClass N] {f g : M →* N} : f = g ↔ ∀ x, f x = g x :=
  FunLike.ext_iff
#align monoid_hom.ext_iff MonoidHom.ext_iff
#align add_monoid_hom.ext_iff AddMonoidHom.ext_iff

/-- Deprecated: use `FunLike.ext_iff` instead. -/
@[deprecated]
theorem MonoidWithZeroHom.ext_iff [MulZeroOneClass M] [MulZeroOneClass N] {f g : M →*₀ N} :
  f = g ↔ ∀ x, f x = g x := FunLike.ext_iff
#align monoid_with_zero_hom.ext_iff MonoidWithZeroHom.ext_iff

end Deprecated

@[to_additive (attr := simp)]
theorem OneHom.mk_coe [One M] [One N] (f : OneHom M N) (h1) : OneHom.mk f h1 = f :=
  OneHom.ext fun _ => rfl
#align one_hom.mk_coe OneHom.mk_coe
#align zero_hom.mk_coe ZeroHom.mk_coe

@[to_additive (attr := simp)]
theorem MulHom.mk_coe [Mul M] [Mul N] (f : M →ₙ* N) (hmul) : MulHom.mk f hmul = f :=
  MulHom.ext fun _ => rfl
#align mul_hom.mk_coe MulHom.mk_coe
#align add_hom.mk_coe AddHom.mk_coe

@[to_additive (attr := simp)]
theorem MonoidHom.mk_coe [MulOneClass M] [MulOneClass N] (f : M →* N) (hmul) :
  MonoidHom.mk f hmul = f := MonoidHom.ext fun _ => rfl
#align monoid_hom.mk_coe MonoidHom.mk_coe
#align add_monoid_hom.mk_coe AddMonoidHom.mk_coe

@[simp]
theorem MonoidWithZeroHom.mk_coe [MulZeroOneClass M] [MulZeroOneClass N] (f : M →*₀ N) (h1 hmul) :
  MonoidWithZeroHom.mk f h1 hmul = f := MonoidWithZeroHom.ext fun _ => rfl
#align monoid_with_zero_hom.mk_coe MonoidWithZeroHom.mk_coe

end Coes

/-- Copy of a `OneHom` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
@[to_additive
  "Copy of a `ZeroHom` with a new `toFun` equal to the old one. Useful to fix
  definitional equalities."]
protected def OneHom.copy {_ : One M} {_ : One N} (f : OneHom M N) (f' : M → N) (h : f' = f) :
  OneHom M N where
  toFun := f'
  map_one' := h.symm ▸ f.map_one'
#align one_hom.copy OneHom.copy
#align zero_hom.copy ZeroHom.copy

@[to_additive (attr := simp)]
theorem OneHom.coe_copy {_ : One M} {_ : One N} (f : OneHom M N) (f' : M → N) (h : f' = f) :
    (f.copy f' h) = f' :=
  rfl
#align one_hom.coe_copy OneHom.coe_copy
#align zero_hom.coe_copy ZeroHom.coe_copy

@[to_additive]
theorem OneHom.coe_copy_eq {_ : One M} {_ : One N} (f : OneHom M N) (f' : M → N) (h : f' = f) :
    f.copy f' h = f :=
  FunLike.ext' h
#align one_hom.coe_copy_eq OneHom.coe_copy_eq
#align zero_hom.coe_copy_eq ZeroHom.coe_copy_eq

/-- Copy of a `MulHom` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
@[to_additive
  "Copy of an `AddHom` with a new `toFun` equal to the old one. Useful to fix
  definitional equalities."]
protected def MulHom.copy {_ : Mul M} {_ : Mul N} (f : M →ₙ* N) (f' : M → N) (h : f' = f) :
  M →ₙ* N where
  toFun := f'
  map_mul' := h.symm ▸ f.map_mul'
#align mul_hom.copy MulHom.copy
#align add_hom.copy AddHom.copy

@[to_additive (attr := simp)]
theorem MulHom.coe_copy {_ : Mul M} {_ : Mul N} (f : M →ₙ* N) (f' : M → N) (h : f' = f) :
    (f.copy f' h) = f' :=
  rfl
#align mul_hom.coe_copy MulHom.coe_copy
#align add_hom.coe_copy AddHom.coe_copy

@[to_additive]
theorem MulHom.coe_copy_eq {_ : Mul M} {_ : Mul N} (f : M →ₙ* N) (f' : M → N) (h : f' = f) :
    f.copy f' h = f :=
  FunLike.ext' h
#align mul_hom.coe_copy_eq MulHom.coe_copy_eq
#align add_hom.coe_copy_eq AddHom.coe_copy_eq

/-- Copy of a `MonoidHom` with a new `toFun` equal to the old one. Useful to fix
definitional equalities. -/
@[to_additive
  "Copy of an `AddMonoidHom` with a new `toFun` equal to the old one. Useful to fix
  definitional equalities."]
protected def MonoidHom.copy {_ : MulOneClass M} {_ : MulOneClass N} (f : M →* N) (f' : M → N)
  (h : f' = f) : M →* N :=
  { f.toOneHom.copy f' h, f.toMulHom.copy f' h with }
#align monoid_hom.copy MonoidHom.copy
#align add_monoid_hom.copy AddMonoidHom.copy

@[to_additive (attr := simp)]
theorem MonoidHom.coe_copy {_ : MulOneClass M} {_ : MulOneClass N} (f : M →* N) (f' : M → N)
    (h : f' = f) : (f.copy f' h) = f' :=
  rfl
#align monoid_hom.coe_copy MonoidHom.coe_copy
#align add_monoid_hom.coe_copy AddMonoidHom.coe_copy

@[to_additive]
theorem MonoidHom.copy_eq {_ : MulOneClass M} {_ : MulOneClass N} (f : M →* N) (f' : M → N)
    (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align monoid_hom.copy_eq MonoidHom.copy_eq
#align add_monoid_hom.copy_eq AddMonoidHom.copy_eq

/-- Copy of a `MonoidHom` with a new `toFun` equal to the old one. Useful to fix
definitional equalities. -/
protected def MonoidWithZeroHom.copy {_ : MulZeroOneClass M} {_ : MulZeroOneClass N} (f : M →*₀ N)
  (f' : M → N) (h : f' = f) : M →* N :=
  { f.toZeroHom.copy f' h, f.toMonoidHom.copy f' h with }
#align monoid_with_zero_hom.copy MonoidWithZeroHom.copy

@[simp]
theorem MonoidWithZeroHom.coe_copy {_ : MulZeroOneClass M} {_ : MulZeroOneClass N} (f : M →*₀ N)
    (f' : M → N) (h : f' = f) : (f.copy f' h) = f' :=
  rfl
#align monoid_with_zero_hom.coe_copy MonoidWithZeroHom.coe_copy

theorem MonoidWithZeroHom.copy_eq {_ : MulZeroOneClass M} {_ : MulZeroOneClass N} (f : M →*₀ N)
    (f' : M → N) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align monoid_with_zero_hom.copy_eq MonoidWithZeroHom.copy_eq

@[to_additive]
protected theorem OneHom.map_one [One M] [One N] (f : OneHom M N) : f 1 = 1 :=
  f.map_one'
#align one_hom.map_one OneHom.map_one
#align zero_hom.map_zero ZeroHom.map_zero

/-- If `f` is a monoid homomorphism then `f 1 = 1`. -/
@[to_additive]
protected theorem MonoidHom.map_one [MulOneClass M] [MulOneClass N] (f : M →* N) : f 1 = 1 :=
  f.map_one'
#align monoid_hom.map_one MonoidHom.map_one
#align add_monoid_hom.map_zero AddMonoidHom.map_zero

protected theorem MonoidWithZeroHom.map_one [MulZeroOneClass M] [MulZeroOneClass N] (f : M →*₀ N) :
  f 1 = 1 := f.map_one'
#align monoid_with_zero_hom.map_one MonoidWithZeroHom.map_one

/-- If `f` is an additive monoid homomorphism then `f 0 = 0`. -/
add_decl_doc AddMonoidHom.map_zero

protected theorem MonoidWithZeroHom.map_zero [MulZeroOneClass M] [MulZeroOneClass N] (f : M →*₀ N) :
  f 0 = 0 := f.map_zero'
#align monoid_with_zero_hom.map_zero MonoidWithZeroHom.map_zero

@[to_additive]
protected theorem MulHom.map_mul [Mul M] [Mul N] (f : M →ₙ* N) (a b : M) : f (a * b) = f a * f b :=
  f.map_mul' a b
#align mul_hom.map_mul MulHom.map_mul
#align add_hom.map_add AddHom.map_add

/-- If `f` is a monoid homomorphism then `f (a * b) = f a * f b`. -/
@[to_additive]
protected theorem MonoidHom.map_mul [MulOneClass M] [MulOneClass N] (f : M →* N) (a b : M) :
  f (a * b) = f a * f b := f.map_mul' a b
#align monoid_hom.map_mul MonoidHom.map_mul
#align add_monoid_hom.map_add AddMonoidHom.map_add

protected theorem MonoidWithZeroHom.map_mul [MulZeroOneClass M] [MulZeroOneClass N] (f : M →*₀ N)
  (a b : M) : f (a * b) = f a * f b := f.map_mul' a b
#align monoid_with_zero_hom.map_mul MonoidWithZeroHom.map_mul

/-- If `f` is an additive monoid homomorphism then `f (a + b) = f a + f b`. -/
add_decl_doc AddMonoidHom.map_add

namespace MonoidHom

variable {_ : MulOneClass M} {_ : MulOneClass N} [MonoidHomClass F M N]

/-- Given a monoid homomorphism `f : M →* N` and an element `x : M`, if `x` has a right inverse,
then `f x` has a right inverse too. For elements invertible on both sides see `IsUnit.map`. -/
@[to_additive
  "Given an AddMonoid homomorphism `f : M →+ N` and an element `x : M`, if `x` has
  a right inverse, then `f x` has a right inverse too."]
theorem map_exists_right_inv (f : F) {x : M} (hx : ∃ y, x * y = 1) : ∃ y, f x * y = 1 :=
  let ⟨y, hy⟩ := hx
  ⟨f y, map_mul_eq_one f hy⟩
#align monoid_hom.map_exists_right_inv MonoidHom.map_exists_right_inv
#align add_monoid_hom.map_exists_right_neg AddMonoidHom.map_exists_right_neg

/-- Given a monoid homomorphism `f : M →* N` and an element `x : M`, if `x` has a left inverse,
then `f x` has a left inverse too. For elements invertible on both sides see `IsUnit.map`. -/
@[to_additive
  "Given an AddMonoid homomorphism `f : M →+ N` and an element `x : M`, if `x` has
  a left inverse, then `f x` has a left inverse too. For elements invertible on both sides see
  `IsAddUnit.map`."]
theorem map_exists_left_inv (f : F) {x : M} (hx : ∃ y, y * x = 1) : ∃ y, y * f x = 1 :=
  let ⟨y, hy⟩ := hx
  ⟨f y, map_mul_eq_one f hy⟩
#align monoid_hom.map_exists_left_inv MonoidHom.map_exists_left_inv
#align add_monoid_hom.map_exists_left_neg AddMonoidHom.map_exists_left_neg

end MonoidHom

section DivisionCommMonoid

variable [DivisionCommMonoid α]

/-- Inversion on a commutative group, considered as a monoid homomorphism. -/
@[to_additive "Negation on a commutative additive group, considered as an additive monoid
homomorphism."]
def invMonoidHom : α →* α where
  toFun := Inv.inv
  map_one' := inv_one
  map_mul' := mul_inv
#align inv_monoid_hom invMonoidHom
#align neg_add_monoid_hom negAddMonoidHom

@[simp]
theorem coe_invMonoidHom : (invMonoidHom : α → α) = Inv.inv := rfl
#align coe_inv_monoid_hom coe_invMonoidHom

@[simp]
theorem invMonoidHom_apply (a : α) : invMonoidHom a = a⁻¹ := rfl
#align inv_monoid_hom_apply invMonoidHom_apply

end DivisionCommMonoid

/-- The identity map from a type with 1 to itself. -/
@[to_additive (attr := simps)]
def OneHom.id (M : Type _) [One M] : OneHom M M where
  toFun x := x
  map_one' := rfl
#align one_hom.id OneHom.id
#align zero_hom.id ZeroHom.id
#align zero_hom.id_apply ZeroHom.id_apply
#align one_hom.id_apply OneHom.id_apply

/-- The identity map from a type with multiplication to itself. -/
@[to_additive (attr := simps)]
def MulHom.id (M : Type _) [Mul M] : M →ₙ* M where
  toFun x := x
  map_mul' _ _ := rfl
#align mul_hom.id MulHom.id
#align add_hom.id AddHom.id
#align add_hom.id_apply AddHom.id_apply
#align mul_hom.id_apply MulHom.id_apply

/-- The identity map from a monoid to itself. -/
@[to_additive (attr := simps)]
def MonoidHom.id (M : Type _) [MulOneClass M] : M →* M where
  toFun x := x
  map_one' := rfl
  map_mul' _ _ := rfl
#align monoid_hom.id MonoidHom.id
#align add_monoid_hom.id AddMonoidHom.id
#align monoid_hom.id_apply MonoidHom.id_apply
#align add_monoid_hom.id_apply AddMonoidHom.id_apply

/-- The identity map from a `MonoidWithZero` to itself. -/
@[simps]
def MonoidWithZeroHom.id (M : Type _) [MulZeroOneClass M] : M →*₀ M where
  toFun x := x
  map_zero' := rfl
  map_one' := rfl
  map_mul' _ _ := rfl
#align monoid_with_zero_hom.id MonoidWithZeroHom.id
#align monoid_with_zero_hom.id_apply MonoidWithZeroHom.id_apply

/-- The identity map from an type with zero to itself. -/
add_decl_doc ZeroHom.id

/-- The identity map from an type with addition to itself. -/
add_decl_doc AddHom.id

/-- The identity map from an additive monoid to itself. -/
add_decl_doc AddMonoidHom.id

/-- Composition of `OneHom`s as a `OneHom`. -/
@[to_additive]
def OneHom.comp [One M] [One N] [One P] (hnp : OneHom N P) (hmn : OneHom M N) : OneHom M P where
  toFun := hnp ∘ hmn
  map_one' := by simp
#align one_hom.comp OneHom.comp
#align zero_hom.comp ZeroHom.comp

/-- Composition of `MulHom`s as a `MulHom`. -/
@[to_additive]
def MulHom.comp [Mul M] [Mul N] [Mul P] (hnp : N →ₙ* P) (hmn : M →ₙ* N) : M →ₙ* P where
  toFun := hnp ∘ hmn
  map_mul' x y := by simp
#align mul_hom.comp MulHom.comp
#align add_hom.comp AddHom.comp

/-- Composition of monoid morphisms as a monoid morphism. -/
@[to_additive]
def MonoidHom.comp [MulOneClass M] [MulOneClass N] [MulOneClass P] (hnp : N →* P) (hmn : M →* N) :
  M →* P where
  toFun := hnp ∘ hmn
  map_one' := by simp
  map_mul' := by simp
#align monoid_hom.comp MonoidHom.comp
#align add_monoid_hom.comp AddMonoidHom.comp

/-- Composition of `MonoidWithZeroHom`s as a `MonoidWithZeroHom`. -/
def MonoidWithZeroHom.comp [MulZeroOneClass M] [MulZeroOneClass N] [MulZeroOneClass P]
  (hnp : N →*₀ P) (hmn : M →*₀ N) : M →*₀ P where
  toFun := hnp ∘ hmn
  map_zero' := by rw [Function.comp_apply, map_zero, map_zero]
  map_one' := by simp
  map_mul' := by simp
#align monoid_with_zero_hom.comp MonoidWithZeroHom.comp

/-- Composition of `ZeroHom`s as a `ZeroHom`. -/
add_decl_doc ZeroHom.comp

/-- Composition of `AddHom`s as a `AddHom`. -/
add_decl_doc AddHom.comp

/-- Composition of additive monoid morphisms as an additive monoid morphism. -/
add_decl_doc AddMonoidHom.comp

@[to_additive (attr := simp)]
theorem OneHom.coe_comp [One M] [One N] [One P] (g : OneHom N P) (f : OneHom M N) :
  ↑(g.comp f) = g ∘ f := rfl
#align one_hom.coe_comp OneHom.coe_comp
#align zero_hom.coe_comp ZeroHom.coe_comp

@[to_additive (attr := simp)]
theorem MulHom.coe_comp [Mul M] [Mul N] [Mul P] (g : N →ₙ* P) (f : M →ₙ* N) :
  ↑(g.comp f) = g ∘ f := rfl
#align mul_hom.coe_comp MulHom.coe_comp
#align add_hom.coe_comp AddHom.coe_comp

@[to_additive (attr := simp)]
theorem MonoidHom.coe_comp [MulOneClass M] [MulOneClass N] [MulOneClass P]
  (g : N →* P) (f : M →* N) : ↑(g.comp f) = g ∘ f := rfl
#align monoid_hom.coe_comp MonoidHom.coe_comp
#align add_monoid_hom.coe_comp AddMonoidHom.coe_comp

@[simp]
theorem MonoidWithZeroHom.coe_comp [MulZeroOneClass M] [MulZeroOneClass N] [MulZeroOneClass P]
  (g : N →*₀ P) (f : M →*₀ N) : ↑(g.comp f) = g ∘ f := rfl
#align monoid_with_zero_hom.coe_comp MonoidWithZeroHom.coe_comp

@[to_additive]
theorem OneHom.comp_apply [One M] [One N] [One P] (g : OneHom N P) (f : OneHom M N) (x : M) :
  g.comp f x = g (f x) := rfl
#align one_hom.comp_apply OneHom.comp_apply
#align zero_hom.comp_apply ZeroHom.comp_apply

@[to_additive]
theorem MulHom.comp_apply [Mul M] [Mul N] [Mul P] (g : N →ₙ* P) (f : M →ₙ* N) (x : M) :
  g.comp f x = g (f x) := rfl
#align mul_hom.comp_apply MulHom.comp_apply
#align add_hom.comp_apply AddHom.comp_apply

@[to_additive]
theorem MonoidHom.comp_apply [MulOneClass M] [MulOneClass N] [MulOneClass P]
  (g : N →* P) (f : M →* N) (x : M) : g.comp f x = g (f x) := rfl
#align monoid_hom.comp_apply MonoidHom.comp_apply
#align add_monoid_hom.comp_apply AddMonoidHom.comp_apply

theorem MonoidWithZeroHom.comp_apply [MulZeroOneClass M] [MulZeroOneClass N] [MulZeroOneClass P]
  (g : N →*₀ P) (f : M →*₀ N) (x : M) : g.comp f x = g (f x) := rfl
#align monoid_with_zero_hom.comp_apply MonoidWithZeroHom.comp_apply

/-- Composition of monoid homomorphisms is associative. -/
@[to_additive "Composition of additive monoid homomorphisms is associative."]
theorem OneHom.comp_assoc {Q : Type _} [One M] [One N] [One P] [One Q]
  (f : OneHom M N) (g : OneHom N P) (h : OneHom P Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl
#align one_hom.comp_assoc OneHom.comp_assoc
#align zero_hom.comp_assoc ZeroHom.comp_assoc

@[to_additive]
theorem MulHom.comp_assoc {Q : Type _} [Mul M] [Mul N] [Mul P] [Mul Q]
  (f : M →ₙ* N) (g : N →ₙ* P) (h : P →ₙ* Q) : (h.comp g).comp f = h.comp (g.comp f) := rfl
#align mul_hom.comp_assoc MulHom.comp_assoc
#align add_hom.comp_assoc AddHom.comp_assoc

@[to_additive]
theorem MonoidHom.comp_assoc {Q : Type _} [MulOneClass M] [MulOneClass N] [MulOneClass P]
  [MulOneClass Q] (f : M →* N) (g : N →* P) (h : P →* Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl
#align monoid_hom.comp_assoc MonoidHom.comp_assoc
#align add_monoid_hom.comp_assoc AddMonoidHom.comp_assoc

theorem MonoidWithZeroHom.comp_assoc {Q : Type _} [MulZeroOneClass M] [MulZeroOneClass N]
  [MulZeroOneClass P] [MulZeroOneClass Q] (f : M →*₀ N) (g : N →*₀ P) (h : P →*₀ Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl
#align monoid_with_zero_hom.comp_assoc MonoidWithZeroHom.comp_assoc

@[to_additive]
theorem OneHom.cancel_right [One M] [One N] [One P] {g₁ g₂ : OneHom N P} {f : OneHom M N}
  (hf : Function.Surjective f) : g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => OneHom.ext <| hf.forall.2 (FunLike.ext_iff.1 h), fun h => h ▸ rfl⟩
#align one_hom.cancel_right OneHom.cancel_right
#align zero_hom.cancel_right ZeroHom.cancel_right

@[to_additive]
theorem MulHom.cancel_right [Mul M] [Mul N] [Mul P] {g₁ g₂ : N →ₙ* P} {f : M →ₙ* N}
  (hf : Function.Surjective f) : g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => MulHom.ext <| hf.forall.2 (FunLike.ext_iff.1 h), fun h => h ▸ rfl⟩
#align mul_hom.cancel_right MulHom.cancel_right
#align add_hom.cancel_right AddHom.cancel_right

@[to_additive]
theorem MonoidHom.cancel_right [MulOneClass M] [MulOneClass N] [MulOneClass P]
  {g₁ g₂ : N →* P} {f : M →* N} (hf : Function.Surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => MonoidHom.ext <| hf.forall.2 (FunLike.ext_iff.1 h), fun h => h ▸ rfl⟩
#align monoid_hom.cancel_right MonoidHom.cancel_right
#align add_monoid_hom.cancel_right AddMonoidHom.cancel_right

theorem MonoidWithZeroHom.cancel_right [MulZeroOneClass M] [MulZeroOneClass N] [MulZeroOneClass P]
  {g₁ g₂ : N →*₀ P} {f : M →*₀ N} (hf : Function.Surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => MonoidWithZeroHom.ext <| hf.forall.2 (FunLike.ext_iff.1 h), fun h => h ▸ rfl⟩
#align monoid_with_zero_hom.cancel_right MonoidWithZeroHom.cancel_right

@[to_additive]
theorem OneHom.cancel_left [One M] [One N] [One P] {g : OneHom N P} {f₁ f₂ : OneHom M N}
  (hg : Function.Injective g) : g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => OneHom.ext fun x => hg <| by rw [← OneHom.comp_apply, h, OneHom.comp_apply],
    fun h => h ▸ rfl⟩
#align one_hom.cancel_left OneHom.cancel_left
#align zero_hom.cancel_left ZeroHom.cancel_left

@[to_additive]
theorem MulHom.cancel_left [Mul M] [Mul N] [Mul P] {g : N →ₙ* P} {f₁ f₂ : M →ₙ* N}
  (hg : Function.Injective g) : g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => MulHom.ext fun x => hg <| by rw [← MulHom.comp_apply, h, MulHom.comp_apply],
    fun h => h ▸ rfl⟩
#align mul_hom.cancel_left MulHom.cancel_left
#align add_hom.cancel_left AddHom.cancel_left

@[to_additive]
theorem MonoidHom.cancel_left [MulOneClass M] [MulOneClass N] [MulOneClass P]
  {g : N →* P} {f₁ f₂ : M →* N} (hg : Function.Injective g) : g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => MonoidHom.ext fun x => hg <| by rw [← MonoidHom.comp_apply, h, MonoidHom.comp_apply],
    fun h => h ▸ rfl⟩
#align monoid_hom.cancel_left MonoidHom.cancel_left
#align add_monoid_hom.cancel_left AddMonoidHom.cancel_left

theorem MonoidWithZeroHom.cancel_left [MulZeroOneClass M] [MulZeroOneClass N] [MulZeroOneClass P]
  {g : N →*₀ P} {f₁ f₂ : M →*₀ N} (hg : Function.Injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h =>
    MonoidWithZeroHom.ext fun x => hg <| by rw [← MonoidWithZeroHom.comp_apply, h,
    MonoidWithZeroHom.comp_apply], fun h => h ▸ rfl⟩
#align monoid_with_zero_hom.cancel_left MonoidWithZeroHom.cancel_left

set_option linter.deprecated false in
section

@[to_additive]
theorem MonoidHom.toOneHom_injective [MulOneClass M] [MulOneClass N] :
  Function.Injective (MonoidHom.toOneHom : (M →* N) → OneHom M N) :=
  fun _ _ h => MonoidHom.ext <| OneHom.ext_iff.mp h
#align monoid_hom.to_one_hom_injective MonoidHom.toOneHom_injective
#align add_monoid_hom.to_zero_hom_injective AddMonoidHom.toZeroHom_injective

@[to_additive]
theorem MonoidHom.toMulHom_injective [MulOneClass M] [MulOneClass N] :
  Function.Injective (MonoidHom.toMulHom : (M →* N) → M →ₙ* N) :=
  fun _ _ h => MonoidHom.ext <| MulHom.ext_iff.mp h
#align monoid_hom.to_mul_hom_injective MonoidHom.toMulHom_injective
#align add_monoid_hom.to_add_hom_injective AddMonoidHom.toAddHom_injective

theorem MonoidWithZeroHom.toMonoidHom_injective [MulZeroOneClass M] [MulZeroOneClass N] :
  Function.Injective (MonoidWithZeroHom.toMonoidHom : (M →*₀ N) → M →* N) :=
  fun _ _ h => MonoidWithZeroHom.ext <| MonoidHom.ext_iff.mp h
#align monoid_with_zero_hom.to_monoid_hom_injective MonoidWithZeroHom.toMonoidHom_injective

end

theorem MonoidWithZeroHom.toZeroHom_injective [MulZeroOneClass M] [MulZeroOneClass N] :
  Function.Injective (MonoidWithZeroHom.toZeroHom : (M →*₀ N) → ZeroHom M N) :=
  fun _ _ h => MonoidWithZeroHom.ext <| (FunLike.ext_iff (F := ZeroHom M N)).mp h
#align monoid_with_zero_hom.to_zero_hom_injective MonoidWithZeroHom.toZeroHom_injective

@[to_additive (attr := simp)]
theorem OneHom.comp_id [One M] [One N] (f : OneHom M N) : f.comp (OneHom.id M) = f :=
  OneHom.ext fun _ => rfl
#align one_hom.comp_id OneHom.comp_id
#align zero_hom.comp_id ZeroHom.comp_id

@[to_additive (attr := simp)]
theorem MulHom.comp_id [Mul M] [Mul N] (f : M →ₙ* N) : f.comp (MulHom.id M) = f :=
  MulHom.ext fun _ => rfl
#align mul_hom.comp_id MulHom.comp_id
#align add_hom.comp_id AddHom.comp_id

@[to_additive (attr := simp)]
theorem MonoidHom.comp_id [MulOneClass M] [MulOneClass N] (f : M →* N) :
  f.comp (MonoidHom.id M) = f := MonoidHom.ext fun _ => rfl
#align monoid_hom.comp_id MonoidHom.comp_id
#align add_monoid_hom.comp_id AddMonoidHom.comp_id

@[simp]
theorem MonoidWithZeroHom.comp_id [MulZeroOneClass M] [MulZeroOneClass N] (f : M →*₀ N) :
  f.comp (MonoidWithZeroHom.id M) = f := MonoidWithZeroHom.ext fun _ => rfl
#align monoid_with_zero_hom.comp_id MonoidWithZeroHom.comp_id

@[to_additive (attr := simp)]
theorem OneHom.id_comp [One M] [One N] (f : OneHom M N) : (OneHom.id N).comp f = f :=
  OneHom.ext fun _ => rfl
#align one_hom.id_comp OneHom.id_comp
#align zero_hom.id_comp ZeroHom.id_comp

@[to_additive (attr := simp)]
theorem MulHom.id_comp [Mul M] [Mul N] (f : M →ₙ* N) : (MulHom.id N).comp f = f :=
  MulHom.ext fun _ => rfl
#align mul_hom.id_comp MulHom.id_comp
#align add_hom.id_comp AddHom.id_comp

@[to_additive (attr := simp)]
theorem MonoidHom.id_comp [MulOneClass M] [MulOneClass N] (f : M →* N) :
  (MonoidHom.id N).comp f = f := MonoidHom.ext fun _ => rfl
#align monoid_hom.id_comp MonoidHom.id_comp
#align add_monoid_hom.id_comp AddMonoidHom.id_comp

@[simp]
theorem MonoidWithZeroHom.id_comp [MulZeroOneClass M] [MulZeroOneClass N] (f : M →*₀ N) :
  (MonoidWithZeroHom.id N).comp f = f := MonoidWithZeroHom.ext fun _ => rfl
#align monoid_with_zero_hom.id_comp MonoidWithZeroHom.id_comp

@[to_additive]
protected theorem MonoidHom.map_pow [Monoid M] [Monoid N] (f : M →* N) (a : M) (n : ℕ) :
  f (a ^ n) = f a ^ n := map_pow f a n
#align monoid_hom.map_pow MonoidHom.map_pow
#align add_monoid_hom.map_nsmul AddMonoidHom.map_nsmul

@[to_additive]
protected theorem MonoidHom.map_zpow' [DivInvMonoid M] [DivInvMonoid N] (f : M →* N)
  (hf : ∀ x, f x⁻¹ = (f x)⁻¹) (a : M) (n : ℤ) :
  f (a ^ n) = f a ^ n := map_zpow' f hf a n
#align monoid_hom.map_zpow' MonoidHom.map_zpow'
#align add_monoid_hom.map_zsmul' AddMonoidHom.map_zsmul'

section End

namespace Monoid

variable (M) [MulOneClass M]

/-- The monoid of endomorphisms. -/
protected def End := M →* M
#align monoid.End Monoid.End

namespace End

instance : Monoid (Monoid.End M) where
  mul := MonoidHom.comp
  one := MonoidHom.id M
  mul_assoc _ _ _ := MonoidHom.comp_assoc _ _ _
  mul_one := MonoidHom.comp_id
  one_mul := MonoidHom.id_comp

instance : Inhabited (Monoid.End M) := ⟨1⟩

instance : MonoidHomClass (Monoid.End M) M M := MonoidHom.monoidHomClass

end End

@[simp]
theorem coe_one : ((1 : Monoid.End M) : M → M) = id := rfl
#align monoid.coe_one Monoid.coe_one

@[simp]
theorem coe_mul (f g) : ((f * g : Monoid.End M) : M → M) = f ∘ g := rfl
#align monoid.coe_mul Monoid.coe_mul

end Monoid

namespace AddMonoid

variable (A : Type _) [AddZeroClass A]

/-- The monoid of endomorphisms. -/
protected def End := A →+ A
#align add_monoid.End AddMonoid.End

namespace End

instance monoid : Monoid (AddMonoid.End A) where
  mul := AddMonoidHom.comp
  one := AddMonoidHom.id A
  mul_assoc _ _ _ := AddMonoidHom.comp_assoc _ _ _
  mul_one := AddMonoidHom.comp_id
  one_mul := AddMonoidHom.id_comp

instance : Inhabited (AddMonoid.End A) := ⟨1⟩

instance : AddMonoidHomClass (AddMonoid.End A) A A := AddMonoidHom.addMonoidHomClass

end End

@[simp]
theorem coe_one : ((1 : AddMonoid.End A) : A → A) = id := rfl
#align add_monoid.coe_one AddMonoid.coe_one

@[simp]
theorem coe_mul (f g) : ((f * g : AddMonoid.End A) : A → A) = f ∘ g := rfl
#align add_monoid.coe_mul AddMonoid.coe_mul

end AddMonoid

end End

/-- `1` is the homomorphism sending all elements to `1`. -/
@[to_additive]
instance [One M] [One N] : One (OneHom M N) := ⟨⟨fun _ => 1, rfl⟩⟩

/-- `1` is the multiplicative homomorphism sending all elements to `1`. -/
@[to_additive]
instance [Mul M] [MulOneClass N] : One (M →ₙ* N) :=
  ⟨⟨fun _ => 1, fun _ _ => (one_mul 1).symm⟩⟩

/-- `1` is the monoid homomorphism sending all elements to `1`. -/
@[to_additive]
instance [MulOneClass M] [MulOneClass N] : One (M →* N) :=
  ⟨⟨⟨fun _ => 1, rfl⟩, fun _ _ => (one_mul 1).symm⟩⟩

/-- `0` is the homomorphism sending all elements to `0`. -/
add_decl_doc instZeroZeroHom

/-- `0` is the additive homomorphism sending all elements to `0`. -/
add_decl_doc instZeroAddHomToAdd

/-- `0` is the additive monoid homomorphism sending all elements to `0`. -/
add_decl_doc instZeroAddMonoidHom

@[to_additive (attr := simp)]
theorem OneHom.one_apply [One M] [One N] (x : M) : (1 : OneHom M N) x = 1 := rfl
#align one_hom.one_apply OneHom.one_apply
#align zero_hom.zero_apply ZeroHom.zero_apply

@[to_additive (attr := simp)]
theorem MonoidHom.one_apply [MulOneClass M] [MulOneClass N] (x : M) : (1 : M →* N) x = 1 := rfl
#align monoid_hom.one_apply MonoidHom.one_apply
#align add_monoid_hom.zero_apply AddMonoidHom.zero_apply

@[to_additive (attr := simp)]
theorem OneHom.one_comp [One M] [One N] [One P] (f : OneHom M N) :
  (1 : OneHom N P).comp f = 1 := rfl
#align one_hom.one_comp OneHom.one_comp
#align zero_hom.zero_comp ZeroHom.zero_comp

@[to_additive (attr := simp)]
theorem OneHom.comp_one [One M] [One N] [One P] (f : OneHom N P) : f.comp (1 : OneHom M N) = 1 := by
  ext
  simp only [OneHom.map_one, OneHom.coe_comp, Function.comp_apply, OneHom.one_apply]
#align one_hom.comp_one OneHom.comp_one
#align zero_hom.comp_zero ZeroHom.comp_zero

@[to_additive]
instance [One M] [One N] : Inhabited (OneHom M N) := ⟨1⟩

attribute [nolint docBlame] instInhabitedOneHom
attribute [nolint docBlame] instInhabitedZeroHom

@[to_additive]
instance [Mul M] [MulOneClass N] : Inhabited (M →ₙ* N) := ⟨1⟩

@[to_additive]
instance [MulOneClass M] [MulOneClass N] : Inhabited (M →* N) := ⟨1⟩

attribute [nolint docBlame] instInhabitedAddHomToAdd
attribute [nolint docBlame] instInhabitedMonoidHom
attribute [nolint docBlame] instInhabitedAddMonoidHom

-- unlike the other homs, `MonoidWithZeroHom` does not have a `1` or `0`
instance [MulZeroOneClass M] : Inhabited (M →*₀ M) := ⟨MonoidWithZeroHom.id M⟩

namespace MulHom

/-- Given two mul morphisms `f`, `g` to a commutative semigroup, `f * g` is the mul morphism
sending `x` to `f x * g x`. -/
@[to_additive]
instance [Mul M] [CommSemigroup N] : Mul (M →ₙ* N) :=
  ⟨fun f g =>
    { toFun := fun m => f m * g m,
      map_mul' := fun x y => by
        intros
        show f (x * y) * g (x * y) = f x * g x * (f y * g y)
        rw [f.map_mul, g.map_mul, ← mul_assoc, ← mul_assoc, mul_right_comm (f x)] }⟩

/-- Given two additive morphisms `f`, `g` to an additive commutative semigroup, `f + g` is the
additive morphism sending `x` to `f x + g x`. -/
add_decl_doc AddHom.instAddAddHomToAddToAddSemigroup

@[to_additive (attr := simp)]
theorem mul_apply {M N} {_ : Mul M} {_ : CommSemigroup N} (f g : M →ₙ* N) (x : M) :
  (f * g) x = f x * g x := rfl
#align mul_hom.mul_apply MulHom.mul_apply
#align add_hom.add_apply AddHom.add_apply

@[to_additive]
theorem mul_comp [Mul M] [Mul N] [CommSemigroup P] (g₁ g₂ : N →ₙ* P) (f : M →ₙ* N) :
  (g₁ * g₂).comp f = g₁.comp f * g₂.comp f := rfl
#align mul_hom.mul_comp MulHom.mul_comp
#align add_hom.add_comp AddHom.add_comp

@[to_additive]
theorem comp_mul [Mul M] [CommSemigroup N] [CommSemigroup P] (g : N →ₙ* P) (f₁ f₂ : M →ₙ* N) :
  g.comp (f₁ * f₂) = g.comp f₁ * g.comp f₂ := by
  ext
  simp only [mul_apply, Function.comp_apply, map_mul, coe_comp]
#align mul_hom.comp_mul MulHom.comp_mul
#align add_hom.comp_add AddHom.comp_add

end MulHom

namespace MonoidHom

variable [Group G] [CommGroup H]

/-- Given two monoid morphisms `f`, `g` to a commutative monoid, `f * g` is the monoid morphism
sending `x` to `f x * g x`. -/
@[to_additive]
instance mul {M N} {_ : MulOneClass M} [CommMonoid N] : Mul (M →* N) :=
  ⟨fun f g =>
    { toFun := fun m => f m * g m,
      map_one' := show f 1 * g 1 = 1 by simp,
      map_mul' := fun x y => by
        intros
        show f (x * y) * g (x * y) = f x * g x * (f y * g y)
        rw [f.map_mul, g.map_mul, ← mul_assoc, ← mul_assoc, mul_right_comm (f x)] }⟩

/-- Given two additive monoid morphisms `f`, `g` to an additive commutative monoid,
`f + g` is the additive monoid morphism sending `x` to `f x + g x`. -/
add_decl_doc AddMonoidHom.add

@[to_additive (attr := simp)]
theorem mul_apply {M N} {_ : MulOneClass M} {_ : CommMonoid N} (f g : M →* N) (x : M) :
  (f * g) x = f x * g x := rfl
#align monoid_hom.mul_apply MonoidHom.mul_apply
#align add_monoid_hom.add_apply AddMonoidHom.add_apply

@[to_additive (attr := simp)]
theorem one_comp [MulOneClass M] [MulOneClass N] [MulOneClass P] (f : M →* N) :
  (1 : N →* P).comp f = 1 := rfl
#align monoid_hom.one_comp MonoidHom.one_comp
#align add_monoid_hom.zero_comp AddMonoidHom.zero_comp

@[to_additive (attr := simp)]
theorem comp_one [MulOneClass M] [MulOneClass N] [MulOneClass P] (f : N →* P) :
  f.comp (1 : M →* N) = 1 := by
  ext
  simp only [map_one, coe_comp, Function.comp_apply, one_apply]
#align monoid_hom.comp_one MonoidHom.comp_one
#align add_monoid_hom.comp_zero AddMonoidHom.comp_zero

@[to_additive]
theorem mul_comp [MulOneClass M] [MulOneClass N] [CommMonoid P] (g₁ g₂ : N →* P) (f : M →* N) :
  (g₁ * g₂).comp f = g₁.comp f * g₂.comp f := rfl
#align monoid_hom.mul_comp MonoidHom.mul_comp
#align add_monoid_hom.add_comp AddMonoidHom.add_comp

@[to_additive]
theorem comp_mul [MulOneClass M] [CommMonoid N] [CommMonoid P] (g : N →* P) (f₁ f₂ : M →* N) :
  g.comp (f₁ * f₂) = g.comp f₁ * g.comp f₂ := by
  ext
  simp only [mul_apply, Function.comp_apply, map_mul, coe_comp]
#align monoid_hom.comp_mul MonoidHom.comp_mul
#align add_monoid_hom.comp_add AddMonoidHom.comp_add

/-- Group homomorphisms preserve inverse. -/
@[to_additive "Additive group homomorphisms preserve negation."]
protected theorem map_inv [Group α] [DivisionMonoid β] (f : α →* β) (a : α) :
  f a⁻¹ = (f a)⁻¹ := map_inv f _
#align monoid_hom.map_inv MonoidHom.map_inv
#align add_monoid_hom.map_neg AddMonoidHom.map_neg

/-- Group homomorphisms preserve integer power. -/
@[to_additive "Additive group homomorphisms preserve integer scaling."]
protected theorem map_zpow [Group α] [DivisionMonoid β] (f : α →* β) (g : α) (n : ℤ) :
  f (g ^ n) = f g ^ n := map_zpow f g n
#align monoid_hom.map_zpow MonoidHom.map_zpow
#align add_monoid_hom.map_zsmul AddMonoidHom.map_zsmul

/-- Group homomorphisms preserve division. -/
@[to_additive "Additive group homomorphisms preserve subtraction."]
protected theorem map_div [Group α] [DivisionMonoid β] (f : α →* β) (g h : α) :
  f (g / h) = f g / f h := map_div f g h
#align monoid_hom.map_div MonoidHom.map_div
#align add_monoid_hom.map_sub AddMonoidHom.map_sub

/-- Group homomorphisms preserve division. -/
@[to_additive "Additive group homomorphisms preserve subtraction."]
protected theorem map_mul_inv [Group α] [DivisionMonoid β] (f : α →* β) (g h : α) :
  f (g * h⁻¹) = f g * (f h)⁻¹ := by simp
#align monoid_hom.map_mul_inv MonoidHom.map_mul_inv
#align add_monoid_hom.map_add_neg AddMonoidHom.map_add_neg

/-- A homomorphism from a group to a monoid is injective iff its kernel is trivial.
For the iff statement on the triviality of the kernel, see `injective_iff_map_eq_one'`.  -/
@[to_additive
  "A homomorphism from an additive group to an additive monoid is injective iff
  its kernel is trivial. For the iff statement on the triviality of the kernel,
  see `injective_iff_map_eq_zero'`."]
theorem _root_.injective_iff_map_eq_one {G H} [Group G] [MulOneClass H] [MonoidHomClass F G H]
  (f : F) : Function.Injective f ↔ ∀ a, f a = 1 → a = 1 :=
  ⟨fun h x => (map_eq_one_iff f h).mp, fun h x y hxy =>
    mul_inv_eq_one.1 <| h _ <| by rw [map_mul, hxy, ← map_mul, mul_inv_self, map_one]⟩
#align injective_iff_map_eq_one injective_iff_map_eq_one
#align injective_iff_map_eq_zero injective_iff_map_eq_zero

/-- A homomorphism from a group to a monoid is injective iff its kernel is trivial,
stated as an iff on the triviality of the kernel.
For the implication, see `injective_iff_map_eq_one`. -/
@[to_additive
  "A homomorphism from an additive group to an additive monoid is injective iff its
  kernel is trivial, stated as an iff on the triviality of the kernel. For the implication, see
  `injective_iff_map_eq_zero`."]
theorem _root_.injective_iff_map_eq_one' {G H} [Group G] [MulOneClass H] [MonoidHomClass F G H]
  (f : F) : Function.Injective f ↔ ∀ a, f a = 1 ↔ a = 1 :=
  (injective_iff_map_eq_one f).trans <|
    forall_congr' fun _ => ⟨fun h => ⟨h, fun H => H.symm ▸ map_one f⟩, Iff.mp⟩
#align injective_iff_map_eq_one' injective_iff_map_eq_one'
#align injective_iff_map_eq_zero' injective_iff_map_eq_zero'

variable [MulOneClass M]

/-- Makes a group homomorphism from a proof that the map preserves multiplication. -/
@[to_additive (attr := simps (config := .asFn))
  "Makes an additive group homomorphism from a proof that the map preserves addition."]
def mk' (f : M → G) (map_mul : ∀ a b : M, f (a * b) = f a * f b) : M →* G where
  toFun := f
  map_mul' := map_mul
  map_one' := mul_left_eq_self.1 <| by rw [← map_mul, mul_one]
#align monoid_hom.mk' MonoidHom.mk'
#align add_monoid_hom.mk' AddMonoidHom.mk'
#align add_monoid_hom.mk'_apply AddMonoidHom.mk'_apply
#align monoid_hom.mk'_apply MonoidHom.mk'_apply

/-- Makes a group homomorphism from a proof that the map preserves right division
`fun x y => x * y⁻¹`. See also `MonoidHom.of_map_div` for a version using `fun x y => x / y`.
-/
@[to_additive
  "Makes an additive group homomorphism from a proof that the map preserves
  the operation `fun a b => a + -b`. See also `AddMonoidHom.ofMapSub` for a version using
  `fun a b => a - b`."]
def ofMapMulInv {H : Type _} [Group H] (f : G → H)
  (map_div : ∀ a b : G, f (a * b⁻¹) = f a * (f b)⁻¹) : G →* H :=
  (mk' f) fun x y =>
    calc
      f (x * y) = f x * (f <| 1 * 1⁻¹ * y⁻¹)⁻¹ := by
        { simp only [one_mul, inv_one, ← map_div, inv_inv] }
      _ = f x * f y := by
        { simp only [map_div]
          simp only [mul_right_inv, one_mul, inv_inv] }

#align monoid_hom.of_map_mul_inv MonoidHom.ofMapMulInv
#align add_monoid_hom.of_map_add_neg AddMonoidHom.ofMapAddNeg

@[to_additive (attr := simp)]
theorem coe_of_map_mul_inv {H : Type _} [Group H] (f : G → H)
  (map_div : ∀ a b : G, f (a * b⁻¹) = f a * (f b)⁻¹) :
  ↑(ofMapMulInv f map_div) = f := rfl
#align monoid_hom.coe_of_map_mul_inv MonoidHom.coe_of_map_mul_inv
#align add_monoid_hom.coe_of_map_add_neg AddMonoidHom.coe_of_map_add_neg

/-- Define a morphism of additive groups given a map which respects ratios. -/
@[to_additive "Define a morphism of additive groups given a map which respects difference."]
def ofMapDiv {H : Type _} [Group H] (f : G → H) (hf : ∀ x y, f (x / y) = f x / f y) : G →* H :=
  ofMapMulInv f (by simpa only [div_eq_mul_inv] using hf)
#align monoid_hom.of_map_div MonoidHom.ofMapDiv
#align add_monoid_hom.of_map_sub AddMonoidHom.ofMapSub

@[to_additive (attr := simp)]
theorem coe_of_map_div {H : Type _} [Group H] (f : G → H) (hf : ∀ x y, f (x / y) = f x / f y) :
  ↑(ofMapDiv f hf) = f := rfl
#align monoid_hom.coe_of_map_div MonoidHom.coe_of_map_div
#align add_monoid_hom.coe_of_map_sub AddMonoidHom.coe_of_map_sub

/-- If `f` is a monoid homomorphism to a commutative group, then `f⁻¹` is the homomorphism sending
`x` to `(f x)⁻¹`. -/
@[to_additive]
instance {M G} [MulOneClass M] [CommGroup G] : Inv (M →* G) :=
  ⟨fun f => (mk' fun g => (f g)⁻¹) fun a b => by rw [← mul_inv, f.map_mul]⟩

/-- If `f` is an additive monoid homomorphism to an additive commutative group, then `-f` is the
homomorphism sending `x` to `-(f x)`. -/
add_decl_doc AddMonoidHom.instNegAddMonoidHomToAddZeroClassToAddMonoidToSubNegAddMonoidToAddGroup

@[to_additive (attr := simp)]
theorem inv_apply {M G} {_ : MulOneClass M} {_ : CommGroup G} (f : M →* G) (x : M) :
  f⁻¹ x = (f x)⁻¹ := rfl
#align monoid_hom.inv_apply MonoidHom.inv_apply
#align add_monoid_hom.neg_apply AddMonoidHom.neg_apply

@[to_additive (attr := simp)]
theorem inv_comp {M N A} {_ : MulOneClass M} {_ : MulOneClass N} {_ : CommGroup A}
  (φ : N →* A) (ψ : M →* N) : φ⁻¹.comp ψ = (φ.comp ψ)⁻¹ := by
  ext
  simp only [Function.comp_apply, inv_apply, coe_comp]
#align monoid_hom.inv_comp MonoidHom.inv_comp
#align add_monoid_hom.neg_comp AddMonoidHom.neg_comp

@[to_additive (attr := simp)]
theorem comp_inv {M A B} {_ : MulOneClass M} {_ : CommGroup A} {_ : CommGroup B}
  (φ : A →* B) (ψ : M →* A) : φ.comp ψ⁻¹ = (φ.comp ψ)⁻¹ := by
  ext
  simp only [Function.comp_apply, inv_apply, map_inv, coe_comp]
#align monoid_hom.comp_inv MonoidHom.comp_inv
#align add_monoid_hom.comp_neg AddMonoidHom.comp_neg

/-- If `f` and `g` are monoid homomorphisms to a commutative group, then `f / g` is the homomorphism
sending `x` to `(f x) / (g x)`. -/
@[to_additive]
instance {M G} [MulOneClass M] [CommGroup G] : Div (M →* G) :=
  ⟨fun f g => (mk' fun x => f x / g x) fun a b => by
    simp [div_eq_mul_inv, mul_assoc, mul_left_comm, mul_comm]⟩

/-- If `f` and `g` are monoid homomorphisms to an additive commutative group, then `f - g`
is the homomorphism sending `x` to `(f x) - (g x)`. -/
add_decl_doc AddMonoidHom.instSubAddMonoidHomToAddZeroClassToAddMonoidToSubNegAddMonoidToAddGroup

@[to_additive (attr := simp)]
theorem div_apply {M G} {_ : MulOneClass M} {_ : CommGroup G} (f g : M →* G) (x : M) :
  (f / g) x = f x / g x := rfl
#align monoid_hom.div_apply MonoidHom.div_apply
#align add_monoid_hom.sub_apply AddMonoidHom.sub_apply

end MonoidHom

/-- Given two monoid with zero morphisms `f`, `g` to a commutative monoid, `f * g` is the monoid
with zero morphism sending `x` to `f x * g x`. -/
instance {M N} {_ : MulZeroOneClass M} [CommMonoidWithZero N] : Mul (M →*₀ N) :=
  ⟨fun f g => { (f * g : M →* N) with
    toFun := fun a => f a * g a,
    map_zero' := by dsimp only []; rw [map_zero, zero_mul] }⟩
    -- Porting note: why do we need `dsimp` here?


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.normed_space.add_torsor
import linear_algebra.affine_space.ordered
import topology.continuous_function.basic

/-!
# Urysohn's lemma

In this file we prove Urysohn's lemma `exists_continuous_zero_one_of_closed`: for any two disjoint
closed sets `s` and `t` in a normal topological space `X` there exists a continuous function
`f : X → ℝ` such that

* `f` equals zero on `s`;
* `f` equals one on `t`;
* `0 ≤ f x ≤ 1` for all `x`.

## Implementation notes

Most paper sources prove Urysohn's lemma using a family of open sets indexed by dyadic rational
numbers on `[0, 1]`. There are many technical difficulties with formalizing this proof (e.g., one
needs to formalize the "dyadic induction", then prove that the resulting family of open sets is
monotone). So, we formalize a slightly different proof.

Let `urysohns.CU` be the type of pairs `(C, U)` of a closed set `C`and an open set `U` such that
`C ⊆ U`. Since `X` is a normal topological space, for each `c : CU X` there exists an open set `u`
such that `c.C ⊆ u ∧ closure u ⊆ c.U`. We define `c.left` and `c.right` to be `(c.C, u)` and
`(closure u, c.U)`, respectively. Then we define a family of functions
`urysohns.CU.approx (c : urysohns.CU X) (n : ℕ) : X → ℝ` by recursion on `n`:

* `c.approx 0` is the indicator of `c.Uᶜ`;
* `c.approx (n + 1) x = (c.left.approx n x + c.right.approx n x) / 2`.

For each `x` this is a monotone family of functions that are equal to zero on `c.C` and are equal to
one outside of `c.U`. We also have `c.approx n x ∈ [0, 1]` for all `c`, `n`, and `x`.

Let `urysohns.CU.lim c` be the supremum (or equivalently, the limit) of `c.approx n`. Then
properties of `urysohns.CU.approx` immediately imply that

* `c.lim x ∈ [0, 1]` for all `x`;
* `c.lim` equals zero on `c.C` and equals one outside of `c.U`;
* `c.lim x = (c.left.lim x + c.right.lim x) / 2`.

In order to prove that `c.lim` is continuous at `x`, we prove by induction on `n : ℕ` that for `y`
in a small neighborhood of `x` we have `|c.lim y - c.lim x| ≤ (3 / 4) ^ n`. Induction base follows
from `c.lim x ∈ [0, 1]`, `c.lim y ∈ [0, 1]`. For the induction step, consider two cases:

* `x ∈ c.left.U`; then for `y` in a small neighborhood of `x` we have `y ∈ c.left.U ⊆ c.right.C`
  (hence `c.right.lim x = c.right.lim y = 0`) and `|c.left.lim y - c.left.lim x| ≤ (3 / 4) ^ n`.
  Then
  `|c.lim y - c.lim x| = |c.left.lim y - c.left.lim x| / 2 ≤ (3 / 4) ^ n / 2 < (3 / 4) ^ (n + 1)`.

* otherwise, `x ∉ c.left.right.C`; then for `y` in a small neighborhood of `x` we have
  `y ∉ c.left.right.C ⊇ c.left.left.U` (hence `c.left.left.lim x = c.left.left.lim y = 1`),
  `|c.left.right.lim y - c.left.right.lim x| ≤ (3 / 4) ^ n`, and
  `|c.right.lim y - c.right.lim x| ≤ (3 / 4) ^ n`. Combining these inequalities, the triangle
  inequality, and the recurrence formula for `c.lim`, we get
  `|c.lim x - c.lim y| ≤ (3 / 4) ^ (n + 1)`.

The actual formalization uses `midpoint ℝ x y` instead of `(x + y) / 2` because we have more API
lemmas about `midpoint`.

## Tags

Urysohn's lemma, normal topological space
-/

variables {X : Type*} [topological_space X]

open set filter topological_space
open_locale topology filter

namespace urysohns

/-- An auxiliary type for the proof of Urysohn's lemma: a pair of a closed set `C` and its
open neighborhood `U`. -/
@[protect_proj] structure CU (X : Type*) [topological_space X] :=
(C U : set X)
(closed_C : is_closed C)
(open_U : is_open U)
(subset : C ⊆ U)

instance : inhabited (CU X) := ⟨⟨∅, univ, is_closed_empty, is_open_univ, empty_subset _⟩⟩

variable [normal_space X]

namespace CU

/-- Due to `normal_exists_closure_subset`, for each `c : CU X` there exists an open set `u`
such chat `c.C ⊆ u` and `closure u ⊆ c.U`. `c.left` is the pair `(c.C, u)`. -/
@[simps C] def left (c : CU X) : CU X :=
{ C := c.C,
  U := (normal_exists_closure_subset c.closed_C c.open_U c.subset).some,
  closed_C := c.closed_C,
  open_U := (normal_exists_closure_subset c.closed_C c.open_U c.subset).some_spec.1,
  subset := (normal_exists_closure_subset c.closed_C c.open_U c.subset).some_spec.2.1 }

/-- Due to `normal_exists_closure_subset`, for each `c : CU X` there exists an open set `u`
such chat `c.C ⊆ u` and `closure u ⊆ c.U`. `c.right` is the pair `(closure u, c.U)`. -/
@[simps U] def right (c : CU X) : CU X :=
{ C := closure (normal_exists_closure_subset c.closed_C c.open_U c.subset).some,
  U := c.U,
  closed_C := is_closed_closure,
  open_U := c.open_U,
  subset := (normal_exists_closure_subset c.closed_C c.open_U c.subset).some_spec.2.2 }

lemma left_U_subset_right_C (c : CU X) : c.left.U ⊆ c.right.C :=
subset_closure

lemma left_U_subset (c : CU X) : c.left.U ⊆ c.U :=
subset.trans c.left_U_subset_right_C c.right.subset

lemma subset_right_C (c : CU X) : c.C ⊆ c.right.C :=
subset.trans c.left.subset c.left_U_subset_right_C

/-- `n`-th approximation to a continuous function `f : X → ℝ` such that `f = 0` on `c.C` and `f = 1`
outside of `c.U`. -/
noncomputable def approx : ℕ → CU X → X → ℝ
| 0 c x := indicator c.Uᶜ 1 x
| (n + 1) c x := midpoint ℝ (approx n c.left x) (approx n c.right x)

lemma approx_of_mem_C (c : CU X) (n : ℕ) {x : X} (hx : x ∈ c.C) :
  c.approx n x = 0 :=
begin
  induction n with n ihn generalizing c,
  { exact indicator_of_not_mem (λ hU, hU $ c.subset hx) _ },
  { simp only [approx],
    rw [ihn, ihn, midpoint_self],
    exacts [c.subset_right_C hx, hx] }
end

lemma approx_of_nmem_U (c : CU X) (n : ℕ) {x : X} (hx : x ∉ c.U) :
  c.approx n x = 1 :=
begin
  induction n with n ihn generalizing c,
  { exact indicator_of_mem hx _ },
  { simp only [approx],
    rw [ihn, ihn, midpoint_self],
    exacts [hx, λ hU, hx $ c.left_U_subset hU] }
end

lemma approx_nonneg (c : CU X) (n : ℕ) (x : X) :
  0 ≤ c.approx n x :=
begin
  induction n with n ihn generalizing c,
  { exact indicator_nonneg (λ _ _, zero_le_one) _ },
  { simp only [approx, midpoint_eq_smul_add, inv_of_eq_inv],
    refine mul_nonneg (inv_nonneg.2 zero_le_two) (add_nonneg _ _); apply ihn }
end

lemma approx_le_one (c : CU X) (n : ℕ) (x : X) :
  c.approx n x ≤ 1 :=
begin
  induction n with n ihn generalizing c,
  { exact indicator_apply_le' (λ _, le_rfl) (λ _, zero_le_one) },
  { simp only [approx, midpoint_eq_smul_add, inv_of_eq_inv, smul_eq_mul, ← div_eq_inv_mul],
    refine iff.mpr (div_le_one zero_lt_two) (add_le_add _ _); apply ihn }
end

lemma bdd_above_range_approx (c : CU X) (x : X) : bdd_above (range $ λ n, c.approx n x) :=
⟨1, λ y ⟨n, hn⟩, hn ▸ c.approx_le_one n x⟩

lemma approx_le_approx_of_U_sub_C {c₁ c₂ : CU X} (h : c₁.U ⊆ c₂.C) (n₁ n₂ : ℕ) (x : X) :
  c₂.approx n₂ x ≤ c₁.approx n₁ x :=
begin
  by_cases hx : x ∈ c₁.U,
  { calc approx n₂ c₂ x = 0              : approx_of_mem_C _ _ (h hx)
                    ... ≤ approx n₁ c₁ x : approx_nonneg _ _ _ },
  { calc approx n₂ c₂ x ≤ 1              : approx_le_one _ _ _
                    ... = approx n₁ c₁ x : (approx_of_nmem_U _ _ hx).symm }
end

lemma approx_mem_Icc_right_left (c : CU X) (n : ℕ) (x : X) :
  c.approx n x ∈ Icc (c.right.approx n x) (c.left.approx n x) :=
begin
  induction n with n ihn generalizing c,
  { exact ⟨le_rfl, indicator_le_indicator_of_subset (compl_subset_compl.2 c.left_U_subset)
      (λ _, zero_le_one) _⟩ },
  { simp only [approx, mem_Icc],
    refine ⟨midpoint_le_midpoint _ (ihn _).1, midpoint_le_midpoint (ihn _).2 _⟩;
      apply approx_le_approx_of_U_sub_C,
    exacts [subset_closure, subset_closure] }
end

lemma approx_le_succ (c : CU X) (n : ℕ) (x : X) :
  c.approx n x ≤ c.approx (n + 1) x :=
begin
  induction n with n ihn generalizing c,
  { simp only [approx, right_U, right_le_midpoint],
    exact (approx_mem_Icc_right_left c 0 x).2 },
  { rw [approx, approx],
    exact midpoint_le_midpoint (ihn _) (ihn _) }
end

lemma approx_mono (c : CU X) (x : X) : monotone (λ n, c.approx n x) :=
monotone_nat_of_le_succ $ λ n, c.approx_le_succ n x

/-- A continuous function `f : X → ℝ` such that

* `0 ≤ f x ≤ 1` for all `x`;
* `f` equals zero on `c.C` and equals one outside of `c.U`;
-/
protected noncomputable def lim (c : CU X) (x : X) : ℝ := ⨆ n, c.approx n x

lemma tendsto_approx_at_top (c : CU X) (x : X) :
  tendsto (λ n, c.approx n x) at_top (𝓝 $ c.lim x) :=
tendsto_at_top_csupr (c.approx_mono x) ⟨1, λ x ⟨n, hn⟩, hn ▸ c.approx_le_one _ _⟩

lemma lim_of_mem_C (c : CU X) (x : X) (h : x ∈ c.C) : c.lim x = 0 :=
by simp only [CU.lim, approx_of_mem_C, h, csupr_const]

lemma lim_of_nmem_U (c : CU X) (x : X) (h : x ∉ c.U) : c.lim x = 1 :=
by simp only [CU.lim, approx_of_nmem_U c _ h, csupr_const]

lemma lim_eq_midpoint (c : CU X) (x : X) :
  c.lim x = midpoint ℝ (c.left.lim x) (c.right.lim x) :=
begin
  refine tendsto_nhds_unique (c.tendsto_approx_at_top x) ((tendsto_add_at_top_iff_nat 1).1 _),
  simp only [approx],
  exact (c.left.tendsto_approx_at_top x).midpoint (c.right.tendsto_approx_at_top x)
end

lemma approx_le_lim (c : CU X) (x : X) (n : ℕ) : c.approx n x ≤ c.lim x :=
le_csupr (c.bdd_above_range_approx x) _

lemma lim_nonneg (c : CU X) (x : X) : 0 ≤ c.lim x :=
(c.approx_nonneg 0 x).trans (c.approx_le_lim x 0)

lemma lim_le_one (c : CU X) (x : X) : c.lim x ≤ 1 :=
csupr_le $ λ n, c.approx_le_one _ _

lemma lim_mem_Icc (c : CU X) (x : X) : c.lim x ∈ Icc (0 : ℝ) 1 :=
⟨c.lim_nonneg x, c.lim_le_one x⟩

/-- Continuity of `urysohns.CU.lim`. See module docstring for a sketch of the proofs. -/

end CU

end urysohns

variable [normal_space X]

/-- Urysohns lemma: if `s` and `t` are two disjoint closed sets in a normal topological space `X`,
then there exists a continuous function `f : X → ℝ` such that

* `f` equals zero on `s`;
* `f` equals one on `t`;
* `0 ≤ f x ≤ 1` for all `x`.
-/
lemma exists_continuous_zero_one_of_closed {s t : set X} (hs : is_closed s) (ht : is_closed t)
  (hd : disjoint s t) :
  ∃ f : C(X, ℝ), eq_on f 0 s ∧ eq_on f 1 t ∧ ∀ x, f x ∈ Icc (0 : ℝ) 1 :=
begin
  -- The actual proof is in the code above. Here we just repack it into the expected format.
  set c : urysohns.CU X := ⟨s, tᶜ, hs, ht.is_open_compl, disjoint_left.1 hd⟩,
  exact ⟨⟨c.lim, c.continuous_lim⟩, c.lim_of_mem_C,
    λ x hx, c.lim_of_nmem_U _ (λ h, h hx), c.lim_mem_Icc⟩
end


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import algebra.module.linear_map
import analysis.convex.topology
import analysis.normed_space.operator_norm
import linear_algebra.affine_space.finite_dimensional

open_locale classical affine big_operators
open set
--TODO: Generalise to LCTVS
variables {E : Type*} [normed_group E] [normed_space ℝ E] {x : E} {A B C : set E}
  {X : finset E}

theorem geometric_hahn_banach_compact_closed {A B : set E}
  (hA₁ : convex A) (hA₂ : is_compact A)
  (hB₁ : convex B) (hB₂ : is_closed B)
  (disj : disjoint A B) :
  ∃ (f : E →L[ℝ] ℝ) (s t : ℝ), s < t ∧ (∀ b ∈ B, f b < s) ∧ (∀ a ∈ A, t < f a) :=
sorry

theorem geometric_hahn_banach_closed_point {A : set E} {x : E}
  (hA₁ : convex A) (hA₂ : is_closed A)
  (disj : x ∉ A) :
  ∃ (f : E →L[ℝ] ℝ) (s : ℝ), (∀ a ∈ A, f a < s) ∧ s < f x := sorry

theorem geometric_hahn_banach_open_point {A : set E} {x : E}
  (hA₁ : convex A) (hA₂ : is_open A)
  (disj : x ∉ A) :
  ∃ (f : E →L[ℝ] ℝ), (∀ a ∈ A, f a < f x) := sorry

theorem geometric_hahn_banach_point_open {x : E} {B : set E}
  (hB₁ : convex B) (hB₂ : is_open B)
  (disj : x ∉ B) :
  ∃ (f : E →L[ℝ] ℝ), (∀ b ∈ B, f x < f b) :=
let ⟨f, hf⟩ := geometric_hahn_banach_open_point hB₁ hB₂ disj in ⟨-f, by simpa⟩

theorem geometric_hahn_banach_point_point {x y : E} (hxy : x ≠ y) :
  ∃ (f : E →L[ℝ] ℝ), f x < f y :=
sorry


import Mathlib.Data.Nat.Basic
import Mathlib.Init.Algebra.Order
import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Data.Equiv.Basic
import Mathlib.Init.Function
import Mathlib.Data.Fin.Basic
import Timelib.Util
import Timelib.NanoPrecision.TimeZone.Basic
import Timelib.NanoPrecision.Duration.SignedDuration
import Timelib.NanoPrecision.Duration.UnsignedDuration
import Timelib.NanoPrecision.ClockTime.NaiveClockTime
import Lean.Data.Json

structure ClockTime (A : TimeZone) where
  naive : NaiveClockTime
deriving DecidableEq, Ord, Hashable, Repr, Lean.ToJson, Lean.FromJson

section ClockTimeStuff

variable {A : TimeZone} (t : ClockTime A)

instance : Inhabited <| ClockTime A := ⟨0, Nat.zero_lt_succ _⟩

theorem ClockTime.eq_of_val_eq : ∀ {t₁ t₂ : ClockTime A} (h : t₁.naive = t₂.naive), t₁ = t₂
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl

/-- Addition of a `SignedDuration` to a `ClockTime`; wraps into the next clock cycle. -/
instance : HAdd (ClockTime A) SignedDuration (ClockTime A) where
  hAdd t d := ⟨t.naive + d⟩

instance : HAdd SignedDuration (ClockTime A) (ClockTime A) where
  hAdd t d := d + t

theorem ClockTime.hAdd_signed_def (dur : SignedDuration) : t + dur = ⟨t.naive + dur⟩ := rfl

theorem ClockTime.hAdd_comm (t : ClockTime A) (d : SignedDuration) : t + d = d + t := rfl
theorem ClockTime.hAdd_assoc (t : ClockTime A) (d₁ d₂ : SignedDuration) : (t + d₁) + d₂ = t + (d₁ + d₂ ):= sorry

/--
Subtraction of a `SignedDuration` from a `ClockTime`; the implementation follows
that of `Fin n`, wrapping into the previous clock cycle on underflow
-/
instance : HSub (ClockTime A) SignedDuration (ClockTime A) where
  hSub t d := ⟨t.naive - d⟩

theorem ClockTime.hSub_signed_def (dur : SignedDuration) : t - dur = ⟨t.naive - dur⟩ := rfl

def ClockTime.toLocalNaive (t : ClockTime A) : NaiveClockTime := t.naive + A.offset

theorem ClockTime.apply_unapply : t + A.offset - A.offset = t := by
  simp [ClockTime.hAdd_signed_def, ClockTime.hSub_signed_def, NaiveClockTime.hAdd_signed_def, NaiveClockTime.hSub_signed_def, sub_eq_add_neg, add_assoc]

theorem ClockTime.unapply_apply : t - A.offset + A.offset = t := by
  simp [ClockTime.hAdd_signed_def, ClockTime.hSub_signed_def, NaiveClockTime.hAdd_signed_def, NaiveClockTime.hSub_signed_def, sub_eq_add_neg, add_assoc]

/-
The nanosecond component of a `ClockTime`. To convert the `ClockTime` to
nanoseconds, use `ClockTime.asNanos`.
-/
def ClockTime.nanoComponent (t : ClockTime A) : Nat := t.toLocalNaive.nanoComponent
def ClockTime.secondComponent (t : ClockTime A) : Nat := t.toLocalNaive.secondComponent
def ClockTime.minuteComponent (t : ClockTime A) : Nat := t.toLocalNaive.minuteComponent
def ClockTime.hourComponent (t : ClockTime A) : Nat := t.toLocalNaive.hourComponent

def ClockTime.fromNeutralSignedDuration (d : SignedDuration) : ClockTime A := ⟨NaiveClockTime.fromSignedDuration d⟩

def ClockTime.fromNeutralHmsn (h : Nat) (m : Nat) (s : Nat) (n : Nat) : ClockTime A :=
  ClockTime.fromNeutralSignedDuration ⟨(h * oneHourNanos) + (m * oneMinuteNanos) + (s * oneSecondNanos) + n⟩

def ClockTime.fromLocalHmsn (h : Nat) (m : Nat) (s : Nat) (n : Nat) : ClockTime A :=
  let dur : SignedDuration := ⟨(h * oneHourNanos) + (m * oneMinuteNanos) + (s * oneSecondNanos) + n⟩
  ⟨NaiveClockTime.fromSignedDuration (dur - A.offset)⟩

instance : LT (ClockTime A) where
  lt := InvImage (instLTNaiveClockTime.lt) ClockTime.naive

instance : LE (ClockTime A) where
  le := InvImage (instLENaiveClockTime.le) ClockTime.naive

@[simp] theorem ClockTime.le_def (d₁ d₂ : ClockTime Z) : (d₁ <= d₂) = (d₁.naive <= d₂.naive) := rfl
@[simp] theorem ClockTime.lt_def (d₁ d₂ : ClockTime Z) : (d₁ < d₂) = (d₁.naive < d₂.naive) := rfl

instance instDecidableLEClockTime (a b : ClockTime A) : Decidable (a <= b) := inferInstanceAs (Decidable (a.naive <= b.naive))
instance instDecidableLTClockTime (a b : ClockTime A) : Decidable (a < b) := inferInstanceAs (Decidable (a.naive < b.naive))

instance {Z : TimeZone} : Equiv (Fin oneDayNanos) (ClockTime Z) where
  toFun := fun fin => ClockTime.mk (NaiveClockTime.mk fin)
  invFun := fun t => t.naive.nanos
  left_inv := by simp [Function.LeftInverse]
  right_inv := by simp [Function.RightInverse, Function.LeftInverse]

instance : LinearOrder (ClockTime Z) where
  le_refl (a) := le_refl a.naive
  le_trans (a b c) := Nat.le_trans
  lt_iff_le_not_le (a b) := Nat.lt_iff_le_not_le
  le_antisymm (a b h1 h2) := by
    apply ClockTime.eq_of_val_eq
    exact le_antisymm h1 h2
  le_total := by simp [ClockTime.le_def, le_total]
  decidable_le := inferInstance

instance : ToString (ClockTime A) where
  toString t :=
    let withTimeZone := t.toLocalNaive
    let h := String.leftpad 2 '0' (ToString.toString $ withTimeZone.hourComponent)
    let m := String.leftpad 2 '0' (ToString.toString $ withTimeZone.minuteComponent)
    let s := String.leftpad 2 '0' (ToString.toString $ withTimeZone.secondComponent)
    let n := String.leftpad 9 '0' (ToString.toString $ withTimeZone.nanoComponent)
  s!"{h}:{m}:{s}.{n}{A.abbreviation}"

end ClockTimeStuff


opaque f : Bool → Bool → Bool
axiom f_comm (a b : Bool) : f a b = f b a
axiom f_assoc (a b c : Bool) : f (f a b) c = f a (f b c)
instance : Lean.IsCommutative f := ⟨f_comm⟩
instance : Lean.IsAssociative f := ⟨f_assoc⟩

example (a b c : Bool) : f (f a b) c = f (f a c) b :=
  by ac_rfl -- good

example (a b c : Bool) : (f (f a b) c = f (f a c) b) ∧ true :=
  And.intro (by ac_rfl) rfl -- good

example (a b c : Bool) : (f (f a b) c = f (f a c) b) ∧ true := by
  apply And.intro
  . ac_rfl
  . rfl


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

import linear_algebra.pi_tensor_product
import logic.equiv.fin
import algebra.direct_sum.algebra

/-!
# Tensor power of a semimodule over a commutative semirings

We define the `n`th tensor power of `M` as the n-ary tensor product indexed by `fin n` of `M`,
`⨂[R] (i : fin n), M`. This is a special case of `pi_tensor_product`.

This file introduces the notation `⨂[R]^n M` for `tensor_power R n M`, which in turn is an
abbreviation for `⨂[R] i : fin n, M`.

## Main definitions:

* `tensor_power.gsemiring`: the tensor powers form a graded semiring.
* `tensor_power.galgebra`: the tensor powers form a graded algebra.

## Implementation notes

In this file we use `ₜ1` and `ₜ*` as local notation for the graded multiplicative structure on
tensor powers. Elsewhere, using `1` and `*` on `graded_monoid` should be preferred.
-/

open_locale tensor_product

/-- Homogenous tensor powers $M^{\otimes n}$. `⨂[R]^n M` is a shorthand for
`⨂[R] (i : fin n), M`. -/
@[reducible] protected def tensor_power (R : Type*) (n : ℕ) (M : Type*)
  [comm_semiring R] [add_comm_monoid M] [module R M] : Type* :=
⨂[R] i : fin n, M

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

localized "notation (name := tensor_power)
  `⨂[`:100 R `]^`:80 n:max := tensor_power R n" in tensor_product

namespace pi_tensor_product

/-- Two dependent pairs of tensor products are equal if their index is equal and the contents
are equal after a canonical reindexing. -/
@[ext]

end pi_tensor_product

namespace tensor_power
open_locale tensor_product direct_sum
open pi_tensor_product

/-- As a graded monoid, `⨂[R]^i M` has a `1 : ⨂[R]^0 M`. -/
instance ghas_one : graded_monoid.ghas_one (λ i, ⨂[R]^i M) :=
{ one := tprod R $ @fin.elim0' M }

local notation `ₜ1` := @graded_monoid.ghas_one.one ℕ (λ i, ⨂[R]^i M) _ _

lemma ghas_one_def : ₜ1 = tprod R (@fin.elim0' M) := rfl

/-- A variant of `pi_tensor_prod.tmul_equiv` with the result indexed by `fin (n + m)`. -/
def mul_equiv {n m : ℕ} : (⨂[R]^n M) ⊗[R] (⨂[R]^m M) ≃ₗ[R] ⨂[R]^(n + m) M :=
(tmul_equiv R M).trans (reindex R M fin_sum_fin_equiv)

/-- As a graded monoid, `⨂[R]^i M` has a `(*) : ⨂[R]^i M → ⨂[R]^j M → ⨂[R]^(i + j) M`. -/
instance ghas_mul : graded_monoid.ghas_mul (λ i, ⨂[R]^i M) :=
{ mul := λ i j a b, (tensor_product.mk R _ _).compr₂ ↑(mul_equiv : _ ≃ₗ[R] ⨂[R]^(i + j) M) a b}

local infix ` ₜ* `:70 := @graded_monoid.ghas_mul.mul ℕ (λ i, ⨂[R]^i M) _ _ _ _

lemma ghas_mul_def {i j} (a : ⨂[R]^i M) (b : ⨂[R]^j M) : a ₜ* b = mul_equiv (a ⊗ₜ b) := rfl

lemma ghas_mul_eq_coe_linear_map {i j} (a : ⨂[R]^i M) (b : ⨂[R]^j M) :
  a ₜ* b =
    ((tensor_product.mk R _ _).compr₂ ↑(mul_equiv : _ ≃ₗ[R] ⨂[R]^(i + j) M)
      : ⨂[R]^i M →ₗ[R] ⨂[R]^j M →ₗ[R] ⨂[R]^(i + j) M) a b := rfl

variables (R M)

/-- Cast between "equal" tensor powers. -/
def cast {i j} (h : i = j) : ⨂[R]^i M ≃ₗ[R] (⨂[R]^j M) :=
reindex R M (fin.cast h).to_equiv

lemma cast_tprod {i j} (h : i = j) (a : fin i → M) :
  cast R M h (tprod R a) = tprod R (a ∘ fin.cast h.symm) :=
reindex_tprod _ _

@[simp] lemma cast_refl {i} (h : i = i) : cast R M h = linear_equiv.refl _ _ :=
(congr_arg (λ f, reindex R M (rel_iso.to_equiv f)) $ fin.cast_refl h).trans reindex_refl

@[simp] lemma cast_symm {i j} (h : i = j) : (cast R M h).symm = cast R M h.symm := reindex_symm _

@[simp] lemma cast_trans {i j k} (h : i = j) (h' : j = k) :
  (cast R M h).trans (cast R M h') = cast R M (h.trans h') := reindex_trans _ _

variables {R M}

@[simp] lemma cast_cast {i j k} (h : i = j) (h' : j = k) (a : ⨂[R]^i M) :
  cast R M h' (cast R M h a) = cast R M (h.trans h') a := reindex_reindex _ _ _

@[ext]
lemma graded_monoid_eq_of_cast {a b : graded_monoid (λ n, ⨂[R] i : fin n, M)}
  (h : a.fst = b.fst) (h2 : cast R M h a.snd = b.snd) : a = b :=
begin
  refine graded_monoid_eq_of_reindex_cast h _,
  rw cast at h2,
  rw [←fin.cast_to_equiv, ← h2],
end

-- named to match `fin.cast_eq_cast`
lemma cast_eq_cast {i j} (h : i = j) : ⇑(cast R M h) = _root_.cast (congr_arg _ h) :=
begin
  subst h,
  rw [cast_refl],
  refl,
end

variables (R)
include R
lemma tprod_mul_tprod {na nb} (a : fin na → M) (b : fin nb → M) :
  tprod R a ₜ* tprod R b = tprod R (fin.append a b) :=
begin
  dsimp [ghas_mul_def, mul_equiv],
  rw [tmul_equiv_apply R M a b],
  refine (reindex_tprod _ _).trans _,
  congr' 1,
  dsimp only [fin.append, fin_sum_fin_equiv, equiv.coe_fn_symm_mk],
  apply funext,
  apply fin.add_cases; simp,
end
omit R
variables {R}

lemma one_mul {n} (a : ⨂[R]^n M) :
  cast R M (zero_add n) (ₜ1 ₜ* a) = a :=
begin
  rw [ghas_mul_def, ghas_one_def],
  induction a using pi_tensor_product.induction_on with r a x y hx hy,
  { dsimp only at a,
    rw [tensor_product.tmul_smul, linear_equiv.map_smul, linear_equiv.map_smul, ←ghas_mul_def,
      tprod_mul_tprod, cast_tprod],
    congr' 2 with i,
    rw fin.elim0'_append,
    refine congr_arg a (fin.ext _),
    simp },
  { rw [tensor_product.tmul_add, map_add, map_add, hx, hy], },
end

lemma mul_one {n} (a : ⨂[R]^n M) : cast R M (add_zero _) (a ₜ* ₜ1) = a :=
begin
  rw [ghas_mul_def, ghas_one_def],
  induction a using pi_tensor_product.induction_on with r a x y hx hy,
  { dsimp only at a,
    rw [←tensor_product.smul_tmul', linear_equiv.map_smul, linear_equiv.map_smul, ←ghas_mul_def,
      tprod_mul_tprod R a _, cast_tprod],
    congr' 2 with i,
    rw fin.append_elim0',
    refine congr_arg a (fin.ext _),
    simp },
  { rw [tensor_product.add_tmul, map_add, map_add, hx, hy], },
end

lemma mul_assoc {na nb nc} (a : ⨂[R]^na M) (b : ⨂[R]^nb M) (c : ⨂[R]^nc M) :
  cast R M (add_assoc _ _ _) ((a ₜ* b) ₜ* c) = a ₜ* (b  ₜ* c) :=
begin
  let mul : Π (n m : ℕ), (⨂[R]^n M) →ₗ[R] (⨂[R]^m M) →ₗ[R] ⨂[R]^(n + m) M :=
    (λ n m, (tensor_product.mk R _ _).compr₂ ↑(mul_equiv : _ ≃ₗ[R] ⨂[R]^(n + m) M)),
  -- replace `a`, `b`, `c` with `tprod R a`, `tprod R b`, `tprod R c`
  let e : ⨂[R]^(na + nb + nc) M ≃ₗ[R] ⨂[R]^(na + (nb + nc)) M := cast R M (add_assoc _ _ _),
  let lhs : (⨂[R]^na M) →ₗ[R] (⨂[R]^nb M) →ₗ[R] (⨂[R]^nc M) →ₗ[R] (⨂[R]^(na + (nb + nc)) M) :=
    (linear_map.llcomp R _ _ _ ((mul _ nc).compr₂ e.to_linear_map)).comp
      (mul na nb),
  have lhs_eq : ∀ a b c, lhs a b c = e ((a ₜ* b) ₜ* c) := λ _ _ _, rfl,
  let rhs : (⨂[R]^na M) →ₗ[R] (⨂[R]^nb M) →ₗ[R] (⨂[R]^nc M) →ₗ[R] (⨂[R]^(na + (nb + nc)) M) :=
    (linear_map.llcomp R _ _ _ (linear_map.lflip R _ _ _) $
      (linear_map.llcomp R _ _ _ (mul na _).flip).comp (mul nb nc)).flip,
  have rhs_eq : ∀ a b c, rhs a b c = (a ₜ* (b ₜ* c)) := λ _ _ _, rfl,
  suffices : lhs = rhs,
  from linear_map.congr_fun (linear_map.congr_fun (linear_map.congr_fun this a) b) c,
  ext a b c,
  -- clean up
  simp only [linear_map.comp_multilinear_map_apply, lhs_eq, rhs_eq, tprod_mul_tprod, e,
    cast_tprod],
  congr' with j,
  rw fin.append_assoc,
  refine congr_arg (fin.append a (fin.append b c)) (fin.ext _),
  rw [fin.coe_cast, fin.coe_cast],
end

-- for now we just use the default for the `gnpow` field as it's easier.
instance gmonoid : graded_monoid.gmonoid (λ i, ⨂[R]^i M) :=
{ one_mul := λ a, graded_monoid_eq_of_cast (zero_add _) (one_mul _),
  mul_one := λ a, graded_monoid_eq_of_cast (add_zero _) (mul_one _),
  mul_assoc := λ a b c, graded_monoid_eq_of_cast (add_assoc _ _ _) (mul_assoc _ _ _),
  ..tensor_power.ghas_mul,
  ..tensor_power.ghas_one, }

/-- The canonical map from `R` to `⨂[R]^0 M` corresponding to the algebra_map of the tensor
algebra. -/
def algebra_map₀ : R ≃ₗ[R] ⨂[R]^0 M :=
linear_equiv.symm $ is_empty_equiv (fin 0)

lemma algebra_map₀_eq_smul_one (r : R) :
  (algebra_map₀ r : ⨂[R]^0 M) = r • ₜ1 :=
by { simp [algebra_map₀], congr }

lemma algebra_map₀_one : (algebra_map₀ 1 : ⨂[R]^0 M) = ₜ1 :=
(algebra_map₀_eq_smul_one 1).trans (one_smul _ _)

lemma algebra_map₀_mul {n} (r : R) (a : ⨂[R]^n M) :
  cast R M (zero_add _) (algebra_map₀ r ₜ* a) = r • a :=
by rw [ghas_mul_eq_coe_linear_map, algebra_map₀_eq_smul_one, linear_map.map_smul₂,
  linear_equiv.map_smul,  ←ghas_mul_eq_coe_linear_map, one_mul]

lemma mul_algebra_map₀ {n} (r : R) (a : ⨂[R]^n M) :
  cast R M (add_zero _) (a ₜ* algebra_map₀ r) = r • a :=
by rw [ghas_mul_eq_coe_linear_map, algebra_map₀_eq_smul_one, linear_map.map_smul,
  linear_equiv.map_smul, ←ghas_mul_eq_coe_linear_map, mul_one]

lemma algebra_map₀_mul_algebra_map₀ (r s : R) :
  cast R M (add_zero _) (algebra_map₀ r ₜ* algebra_map₀ s) = algebra_map₀ (r * s) :=
begin
  rw [←smul_eq_mul, linear_equiv.map_smul],
  exact algebra_map₀_mul r (@algebra_map₀ R M _ _ _ s),
end

instance gsemiring : direct_sum.gsemiring (λ i, ⨂[R]^i M) :=
{ mul_zero := λ i j a, linear_map.map_zero _,
  zero_mul := λ i j b, linear_map.map_zero₂ _ _,
  mul_add := λ i j a b₁ b₂, linear_map.map_add _ _ _,
  add_mul := λ i j a₁ a₂ b, linear_map.map_add₂ _ _ _ _,
  nat_cast := λ n, algebra_map₀ (n : R),
  nat_cast_zero := by rw [nat.cast_zero, map_zero],
  nat_cast_succ := λ n, by rw [nat.cast_succ, map_add, algebra_map₀_one],
  ..tensor_power.gmonoid }

example : semiring (⨁ n : ℕ, ⨂[R]^n M) := by apply_instance

/-- The tensor powers form a graded algebra.

Note that this instance implies `algebra R (⨁ n : ℕ, ⨂[R]^n M)` via `direct_sum.algebra`. -/
instance galgebra : direct_sum.galgebra R (λ i, ⨂[R]^i M) :=
{ to_fun := (algebra_map₀ : R ≃ₗ[R] ⨂[R]^0 M).to_linear_map.to_add_monoid_hom,
  map_one := algebra_map₀_one,
  map_mul := λ r s, graded_monoid_eq_of_cast rfl begin
    rw [←linear_equiv.eq_symm_apply],
    have := algebra_map₀_mul_algebra_map₀ r s,
    exact this.symm,
  end,
  commutes := λ r x, graded_monoid_eq_of_cast (add_comm _ _) begin
    have := (algebra_map₀_mul r x.snd).trans (mul_algebra_map₀ r x.snd).symm,
    rw [←linear_equiv.eq_symm_apply, cast_symm],
    rw [←linear_equiv.eq_symm_apply, cast_symm, cast_cast] at this,
    exact this,
  end,
  smul_def := λ r x, graded_monoid_eq_of_cast (zero_add x.fst).symm begin
    rw [←linear_equiv.eq_symm_apply, cast_symm],
    exact (algebra_map₀_mul r x.snd).symm,
  end }

lemma galgebra_to_fun_def (r : R) :
  @direct_sum.galgebra.to_fun ℕ R (λ i, ⨂[R]^i M) _ _ _ _ _ _ _ r = algebra_map₀ r := rfl

example : algebra R (⨁ n : ℕ, ⨂[R]^n M) := by apply_instance

end tensor_power


import data.equiv.fin

lemma fin.cast_id {n : ℕ} {h : n = n} : fin.cast h = id :=
by { ext, refl }

@[simp] lemma fin.nat_add_val {n m : ℕ} (i : fin n) : (i.nat_add m).val = m + i.val :=
rfl

lemma fin.nat_add_zero {n : ℕ} : fin.nat_add 0 = fin.cast (zero_add n).symm :=
by { ext, apply zero_add }

lemma fin.nat_add_add {n m k : ℕ} :
  fin.nat_add (m+k) = fin.cast (add_assoc m k n).symm ∘ fin.nat_add m ∘ fin.nat_add k :=
by { ext, apply add_assoc }

@[simp] lemma sum_fin_sum_equiv_inl {m n : ℕ} (i : fin m) :
  sum_fin_sum_equiv (sum.inl i) = fin.cast_add n i :=
rfl

@[simp] lemma sum_fin_sum_equiv_inr {m n : ℕ} (i : fin n) :
  sum_fin_sum_equiv (sum.inr i) = fin.nat_add m i :=
rfl