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

! This file was ported from Lean 3 source module category_theory.adjunction.comma
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Adjunction.Basic
import Mathbin.CategoryTheory.Punit
import Mathbin.CategoryTheory.StructuredArrow

/-!
# Properties of comma categories relating to adjunctions

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

This file shows that for a functor `G : D ⥤ C` the data of an initial object in each
`structured_arrow` category on `G` is equivalent to a left adjoint to `G`, as well as the dual.

Specifically, `adjunction_of_structured_arrow_initials` gives the left adjoint assuming the
appropriate initial objects exist, and `mk_initial_of_left_adjoint` constructs the initial objects
provided a left adjoint.

The duals are also shown.
-/

universe v₁ v₂ u₁ u₂

noncomputable section

namespace CategoryTheory

open Limits

variable {C : Type u₁} {D : Type u₂} [Category.{v₁} C] [Category.{v₂} D] (G : D ⥤ C)

section OfInitials

variable [∀ A, HasInitial (StructuredArrow A G)]

/- warning: category_theory.left_adjoint_of_structured_arrow_initials_aux -> CategoryTheory.leftAdjointOfStructuredArrowInitialsAux is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (G : CategoryTheory.Functor.{u2, u1, u4, u3} D _inst_2 C _inst_1) [_inst_3 : forall (A : C), CategoryTheory.Limits.HasInitial.{max u1 u2, max u4 u1} (CategoryTheory.StructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 A G) (CategoryTheory.StructuredArrow.category.{u1, u3, u4, u2} D _inst_2 C _inst_1 A G)] (A : C) (B : D), Equiv.{succ u2, succ u1} (Quiver.Hom.{succ u2, u4} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Comma.right.{u1, u2, u1, u1, u4, u3} (CategoryTheory.Discrete.{u1} PUnit.{succ u1}) (CategoryTheory.discreteCategory.{u1} PUnit.{succ u1}) D _inst_2 C _inst_1 (CategoryTheory.Functor.fromPUnit.{u1, u3} C _inst_1 A) G (CategoryTheory.Limits.initial.{max u1 u2, max u4 u1} (CategoryTheory.StructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 A G) (CategoryTheory.StructuredArrow.category.{u1, u3, u4, u2} D _inst_2 C _inst_1 A G) (_inst_3 A))) B) (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) A (CategoryTheory.Functor.obj.{u2, u1, u4, u3} D _inst_2 C _inst_1 G B))
but is expected to have type
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (G : CategoryTheory.Functor.{u2, u1, u4, u3} D _inst_2 C _inst_1) [_inst_3 : forall (A : C), CategoryTheory.Limits.HasInitial.{max u1 u2, max u4 u1} (CategoryTheory.StructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 A G) (CategoryTheory.instCategoryStructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 A G)] (A : C) (B : D), Equiv.{succ u2, succ u1} (Quiver.Hom.{succ u2, u4} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Comma.right.{u1, u2, u1, u1, u4, u3} (CategoryTheory.Discrete.{u1} PUnit.{succ u1}) (CategoryTheory.discreteCategory.{u1} PUnit.{succ u1}) D _inst_2 C _inst_1 (CategoryTheory.Functor.fromPUnit.{u1, u3} C _inst_1 A) G (CategoryTheory.Limits.initial.{max u1 u2, max u4 u1} (CategoryTheory.StructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 A G) (CategoryTheory.instCategoryStructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 A G) (_inst_3 A))) B) (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) A (Prefunctor.obj.{succ u2, succ u1, u4, u3} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{u2, u1, u4, u3} D _inst_2 C _inst_1 G) B))
Case conversion may be inaccurate. Consider using '#align category_theory.left_adjoint_of_structured_arrow_initials_aux CategoryTheory.leftAdjointOfStructuredArrowInitialsAuxₓ'. -/
/-- Implementation: If each structured arrow category on `G` has an initial object, an equivalence
which is helpful for constructing a left adjoint to `G`.
-/
@[simps]
def leftAdjointOfStructuredArrowInitialsAux (A : C) (B : D) :
    ((⊥_ StructuredArrow A G).right ⟶ B) ≃ (A ⟶ G.obj B)
    where
  toFun g := (⊥_ StructuredArrow A G).Hom ≫ G.map g
  invFun f := CommaMorphism.right (initial.to (StructuredArrow.mk f))
  left_inv g :=
    by
    let B' : structured_arrow A G := structured_arrow.mk ((⊥_ structured_arrow A G).Hom ≫ G.map g)
    let g' : ⊥_ structured_arrow A G ⟶ B' := structured_arrow.hom_mk g rfl
    have : initial.to _ = g' := by
      apply colimit.hom_ext
      rintro ⟨⟨⟩⟩
    change comma_morphism.right (initial.to B') = _
    rw [this]
    rfl
  right_inv f := by
    let B' : structured_arrow A G := structured_arrow.mk f
    apply (comma_morphism.w (initial.to B')).symm.trans (category.id_comp _)
#align category_theory.left_adjoint_of_structured_arrow_initials_aux CategoryTheory.leftAdjointOfStructuredArrowInitialsAux

#print CategoryTheory.leftAdjointOfStructuredArrowInitials /-
/--
If each structured arrow category on `G` has an initial object, construct a left adjoint to `G`. It
is shown that it is a left adjoint in `adjunction_of_structured_arrow_initials`.
-/
def leftAdjointOfStructuredArrowInitials : C ⥤ D :=
  Adjunction.leftAdjointOfEquiv (leftAdjointOfStructuredArrowInitialsAux G) fun _ _ => by simp
#align category_theory.left_adjoint_of_structured_arrow_initials CategoryTheory.leftAdjointOfStructuredArrowInitials
-/

#print CategoryTheory.adjunctionOfStructuredArrowInitials /-
/--
If each structured arrow category on `G` has an initial object, we have a constructed left adjoint
to `G`.
-/
def adjunctionOfStructuredArrowInitials : leftAdjointOfStructuredArrowInitials G ⊣ G :=
  Adjunction.adjunctionOfEquivLeft _ _
#align category_theory.adjunction_of_structured_arrow_initials CategoryTheory.adjunctionOfStructuredArrowInitials
-/

#print CategoryTheory.isRightAdjointOfStructuredArrowInitials /-
/-- If each structured arrow category on `G` has an initial object, `G` is a right adjoint. -/
def isRightAdjointOfStructuredArrowInitials : IsRightAdjoint G
    where
  left := _
  adj := adjunctionOfStructuredArrowInitials G
#align category_theory.is_right_adjoint_of_structured_arrow_initials CategoryTheory.isRightAdjointOfStructuredArrowInitials
-/

end OfInitials

section OfTerminals

variable [∀ A, HasTerminal (CostructuredArrow G A)]

/- warning: category_theory.right_adjoint_of_costructured_arrow_terminals_aux -> CategoryTheory.rightAdjointOfCostructuredArrowTerminalsAux is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (G : CategoryTheory.Functor.{u2, u1, u4, u3} D _inst_2 C _inst_1) [_inst_3 : forall (A : C), CategoryTheory.Limits.HasTerminal.{max u2 u1, max u4 u1} (CategoryTheory.CostructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 G A) (CategoryTheory.CostructuredArrow.category.{u1, u3, u4, u2} D _inst_2 C _inst_1 G A)] (B : D) (A : C), Equiv.{succ u1, succ u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) (CategoryTheory.Functor.obj.{u2, u1, u4, u3} D _inst_2 C _inst_1 G B) A) (Quiver.Hom.{succ u2, u4} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) B (CategoryTheory.Comma.left.{u2, u1, u1, u4, u1, u3} D _inst_2 (CategoryTheory.Discrete.{u1} PUnit.{succ u1}) (CategoryTheory.discreteCategory.{u1} PUnit.{succ u1}) C _inst_1 G (CategoryTheory.Functor.fromPUnit.{u1, u3} C _inst_1 A) (CategoryTheory.Limits.terminal.{max u2 u1, max u4 u1} (CategoryTheory.CostructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 G A) (CategoryTheory.CostructuredArrow.category.{u1, u3, u4, u2} D _inst_2 C _inst_1 G A) (_inst_3 A))))
but is expected to have type
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (G : CategoryTheory.Functor.{u2, u1, u4, u3} D _inst_2 C _inst_1) [_inst_3 : forall (A : C), CategoryTheory.Limits.HasTerminal.{max u1 u2, max u4 u1} (CategoryTheory.CostructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 G A) (CategoryTheory.instCategoryCostructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 G A)] (B : D) (A : C), Equiv.{succ u1, succ u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) (Prefunctor.obj.{succ u2, succ u1, u4, u3} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{u2, u1, u4, u3} D _inst_2 C _inst_1 G) B) A) (Quiver.Hom.{succ u2, u4} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) B (CategoryTheory.Comma.left.{u2, u1, u1, u4, u1, u3} D _inst_2 (CategoryTheory.Discrete.{u1} PUnit.{succ u1}) (CategoryTheory.discreteCategory.{u1} PUnit.{succ u1}) C _inst_1 G (CategoryTheory.Functor.fromPUnit.{u1, u3} C _inst_1 A) (CategoryTheory.Limits.terminal.{max u1 u2, max u4 u1} (CategoryTheory.CostructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 G A) (CategoryTheory.instCategoryCostructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 G A) (_inst_3 A))))
Case conversion may be inaccurate. Consider using '#align category_theory.right_adjoint_of_costructured_arrow_terminals_aux CategoryTheory.rightAdjointOfCostructuredArrowTerminalsAuxₓ'. -/
/-- Implementation: If each costructured arrow category on `G` has a terminal object, an equivalence
which is helpful for constructing a right adjoint to `G`.
-/
@[simps]
def rightAdjointOfCostructuredArrowTerminalsAux (B : D) (A : C) :
    (G.obj B ⟶ A) ≃ (B ⟶ (⊤_ CostructuredArrow G A).left)
    where
  toFun g := CommaMorphism.left (terminal.from (CostructuredArrow.mk g))
  invFun g := G.map g ≫ (⊤_ CostructuredArrow G A).Hom
  left_inv := by tidy
  right_inv g :=
    by
    let B' : costructured_arrow G A :=
      costructured_arrow.mk (G.map g ≫ (⊤_ costructured_arrow G A).Hom)
    let g' : B' ⟶ ⊤_ costructured_arrow G A := costructured_arrow.hom_mk g rfl
    have : terminal.from _ = g' := by
      apply limit.hom_ext
      rintro ⟨⟨⟩⟩
    change comma_morphism.left (terminal.from B') = _
    rw [this]
    rfl
#align category_theory.right_adjoint_of_costructured_arrow_terminals_aux CategoryTheory.rightAdjointOfCostructuredArrowTerminalsAux

#print CategoryTheory.rightAdjointOfCostructuredArrowTerminals /-
/--
If each costructured arrow category on `G` has a terminal object, construct a right adjoint to `G`.
It is shown that it is a right adjoint in `adjunction_of_structured_arrow_initials`.
-/
def rightAdjointOfCostructuredArrowTerminals : C ⥤ D :=
  Adjunction.rightAdjointOfEquiv (rightAdjointOfCostructuredArrowTerminalsAux G) fun B₁ B₂ A f g =>
    by
    rw [← Equiv.eq_symm_apply]
    simp
#align category_theory.right_adjoint_of_costructured_arrow_terminals CategoryTheory.rightAdjointOfCostructuredArrowTerminals
-/

#print CategoryTheory.adjunctionOfCostructuredArrowTerminals /-
/-- If each costructured arrow category on `G` has a terminal object, we have a constructed right
adjoint to `G`.
-/
def adjunctionOfCostructuredArrowTerminals : G ⊣ rightAdjointOfCostructuredArrowTerminals G :=
  Adjunction.adjunctionOfEquivRight _ _
#align category_theory.adjunction_of_costructured_arrow_terminals CategoryTheory.adjunctionOfCostructuredArrowTerminals
-/

#print CategoryTheory.isLeftAdjointOfCostructuredArrowTerminals /-
/-- If each costructured arrow category on `G` has an terminal object, `G` is a left adjoint. -/
def isLeftAdjointOfCostructuredArrowTerminals : IsLeftAdjoint G
    where
  right := rightAdjointOfCostructuredArrowTerminals G
  adj := Adjunction.adjunctionOfEquivRight _ _
#align category_theory.is_left_adjoint_of_costructured_arrow_terminals CategoryTheory.isLeftAdjointOfCostructuredArrowTerminals
-/

end OfTerminals

section

variable {F : C ⥤ D}

attribute [local tidy] tactic.discrete_cases

/- warning: category_theory.mk_initial_of_left_adjoint -> CategoryTheory.mkInitialOfLeftAdjoint is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (G : CategoryTheory.Functor.{u2, u1, u4, u3} D _inst_2 C _inst_1) {F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} (h : CategoryTheory.Adjunction.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G) (A : C), CategoryTheory.Limits.IsInitial.{max u1 u2, max u4 u1} (CategoryTheory.StructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 A G) (CategoryTheory.StructuredArrow.category.{u1, u3, u4, u2} D _inst_2 C _inst_1 A G) (CategoryTheory.StructuredArrow.mk.{u2, u1, u4, u3} D _inst_2 C _inst_1 A (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F A) G (CategoryTheory.NatTrans.app.{u1, u1, u3, u3} C _inst_1 C _inst_1 (CategoryTheory.Functor.id.{u1, u3} C _inst_1) (CategoryTheory.Functor.comp.{u1, u2, u1, u3, u4, u3} C _inst_1 D _inst_2 C _inst_1 F G) (CategoryTheory.Adjunction.unit.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G h) A))
but is expected to have type
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (G : CategoryTheory.Functor.{u2, u1, u4, u3} D _inst_2 C _inst_1) {F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} (h : CategoryTheory.Adjunction.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G) (A : C), CategoryTheory.Limits.IsInitial.{max u1 u2, max u4 u1} (CategoryTheory.StructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 A G) (CategoryTheory.instCategoryStructuredArrow.{u2, u1, u4, u3} D _inst_2 C _inst_1 A G) (CategoryTheory.StructuredArrow.mk.{u2, u1, u4, u3} D _inst_2 C _inst_1 A (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) A) G (CategoryTheory.NatTrans.app.{u1, u1, u3, u3} C _inst_1 C _inst_1 (CategoryTheory.Functor.id.{u1, u3} C _inst_1) (CategoryTheory.Functor.comp.{u1, u2, u1, u3, u4, u3} C _inst_1 D _inst_2 C _inst_1 F G) (CategoryTheory.Adjunction.unit.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G h) A))
Case conversion may be inaccurate. Consider using '#align category_theory.mk_initial_of_left_adjoint CategoryTheory.mkInitialOfLeftAdjointₓ'. -/
/-- Given a left adjoint to `G`, we can construct an initial object in each structured arrow
category on `G`. -/
def mkInitialOfLeftAdjoint (h : F ⊣ G) (A : C) :
    IsInitial (StructuredArrow.mk (h.Unit.app A) : StructuredArrow A G)
    where
  desc B := StructuredArrow.homMk ((h.homEquiv _ _).symm B.pt.Hom) (by tidy)
  uniq s m w := by
    ext
    dsimp
    rw [Equiv.eq_symm_apply, adjunction.hom_equiv_unit]
    apply structured_arrow.w m
#align category_theory.mk_initial_of_left_adjoint CategoryTheory.mkInitialOfLeftAdjoint

/- warning: category_theory.mk_terminal_of_right_adjoint -> CategoryTheory.mkTerminalOfRightAdjoint is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (G : CategoryTheory.Functor.{u2, u1, u4, u3} D _inst_2 C _inst_1) {F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} (h : CategoryTheory.Adjunction.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G) (A : D), CategoryTheory.Limits.IsTerminal.{max u1 u2, max u3 u2} (CategoryTheory.CostructuredArrow.{u1, u2, u3, u4} C _inst_1 D _inst_2 F A) (CategoryTheory.CostructuredArrow.category.{u2, u4, u3, u1} C _inst_1 D _inst_2 F A) (CategoryTheory.CostructuredArrow.mk.{u1, u2, u3, u4} C _inst_1 D _inst_2 A (CategoryTheory.Functor.obj.{u2, u1, u4, u3} D _inst_2 C _inst_1 G A) F (CategoryTheory.NatTrans.app.{u2, u2, u4, u4} D _inst_2 D _inst_2 (CategoryTheory.Functor.comp.{u2, u1, u2, u4, u3, u4} D _inst_2 C _inst_1 D _inst_2 G F) (CategoryTheory.Functor.id.{u2, u4} D _inst_2) (CategoryTheory.Adjunction.counit.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G h) A))
but is expected to have type
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (G : CategoryTheory.Functor.{u2, u1, u4, u3} D _inst_2 C _inst_1) {F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} (h : CategoryTheory.Adjunction.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G) (A : D), CategoryTheory.Limits.IsTerminal.{max u1 u2, max u3 u2} (CategoryTheory.CostructuredArrow.{u1, u2, u3, u4} C _inst_1 D _inst_2 F A) (CategoryTheory.instCategoryCostructuredArrow.{u1, u2, u3, u4} C _inst_1 D _inst_2 F A) (CategoryTheory.CostructuredArrow.mk.{u1, u2, u3, u4} C _inst_1 D _inst_2 A (Prefunctor.obj.{succ u2, succ u1, u4, u3} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{u2, u1, u4, u3} D _inst_2 C _inst_1 G) A) F (CategoryTheory.NatTrans.app.{u2, u2, u4, u4} D _inst_2 D _inst_2 (CategoryTheory.Functor.comp.{u2, u1, u2, u4, u3, u4} D _inst_2 C _inst_1 D _inst_2 G F) (CategoryTheory.Functor.id.{u2, u4} D _inst_2) (CategoryTheory.Adjunction.counit.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G h) A))
Case conversion may be inaccurate. Consider using '#align category_theory.mk_terminal_of_right_adjoint CategoryTheory.mkTerminalOfRightAdjointₓ'. -/
/-- Given a right adjoint to `F`, we can construct a terminal object in each costructured arrow
category on `F`. -/
def mkTerminalOfRightAdjoint (h : F ⊣ G) (A : D) :
    IsTerminal (CostructuredArrow.mk (h.counit.app A) : CostructuredArrow F A)
    where
  lift B := CostructuredArrow.homMk (h.homEquiv _ _ B.pt.Hom) (by tidy)
  uniq s m w := by
    ext
    dsimp
    rw [h.eq_hom_equiv_apply, adjunction.hom_equiv_counit]
    exact costructured_arrow.w m
#align category_theory.mk_terminal_of_right_adjoint CategoryTheory.mkTerminalOfRightAdjoint

end

#print CategoryTheory.nonempty_isRightAdjoint_iff_hasInitial_structuredArrow /-
theorem nonempty_isRightAdjoint_iff_hasInitial_structuredArrow {G : D ⥤ C} :
    Nonempty (IsRightAdjoint G) ↔ ∀ A, HasInitial (StructuredArrow A G) :=
  ⟨fun ⟨h⟩ A => (mk_initial_of_left_adjoint _ h.adj A).HasInitial, fun h =>
    ⟨is_right_adjoint_of_structured_arrow_initials _⟩⟩
#align category_theory.nonempty_is_right_adjoint_iff_has_initial_structured_arrow CategoryTheory.nonempty_isRightAdjoint_iff_hasInitial_structuredArrow
-/

#print CategoryTheory.nonempty_isLeftAdjoint_iff_hasTerminal_costructuredArrow /-
theorem nonempty_isLeftAdjoint_iff_hasTerminal_costructuredArrow {F : C ⥤ D} :
    Nonempty (IsLeftAdjoint F) ↔ ∀ A, HasTerminal (CostructuredArrow F A) :=
  ⟨fun ⟨h⟩ A => (mk_terminal_of_right_adjoint _ h.adj A).HasTerminal, fun h =>
    ⟨is_left_adjoint_of_costructured_arrow_terminals _⟩⟩
#align category_theory.nonempty_is_left_adjoint_iff_has_terminal_costructured_arrow CategoryTheory.nonempty_isLeftAdjoint_iff_hasTerminal_costructuredArrow
-/

end CategoryTheory


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

! This file was ported from Lean 3 source module combinatorics.derangements.basic
! leanprover-community/mathlib commit 97eab48559068f3d6313da387714ef25768fb730
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Dynamics.FixedPoints.Basic
import Mathbin.GroupTheory.Perm.Option
import Mathbin.Logic.Equiv.Defs
import Mathbin.Logic.Equiv.Option

/-!
# Derangements on types

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

In this file we define `derangements α`, the set of derangements on a type `α`.

We also define some equivalences involving various subtypes of `perm α` and `derangements α`:
* `derangements_option_equiv_sigma_at_most_one_fixed_point`: An equivalence between
  `derangements (option α)` and the sigma-type `Σ a : α, {f : perm α // fixed_points f ⊆ a}`.
* `derangements_recursion_equiv`: An equivalence between `derangements (option α)` and the
  sigma-type `Σ a : α, (derangements (({a}ᶜ : set α) : Type _) ⊕ derangements α)` which is later
  used to inductively count the number of derangements.

In order to prove the above, we also prove some results about the effect of `equiv.remove_none`
on derangements: `remove_none.fiber_none` and `remove_none.fiber_some`.
-/

open Equiv Function

#print derangements /-
/-- A permutation is a derangement if it has no fixed points. -/
def derangements (α : Type _) : Set (Perm α) :=
  { f : Perm α | ∀ x : α, f x ≠ x }
#align derangements derangements
-/

variable {α β : Type _}

#print mem_derangements_iff_fixedPoints_eq_empty /-
theorem mem_derangements_iff_fixedPoints_eq_empty {f : Perm α} :
    f ∈ derangements α ↔ fixedPoints f = ∅ :=
  Set.eq_empty_iff_forall_not_mem.symm
#align mem_derangements_iff_fixed_points_eq_empty mem_derangements_iff_fixedPoints_eq_empty
-/

#print Equiv.derangementsCongr /-
/-- If `α` is equivalent to `β`, then `derangements α` is equivalent to `derangements β`. -/
def Equiv.derangementsCongr (e : α ≃ β) : derangements α ≃ derangements β :=
  e.permCongr.subtypeEquiv fun f => e.forall_congr' <| by simp
#align equiv.derangements_congr Equiv.derangementsCongr
-/

namespace derangements

#print derangements.subtypeEquiv /-
/-- Derangements on a subtype are equivalent to permutations on the original type where points are
fixed iff they are not in the subtype. -/
protected def subtypeEquiv (p : α → Prop) [DecidablePred p] :
    derangements (Subtype p) ≃ { f : Perm α // ∀ a, ¬p a ↔ a ∈ fixedPoints f } :=
  calc
    derangements (Subtype p) ≃
        { f : { f : Perm α // ∀ a, ¬p a → a ∈ fixedPoints f } // ∀ a, a ∈ fixedPoints f → ¬p a } :=
      by
      refine' (perm.subtype_equiv_subtype_perm p).subtypeEquiv fun f => ⟨fun hf a hfa ha => _, _⟩
      · refine' hf ⟨a, ha⟩ (Subtype.ext _)
        rwa [mem_fixed_points, is_fixed_pt, perm.subtype_equiv_subtype_perm, @coeFn_coe_base',
          Equiv.coe_fn_mk, Subtype.coe_mk, Equiv.Perm.ofSubtype_apply_of_mem] at hfa
      rintro hf ⟨a, ha⟩ hfa
      refine' hf _ _ ha
      change perm.subtype_equiv_subtype_perm p f a = a
      rw [perm.subtype_equiv_subtype_perm_apply_of_mem f ha, hfa, Subtype.coe_mk]
    _ ≃ { f : Perm α // ∃ h : ∀ a, ¬p a → a ∈ fixedPoints f, ∀ a, a ∈ fixedPoints f → ¬p a } :=
      (subtypeSubtypeEquivSubtypeExists _ _)
    _ ≃ { f : Perm α // ∀ a, ¬p a ↔ a ∈ fixedPoints f } :=
      subtypeEquivRight fun f => by
        simp_rw [exists_prop, ← forall_and, ← iff_iff_implies_and_implies]

#align derangements.subtype_equiv derangements.subtypeEquiv
-/

#print derangements.atMostOneFixedPointEquivSum_derangements /-
/-- The set of permutations that fix either `a` or nothing is equivalent to the sum of:
    - derangements on `α`
    - derangements on `α` minus `a`. -/
def atMostOneFixedPointEquivSum_derangements [DecidableEq α] (a : α) :
    { f : Perm α // fixedPoints f ⊆ {a} } ≃ Sum (derangements ({a}ᶜ : Set α)) (derangements α) :=
  calc
    { f : Perm α // fixedPoints f ⊆ {a} } ≃
        Sum { f : { f : Perm α // fixedPoints f ⊆ {a} } // a ∈ fixedPoints f }
          { f : { f : Perm α // fixedPoints f ⊆ {a} } // a ∉ fixedPoints f } :=
      (Equiv.sumCompl _).symm
    _ ≃
        Sum { f : Perm α // fixedPoints f ⊆ {a} ∧ a ∈ fixedPoints f }
          { f : Perm α // fixedPoints f ⊆ {a} ∧ a ∉ fixedPoints f } :=
      by
      refine' Equiv.sumCongr _ _ <;>
        · convert subtype_subtype_equiv_subtype_inter _ _
          ext f
          rfl
    _ ≃ Sum { f : Perm α // fixedPoints f = {a} } { f : Perm α // fixedPoints f = ∅ } :=
      by
      refine' Equiv.sumCongr (subtype_equiv_right fun f => _) (subtype_equiv_right fun f => _)
      · rw [Set.eq_singleton_iff_unique_mem, and_comm']
        rfl
      · rw [Set.eq_empty_iff_forall_not_mem]
        refine' ⟨fun h x hx => h.2 (h.1 hx ▸ hx), fun h => ⟨fun x hx => (h _ hx).elim, h _⟩⟩
    _ ≃ Sum (derangements ({a}ᶜ : Set α)) (derangements α) :=
      by
      refine'
        Equiv.sumCongr ((derangements.subtypeEquiv _).trans <| subtype_equiv_right fun x => _).symm
          (subtype_equiv_right fun f => mem_derangements_iff_fixed_points_eq_empty.symm)
      rw [eq_comm, Set.ext_iff]
      simp_rw [Set.mem_compl_iff, Classical.not_not]

#align derangements.at_most_one_fixed_point_equiv_sum_derangements derangements.atMostOneFixedPointEquivSum_derangements
-/

namespace Equiv

variable [DecidableEq α]

#print derangements.Equiv.RemoveNone.fiber /-
/-- The set of permutations `f` such that the preimage of `(a, f)` under
    `equiv.perm.decompose_option` is a derangement. -/
def RemoveNone.fiber (a : Option α) : Set (Perm α) :=
  { f : Perm α | (a, f) ∈ Equiv.Perm.decomposeOption '' derangements (Option α) }
#align derangements.equiv.remove_none.fiber derangements.Equiv.RemoveNone.fiber
-/

#print derangements.Equiv.RemoveNone.mem_fiber /-
theorem RemoveNone.mem_fiber (a : Option α) (f : Perm α) :
    f ∈ RemoveNone.fiber a ↔
      ∃ F : Perm (Option α), F ∈ derangements (Option α) ∧ F none = a ∧ removeNone F = f :=
  by simp [remove_none.fiber, derangements]
#align derangements.equiv.remove_none.mem_fiber derangements.Equiv.RemoveNone.mem_fiber
-/

#print derangements.Equiv.RemoveNone.fiber_none /-
theorem RemoveNone.fiber_none : RemoveNone.fiber (@none α) = ∅ :=
  by
  rw [Set.eq_empty_iff_forall_not_mem]
  intro f hyp
  rw [remove_none.mem_fiber] at hyp
  rcases hyp with ⟨F, F_derangement, F_none, _⟩
  exact F_derangement none F_none
#align derangements.equiv.remove_none.fiber_none derangements.Equiv.RemoveNone.fiber_none
-/

#print derangements.Equiv.RemoveNone.fiber_some /-
/-- For any `a : α`, the fiber over `some a` is the set of permutations
    where `a` is the only possible fixed point. -/
theorem RemoveNone.fiber_some (a : α) :
    RemoveNone.fiber (some a) = { f : Perm α | fixedPoints f ⊆ {a} } :=
  by
  ext f
  constructor
  · rw [remove_none.mem_fiber]
    rintro ⟨F, F_derangement, F_none, rfl⟩ x x_fixed
    rw [mem_fixed_points_iff] at x_fixed
    apply_fun some  at x_fixed
    cases' Fx : F (some x) with y
    · rwa [remove_none_none F Fx, F_none, Option.some_inj, eq_comm] at x_fixed
    · exfalso
      rw [remove_none_some F ⟨y, Fx⟩] at x_fixed
      exact F_derangement _ x_fixed
  · intro h_opfp
    use equiv.perm.decompose_option.symm (some a, f)
    constructor
    · intro x
      apply_fun swap none (some a)
      simp only [perm.decompose_option_symm_apply, swap_apply_self, perm.coe_mul]
      cases x
      · simp
      simp only [Equiv.optionCongr_apply, Option.map_some']
      by_cases x_vs_a : x = a
      · rw [x_vs_a, swap_apply_right]
        apply Option.some_ne_none
      have ne_1 : some x ≠ none := Option.some_ne_none _
      have ne_2 : some x ≠ some a := (Option.some_injective α).ne_iff.mpr x_vs_a
      rw [swap_apply_of_ne_of_ne ne_1 ne_2, (Option.some_injective α).ne_iff]
      intro contra
      exact x_vs_a (h_opfp contra)
    · rw [apply_symm_apply]
#align derangements.equiv.remove_none.fiber_some derangements.Equiv.RemoveNone.fiber_some
-/

end Equiv

section Option

variable [DecidableEq α]

#print derangements.derangementsOptionEquivSigmaAtMostOneFixedPoint /-
/-- The set of derangements on `option α` is equivalent to the union over `a : α`
    of "permutations with `a` the only possible fixed point". -/
def derangementsOptionEquivSigmaAtMostOneFixedPoint :
    derangements (Option α) ≃ Σa : α, { f : Perm α | fixedPoints f ⊆ {a} } :=
  by
  have fiber_none_is_false : equiv.remove_none.fiber (@none α) → False :=
    by
    rw [equiv.remove_none.fiber_none]
    exact IsEmpty.false
  calc
    derangements (Option α) ≃ Equiv.Perm.decomposeOption '' derangements (Option α) :=
      Equiv.image _ _
    _ ≃ Σa : Option α, ↥(equiv.remove_none.fiber a) := (set_prod_equiv_sigma _)
    _ ≃ Σa : α, ↥(equiv.remove_none.fiber (some a)) :=
      (sigma_option_equiv_of_some _ fiber_none_is_false)
    _ ≃ Σa : α, { f : perm α | fixed_points f ⊆ {a} } := by simp_rw [equiv.remove_none.fiber_some]

#align derangements.derangements_option_equiv_sigma_at_most_one_fixed_point derangements.derangementsOptionEquivSigmaAtMostOneFixedPoint
-/

/- warning: derangements.derangements_recursion_equiv -> derangements.derangementsRecursionEquiv is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α], Equiv.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α))) Type.{u1} (Set.hasCoeToSort.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α))) (derangements.{u1} (Option.{u1} α))) (Sigma.{u1, u1} α (fun (a : α) => Sum.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Equiv.Perm.{succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α)) (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.hasSingleton.{u1} α) a))))) Type.{u1} (Set.hasCoeToSort.{u1} (Equiv.Perm.{succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α)) (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.hasSingleton.{u1} α) a))))) (derangements.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α)) (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.hasSingleton.{u1} α) a))))) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Equiv.Perm.{succ u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Equiv.Perm.{succ u1} α)) (derangements.{u1} α))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α], Equiv.{succ u1, succ u1} (Set.Elem.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (derangements.{u1} (Option.{u1} α))) (Sigma.{u1, u1} α (fun (a : α) => Sum.{u1, u1} (Set.Elem.{u1} (Equiv.Perm.{succ u1} (Set.Elem.{u1} α (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.instBooleanAlgebraSet.{u1} α)) (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.instSingletonSet.{u1} α) a)))) (derangements.{u1} (Set.Elem.{u1} α (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.instBooleanAlgebraSet.{u1} α)) (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.instSingletonSet.{u1} α) a))))) (Set.Elem.{u1} (Equiv.Perm.{succ u1} α) (derangements.{u1} α))))
Case conversion may be inaccurate. Consider using '#align derangements.derangements_recursion_equiv derangements.derangementsRecursionEquivₓ'. -/
/-- The set of derangements on `option α` is equivalent to the union over all `a : α` of
    "derangements on `α` ⊕ derangements on `{a}ᶜ`". -/
def derangementsRecursionEquiv :
    derangements (Option α) ≃
      Σa : α, Sum (derangements (({a}ᶜ : Set α) : Type _)) (derangements α) :=
  derangementsOptionEquivSigmaAtMostOneFixedPoint.trans
    (sigmaCongrRight atMostOneFixedPointEquivSum_derangements)
#align derangements.derangements_recursion_equiv derangements.derangementsRecursionEquiv

end Option

end derangements


/-
Copyright (c) 2015 Joey Teng. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Joey Teng.
-/
import tactic -- imports all the Lean tactics
import combinatorics.simple_graph.connectivity

-- Graph Theory

universe u

namespace simple_graph
variables {V : Type u} (G : simple_graph V)

/-!
## Connectivity

Utilities about `walk`, `trail` and `path`.
-/

-- def trail_from_walk [decidable_eq V]: Π {v w : V}, G.walk v w → G.walk v w
-- | _ _ walk.nil := walk.nil
-- | x _ (walk.cons p q) :=
--   if q.edges.nodup then walk.cons p q else walk.cons p q

-- def walk_drop_loop [decidable_eq V]: Π {u v w : V}, G.adj u v → G.walk u w → G.walk v w
-- | _ v w _ (walk.cons _ walk.nil) := G.walk v w
-- | u v w adj (walk.cons a t) := if

def subwalk_nil_from_vertex : Π {u : V}, G.walk u u
| u := (walk.nil : G.walk u u)

-- def walk_from_edges : Π {u v : V}, list (sym2 V) → G.walk u v
-- | u v (a :: []) := walk.cons (a : G.adj u v) (walk.nil : G.walk v v)

-- def subwalk_from_adj [decidable_eq V]:
--   Π {u v w x: V}, G.adj u v → G.walk w x → G.walk u x
-- | u _ _ x adj walk.nil := walk.cons adj (walk.nil : G.walk x x)
-- | u v w x _adj (walk.cons (adj _ _) q) :=
--   if p u v then walk.cons p q else subwalk_from_vertex u q

theorem is_trail_nil {v : V} (p : G.walk v v): p = walk.nil → p.is_trail :=
begin
  intro hp,
  rw hp,
  simp,
end

theorem has_trail_iff_walk {v w : V} (p : G.walk v w) [decidable_eq V]:
  ∃ ⦃p' : G.walk v w⦄, p'.is_trail :=
begin
  induction p with d v_ mid w_ adj walk_ hd,
  { dsimp at *,
    fsplit,
    work_on_goal 0 { refl },
    fsplit,
    exact dec_trivial,
  },
  { cases hd with trail_ h,
    -- by_cases hdup : adj ∈ trail_.edges, -- not working
    -- Should discuss by cases
    -- If adj is a dup, then roll-back all the way s.t. adj is not a dup
    -- Else append_left
    have t' := walk.cons adj trail_,
    have htcons : t' = walk.cons adj trail_,
    {
      sorry,
    },
    have ht' : t'.is_trail,
    {
      sorry,
      -- rw t',
      -- rw walk.cons_is_trail_iff,
    },
    use t',
    exact ht'
  },
end

/-!
## Reachable

Based on `simple_graph.walk`
-/

/-- Exists an walk in `G` from `v` to `w` --/
def reachable (v w : V) : Prop :=
  ∃ p : G.walk v w, true

theorem reachable_def {v w : V} :
  G.reachable v w ↔ ∃ ⦃p : G.walk v w⦄, true :=
begin
  refl,
end

theorem reachable_if_walk {v w : V} (p : G.walk v w):
  G.reachable v w :=
begin
  use p,
end

/-- `v` is always reachable to itself --/
@[simp]
theorem reachable_self {v : V} : G.reachable v v :=
begin
  use walk.nil,
end

@[simp]
theorem reachable_trans {u v w : V} :
  G.reachable u v → G.reachable v w → G.reachable u w :=
begin
  intros h1 h2,
  cases h1 with p1 hp1,
  cases h2 with p2 hp2,
  have p := p1.append p2,
  use p,
end

-- @[simp]
theorem reachable_symm {u v : V} :
  G.reachable u v → G.reachable v u :=
begin
  intro h,
  cases h with p _,
  use p.reverse,
end

@[simp]
theorem reachable_adj {v w : V} : G.adj v w → G.reachable v w :=
begin
  intro h,
  have p : G.walk v w,
  { constructor,
    assumption,
    exact walk.nil, },
  use p,
end

theorem reachable_if_passing {u v w : V} (p : G.walk u w):
  v ∈ p.support → G.reachable v w :=
begin
  intro hp,
  fconstructor,
  {
    haveI support := p.support,
    sorry,
  },
  { triv },
end

theorem reachable_if_support {u v w x : V} :
  ∃ {p : G.walk u x}, v ∈ p.support ∧ w ∈ p.support → G.reachable v w :=
begin
  sorry,
end

/-### Extend to trail-/

theorem reachable_trail {v w : V} :
  G.reachable v w ↔ ∃ ⦃p : G.walk v w⦄, p.is_trail :=
begin
  split,
  { simp,
    intro h,
    rw reachable at h,
    cases h with p _,
    use p,
    sorry,
  },
  { simp,
    intros x hx,
    use x,
  },
end

/-!## Connected-/

/-- All vertices are reachable to each other --/
def is_connected : Prop :=
  ∀ ⦃v w : V⦄, G.reachable v w

/-- Complete Graph is connected.
  Note that empty graph may not, unless `V` is empty. --/
theorem complete_graph_is_connected : G = ⊤ → G.is_connected :=
begin
  intros hG v w,
  by_cases eq : v = w,
  { rw eq,
    exact G.reachable_self, },
  { rw ← ne at eq,
    have p : G.walk v w,
    {
       have h : G.adj v w,
      { finish, },
      { exact walk.cons h walk.nil },
    },
    rw reachable,
    use p,
  },
end

/-!## Eulerian Walks-/
section Eulerian
variables [decidable_eq V]

def is_euler_circuit {v : V} (p : G.walk v v) : Prop :=
  p.is_circuit ∧ ∀ ⦃e : sym2 V⦄, e ∈ G.edge_set → (e ∈ p.edges)

def is_eulerian [decidable_eq V] : Prop :=
  ∃ {v : V}, ∃ {p : G.walk v v}, G.is_euler_circuit p

theorem eulerian_is_connected :
  G.is_eulerian → G.is_connected :=
begin
  rw is_eulerian,
  intro h,
  cases h with v hv,
  cases hv with p hp,
  sorry,
end

theorem eulerian_all_even_degree [decidable_rel G.adj] [fintype V] :
  G.is_eulerian → ∀ (v : V), even (G.degree v):=
begin
  sorry
end

/-Euler's Theorem-/
theorem is_eulerian_iff_all_even_degree [decidable_rel G.adj] [fintype V] :
  is_connected G ∧ ∀ (v : V), even (G.degree v) ↔ G.is_eulerian :=
begin
  sorry
end

/-!### Example: Seven Bridges of Königsberg

  A modified version of "Seven Bridges of Königsberg", which now contains a Euler path.

  Two duplicated edges (bridges) are removed from the original graph.
-/
section Konigsberg

/- Four sectors -/
@[derive decidable_eq]
inductive sector_
| v1 : sector_
| v2 : sector_
| v3 : sector_
| v4 : sector_

/-
  v1
  | \
  v2 - v4
  | /
  v3
-/
def bridge_ : sector_ → sector_ → Prop
| sector_.v1 sector_.v3 := false
| sector_.v3 sector_.v1 := false
| _ _ := true

/-
  A Euler Graph

    v1
   / \
  v2  v4
   \ /
    v3
-/
def bridge_2 : sector_ → sector_ → Prop
| sector_.v1 sector_.v3 := false
| sector_.v3 sector_.v1 := false
| sector_.v2 sector_.v4 := false
| sector_.v4 sector_.v2 := false
| _ _ := true

def graph_ : simple_graph sector_ := simple_graph.from_rel bridge_
def graph_2 : simple_graph sector_ := simple_graph.from_rel bridge_2

example : sector_.v1 ≠ sector_.v4 :=
begin
  exact dec_trivial
end

example {G : simple_graph sector_}:
   G = graph_2 → G.is_eulerian :=
begin
  intro h,
  have v1 := sector_.v1,
  have v2 := sector_.v2,
  have v3 := sector_.v3,
  have v4 := sector_.v4,
  rw is_eulerian,
  use v4,
  have p' : G.walk v4 v4 := walk.nil,
  have e14 : G.adj v1 v4,
  { rw h,
    split,
    { sorry, },
    { have h_ := bridge_2(v1)(v4),
      sorry,
    },
  },
  have e21 : G.adj v2 v1,
  { sorry, }, -- same as e14
  have e32 : G.adj v3 v2,
  { sorry, },
  have e43 : G.adj v4 v3,
  { sorry, },
  have p : G.walk v4 v4 := walk.cons e43 (walk.cons e32 (walk.cons e21 (walk.cons e14 p'))),
  use p,
  rw is_euler_circuit,
  split,
  {
    split,
    {
      split,
      rw list.nodup,
      sorry,
    },
    {
      intro h,
      sorry, -- by the construction of p
    },
  },
  intro e,
  intro he,
  have _set := G.edge_set,
  induction e,
  { cases e,
    sorry,
  },
  { refl },
end

end Konigsberg

end Eulerian

end simple_graph


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.module.equiv

/-!
# The general linear group of linear maps

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

The general linear group is defined to be the group of invertible linear maps from `M` to itself.

See also `matrix.general_linear_group`

## Main definitions

* `linear_map.general_linear_group`

-/

variables (R M : Type*)

namespace linear_map

variables [semiring R] [add_comm_monoid M] [module R M]
variables (R M)

/-- The group of invertible linear maps from `M` to itself -/
@[reducible] def general_linear_group := (M →ₗ[R] M)ˣ

namespace general_linear_group
variables {R M}

instance : has_coe_to_fun (general_linear_group R M) (λ _, M → M) := by apply_instance

/-- An invertible linear map `f` determines an equivalence from `M` to itself. -/
def to_linear_equiv (f : general_linear_group R M) : (M ≃ₗ[R] M) :=
{ inv_fun := f.inv.to_fun,
  left_inv := λ m, show (f.inv * f.val) m = m,
    by erw f.inv_val; simp,
  right_inv := λ m, show (f.val * f.inv) m = m,
    by erw f.val_inv; simp,
  ..f.val }

/-- An equivalence from `M` to itself determines an invertible linear map. -/
def of_linear_equiv (f : (M ≃ₗ[R] M)) : general_linear_group R M :=
{ val := f,
  inv := (f.symm : M →ₗ[R] M),
  val_inv := linear_map.ext $ λ _, f.apply_symm_apply _,
  inv_val := linear_map.ext $ λ _, f.symm_apply_apply _ }

variables (R M)

/-- The general linear group on `R` and `M` is multiplicatively equivalent to the type of linear
equivalences between `M` and itself. -/
def general_linear_equiv : general_linear_group R M ≃* (M ≃ₗ[R] M) :=
{ to_fun := to_linear_equiv,
  inv_fun := of_linear_equiv,
  left_inv := λ f, by { ext, refl },
  right_inv := λ f, by { ext, refl },
  map_mul' := λ x y, by {ext, refl} }

@[simp] lemma general_linear_equiv_to_linear_map (f : general_linear_group R M) :
  (general_linear_equiv R M f : M →ₗ[R] M) = f :=
by {ext, refl}

@[simp] lemma coe_fn_general_linear_equiv (f : general_linear_group R M) :
  ⇑(general_linear_equiv R M f) = (f : M → M) :=
rfl

end general_linear_group

end linear_map


/-
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
-/
import algebra.group.commute
import algebra.group_with_zero.defs
import data.fun_like.basic

/-!
# Monoid and group homomorphisms

This file defines the bundled structures for monoid and group homomorphisms. Namely, we define
`monoid_hom` (resp., `add_monoid_hom`) 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:

* `zero_hom`
* `one_hom`
* `add_hom`
* `mul_hom`
* `monoid_with_zero_hom`

## Notations

* `→+`: Bundled `add_monoid` homs. Also use for `add_group` homs.
* `→*`: Bundled `monoid` homs. Also use for `group` homs.
* `→*₀`: Bundled `monoid_with_zero` homs. Also use for `group_with_zero` 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 `group_hom` -- the idea is that `monoid_hom` is used.
The constructor for `monoid_hom` needs a proof of `map_one` as well
as `map_mul`; a separate constructor `monoid_hom.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 `monoid_hom`.  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

monoid_hom, add_monoid_hom

-/

variables {M : Type*} {N : Type*} {P : Type*} -- monoids
variables {G : Type*} {H : Type*} -- groups
variables {F : Type*} -- homs

-- for easy multiple inheritance
set_option old_structure_cmd true

section zero

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

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

When you extend this structure, make sure to also extend `zero_hom_class`.
-/
structure zero_hom (M : Type*) (N : Type*) [has_zero M] [has_zero N] :=
(to_fun : M → N)
(map_zero' : to_fun 0 = 0)

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

You should extend this typeclass when you extend `zero_hom`.
-/
class zero_hom_class (F : Type*) (M N : out_param $ Type*)
  [has_zero M] [has_zero N] extends fun_like F M (λ _, N) :=
(map_zero : ∀ (f : F), f 0 = 0)

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

end zero

section add

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

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

When you extend this structure, make sure to extend `add_hom_class`.
-/
structure add_hom (M : Type*) (N : Type*) [has_add M] [has_add N] :=
(to_fun : M → N)
(map_add' : ∀ x y, to_fun (x + y) = to_fun x + to_fun y)

/-- `add_hom_class F M N` states that `F` is a type of addition-preserving homomorphisms.
You should declare an instance of this typeclass when you extend `add_hom`.
-/
class add_hom_class (F : Type*) (M N : out_param $ Type*)
  [has_add M] [has_add N] extends fun_like F M (λ _, N) :=
(map_add : ∀ (f : F) (x y : M), f (x + y) = f x + f y)

-- 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 `add_zero_class` structure.

`add_monoid_hom` is also used for group homomorphisms.

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

When you extend this structure, make sure to extend `add_monoid_hom_class`.
-/
@[ancestor zero_hom add_hom]
structure add_monoid_hom (M : Type*) (N : Type*) [add_zero_class M] [add_zero_class N]
  extends zero_hom M N, add_hom M N

attribute [nolint doc_blame] add_monoid_hom.to_add_hom
attribute [nolint doc_blame] add_monoid_hom.to_zero_hom

infixr ` →+ `:25 := add_monoid_hom

/-- `add_monoid_hom_class F M N` states that `F` is a type of `add_zero_class`-preserving
homomorphisms.

You should also extend this typeclass when you extend `add_monoid_hom`.
-/
@[ancestor add_hom_class zero_hom_class]
class add_monoid_hom_class (F : Type*) (M N : out_param $ Type*)
  [add_zero_class M] [add_zero_class N]
  extends add_hom_class F M N, zero_hom_class F M N

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

end add_zero

section one

variables [has_one M] [has_one N]

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

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

When you extend this structure, make sure to also extend `one_hom_class`.
-/
@[to_additive]
structure one_hom (M : Type*) (N : Type*) [has_one M] [has_one N] :=
(to_fun : M → N)
(map_one' : to_fun 1 = 1)

/-- `one_hom_class F M N` states that `F` is a type of one-preserving homomorphisms.
You should extend this typeclass when you extend `one_hom`.
-/
@[to_additive]
class one_hom_class (F : Type*) (M N : out_param $ Type*)
  [has_one M] [has_one N]
  extends fun_like F M (λ _, N) :=
(map_one : ∀ (f : F), f 1 = 1)

@[to_additive]
instance one_hom.one_hom_class : one_hom_class (one_hom M N) M N :=
{ coe := one_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_one := one_hom.map_one' }

@[simp, to_additive] lemma map_one [one_hom_class F M N] (f : F) : f 1 = 1 :=
one_hom_class.map_one f

@[to_additive] lemma map_eq_one_iff [one_hom_class F M N] (f : F)
  (hf : function.injective f) {x : M} : f x = 1 ↔ x = 1 :=
hf.eq_iff' (map_one f)

@[to_additive]
instance [one_hom_class F M N] : has_coe_t F (one_hom M N) :=
⟨λ f, { to_fun := f, map_one' := map_one f }⟩

end one

section mul

variables [has_mul M] [has_mul N]

/-- `mul_hom M N` is the type of functions `M → N` that preserve multiplication.

When possible, instead of parametrizing results over `(f : mul_hom M N)`,
you should parametrize over `(F : Type*) [mul_hom_class F M N] (f : F)`.
When you extend this structure, make sure to extend `mul_hom_class`.
-/
@[to_additive]
structure mul_hom (M : Type*) (N : Type*) [has_mul M] [has_mul N] :=
(to_fun : M → N)
(map_mul' : ∀ x y, to_fun (x * y) = to_fun x * to_fun y)

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

You should declare an instance of this typeclass when you extend `mul_hom`.
-/
@[to_additive]
class mul_hom_class (F : Type*) (M N : out_param $ Type*)
  [has_mul M] [has_mul N] extends fun_like F M (λ _, N) :=
(map_mul : ∀ (f : F) (x y : M), f (x * y) = f x * f y)

@[to_additive]
instance mul_hom.mul_hom_class : mul_hom_class (mul_hom M N) M N :=
{ coe := mul_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_mul := mul_hom.map_mul' }

@[simp, to_additive] lemma map_mul [mul_hom_class F M N] (f : F) (x y : M) :
  f (x * y) = f x * f y :=
mul_hom_class.map_mul f x y

@[to_additive]
instance [mul_hom_class F M N] : has_coe_t F (mul_hom M N) :=
⟨λ f, { to_fun := f, map_mul' := map_mul f }⟩

end mul

section mul_one

variables [mul_one_class M] [mul_one_class N]

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

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

When you extend this structure, make sure to extend `monoid_hom_class`.
-/
@[ancestor one_hom mul_hom, to_additive]
structure monoid_hom (M : Type*) (N : Type*) [mul_one_class M] [mul_one_class N]
  extends one_hom M N, mul_hom M N

attribute [nolint doc_blame] monoid_hom.to_mul_hom
attribute [nolint doc_blame] monoid_hom.to_one_hom

infixr ` →* `:25 := monoid_hom

/-- `monoid_hom_class F M N` states that `F` is a type of `monoid`-preserving homomorphisms.
You should also extend this typeclass when you extend `monoid_hom`.
-/
@[ancestor mul_hom_class one_hom_class, to_additive]
class monoid_hom_class (F : Type*) (M N : out_param $ Type*)
  [mul_one_class M] [mul_one_class N]
  extends mul_hom_class F M N, one_hom_class F M N

@[to_additive]
instance monoid_hom.monoid_hom_class : monoid_hom_class (M →* N) M N :=
{ coe := monoid_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_mul := monoid_hom.map_mul',
  map_one := monoid_hom.map_one' }

@[to_additive]
instance [monoid_hom_class F M N] : has_coe_t F (M →* N) :=
⟨λ f, { to_fun := f, map_one' := map_one f, map_mul' := map_mul f }⟩

@[to_additive]
lemma map_mul_eq_one [monoid_hom_class F M N] (f : F) {a b : M} (h : a * b = 1) :
  f a * f b = 1 :=
by rw [← map_mul, h, map_one]

/-- Group homomorphisms preserve inverse. -/
@[simp, to_additive]
theorem map_inv [group G] [group H] [monoid_hom_class F G H]
  (f : F) (g : G) : f g⁻¹ = (f g)⁻¹ :=
eq_inv_of_mul_eq_one $ map_mul_eq_one f $ inv_mul_self g

/-- Group homomorphisms preserve division. -/
@[simp, to_additive]
theorem map_mul_inv [group G] [group H] [monoid_hom_class F G H]
  (f : F) (g h : G) : f (g * h⁻¹) = f g * (f h)⁻¹ :=
by rw [map_mul, map_inv]

/-- Group homomorphisms preserve division. -/
@[simp, to_additive] lemma map_div [group G] [group H] [monoid_hom_class F G H]
  (f : F) (x y : G) : f (x / y) = f x / f y :=
by rw [div_eq_mul_inv, div_eq_mul_inv, map_mul_inv]

@[simp, to_additive map_nsmul] theorem map_pow [monoid G] [monoid H] [monoid_hom_class 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]

@[to_additive]
theorem map_zpow' [div_inv_monoid G] [div_inv_monoid H] [monoid_hom_class 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_coe_nat, map_pow, zpow_coe_nat]
| -[1+n]  := by rw [zpow_neg_succ_of_nat, hf, map_pow, ← zpow_neg_succ_of_nat]

/-- Group homomorphisms preserve integer power. -/
@[simp, to_additive /-" Additive group homomorphisms preserve integer scaling. "-/]
theorem map_zpow [group G] [group H] [monoid_hom_class F G H] (f : F) (g : G) (n : ℤ) :
  f (g ^ n) = (f g) ^ n :=
map_zpow' f (map_inv f) g n

end mul_one

section mul_zero_one

variables [mul_zero_one_class M] [mul_zero_one_class N]

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

`monoid_with_zero_hom` is also used for group homomorphisms.

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

When you extend this structure, make sure to extend `monoid_with_zero_hom_class`.
-/
@[ancestor zero_hom monoid_hom]
structure monoid_with_zero_hom (M : Type*) (N : Type*) [mul_zero_one_class M] [mul_zero_one_class N]
  extends zero_hom M N, monoid_hom M N

attribute [nolint doc_blame] monoid_with_zero_hom.to_monoid_hom
attribute [nolint doc_blame] monoid_with_zero_hom.to_zero_hom

infixr ` →*₀ `:25 := monoid_with_zero_hom

/-- `monoid_with_zero_hom_class F M N` states that `F` is a type of
`monoid_with_zero`-preserving homomorphisms.

You should also extend this typeclass when you extend `monoid_with_zero_hom`.
-/
class monoid_with_zero_hom_class (F : Type*) (M N : out_param $ Type*)
  [mul_zero_one_class M] [mul_zero_one_class N]
  extends monoid_hom_class F M N, zero_hom_class F M N

instance monoid_with_zero_hom.monoid_with_zero_hom_class :
  monoid_with_zero_hom_class (M →*₀ N) M N :=
{ coe := monoid_with_zero_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_mul := monoid_with_zero_hom.map_mul',
  map_one := monoid_with_zero_hom.map_one',
  map_zero := monoid_with_zero_hom.map_zero' }

instance [monoid_with_zero_hom_class F M N] : has_coe_t F (M →*₀ N) :=
⟨λ f, { to_fun := f, map_one' := map_one f, map_zero' := map_zero f, map_mul' := map_mul f }⟩

end mul_zero_one

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

/-! Bundled morphisms can be down-cast to weaker bundlings -/
@[to_additive]
instance monoid_hom.has_coe_to_one_hom {mM : mul_one_class M} {mN : mul_one_class N} :
  has_coe (M →* N) (one_hom M N) := ⟨monoid_hom.to_one_hom⟩
@[to_additive]
instance monoid_hom.has_coe_to_mul_hom {mM : mul_one_class M} {mN : mul_one_class N} :
  has_coe (M →* N) (mul_hom M N) := ⟨monoid_hom.to_mul_hom⟩
instance monoid_with_zero_hom.has_coe_to_monoid_hom
  {mM : mul_zero_one_class M} {mN : mul_zero_one_class N} :
  has_coe (M →*₀ N) (M →* N) := ⟨monoid_with_zero_hom.to_monoid_hom⟩
instance monoid_with_zero_hom.has_coe_to_zero_hom
  {mM : mul_zero_one_class M} {mN : mul_zero_one_class N} :
  has_coe (M →*₀ N) (zero_hom M N) := ⟨monoid_with_zero_hom.to_zero_hom⟩

/-! The simp-normal form of morphism coercion is `f.to_..._hom`. This choice is primarily because
this is the way things were before the above coercions were introduced. Bundled morphisms defined
elsewhere in Mathlib may choose `↑f` as their simp-normal form instead. -/
@[simp, to_additive]
lemma monoid_hom.coe_eq_to_one_hom {mM : mul_one_class M} {mN : mul_one_class N} (f : M →* N) :
  (f : one_hom M N) = f.to_one_hom := rfl
@[simp, to_additive]
lemma monoid_hom.coe_eq_to_mul_hom {mM : mul_one_class M} {mN : mul_one_class N} (f : M →* N) :
  (f : mul_hom M N) = f.to_mul_hom := rfl
@[simp]
lemma monoid_with_zero_hom.coe_eq_to_monoid_hom
  {mM : mul_zero_one_class M} {mN : mul_zero_one_class N} (f : M →*₀ N) :
  (f : M →* N) = f.to_monoid_hom := rfl
@[simp]
lemma monoid_with_zero_hom.coe_eq_to_zero_hom
  {mM : mul_zero_one_class M} {mN : mul_zero_one_class N} (f : M →*₀ N) :
  (f : zero_hom M N) = f.to_zero_hom := rfl

-- Fallback `has_coe_to_fun` instances to help the elaborator
@[to_additive]
instance {mM : has_one M} {mN : has_one N} : has_coe_to_fun (one_hom M N) (λ _, M → N) :=
⟨one_hom.to_fun⟩
@[to_additive]
instance {mM : has_mul M} {mN : has_mul N} : has_coe_to_fun (mul_hom M N) (λ _, M → N) :=
⟨mul_hom.to_fun⟩
@[to_additive]
instance {mM : mul_one_class M} {mN : mul_one_class N} : has_coe_to_fun (M →* N) (λ _, M → N) :=
⟨monoid_hom.to_fun⟩
instance {mM : mul_zero_one_class M} {mN : mul_zero_one_class N} :
  has_coe_to_fun (M →*₀ N) (λ _, M → N) :=
⟨monoid_with_zero_hom.to_fun⟩

-- these must come after the coe_to_fun definitions
initialize_simps_projections zero_hom (to_fun → apply)
initialize_simps_projections add_hom (to_fun → apply)
initialize_simps_projections add_monoid_hom (to_fun → apply)

initialize_simps_projections one_hom (to_fun → apply)
initialize_simps_projections mul_hom (to_fun → apply)
initialize_simps_projections monoid_hom (to_fun → apply)
initialize_simps_projections monoid_with_zero_hom (to_fun → apply)

@[simp, to_additive]
lemma one_hom.to_fun_eq_coe [has_one M] [has_one N] (f : one_hom M N) : f.to_fun = f := rfl
@[simp, to_additive]
lemma mul_hom.to_fun_eq_coe [has_mul M] [has_mul N] (f : mul_hom M N) : f.to_fun = f := rfl
@[simp, to_additive]
lemma monoid_hom.to_fun_eq_coe [mul_one_class M] [mul_one_class N]
  (f : M →* N) : f.to_fun = f := rfl
@[simp]
lemma monoid_with_zero_hom.to_fun_eq_coe [mul_zero_one_class M] [mul_zero_one_class N]
  (f : M →*₀ N) : f.to_fun = f := rfl

@[simp, to_additive]
lemma one_hom.coe_mk [has_one M] [has_one N]
  (f : M → N) (h1) : (one_hom.mk f h1 : M → N) = f := rfl
@[simp, to_additive]
lemma mul_hom.coe_mk [has_mul M] [has_mul N]
  (f : M → N) (hmul) : (mul_hom.mk f hmul : M → N) = f := rfl
@[simp, to_additive]
lemma monoid_hom.coe_mk [mul_one_class M] [mul_one_class N]
  (f : M → N) (h1 hmul) : (monoid_hom.mk f h1 hmul : M → N) = f := rfl
@[simp]
lemma monoid_with_zero_hom.coe_mk [mul_zero_one_class M] [mul_zero_one_class N]
  (f : M → N) (h0 h1 hmul) : (monoid_with_zero_hom.mk f h0 h1 hmul : M → N) = f := rfl

@[simp, to_additive]
lemma monoid_hom.to_one_hom_coe [mul_one_class M] [mul_one_class N] (f : M →* N) :
  (f.to_one_hom : M → N) = f := rfl
@[simp, to_additive]
lemma monoid_hom.to_mul_hom_coe [mul_one_class M] [mul_one_class N] (f : M →* N) :
  (f.to_mul_hom : M → N) = f := rfl
@[simp]
lemma monoid_with_zero_hom.to_zero_hom_coe [mul_zero_one_class M] [mul_zero_one_class N]
  (f : M →*₀ N) :
  (f.to_zero_hom : M → N) = f := rfl
@[simp]
lemma monoid_with_zero_hom.to_monoid_hom_coe [mul_zero_one_class M] [mul_zero_one_class N]
  (f : M →*₀ N) :
  (f.to_monoid_hom : M → N) = f := rfl

@[to_additive]
theorem one_hom.congr_fun [has_one M] [has_one N]
  {f g : one_hom M N} (h : f = g) (x : M) : f x = g x :=
congr_arg (λ h : one_hom M N, h x) h
@[to_additive]
theorem mul_hom.congr_fun [has_mul M] [has_mul N]
  {f g : mul_hom M N} (h : f = g) (x : M) : f x = g x :=
congr_arg (λ h : mul_hom M N, h x) h
@[to_additive]
theorem monoid_hom.congr_fun [mul_one_class M] [mul_one_class N]
  {f g : M →* N} (h : f = g) (x : M) : f x = g x :=
congr_arg (λ h : M →* N, h x) h
theorem monoid_with_zero_hom.congr_fun [mul_zero_one_class M] [mul_zero_one_class N] {f g : M →*₀ N}
  (h : f = g) (x : M) : f x = g x :=
congr_arg (λ h : M →*₀ N, h x) h

@[to_additive]
theorem one_hom.congr_arg [has_one M] [has_one N]
  (f : one_hom M N) {x y : M} (h : x = y) : f x = f y :=
congr_arg (λ x : M, f x) h
@[to_additive]
theorem mul_hom.congr_arg [has_mul M] [has_mul N]
  (f : mul_hom M N) {x y : M} (h : x = y) : f x = f y :=
congr_arg (λ x : M, f x) h
@[to_additive]
theorem monoid_hom.congr_arg [mul_one_class M] [mul_one_class N]
  (f : M →* N) {x y : M} (h : x = y) : f x = f y :=
congr_arg (λ x : M, f x) h
theorem monoid_with_zero_hom.congr_arg [mul_zero_one_class M] [mul_zero_one_class N] (f : M →*₀ N)
  {x y : M} (h : x = y) : f x = f y :=
congr_arg (λ x : M, f x) h

@[to_additive]
lemma one_hom.coe_inj [has_one M] [has_one N] ⦃f g : one_hom M N⦄ (h : (f : M → N) = g) : f = g :=
by cases f; cases g; cases h; refl
@[to_additive]
lemma mul_hom.coe_inj [has_mul M] [has_mul N] ⦃f g : mul_hom M N⦄ (h : (f : M → N) = g) : f = g :=
by cases f; cases g; cases h; refl
@[to_additive]
lemma monoid_hom.coe_inj [mul_one_class M] [mul_one_class N]
  ⦃f g : M →* N⦄ (h : (f : M → N) = g) : f = g :=
by cases f; cases g; cases h; refl
lemma monoid_with_zero_hom.coe_inj [mul_zero_one_class M] [mul_zero_one_class N]
  ⦃f g : M →*₀ N⦄ (h : (f : M → N) = g) : f = g :=
by cases f; cases g; cases h; refl

@[ext, to_additive]
lemma one_hom.ext [has_one M] [has_one N] ⦃f g : one_hom M N⦄ (h : ∀ x, f x = g x) : f = g :=
one_hom.coe_inj (funext h)
@[ext, to_additive]
lemma mul_hom.ext [has_mul M] [has_mul N] ⦃f g : mul_hom M N⦄ (h : ∀ x, f x = g x) : f = g :=
mul_hom.coe_inj (funext h)
@[ext, to_additive]
lemma monoid_hom.ext [mul_one_class M] [mul_one_class N]
  ⦃f g : M →* N⦄ (h : ∀ x, f x = g x) : f = g :=
monoid_hom.coe_inj (funext h)
@[ext]
lemma monoid_with_zero_hom.ext [mul_zero_one_class M] [mul_zero_one_class N] ⦃f g : M →*₀ N⦄
  (h : ∀ x, f x = g x) : f = g :=
monoid_with_zero_hom.coe_inj (funext h)

@[to_additive]
lemma one_hom.ext_iff [has_one M] [has_one N] {f g : one_hom M N} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, one_hom.ext h⟩
@[to_additive]
lemma mul_hom.ext_iff [has_mul M] [has_mul N] {f g : mul_hom M N} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, mul_hom.ext h⟩
@[to_additive]
lemma monoid_hom.ext_iff [mul_one_class M] [mul_one_class N]
  {f g : M →* N} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, monoid_hom.ext h⟩
lemma monoid_with_zero_hom.ext_iff [mul_zero_one_class M] [mul_zero_one_class N] {f g : M →*₀ N} :
  f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, monoid_with_zero_hom.ext h⟩

@[simp, to_additive]
lemma one_hom.mk_coe [has_one M] [has_one N]
  (f : one_hom M N) (h1) : one_hom.mk f h1 = f :=
one_hom.ext $ λ _, rfl
@[simp, to_additive]
lemma mul_hom.mk_coe [has_mul M] [has_mul N]
  (f : mul_hom M N) (hmul) : mul_hom.mk f hmul = f :=
mul_hom.ext $ λ _, rfl
@[simp, to_additive]
lemma monoid_hom.mk_coe [mul_one_class M] [mul_one_class N]
  (f : M →* N) (h1 hmul) : monoid_hom.mk f h1 hmul = f :=
monoid_hom.ext $ λ _, rfl
@[simp]
lemma monoid_with_zero_hom.mk_coe [mul_zero_one_class M] [mul_zero_one_class N] (f : M →*₀ N)
  (h0 h1 hmul) : monoid_with_zero_hom.mk f h0 h1 hmul = f :=
monoid_with_zero_hom.ext $ λ _, rfl

end coes

/-- Copy of a `one_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
@[to_additive "Copy of a `zero_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities."]
protected def one_hom.copy {hM : has_one M} {hN : has_one N} (f : one_hom M N) (f' : M → N)
  (h : f' = f) : one_hom M N :=
{ to_fun := f',
  map_one' := h.symm ▸ f.map_one' }

/-- Copy of a `mul_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
@[to_additive "Copy of an `add_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities."]
protected def mul_hom.copy {hM : has_mul M} {hN : has_mul N} (f : mul_hom M N) (f' : M → N)
  (h : f' = f) : mul_hom M N :=
{ to_fun := f',
  map_mul' := h.symm ▸ f.map_mul' }

/-- Copy of a `monoid_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities. -/
@[to_additive "Copy of an `add_monoid_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities."]
protected def monoid_hom.copy {hM : mul_one_class M} {hN : mul_one_class N} (f : M →* N)
  (f' : M → N) (h : f' = f) : M →* N :=
{ ..f.to_one_hom.copy f' h, ..f.to_mul_hom.copy f' h }

/-- Copy of a `monoid_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities. -/
protected def monoid_with_zero_hom.copy {hM : mul_zero_one_class M} {hN : mul_zero_one_class N}
  (f : M →*₀ N) (f' : M → N) (h : f' = f) : M →* N :=
{ ..f.to_zero_hom.copy f' h, ..f.to_monoid_hom.copy f' h }

@[to_additive]
protected lemma one_hom.map_one [has_one M] [has_one N] (f : one_hom M N) : f 1 = 1 := f.map_one'
/-- If `f` is a monoid homomorphism then `f 1 = 1`. -/
@[to_additive]
protected lemma monoid_hom.map_one [mul_one_class M] [mul_one_class N] (f : M →* N) :
  f 1 = 1 := f.map_one'
protected lemma monoid_with_zero_hom.map_one [mul_zero_one_class M] [mul_zero_one_class N]
  (f : M →*₀ N) : f 1 = 1 := f.map_one'

/-- If `f` is an additive monoid homomorphism then `f 0 = 0`. -/
add_decl_doc add_monoid_hom.map_zero
protected lemma monoid_with_zero_hom.map_zero [mul_zero_one_class M] [mul_zero_one_class N]
  (f : M →*₀ N) : f 0 = 0 := f.map_zero'

@[to_additive]
protected lemma mul_hom.map_mul [has_mul M] [has_mul N]
  (f : mul_hom M N) (a b : M) : f (a * b) = f a * f b := f.map_mul' a b
/-- If `f` is a monoid homomorphism then `f (a * b) = f a * f b`. -/
@[to_additive]
protected lemma monoid_hom.map_mul [mul_one_class M] [mul_one_class N]
  (f : M →* N) (a b : M) : f (a * b) = f a * f b := f.map_mul' a b
protected lemma monoid_with_zero_hom.map_mul [mul_zero_one_class M] [mul_zero_one_class N]
  (f :  M →*₀ N) (a b : M) : f (a * b) = f a * f b := f.map_mul' a b

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

namespace monoid_hom
variables {mM : mul_one_class M} {mN : mul_one_class N} {mP : mul_one_class P}
variables [group G] [comm_group H]

include mM mN

@[to_additive]
lemma map_mul_eq_one (f : M →* N) {a b : M} (h : a * b = 1) : f a * f b = 1 :=
map_mul_eq_one f h

/-- 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 `is_unit.map`. -/
@[to_additive "Given an add_monoid homomorphism `f : M →+ N` and an element `x : M`, if `x` has
a right inverse, then `f x` has a right inverse too."]
lemma map_exists_right_inv (f : M →* N) {x : M} (hx : ∃ y, x * y = 1) :
  ∃ y, f x * y = 1 :=
let ⟨y, hy⟩ := hx in ⟨f y, f.map_mul_eq_one hy⟩

/-- 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 `is_unit.map`. -/
@[to_additive "Given an add_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
`is_add_unit.map`."]
lemma map_exists_left_inv (f : M →* N) {x : M} (hx : ∃ y, y * x = 1) :
  ∃ y, y * f x = 1 :=
let ⟨y, hy⟩ := hx in ⟨f y, f.map_mul_eq_one hy⟩

end monoid_hom

/-- Inversion on a commutative group, considered as a monoid homomorphism. -/
@[to_additive "Inversion on a commutative additive group, considered as an additive
monoid homomorphism."]
def comm_group.inv_monoid_hom {G : Type*} [comm_group G] : G →* G :=
{ to_fun := has_inv.inv,
  map_one' := one_inv,
  map_mul' := mul_inv }

/-- The identity map from a type with 1 to itself. -/
@[to_additive, simps]
def one_hom.id (M : Type*) [has_one M] : one_hom M M :=
{ to_fun := λ x, x, map_one' := rfl, }
/-- The identity map from a type with multiplication to itself. -/
@[to_additive, simps]
def mul_hom.id (M : Type*) [has_mul M] : mul_hom M M :=
{ to_fun := λ x, x, map_mul' := λ _ _, rfl, }
/-- The identity map from a monoid to itself. -/
@[to_additive, simps]
def monoid_hom.id (M : Type*) [mul_one_class M] : M →* M :=
{ to_fun := λ x, x, map_one' := rfl, map_mul' := λ _ _, rfl, }
/-- The identity map from a monoid_with_zero to itself. -/
@[simps]
def monoid_with_zero_hom.id (M : Type*) [mul_zero_one_class M] : M →*₀ M :=
{ to_fun := λ x, x, map_zero' := rfl, map_one' := rfl, map_mul' := λ _ _, rfl, }

/-- The identity map from an type with zero to itself. -/
add_decl_doc zero_hom.id
/-- The identity map from an type with addition to itself. -/
add_decl_doc add_hom.id
/-- The identity map from an additive monoid to itself. -/
add_decl_doc add_monoid_hom.id

/-- Composition of `one_hom`s as a `one_hom`. -/
@[to_additive]
def one_hom.comp [has_one M] [has_one N] [has_one P]
  (hnp : one_hom N P) (hmn : one_hom M N) : one_hom M P :=
{ to_fun := hnp ∘ hmn, map_one' := by simp, }
/-- Composition of `mul_hom`s as a `mul_hom`. -/
@[to_additive]
def mul_hom.comp [has_mul M] [has_mul N] [has_mul P]
  (hnp : mul_hom N P) (hmn : mul_hom M N) : mul_hom M P :=
{ to_fun := hnp ∘ hmn, map_mul' := by simp, }

/-- Composition of monoid morphisms as a monoid morphism. -/
@[to_additive]
def monoid_hom.comp [mul_one_class M] [mul_one_class N] [mul_one_class P]
  (hnp : N →* P) (hmn : M →* N) : M →* P :=
{ to_fun := hnp ∘ hmn, map_one' := by simp, map_mul' := by simp, }

/-- Composition of `monoid_with_zero_hom`s as a `monoid_with_zero_hom`. -/
def monoid_with_zero_hom.comp [mul_zero_one_class M] [mul_zero_one_class N] [mul_zero_one_class P]
  (hnp : N →*₀ P) (hmn : M →*₀ N) : M →*₀ P :=
{ to_fun := hnp ∘ hmn, map_zero' := by simp, map_one' := by simp, map_mul' := by simp, }

/-- Composition of `zero_hom`s as a `zero_hom`. -/
add_decl_doc zero_hom.comp
/-- Composition of `add_hom`s as a `add_hom`. -/
add_decl_doc add_hom.comp
/-- Composition of additive monoid morphisms as an additive monoid morphism. -/
add_decl_doc add_monoid_hom.comp

@[simp, to_additive] lemma one_hom.coe_comp [has_one M] [has_one N] [has_one P]
  (g : one_hom N P) (f : one_hom M N) :
  ⇑(g.comp f) = g ∘ f := rfl
@[simp, to_additive] lemma mul_hom.coe_comp [has_mul M] [has_mul N] [has_mul P]
  (g : mul_hom N P) (f : mul_hom M N) :
  ⇑(g.comp f) = g ∘ f := rfl
@[simp, to_additive] lemma monoid_hom.coe_comp [mul_one_class M] [mul_one_class N] [mul_one_class P]
  (g : N →* P) (f : M →* N) :
  ⇑(g.comp f) = g ∘ f := rfl
@[simp] lemma monoid_with_zero_hom.coe_comp [mul_zero_one_class M] [mul_zero_one_class N]
  [mul_zero_one_class P] (g : N →*₀ P) (f : M →*₀ N) :
  ⇑(g.comp f) = g ∘ f := rfl

@[to_additive] lemma one_hom.comp_apply [has_one M] [has_one N] [has_one P]
  (g : one_hom N P) (f : one_hom M N) (x : M) :
  g.comp f x = g (f x) := rfl
@[to_additive] lemma mul_hom.comp_apply [has_mul M] [has_mul N] [has_mul P]
  (g : mul_hom N P) (f : mul_hom M N) (x : M) :
  g.comp f x = g (f x) := rfl
@[to_additive] lemma monoid_hom.comp_apply [mul_one_class M] [mul_one_class N] [mul_one_class P]
  (g : N →* P) (f : M →* N) (x : M) :
  g.comp f x = g (f x) := rfl
lemma monoid_with_zero_hom.comp_apply [mul_zero_one_class M] [mul_zero_one_class N]
  [mul_zero_one_class P] (g : N →*₀ P) (f : M →*₀ N) (x : M) :
  g.comp f x = g (f x) := rfl

/-- Composition of monoid homomorphisms is associative. -/
@[to_additive] lemma one_hom.comp_assoc {Q : Type*} [has_one M] [has_one N] [has_one P] [has_one Q]
  (f : one_hom M N) (g : one_hom N P) (h : one_hom P Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl
@[to_additive] lemma mul_hom.comp_assoc {Q : Type*} [has_mul M] [has_mul N] [has_mul P] [has_mul Q]
  (f : mul_hom M N) (g : mul_hom N P) (h : mul_hom P Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl
@[to_additive] lemma monoid_hom.comp_assoc {Q : Type*}
  [mul_one_class M] [mul_one_class N] [mul_one_class P] [mul_one_class Q]
  (f : M →* N) (g : N →* P) (h : P →* Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl
lemma monoid_with_zero_hom.comp_assoc {Q : Type*}
  [mul_zero_one_class M] [mul_zero_one_class N] [mul_zero_one_class P] [mul_zero_one_class Q]
  (f : M →*₀ N) (g : N →*₀ P) (h : P →*₀ Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl

@[to_additive]
lemma one_hom.cancel_right [has_one M] [has_one N] [has_one P]
  {g₁ g₂ : one_hom N P} {f : one_hom M N} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, one_hom.ext $ hf.forall.2 (one_hom.ext_iff.1 h), λ h, h ▸ rfl⟩
@[to_additive]
lemma mul_hom.cancel_right [has_mul M] [has_mul N] [has_mul P]
  {g₁ g₂ : mul_hom N P} {f : mul_hom M N} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, mul_hom.ext $ hf.forall.2 (mul_hom.ext_iff.1 h), λ h, h ▸ rfl⟩
@[to_additive]
lemma monoid_hom.cancel_right
  [mul_one_class M] [mul_one_class N] [mul_one_class P]
  {g₁ g₂ : N →* P} {f : M →* N} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, monoid_hom.ext $ hf.forall.2 (monoid_hom.ext_iff.1 h), λ h, h ▸ rfl⟩
lemma monoid_with_zero_hom.cancel_right [mul_zero_one_class M] [mul_zero_one_class N]
  [mul_zero_one_class P] {g₁ g₂ : N →*₀ P} {f : M →*₀ N} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, monoid_with_zero_hom.ext $ hf.forall.2 (monoid_with_zero_hom.ext_iff.1 h),
 λ h, h ▸ rfl⟩

@[to_additive]
lemma one_hom.cancel_left [has_one M] [has_one N] [has_one P]
  {g : one_hom N P} {f₁ f₂ : one_hom M N} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, one_hom.ext $ λ x, hg $ by rw [← one_hom.comp_apply, h, one_hom.comp_apply],
 λ h, h ▸ rfl⟩
@[to_additive]
lemma mul_hom.cancel_left [has_mul M] [has_mul N] [has_mul P]
  {g : mul_hom N P} {f₁ f₂ : mul_hom M N} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, mul_hom.ext $ λ x, hg $ by rw [← mul_hom.comp_apply, h, mul_hom.comp_apply],
 λ h, h ▸ rfl⟩
@[to_additive]
lemma monoid_hom.cancel_left [mul_one_class M] [mul_one_class N] [mul_one_class P]
  {g : N →* P} {f₁ f₂ : M →* N} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, monoid_hom.ext $ λ x, hg $ by rw [← monoid_hom.comp_apply, h, monoid_hom.comp_apply],
 λ h, h ▸ rfl⟩
lemma monoid_with_zero_hom.cancel_left [mul_zero_one_class M] [mul_zero_one_class N]
  [mul_zero_one_class P] {g : N →*₀ P} {f₁ f₂ : M →*₀ N} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, monoid_with_zero_hom.ext $ λ x, hg $ by rw [
        ← monoid_with_zero_hom.comp_apply, h, monoid_with_zero_hom.comp_apply],
 λ h, h ▸ rfl⟩

@[to_additive]
lemma monoid_hom.to_one_hom_injective [mul_one_class M] [mul_one_class N] :
  function.injective (monoid_hom.to_one_hom : (M →* N) → one_hom M N) :=
λ f g h, monoid_hom.ext $ one_hom.ext_iff.mp h
@[to_additive]
lemma monoid_hom.to_mul_hom_injective [mul_one_class M] [mul_one_class N] :
  function.injective (monoid_hom.to_mul_hom : (M →* N) → mul_hom M N) :=
λ f g h, monoid_hom.ext $ mul_hom.ext_iff.mp h
lemma monoid_with_zero_hom.to_monoid_hom_injective [monoid_with_zero M] [monoid_with_zero N] :
  function.injective (monoid_with_zero_hom.to_monoid_hom : (M →*₀ N) → M →* N) :=
λ f g h, monoid_with_zero_hom.ext $ monoid_hom.ext_iff.mp h
lemma monoid_with_zero_hom.to_zero_hom_injective [monoid_with_zero M] [monoid_with_zero N] :
  function.injective (monoid_with_zero_hom.to_zero_hom : (M →*₀ N) → zero_hom M N) :=
λ f g h, monoid_with_zero_hom.ext $ zero_hom.ext_iff.mp h

@[simp, to_additive] lemma one_hom.comp_id [has_one M] [has_one N]
  (f : one_hom M N) : f.comp (one_hom.id M) = f := one_hom.ext $ λ x, rfl
@[simp, to_additive] lemma mul_hom.comp_id [has_mul M] [has_mul N]
  (f : mul_hom M N) : f.comp (mul_hom.id M) = f := mul_hom.ext $ λ x, rfl
@[simp, to_additive] lemma monoid_hom.comp_id [mul_one_class M] [mul_one_class N]
  (f : M →* N) : f.comp (monoid_hom.id M) = f := monoid_hom.ext $ λ x, rfl
@[simp] lemma monoid_with_zero_hom.comp_id [mul_zero_one_class M] [mul_zero_one_class N]
  (f : M →*₀ N) : f.comp (monoid_with_zero_hom.id M) = f :=
monoid_with_zero_hom.ext $ λ x, rfl

@[simp, to_additive] lemma one_hom.id_comp [has_one M] [has_one N]
  (f : one_hom M N) : (one_hom.id N).comp f = f := one_hom.ext $ λ x, rfl
@[simp, to_additive] lemma mul_hom.id_comp [has_mul M] [has_mul N]
  (f : mul_hom M N) : (mul_hom.id N).comp f = f := mul_hom.ext $ λ x, rfl
@[simp, to_additive] lemma monoid_hom.id_comp [mul_one_class M] [mul_one_class N]
  (f : M →* N) : (monoid_hom.id N).comp f = f := monoid_hom.ext $ λ x, rfl
@[simp] lemma monoid_with_zero_hom.id_comp [mul_zero_one_class M] [mul_zero_one_class N]
  (f : M →*₀ N) : (monoid_with_zero_hom.id N).comp f = f :=
monoid_with_zero_hom.ext $ λ x, rfl

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

@[to_additive]
protected theorem monoid_hom.map_zpow' [div_inv_monoid M] [div_inv_monoid 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

@[to_additive]
theorem monoid_hom.map_div' [div_inv_monoid M] [div_inv_monoid N] (f : M →* N)
  (hf : ∀ x, f (x⁻¹) = (f x)⁻¹) (a b : M) : f (a / b) = f a / f b :=
by rw [div_eq_mul_inv, div_eq_mul_inv, f.map_mul, hf]

section End

namespace monoid

variables (M) [mul_one_class M]

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

namespace End

instance : monoid (monoid.End M) :=
{ mul := monoid_hom.comp,
  one := monoid_hom.id M,
  mul_assoc := λ _ _ _, monoid_hom.comp_assoc _ _ _,
  mul_one := monoid_hom.comp_id,
  one_mul := monoid_hom.id_comp }

instance : inhabited (monoid.End M) := ⟨1⟩

instance : has_coe_to_fun (monoid.End M) (λ _, M → M) := ⟨monoid_hom.to_fun⟩

end End

@[simp] lemma coe_one : ((1 : monoid.End M) : M → M) = id := rfl
@[simp] lemma coe_mul (f g) : ((f * g : monoid.End M) : M → M) = f ∘ g := rfl

end monoid

namespace add_monoid

variables (A : Type*) [add_zero_class A]

/-- The monoid of endomorphisms. -/
protected def End := A →+ A

namespace End

instance : monoid (add_monoid.End A) :=
{ mul := add_monoid_hom.comp,
  one := add_monoid_hom.id A,
  mul_assoc := λ _ _ _, add_monoid_hom.comp_assoc _ _ _,
  mul_one := add_monoid_hom.comp_id,
  one_mul := add_monoid_hom.id_comp }

instance : inhabited (add_monoid.End A) := ⟨1⟩

instance : has_coe_to_fun (add_monoid.End A) (λ _, A → A) := ⟨add_monoid_hom.to_fun⟩

end End

@[simp] lemma coe_one : ((1 : add_monoid.End A) : A → A) = id := rfl
@[simp] lemma coe_mul (f g) : ((f * g : add_monoid.End A) : A → A) = f ∘ g := rfl

end add_monoid

end End

/-- `1` is the homomorphism sending all elements to `1`. -/
@[to_additive]
instance [has_one M] [has_one N] : has_one (one_hom M N) := ⟨⟨λ _, 1, rfl⟩⟩
/-- `1` is the multiplicative homomorphism sending all elements to `1`. -/
@[to_additive]
instance [has_mul M] [mul_one_class N] : has_one (mul_hom M N) :=
⟨⟨λ _, 1, λ _ _, (one_mul 1).symm⟩⟩
/-- `1` is the monoid homomorphism sending all elements to `1`. -/
@[to_additive]
instance [mul_one_class M] [mul_one_class N] : has_one (M →* N) :=
⟨⟨λ _, 1, rfl, λ _ _, (one_mul 1).symm⟩⟩

/-- `0` is the homomorphism sending all elements to `0`. -/
add_decl_doc zero_hom.has_zero
/-- `0` is the additive homomorphism sending all elements to `0`. -/
add_decl_doc add_hom.has_zero
/-- `0` is the additive monoid homomorphism sending all elements to `0`. -/
add_decl_doc add_monoid_hom.has_zero

@[simp, to_additive] lemma one_hom.one_apply [has_one M] [has_one N]
  (x : M) : (1 : one_hom M N) x = 1 := rfl
@[simp, to_additive] lemma monoid_hom.one_apply [mul_one_class M] [mul_one_class N]
  (x : M) : (1 : M →* N) x = 1 := rfl

@[simp, to_additive] lemma one_hom.one_comp [has_one M] [has_one N] [has_one P] (f : one_hom M N) :
  (1 : one_hom N P).comp f = 1 := rfl
@[simp, to_additive] lemma one_hom.comp_one [has_one M] [has_one N] [has_one P] (f : one_hom N P) :
  f.comp (1 : one_hom M N) = 1 :=
by { ext, simp only [one_hom.map_one, one_hom.coe_comp, function.comp_app, one_hom.one_apply] }

@[to_additive]
instance [has_one M] [has_one N] : inhabited (one_hom M N) := ⟨1⟩
@[to_additive]
instance [has_mul M] [mul_one_class N] : inhabited (mul_hom M N) := ⟨1⟩
@[to_additive]
instance [mul_one_class M] [mul_one_class N] : inhabited (M →* N) := ⟨1⟩
-- unlike the other homs, `monoid_with_zero_hom` does not have a `1` or `0`
instance [mul_zero_one_class M] : inhabited (M →*₀ M) := ⟨monoid_with_zero_hom.id M⟩

namespace monoid_hom
variables [mM : mul_one_class M] [mN : mul_one_class N] [mP : mul_one_class P]
variables [group G] [comm_group 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 {M N} {mM : mul_one_class M} [comm_monoid N] : has_mul (M →* N) :=
⟨λ f g,
  { to_fun := λ m, f m * g m,
    map_one' := show f 1 * g 1 = 1, by simp,
    map_mul' := begin 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)], end }⟩

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

@[simp, to_additive] lemma mul_apply {M N} {mM : mul_one_class M} {mN : comm_monoid N}
  (f g : M →* N) (x : M) :
  (f * g) x = f x * g x := rfl

@[simp, to_additive] lemma one_comp [mul_one_class M] [mul_one_class N] [mul_one_class P]
  (f : M →* N) : (1 : N →* P).comp f = 1 := rfl
@[simp, to_additive] lemma comp_one [mul_one_class M] [mul_one_class N] [mul_one_class P]
  (f : N →* P) : f.comp (1 : M →* N) = 1 :=
by { ext, simp only [map_one, coe_comp, function.comp_app, one_apply] }

@[to_additive] lemma mul_comp [mul_one_class M] [comm_monoid N] [comm_monoid P]
  (g₁ g₂ : N →* P) (f : M →* N) :
  (g₁ * g₂).comp f = g₁.comp f * g₂.comp f := rfl
@[to_additive] lemma comp_mul [mul_one_class M] [comm_monoid N] [comm_monoid 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_app, map_mul, coe_comp] }

/-- If two homomorphism from a group to a monoid are equal at `x`, then they are equal at `x⁻¹`. -/
@[to_additive "If two homomorphism from an additive group to an additive monoid are equal at `x`,
then they are equal at `-x`." ]
lemma eq_on_inv {G} [group G] [monoid M] {f g : G →* M} {x : G} (h : f x = g x) :
  f x⁻¹ = g x⁻¹ :=
left_inv_eq_right_inv (map_mul_eq_one f $ inv_mul_self x) $
  h.symm ▸ g.map_mul_eq_one $ mul_inv_self x

/-- Group homomorphisms preserve inverse. -/
@[to_additive]
protected theorem map_inv {G H} [group G] [group H] (f : G →* H) (g : G) : f g⁻¹ = (f g)⁻¹ :=
map_inv f g

/-- Group homomorphisms preserve integer power. -/
@[to_additive /-" Additive group homomorphisms preserve integer scaling. "-/]
protected theorem map_zpow {G H} [group G] [group H] (f : G →* H) (g : G) (n : ℤ) :
  f (g ^ n) = (f g) ^ n :=
map_zpow f g n

/-- Group homomorphisms preserve division. -/
@[to_additive /-" Additive group homomorphisms preserve subtraction. "-/]
protected theorem map_div {G H} [group G] [group H] (f : G →* H) (g h : G) :
  f (g / h) = f g / f h :=
map_div f g h

/-- Group homomorphisms preserve division. -/
@[to_additive]
protected theorem map_mul_inv {G H} [group G] [group H] (f : G →* H) (g h : G) :
  f (g * h⁻¹) = (f g) * (f h)⁻¹ :=
map_mul_inv f g h

/-- 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 `monoid_hom.injective_iff'`.  -/
@[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 `add_monoid_hom.injective_iff'`. "-/]
lemma injective_iff {G H} [group G] [mul_one_class H] (f : G →* H) :
  function.injective f ↔ (∀ a, f a = 1 → a = 1) :=
⟨λ h x, (map_eq_one_iff f h).mp,
 λ h x y hxy, mul_inv_eq_one.1 $ h _ $ by rw [f.map_mul, hxy, ← f.map_mul, mul_inv_self, f.map_one]⟩

/-- 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 `monoid_hom.injective_iff`. -/
@[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
`add_monoid_hom.injective_iff`. "-/]
lemma injective_iff' {G H} [group G] [mul_one_class H] (f : G →* H) :
  function.injective f ↔ (∀ a, f a = 1 ↔ a = 1) :=
f.injective_iff.trans $ forall_congr $ λ a, ⟨λ h, ⟨h, λ H, H.symm ▸ f.map_one⟩, iff.mp⟩

include mM
/-- Makes a group homomorphism from a proof that the map preserves multiplication. -/
@[to_additive "Makes an additive group homomorphism from a proof that the map preserves addition.",
  simps {fully_applied := ff}]
def mk' (f : M → G) (map_mul : ∀ a b : M, f (a * b) = f a * f b) : M →* G :=
{ to_fun := f,
  map_mul' := map_mul,
  map_one' := mul_left_eq_self.1 $ by rw [←map_mul, mul_one] }

omit mM

/-- Makes a group homomorphism from a proof that the map preserves right division `λ x y, x * y⁻¹`.
See also `monoid_hom.of_map_div` for a version using `λ x y, x / y`.
-/
@[to_additive "Makes an additive group homomorphism from a proof that the map preserves
the operation `λ a b, a + -b`. See also `add_monoid_hom.of_map_sub` for a version using
`λ a b, a - b`."]
def of_map_mul_inv {H : Type*} [group H] (f : G → H)
  (map_div : ∀ a b : G, f (a * b⁻¹) = f a * (f b)⁻¹) :
  G →* H :=
mk' f $ λ x y,
calc f (x * y) = f x * (f $ 1 * 1⁻¹ * y⁻¹)⁻¹ : by simp only [one_mul, one_inv, ← map_div, inv_inv]
... = f x * f y : by { simp only [map_div], simp only [mul_right_inv, one_mul, inv_inv] }

@[simp, to_additive] lemma coe_of_map_mul_inv {H : Type*} [group H] (f : G → H)
  (map_div : ∀ a b : G, f (a * b⁻¹) = f a * (f b)⁻¹) :
  ⇑(of_map_mul_inv f map_div) = f :=
rfl

/-- 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 of_map_div {H : Type*} [group H] (f : G → H) (hf : ∀ x y, f (x / y) = f x / f y) : G →* H :=
of_map_mul_inv f (by simpa only [div_eq_mul_inv] using hf)

@[simp, to_additive]
lemma coe_of_map_div {H : Type*} [group H] (f : G → H) (hf : ∀ x y, f (x / y) = f x / f y) :
  ⇑(of_map_div f hf) = f :=
rfl

/-- 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} [mul_one_class M] [comm_group G] : has_inv (M →* G) :=
⟨λ f, mk' (λ g, (f g)⁻¹) $ λ 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 add_monoid_hom.has_neg

@[simp, to_additive] lemma inv_apply {M G} {mM : mul_one_class M} {gG : comm_group G}
  (f : M →* G) (x : M) :
  f⁻¹ x = (f x)⁻¹ := rfl

@[simp, to_additive] lemma inv_comp {M N A} {mM : mul_one_class M} {gN : mul_one_class N}
  {gA : comm_group A} (φ : N →* A) (ψ : M →* N) : φ⁻¹.comp ψ = (φ.comp ψ)⁻¹ :=
by { ext, simp only [function.comp_app, inv_apply, coe_comp] }

@[simp, to_additive] lemma comp_inv {M A B} {mM : mul_one_class M} {mA : comm_group A}
  {mB : comm_group B} (φ : A →* B) (ψ : M →* A) : φ.comp ψ⁻¹ = (φ.comp ψ)⁻¹ :=
by { ext, simp only [function.comp_app, inv_apply, map_inv, coe_comp] }

/-- 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} [mul_one_class M] [comm_group G] : has_div (M →* G) :=
⟨λ f g, mk' (λ x, f x / g x) $ λ 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 add_monoid_hom.has_sub

@[simp, to_additive] lemma div_apply {M G} {mM : mul_one_class M} {gG : comm_group G}
  (f g : M →* G) (x : M) :
  (f / g) x = f x / g x := rfl

end monoid_hom

/-- 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} {hM : mul_zero_one_class M} [comm_monoid_with_zero N] : has_mul (M →*₀ N) :=
⟨λ f g,
  { to_fun := λ a, f a * g a,
    map_zero' := by rw [map_zero, zero_mul],
    ..(f * g : M →* N) }⟩

section commute

variables [has_mul M] [has_mul N] {a x y : M}

@[simp, to_additive]
protected lemma semiconj_by.map [mul_hom_class F M N] (h : semiconj_by a x y) (f : F) :
  semiconj_by (f a) (f x) (f y) :=
by simpa only [semiconj_by, map_mul] using congr_arg f h

@[simp, to_additive]
protected lemma commute.map [mul_hom_class F M N] (h : commute x y) (f : F) :
  commute (f x) (f y) :=
h.map f

end commute