/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module topology.category.Top.opens
! leanprover-community/mathlib commit d39590fc8728fbf6743249802486f8c91ffe07bc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Category.Preorder
import Mathbin.CategoryTheory.EqToHom
import Mathbin.Topology.Category.Top.EpiMono
import Mathbin.Topology.Sets.Opens

/-!
# The category of open sets in a topological space.

We define `to_Top : opens X ⥤ Top` and
`map (f : X ⟶ Y) : opens Y ⥤ opens X`, given by taking preimages of open sets.

Unfortunately `opens` isn't (usefully) a functor `Top ⥤ Cat`.
(One can in fact define such a functor,
but using it results in unresolvable `eq.rec` terms in goals.)

Really it's a 2-functor from (spaces, continuous functions, equalities)
to (categories, functors, natural isomorphisms).
We don't attempt to set up the full theory here, but do provide the natural isomorphisms
`map_id : map (𝟙 X) ≅ 𝟭 (opens X)` and
`map_comp : map (f ≫ g) ≅ map g ⋙ map f`.

Beyond that, there's a collection of simp lemmas for working with these constructions.
-/

open CategoryTheory

open TopologicalSpace

open Opposite

universe u

namespace TopologicalSpace.Opens

variable {X Y Z : TopCat.{u}}

/-!
Since `opens X` has a partial order, it automatically receives a `category` instance.
Unfortunately, because we do not allow morphisms in `Prop`,
the morphisms `U ⟶ V` are not just proofs `U ≤ V`, but rather
`ulift (plift (U ≤ V))`.
-/

instance opensHomHasCoeToFun {U V : Opens X} : CoeFun (U ⟶ V) fun f => U → V :=
  ⟨fun f x => ⟨x, f.le x.2⟩⟩
#align topological_space.opens.opens_hom_has_coe_to_fun TopologicalSpace.Opens.opensHomHasCoeToFun

/-!
We now construct as morphisms various inclusions of open sets.
-/

-- This is tedious, but necessary because we decided not to allow Prop as morphisms in a category...
/-- The inclusion `U ⊓ V ⟶ U` as a morphism in the category of open sets.
-/
def infLeLeft (U V : Opens X) : U ⊓ V ⟶ U :=
  inf_le_left.Hom
#align topological_space.opens.inf_le_left TopologicalSpace.Opens.infLeLeft

/-- The inclusion `U ⊓ V ⟶ V` as a morphism in the category of open sets.
-/
def infLeRight (U V : Opens X) : U ⊓ V ⟶ V :=
  inf_le_right.Hom
#align topological_space.opens.inf_le_right TopologicalSpace.Opens.infLeRight

/-- The inclusion `U i ⟶ supr U` as a morphism in the category of open sets.
-/
def leSupr {ι : Type _} (U : ι → Opens X) (i : ι) : U i ⟶ supᵢ U :=
  (le_supᵢ U i).Hom
#align topological_space.opens.le_supr TopologicalSpace.Opens.leSupr

/-- The inclusion `⊥ ⟶ U` as a morphism in the category of open sets.
-/
def botLe (U : Opens X) : ⊥ ⟶ U :=
  bot_le.Hom
#align topological_space.opens.bot_le TopologicalSpace.Opens.botLe

/-- The inclusion `U ⟶ ⊤` as a morphism in the category of open sets.
-/
def leTop (U : Opens X) : U ⟶ ⊤ :=
  le_top.Hom
#align topological_space.opens.le_top TopologicalSpace.Opens.leTop

-- We do not mark this as a simp lemma because it breaks open `x`.
-- Nevertheless, it is useful in `sheaf_of_functions`.
theorem infLeLeft_apply (U V : Opens X) (x) :
    (infLeLeft U V) x = ⟨x.1, (@inf_le_left _ _ U V : _ ≤ _) x.2⟩ :=
  rfl
#align topological_space.opens.inf_le_left_apply TopologicalSpace.Opens.infLeLeft_apply

@[simp]
theorem infLeLeft_apply_mk (U V : Opens X) (x) (m) :
    (infLeLeft U V) ⟨x, m⟩ = ⟨x, (@inf_le_left _ _ U V : _ ≤ _) m⟩ :=
  rfl
#align topological_space.opens.inf_le_left_apply_mk TopologicalSpace.Opens.infLeLeft_apply_mk

@[simp]
theorem leSupr_apply_mk {ι : Type _} (U : ι → Opens X) (i : ι) (x) (m) :
    (leSupr U i) ⟨x, m⟩ = ⟨x, (le_supᵢ U i : _) m⟩ :=
  rfl
#align topological_space.opens.le_supr_apply_mk TopologicalSpace.Opens.leSupr_apply_mk

/-- The functor from open sets in `X` to `Top`,
realising each open set as a topological space itself.
-/
def toTop (X : TopCat.{u}) : Opens X ⥤ TopCat
    where
  obj U := ⟨U, inferInstance⟩
  map U V i :=
    ⟨fun x => ⟨x.1, i.le x.2⟩,
      (Embedding.continuous_iff embedding_subtype_val).2 continuous_induced_dom⟩
#align topological_space.opens.to_Top TopologicalSpace.Opens.toTop

@[simp]
theorem toTop_map (X : TopCat.{u}) {U V : Opens X} {f : U ⟶ V} {x} {h} :
    ((toTop X).map f) ⟨x, h⟩ = ⟨x, f.le h⟩ :=
  rfl
#align topological_space.opens.to_Top_map TopologicalSpace.Opens.toTop_map

/-- The inclusion map from an open subset to the whole space, as a morphism in `Top`.
-/
@[simps (config := { fullyApplied := false })]
def inclusion {X : TopCat.{u}} (U : Opens X) : (toTop X).obj U ⟶ X
    where
  toFun := _
  continuous_toFun := continuous_subtype_val
#align topological_space.opens.inclusion TopologicalSpace.Opens.inclusion

theorem openEmbedding {X : TopCat.{u}} (U : Opens X) : OpenEmbedding (inclusion U) :=
  IsOpen.openEmbedding_subtype_val U.2
#align topological_space.opens.open_embedding TopologicalSpace.Opens.openEmbedding

/-- The inclusion of the top open subset (i.e. the whole space) is an isomorphism.
-/
def inclusionTopIso (X : TopCat.{u}) : (toTop X).obj ⊤ ≅ X
    where
  Hom := inclusion ⊤
  inv := ⟨fun x => ⟨x, trivial⟩, continuous_def.2 fun U ⟨S, hS, hSU⟩ => hSU ▸ hS⟩
#align topological_space.opens.inclusion_top_iso TopologicalSpace.Opens.inclusionTopIso

/-- `opens.map f` gives the functor from open sets in Y to open set in X,
    given by taking preimages under f. -/
def map (f : X ⟶ Y) : Opens Y ⥤ Opens X
    where
  obj U := ⟨f ⁻¹' U, U.IsOpen.preimage f.Continuous⟩
  map U V i := ⟨⟨fun x h => i.le h⟩⟩
#align topological_space.opens.map TopologicalSpace.Opens.map

theorem map_coe (f : X ⟶ Y) (U : Opens Y) : ↑((map f).obj U) = f ⁻¹' U :=
  rfl
#align topological_space.opens.map_coe TopologicalSpace.Opens.map_coe

@[simp]
theorem map_obj (f : X ⟶ Y) (U) (p) : (map f).obj ⟨U, p⟩ = ⟨f ⁻¹' U, p.preimage f.Continuous⟩ :=
  rfl
#align topological_space.opens.map_obj TopologicalSpace.Opens.map_obj

@[simp]
theorem map_id_obj (U : Opens X) : (map (𝟙 X)).obj U = U :=
  let ⟨_, _⟩ := U
  rfl
#align topological_space.opens.map_id_obj TopologicalSpace.Opens.map_id_obj

@[simp]
theorem map_id_obj' (U) (p) : (map (𝟙 X)).obj ⟨U, p⟩ = ⟨U, p⟩ :=
  rfl
#align topological_space.opens.map_id_obj' TopologicalSpace.Opens.map_id_obj'

@[simp]
theorem map_id_obj_unop (U : (Opens X)ᵒᵖ) : (map (𝟙 X)).obj (unop U) = unop U :=
  let ⟨_, _⟩ := U.unop
  rfl
#align topological_space.opens.map_id_obj_unop TopologicalSpace.Opens.map_id_obj_unop

@[simp]
theorem op_map_id_obj (U : (Opens X)ᵒᵖ) : (map (𝟙 X)).op.obj U = U := by simp
#align topological_space.opens.op_map_id_obj TopologicalSpace.Opens.op_map_id_obj

/-- The inclusion `U ⟶ (map f).obj ⊤` as a morphism in the category of open sets.
-/
def leMapTop (f : X ⟶ Y) (U : Opens X) : U ⟶ (map f).obj ⊤ :=
  leTop U
#align topological_space.opens.le_map_top TopologicalSpace.Opens.leMapTop

@[simp]
theorem map_comp_obj (f : X ⟶ Y) (g : Y ⟶ Z) (U) :
    (map (f ≫ g)).obj U = (map f).obj ((map g).obj U) :=
  rfl
#align topological_space.opens.map_comp_obj TopologicalSpace.Opens.map_comp_obj

@[simp]
theorem map_comp_obj' (f : X ⟶ Y) (g : Y ⟶ Z) (U) (p) :
    (map (f ≫ g)).obj ⟨U, p⟩ = (map f).obj ((map g).obj ⟨U, p⟩) :=
  rfl
#align topological_space.opens.map_comp_obj' TopologicalSpace.Opens.map_comp_obj'

@[simp]
theorem map_comp_map (f : X ⟶ Y) (g : Y ⟶ Z) {U V} (i : U ⟶ V) :
    (map (f ≫ g)).map i = (map f).map ((map g).map i) :=
  rfl
#align topological_space.opens.map_comp_map TopologicalSpace.Opens.map_comp_map

@[simp]
theorem map_comp_obj_unop (f : X ⟶ Y) (g : Y ⟶ Z) (U) :
    (map (f ≫ g)).obj (unop U) = (map f).obj ((map g).obj (unop U)) :=
  rfl
#align topological_space.opens.map_comp_obj_unop TopologicalSpace.Opens.map_comp_obj_unop

@[simp]
theorem op_map_comp_obj (f : X ⟶ Y) (g : Y ⟶ Z) (U) :
    (map (f ≫ g)).op.obj U = (map f).op.obj ((map g).op.obj U) :=
  rfl
#align topological_space.opens.op_map_comp_obj TopologicalSpace.Opens.op_map_comp_obj

theorem map_supᵢ (f : X ⟶ Y) {ι : Type _} (U : ι → Opens Y) :
    (map f).obj (supᵢ U) = supᵢ ((map f).obj ∘ U) :=
  by
  ext1; rw [supr_def, supr_def, map_obj]
  dsimp; rw [Set.preimage_unionᵢ]; rfl
#align topological_space.opens.map_supr TopologicalSpace.Opens.map_supᵢ

section

variable (X)

/-- The functor `opens X ⥤ opens X` given by taking preimages under the identity function
is naturally isomorphic to the identity functor.
-/
@[simps]
def mapId : map (𝟙 X) ≅ 𝟭 (Opens X)
    where
  Hom := { app := fun U => eqToHom (map_id_obj U) }
  inv := { app := fun U => eqToHom (map_id_obj U).symm }
#align topological_space.opens.map_id TopologicalSpace.Opens.mapId

theorem map_id_eq : map (𝟙 X) = 𝟭 (Opens X) :=
  by
  unfold map
  congr
  ext
  rfl
  ext
#align topological_space.opens.map_id_eq TopologicalSpace.Opens.map_id_eq

end

/-- The natural isomorphism between taking preimages under `f ≫ g`, and the composite
of taking preimages under `g`, then preimages under `f`.
-/
@[simps]
def mapComp (f : X ⟶ Y) (g : Y ⟶ Z) : map (f ≫ g) ≅ map g ⋙ map f
    where
  Hom := { app := fun U => eqToHom (map_comp_obj f g U) }
  inv := { app := fun U => eqToHom (map_comp_obj f g U).symm }
#align topological_space.opens.map_comp TopologicalSpace.Opens.mapComp

theorem map_comp_eq (f : X ⟶ Y) (g : Y ⟶ Z) : map (f ≫ g) = map g ⋙ map f :=
  rfl
#align topological_space.opens.map_comp_eq TopologicalSpace.Opens.map_comp_eq

-- We could make `f g` implicit here, but it's nice to be able to see when
-- they are the identity (often!)
/-- If two continuous maps `f g : X ⟶ Y` are equal,
then the functors `opens Y ⥤ opens X` they induce are isomorphic.
-/
def mapIso (f g : X ⟶ Y) (h : f = g) : map f ≅ map g :=
  NatIso.ofComponents (fun U => eqToIso (congr_fun (congr_arg Functor.obj (congr_arg map h)) U))
    (by obviously)
#align topological_space.opens.map_iso TopologicalSpace.Opens.mapIso

theorem map_eq (f g : X ⟶ Y) (h : f = g) : map f = map g :=
  by
  unfold map
  congr
  ext
  rw [h]
  rw [h]
  assumption'
#align topological_space.opens.map_eq TopologicalSpace.Opens.map_eq

@[simp]
theorem mapIso_refl (f : X ⟶ Y) (h) : mapIso f f h = Iso.refl (map _) :=
  rfl
#align topological_space.opens.map_iso_refl TopologicalSpace.Opens.mapIso_refl

@[simp]
theorem mapIso_hom_app (f g : X ⟶ Y) (h : f = g) (U : Opens Y) :
    (mapIso f g h).Hom.app U = eqToHom (congr_fun (congr_arg Functor.obj (congr_arg map h)) U) :=
  rfl
#align topological_space.opens.map_iso_hom_app TopologicalSpace.Opens.mapIso_hom_app

@[simp]
theorem mapIso_inv_app (f g : X ⟶ Y) (h : f = g) (U : Opens Y) :
    (mapIso f g h).inv.app U =
      eqToHom (congr_fun (congr_arg Functor.obj (congr_arg map h.symm)) U) :=
  rfl
#align topological_space.opens.map_iso_inv_app TopologicalSpace.Opens.mapIso_inv_app

/-- A homeomorphism of spaces gives an equivalence of categories of open sets.

TODO: define `order_iso.equivalence`, use it.
-/
@[simps]
def mapMapIso {X Y : TopCat.{u}} (H : X ≅ Y) : Opens Y ≌ Opens X
    where
  Functor := map H.Hom
  inverse := map H.inv
  unitIso :=
    NatIso.ofComponents (fun U => eqToIso (by simp [map, Set.preimage_preimage]))
      (by
        intro _ _ _
        simp)
  counitIso :=
    NatIso.ofComponents (fun U => eqToIso (by simp [map, Set.preimage_preimage]))
      (by
        intro _ _ _
        simp)
#align topological_space.opens.map_map_iso TopologicalSpace.Opens.mapMapIso

end TopologicalSpace.Opens

/-- An open map `f : X ⟶ Y` induces a functor `opens X ⥤ opens Y`.
-/
@[simps]
def IsOpenMap.functor {X Y : TopCat} {f : X ⟶ Y} (hf : IsOpenMap f) : Opens X ⥤ Opens Y
    where
  obj U := ⟨f '' U, hf U U.2⟩
  map U V h := ⟨⟨Set.image_subset _ h.down.down⟩⟩
#align is_open_map.functor IsOpenMap.functor

/-- An open map `f : X ⟶ Y` induces an adjunction between `opens X` and `opens Y`.
-/
def IsOpenMap.adjunction {X Y : TopCat} {f : X ⟶ Y} (hf : IsOpenMap f) :
    Adjunction hf.Functor (TopologicalSpace.Opens.map f) :=
  Adjunction.mkOfUnitCounit
    { Unit := { app := fun U => homOfLE fun x hxU => ⟨x, hxU, rfl⟩ }
      counit := { app := fun V => homOfLE fun y ⟨x, hfxV, hxy⟩ => hxy ▸ hfxV } }
#align is_open_map.adjunction IsOpenMap.adjunction

instance IsOpenMap.functorFullOfMono {X Y : TopCat} {f : X ⟶ Y} (hf : IsOpenMap f) [H : Mono f] :
    Full hf.Functor
    where preimage U V i :=
    homOfLE fun x hx => by
      obtain ⟨y, hy, eq⟩ := i.le ⟨x, hx, rfl⟩
      exact (TopCat.mono_iff_injective f).mp H Eq ▸ hy
#align is_open_map.functor_full_of_mono IsOpenMap.functorFullOfMono

instance IsOpenMap.functor_faithful {X Y : TopCat} {f : X ⟶ Y} (hf : IsOpenMap f) :
    Faithful hf.Functor where
#align is_open_map.functor_faithful IsOpenMap.functor_faithful

namespace TopologicalSpace.Opens

open TopologicalSpace

@[simp]
theorem openEmbedding_obj_top {X : TopCat} (U : Opens X) :
    U.OpenEmbedding.IsOpenMap.Functor.obj ⊤ = U :=
  by
  ext1
  exact set.image_univ.trans Subtype.range_coe
#align topological_space.opens.open_embedding_obj_top TopologicalSpace.Opens.openEmbedding_obj_top

@[simp]
theorem inclusion_map_eq_top {X : TopCat} (U : Opens X) : (Opens.map U.inclusion).obj U = ⊤ :=
  by
  ext1
  exact Subtype.coe_preimage_self _
#align topological_space.opens.inclusion_map_eq_top TopologicalSpace.Opens.inclusion_map_eq_top

@[simp]
theorem adjunction_counit_app_self {X : TopCat} (U : Opens X) :
    U.OpenEmbedding.IsOpenMap.Adjunction.counit.app U = eqToHom (by simp) := by ext
#align topological_space.opens.adjunction_counit_app_self TopologicalSpace.Opens.adjunction_counit_app_self

theorem inclusion_top_functor (X : TopCat) :
    (@Opens.openEmbedding X ⊤).IsOpenMap.Functor = map (inclusionTopIso X).inv :=
  by
  apply functor.hext; intro ;
  abstract obj_eq
    ext
    exact ⟨fun ⟨⟨_, _⟩, h, rfl⟩ => h, fun h => ⟨⟨x, trivial⟩, h, rfl⟩⟩
  intros ; apply Subsingleton.helim; congr 1
  iterate 2 apply inclusion_top_functor.obj_eq
#align topological_space.opens.inclusion_top_functor TopologicalSpace.Opens.inclusion_top_functor

theorem functor_obj_map_obj {X Y : TopCat} {f : X ⟶ Y} (hf : IsOpenMap f) (U : Opens Y) :
    hf.Functor.obj ((Opens.map f).obj U) = hf.Functor.obj ⊤ ⊓ U :=
  by
  ext; constructor
  · rintro ⟨x, hx, rfl⟩
    exact ⟨⟨x, trivial, rfl⟩, hx⟩
  · rintro ⟨⟨x, -, rfl⟩, hx⟩
    exact ⟨x, hx, rfl⟩
#align topological_space.opens.functor_obj_map_obj TopologicalSpace.Opens.functor_obj_map_obj

@[simp]
theorem functor_map_eq_inf {X : TopCat} (U V : Opens X) :
    U.OpenEmbedding.IsOpenMap.Functor.obj ((Opens.map U.inclusion).obj V) = V ⊓ U :=
  by
  ext1
  refine' set.image_preimage_eq_inter_range.trans _
  simpa
#align topological_space.opens.functor_map_eq_inf TopologicalSpace.Opens.functor_map_eq_inf

theorem map_functor_eq' {X U : TopCat} (f : U ⟶ X) (hf : OpenEmbedding f) (V) :
    ((Opens.map f).obj <| hf.IsOpenMap.Functor.obj V) = V :=
  Opens.ext <| Set.preimage_image_eq _ hf.inj
#align topological_space.opens.map_functor_eq' TopologicalSpace.Opens.map_functor_eq'

@[simp]
theorem map_functor_eq {X : TopCat} {U : Opens X} (V : Opens U) :
    ((Opens.map U.inclusion).obj <| U.OpenEmbedding.IsOpenMap.Functor.obj V) = V :=
  TopologicalSpace.Opens.map_functor_eq' _ U.OpenEmbedding V
#align topological_space.opens.map_functor_eq TopologicalSpace.Opens.map_functor_eq

@[simp]
theorem adjunction_counit_map_functor {X : TopCat} {U : Opens X} (V : Opens U) :
    U.OpenEmbedding.IsOpenMap.Adjunction.counit.app (U.OpenEmbedding.IsOpenMap.Functor.obj V) =
      eqToHom
        (by
          conv_rhs => rw [← V.map_functor_eq]
          rfl) :=
  by ext
#align topological_space.opens.adjunction_counit_map_functor TopologicalSpace.Opens.adjunction_counit_map_functor

end TopologicalSpace.Opens


/-
Copyright (c) 2023 Antoine Labelle. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Antoine Labelle

! This file was ported from Lean 3 source module combinatorics.quiver.single_obj
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.Quiver.Cast
import Mathlib.Combinatorics.Quiver.Symmetric

/-!
# Single-object quiver

Single object quiver with a given arrows type.

## Main definitions

Given a type `α`, `SingleObj α` is the `unit` type, whose single object is called `star α`, with
`Quiver` structure such that `star α ⟶ star α` is the type `α`.
An element `x : α` can be reinterpreted as an element of `star α ⟶ star α` using
`toHom`.
More generally, a list of elements of `a` can be reinterpreted as a path from `star α` to
itself using `pathEquivList`.
-/

namespace Quiver

/-- Type tag on `Unit` used to define single-object quivers. -/
-- Porting note: Removed `deriving Unique`.
@[nolint unusedArguments]
def SingleObj (_ : Type _) : Type :=
  Unit
#align quiver.single_obj Quiver.SingleObj

-- Porting note: `deriving` from above has been moved to below.
instance : Unique (SingleObj α) where
  default := ⟨⟩
  uniq := fun _ => rfl

namespace SingleObj

variable (α β γ : Type _)

instance : Quiver (SingleObj α) :=
  ⟨fun _ _ => α⟩

/-- The single object in `SingleObj α`. -/
def star : SingleObj α :=
  Unit.unit
#align quiver.single_obj.star Quiver.SingleObj.star

instance : Inhabited (SingleObj α) :=
  ⟨star α⟩

variable {α β γ}

lemma ext {x y : SingleObj α} : x = y := Unit.ext x y

-- See note [reducible non-instances]
/-- Equip `SingleObj α` with a reverse operation. -/
@[reducible]
def hasReverse (rev : α → α) : HasReverse (SingleObj α) := ⟨rev⟩
#align quiver.single_obj.has_reverse Quiver.SingleObj.hasReverse

-- See note [reducible non-instances]
/-- Equip `SingleObj α` with an involutive reverse operation. -/
@[reducible]
def hasInvolutiveReverse (rev : α → α) (h : Function.Involutive rev) :
    HasInvolutiveReverse (SingleObj α) where
  toHasReverse := hasReverse rev
  inv' := h
#align quiver.single_obj.has_involutive_reverse Quiver.SingleObj.hasInvolutiveReverse

/-- The type of arrows from `star α` to itself is equivalent to the original type `α`. -/
@[simps!]
def toHom : α ≃ (star α ⟶ star α) :=
  Equiv.refl _
#align quiver.single_obj.to_hom Quiver.SingleObj.toHom
#align quiver.single_obj.to_hom_apply Quiver.SingleObj.toHom_apply
#align quiver.single_obj.to_hom_symm_apply Quiver.SingleObj.toHom_symm_apply

/-- Prefunctors between two `SingleObj` quivers correspond to functions between the corresponding
arrows types.
-/
@[simps]
def toPrefunctor : (α → β) ≃ SingleObj α ⥤q SingleObj β where
  toFun f := ⟨id, f⟩
  invFun f a := f.map (toHom a)
  left_inv _ := rfl
  right_inv _ := rfl
#align quiver.single_obj.to_prefunctor_symm_apply Quiver.SingleObj.toPrefunctor_symm_apply
#align quiver.single_obj.to_prefunctor_apply_map Quiver.SingleObj.toPrefunctor_apply_map
#align quiver.single_obj.to_prefunctor_apply_obj Quiver.SingleObj.toPrefunctor_apply_obj

#align quiver.single_obj.to_prefunctor Quiver.SingleObj.toPrefunctor

theorem toPrefunctor_id : toPrefunctor id = 𝟭q (SingleObj α) :=
  rfl
#align quiver.single_obj.to_prefunctor_id Quiver.SingleObj.toPrefunctor_id

@[simp]
theorem toPrefunctor_symm_id : toPrefunctor.symm (𝟭q (SingleObj α)) = id :=
  rfl
#align quiver.single_obj.to_prefunctor_symm_id Quiver.SingleObj.toPrefunctor_symm_id

theorem toPrefunctor_comp (f : α → β) (g : β → γ) :
    toPrefunctor (g ∘ f) = toPrefunctor f ⋙q toPrefunctor g :=
  rfl
#align quiver.single_obj.to_prefunctor_comp Quiver.SingleObj.toPrefunctor_comp

@[simp]
theorem toPrefunctor_symm_comp (f : SingleObj α ⥤q SingleObj β) (g : SingleObj β ⥤q SingleObj γ) :
    toPrefunctor.symm (f ⋙q g) = toPrefunctor.symm g ∘ toPrefunctor.symm f := by
  simp only [Equiv.symm_apply_eq, toPrefunctor_comp, Equiv.apply_symm_apply]
#align quiver.single_obj.to_prefunctor_symm_comp Quiver.SingleObj.toPrefunctor_symm_comp

/-- Auxiliary definition for `quiver.SingleObj.pathEquivList`.
Converts a path in the quiver `single_obj α` into a list of elements of type `a`.
-/
def pathToList : ∀ {x : SingleObj α}, Path (star α) x → List α
  | _, Path.nil => []
  | _, Path.cons p a => a :: pathToList p
#align quiver.single_obj.path_to_list Quiver.SingleObj.pathToList

/-- Auxiliary definition for `quiver.SingleObj.pathEquivList`.
Converts a list of elements of type `α` into a path in the quiver `SingleObj α`.
-/
@[simp]
def listToPath : List α → Path (star α) (star α)
  | [] => Path.nil
  | a :: l => (listToPath l).cons a
#align quiver.single_obj.list_to_path Quiver.SingleObj.listToPath

theorem listToPath_pathToList {x : SingleObj α} (p : Path (star α) x) :
    listToPath (pathToList p) = p.cast rfl ext := by
  induction' p with y z p a ih
  · rfl
  · dsimp at *; rw [ih]
#align quiver.single_obj.path_to_list_to_path Quiver.SingleObj.listToPath_pathToList

theorem pathToList_listToPath (l : List α) : pathToList (listToPath l) = l := by
  induction' l with a l ih
  · rfl
  · change a :: pathToList (listToPath l) = a :: l; rw [ih]

#align quiver.single_obj.list_to_path_to_list Quiver.SingleObj.pathToList_listToPath

/-- Paths in `SingleObj α` quiver correspond to lists of elements of type `α`. -/
def pathEquivList : Path (star α) (star α) ≃ List α :=
  ⟨pathToList, listToPath, fun p => listToPath_pathToList p, pathToList_listToPath⟩
#align quiver.single_obj.path_equiv_list Quiver.SingleObj.pathEquivList

@[simp]
theorem pathEquivList_nil : pathEquivList Path.nil = ([] : List α) :=
  rfl
#align quiver.single_obj.path_equiv_list_nil Quiver.SingleObj.pathEquivList_nil

@[simp]
theorem pathEquivList_cons (p : Path (star α) (star α)) (a : star α ⟶ star α) :
    pathEquivList (Path.cons p a) = a :: pathToList p :=
  rfl
#align quiver.single_obj.path_equiv_list_cons Quiver.SingleObj.pathEquivList_cons

@[simp]
theorem pathEquivList_symm_nil : pathEquivList.symm ([] : List α) = Path.nil :=
  rfl
#align quiver.single_obj.path_equiv_list_symm_nil Quiver.SingleObj.pathEquivList_symm_nil

@[simp]
theorem pathEquivList_symm_cons (l : List α) (a : α) :
    pathEquivList.symm (a :: l) = Path.cons (pathEquivList.symm l) a :=
  rfl
#align quiver.single_obj.path_equiv_list_symm_cons Quiver.SingleObj.pathEquivList_symm_cons

end SingleObj

end Quiver


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

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

* `→*` for bundled monoid homs (also use for group homs)
* `→+` for bundled add_monoid homs (also use for add_group 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
  {G : Type*} {H : Type*} -- groups

-- for easy multiple inheritance
set_option old_structure_cmd true

/-- Homomorphism that preserves zero -/
structure zero_hom (M : Type*) (N : Type*) [has_zero M] [has_zero N] :=
(to_fun : M → N)
(map_zero' : to_fun 0 = 0)

/-- Homomorphism that preserves addition -/
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)

/-- Bundled add_monoid homomorphisms; use this for bundled add_group homomorphisms too. -/
@[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

/-- Homomorphism that preserves one -/
@[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)

/-- Homomorphism that preserves multiplication -/
@[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)

/-- Bundled monoid homomorphisms; use this for bundled group homomorphisms too. -/
@[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

/-- Bundled monoid with zero homomorphisms; use this for bundled group with zero homomorphisms
too. -/
@[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_hom.to_mul_hom
attribute [nolint doc_blame] monoid_hom.to_one_hom
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_hom

-- 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 (monoid_with_zero_hom 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 (monoid_with_zero_hom 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 : monoid_with_zero_hom 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 : monoid_with_zero_hom M N) :
  (f : zero_hom M N) = f.to_zero_hom := rfl

@[to_additive]
instance {mM : has_one M} {mN : has_one N} : has_coe_to_fun (one_hom 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) :=
⟨_, mul_hom.to_fun⟩
@[to_additive]
instance {mM : mul_one_class M} {mN : mul_one_class N} : has_coe_to_fun (M →* N) :=
⟨_, monoid_hom.to_fun⟩
instance {mM : mul_zero_one_class M} {mN : mul_zero_one_class N} :
  has_coe_to_fun (monoid_with_zero_hom 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 : monoid_with_zero_hom 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) = 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) = 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) = 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) = 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 : monoid_with_zero_hom 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 : monoid_with_zero_hom 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 : monoid_with_zero_hom M N} (h : f = g) (x : M) : f x = g x :=
congr_arg (λ h : monoid_with_zero_hom 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 : monoid_with_zero_hom 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 : monoid_with_zero_hom 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 : monoid_with_zero_hom M N⦄ (h : ∀ x, f x = g x) : f = g :=
monoid_with_zero_hom.coe_inj (funext h)

attribute [ext] zero_hom.ext add_hom.ext add_monoid_hom.ext

@[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 : monoid_with_zero_hom 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 : monoid_with_zero_hom M N) (h0 h1 hmul) : monoid_with_zero_hom.mk f h0 h1 hmul = f :=
monoid_with_zero_hom.ext $ λ _, rfl

end coes

@[simp, to_additive]
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`. -/
@[simp, to_additive]
lemma monoid_hom.map_one [mul_one_class M] [mul_one_class N] (f : M →* N) : f 1 = 1 := f.map_one'
@[simp]
lemma monoid_with_zero_hom.map_one [mul_zero_one_class M] [mul_zero_one_class N]
  (f : monoid_with_zero_hom 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
@[simp]
lemma monoid_with_zero_hom.map_zero [mul_zero_one_class M] [mul_zero_one_class N]
  (f : monoid_with_zero_hom M N) : f 0 = 0 := f.map_zero'

@[simp, to_additive]
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`. -/
@[simp, to_additive]
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
@[simp]
lemma monoid_with_zero_hom.map_mul [mul_zero_one_class M] [mul_zero_one_class N]
  (f :  monoid_with_zero_hom 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 :=
by rw [← f.map_mul, h, f.map_one]

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

/-- 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] : monoid_with_zero_hom 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 : monoid_with_zero_hom N P) (hmn : monoid_with_zero_hom M N) : monoid_with_zero_hom 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 : monoid_with_zero_hom N P) (f : monoid_with_zero_hom 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 : monoid_with_zero_hom N P) (f : monoid_with_zero_hom 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 : monoid_with_zero_hom M N) (g : monoid_with_zero_hom N P) (h : monoid_with_zero_hom 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 $ (forall_iff_forall_surj hf).1 (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 $ (forall_iff_forall_surj hf).1 (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 $ (forall_iff_forall_surj hf).1 (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₂ : monoid_with_zero_hom N P} {f : monoid_with_zero_hom M N} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, monoid_with_zero_hom.ext $ (forall_iff_forall_surj hf).1 (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_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 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 : monoid_with_zero_hom N P} {f₁ f₂ : monoid_with_zero_hom 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 : monoid_with_zero_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 : monoid_with_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 : monoid_with_zero_hom 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 : monoid_with_zero_hom M N) : (monoid_with_zero_hom.id N).comp f = f :=
monoid_with_zero_hom.ext $ λ x, rfl

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) := ⟨_, 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) := ⟨_, 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 (monoid_with_zero_hom 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 (f.map_mul_eq_one $ inv_mul_self x) $
  h.symm ▸ g.map_mul_eq_one $ mul_inv_self x

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

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

/-- A homomorphism from a group to a monoid is injective iff its kernel is trivial. -/
@[to_additive]
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 hfx, h $ hfx.trans f.map_one.symm,
 λ 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]⟩

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⁻¹`.
-/
@[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

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

namespace add_monoid_hom

variables {A B : Type*} [add_zero_class A] [add_comm_group B] [add_group G] [add_group H]

/-- Additive group homomorphisms preserve subtraction. -/
@[simp] theorem map_sub (f : G →+ H) (g h : G) : f (g - h) = (f g) - (f h) :=
by rw [sub_eq_add_neg, sub_eq_add_neg, f.map_add_neg g h]

/-- Define a morphism of additive groups given a map which respects difference. -/
def of_map_sub (f : G → H) (hf : ∀ x y, f (x - y) = f x - f y) : G →+ H :=
of_map_add_neg f (by simpa only [sub_eq_add_neg] using hf)

@[simp] lemma coe_of_map_sub (f : G → H) (hf : ∀ x y, f (x - y) = f x - f y) :
  ⇑(of_map_sub f hf) = f :=
rfl

end add_monoid_hom

section commute

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

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

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

end commute


/-
Copyright (c) 2021 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import ring_theory.jacobson
import field_theory.is_alg_closed.basic
import field_theory.mv_polynomial
import algebraic_geometry.prime_spectrum.basic

/-!
# Nullstellensatz
This file establishes a version of Hilbert's classical Nullstellensatz for `mv_polynomial`s.
The main statement of the theorem is `vanishing_ideal_zero_locus_eq_radical`.

The statement is in terms of new definitions `vanishing_ideal` and `zero_locus`.
Mathlib already has versions of these in terms of the prime spectrum of a ring,
  but those are not well-suited for expressing this result.
Suggestions for better ways to state this theorem or organize things are welcome.

The machinery around `vanishing_ideal` and `zero_locus` is also minimal, I only added lemmas
  directly needed in this proof, since I'm not sure if they are the right approach.
-/

open ideal

noncomputable theory

namespace mv_polynomial
open mv_polynomial

variables {k : Type*} [field k]
variables {σ : Type*}

/-- Set of points that are zeroes of all polynomials in an ideal -/
def zero_locus (I : ideal (mv_polynomial σ k)) : set (σ → k) :=
{x : σ → k | ∀ p ∈ I, eval x p = 0}

@[simp] lemma mem_zero_locus_iff {I : ideal (mv_polynomial σ k)} {x : σ → k} :
  x ∈ zero_locus I ↔ ∀ p ∈ I, eval x p = 0 := iff.rfl

lemma zero_locus_anti_mono {I J : ideal (mv_polynomial σ k)} (h : I ≤ J) :
  zero_locus J ≤ zero_locus I :=
λ x hx p hp, hx p $ h hp

lemma zero_locus_bot : zero_locus (⊥ : ideal (mv_polynomial σ k)) = ⊤ :=
eq_top_iff.2 (λ x hx p hp, trans (congr_arg (eval x) (mem_bot.1 hp)) (eval x).map_zero)

lemma zero_locus_top : zero_locus (⊤ : ideal (mv_polynomial σ k)) = ⊥ :=
eq_bot_iff.2 $ λ x hx, one_ne_zero ((eval x).map_one ▸ (hx 1 submodule.mem_top) : (1 : k) = 0)

/-- Ideal of polynomials with common zeroes at all elements of a set -/
def vanishing_ideal (V : set (σ → k)) : ideal (mv_polynomial σ k) :=
{ carrier := {p | ∀ x ∈ V, eval x p = 0},
  zero_mem' := λ x hx, ring_hom.map_zero _,
  add_mem' := λ p q hp hq x hx, by simp only [hq x hx, hp x hx, add_zero, ring_hom.map_add],
  smul_mem' := λ p q hq x hx,
    by simp only [hq x hx, algebra.id.smul_eq_mul, mul_zero, ring_hom.map_mul] }

@[simp] lemma mem_vanishing_ideal_iff {V : set (σ → k)} {p : mv_polynomial σ k} :
  p ∈ vanishing_ideal V ↔ ∀ x ∈ V, eval x p = 0 := iff.rfl

lemma vanishing_ideal_anti_mono {A B : set (σ → k)} (h : A ≤ B) :
  vanishing_ideal B ≤ vanishing_ideal A :=
λ p hp x hx, hp x $ h hx

lemma le_vanishing_ideal_zero_locus (I : ideal (mv_polynomial σ k)) :
  I ≤ vanishing_ideal (zero_locus I) :=
λ p hp x hx, hx p hp

lemma zero_locus_vanishing_ideal_le (V : set (σ → k)) :
  V ≤ zero_locus (vanishing_ideal V) :=
λ V hV p hp, hp V hV

theorem zero_locus_vanishing_ideal_galois_connection :
  @galois_connection (ideal (mv_polynomial σ k)) (set (σ → k))ᵒᵈ _ _
    zero_locus vanishing_ideal :=
λ I V, ⟨λ h, le_trans (le_vanishing_ideal_zero_locus I) (vanishing_ideal_anti_mono h),
  λ h, le_trans (zero_locus_anti_mono h) (zero_locus_vanishing_ideal_le V)⟩

lemma mem_vanishing_ideal_singleton_iff (x : σ → k) (p : mv_polynomial σ k) :
  p ∈ (vanishing_ideal {x} : ideal (mv_polynomial σ k)) ↔ (eval x p = 0) :=
⟨λ h, h x rfl, λ hpx y hy, hy.symm ▸ hpx⟩

instance vanishing_ideal_singleton_is_maximal {x : σ → k} :
  (vanishing_ideal {x} : ideal (mv_polynomial σ k)).is_maximal :=
begin
  have : mv_polynomial σ k ⧸ vanishing_ideal {x} ≃+* k := ring_equiv.of_bijective
    (ideal.quotient.lift _ (eval x) (λ p h, (mem_vanishing_ideal_singleton_iff x p).mp h))
    begin
      refine ⟨(injective_iff_map_eq_zero _).mpr (λ p hp, _), λ z,
        ⟨(ideal.quotient.mk (vanishing_ideal {x} : ideal (mv_polynomial σ k))) (C z), by simp⟩⟩,
      obtain ⟨q, rfl⟩ := quotient.mk_surjective p,
      rwa [ideal.quotient.lift_mk, ← mem_vanishing_ideal_singleton_iff,
        ← quotient.eq_zero_iff_mem] at hp,
    end,
  rw [← bot_quotient_is_maximal_iff, ring_equiv.bot_maximal_iff this],
  exact bot_is_maximal,
end

lemma radical_le_vanishing_ideal_zero_locus (I : ideal (mv_polynomial σ k)) :
  I.radical ≤ vanishing_ideal (zero_locus I) :=
begin
  intros p hp x hx,
  rw ← mem_vanishing_ideal_singleton_iff,
  rw radical_eq_Inf at hp,
  refine (mem_Inf.mp hp) ⟨le_trans (le_vanishing_ideal_zero_locus I)
    (vanishing_ideal_anti_mono (λ y hy, hy.symm ▸ hx)), is_maximal.is_prime' _⟩,
end

/-- The point in the prime spectrum assosiated to a given point -/
def point_to_point (x : σ → k) : prime_spectrum (mv_polynomial σ k) :=
⟨(vanishing_ideal {x} : ideal (mv_polynomial σ k)), by apply_instance⟩

@[simp] lemma vanishing_ideal_point_to_point (V : set (σ → k)) :
  prime_spectrum.vanishing_ideal (point_to_point '' V) = mv_polynomial.vanishing_ideal V :=
le_antisymm
  (λ p hp x hx, (((prime_spectrum.mem_vanishing_ideal _ _).1 hp)
    ⟨vanishing_ideal {x}, by apply_instance⟩ ⟨x, ⟨hx, rfl⟩⟩) x rfl)
  (λ p hp, (prime_spectrum.mem_vanishing_ideal _ _).2
    (λ I hI, let ⟨x, hx⟩ := hI in hx.2 ▸ λ x' hx', (set.mem_singleton_iff.1 hx').symm ▸ hp x hx.1))

lemma point_to_point_zero_locus_le (I : ideal (mv_polynomial σ k)) :
  point_to_point '' (mv_polynomial.zero_locus I) ≤ prime_spectrum.zero_locus ↑I :=
λ J hJ, let ⟨x, hx⟩ := hJ in (le_trans (le_vanishing_ideal_zero_locus I)
  (hx.2 ▸ vanishing_ideal_anti_mono (set.singleton_subset_iff.2 hx.1)) : I ≤ J.as_ideal)

variables [is_alg_closed k] [finite σ]

lemma is_maximal_iff_eq_vanishing_ideal_singleton (I : ideal (mv_polynomial σ k)) :
  I.is_maximal ↔ ∃ (x : σ → k), I = vanishing_ideal {x} :=
begin
  casesI nonempty_fintype σ,
  refine ⟨λ hI, _, λ h, let ⟨x, hx⟩ := h in
    hx.symm ▸ (mv_polynomial.vanishing_ideal_singleton_is_maximal)⟩,
  letI : I.is_maximal := hI,
  letI : field (mv_polynomial σ k ⧸ I) := quotient.field I,
  let ϕ : k →+* mv_polynomial σ k ⧸ I := (ideal.quotient.mk I).comp C,
  have hϕ : function.bijective ϕ := ⟨quotient_mk_comp_C_injective _ _ I hI.ne_top,
    is_alg_closed.algebra_map_surjective_of_is_integral' ϕ
      (mv_polynomial.comp_C_integral_of_surjective_of_jacobson _ quotient.mk_surjective)⟩,
  obtain ⟨φ, hφ⟩ := function.surjective.has_right_inverse hϕ.2,
  let x : σ → k := λ s, φ ((ideal.quotient.mk I) (X s)),
  have hx : ∀ s : σ, ϕ (x s) = (ideal.quotient.mk I) (X s) := λ s, hφ ((ideal.quotient.mk I) (X s)),
  refine ⟨x, (is_maximal.eq_of_le (by apply_instance) hI.ne_top _).symm⟩,
  intros p hp,
  rw [← quotient.eq_zero_iff_mem, map_mv_polynomial_eq_eval₂ (ideal.quotient.mk I) p, eval₂_eq'],
  rw [mem_vanishing_ideal_singleton_iff, eval_eq'] at hp,
  simpa only [ϕ.map_sum, ϕ.map_mul, ϕ.map_prod, ϕ.map_pow, ϕ.map_zero, hx] using congr_arg ϕ hp,
end

/-- Main statement of the Nullstellensatz -/
@[simp] theorem vanishing_ideal_zero_locus_eq_radical (I : ideal (mv_polynomial σ k)) :
  vanishing_ideal (zero_locus I) = I.radical :=
begin
  rw I.radical_eq_jacobson,
  refine le_antisymm (le_Inf _) (λ p hp x hx, _),
  { rintros J ⟨hJI, hJ⟩,
    obtain ⟨x, hx⟩ := (is_maximal_iff_eq_vanishing_ideal_singleton J).1 hJ,
    refine hx.symm ▸ vanishing_ideal_anti_mono (λ y hy p hp, _),
    rw [← mem_vanishing_ideal_singleton_iff, set.mem_singleton_iff.1 hy, ← hx],
    refine hJI hp },
  { rw ← mem_vanishing_ideal_singleton_iff x p,
    refine (mem_Inf.mp hp) ⟨le_trans (le_vanishing_ideal_zero_locus I)
      (vanishing_ideal_anti_mono (λ y hy, hy.symm ▸ hx)),
        mv_polynomial.vanishing_ideal_singleton_is_maximal⟩ },
end

@[simp] lemma is_prime.vanishing_ideal_zero_locus (P : ideal (mv_polynomial σ k)) [h : P.is_prime] :
  vanishing_ideal (zero_locus P) = P :=
trans (vanishing_ideal_zero_locus_eq_radical P) h.radical

end mv_polynomial


/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky, Chris Hughes
-/
import data.list.nodup

/-!
# List duplicates

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

## Main definitions

* `list.duplicate x l : Prop` is an inductive property that holds when `x` is a duplicate in `l`

## Implementation details

In this file, `x ∈+ l` notation is shorthand for `list.duplicate x l`.

-/

variable {α : Type*}

namespace list

/-- Property that an element `x : α` of `l : list α` can be found in the list more than once. -/
inductive duplicate (x : α) : list α → Prop
| cons_mem {l : list α} : x ∈ l → duplicate (x :: l)
| cons_duplicate {y : α} {l : list α} : duplicate l → duplicate (y :: l)

local infix ` ∈+ `:50 := list.duplicate

variables {l : list α} {x : α}

lemma mem.duplicate_cons_self (h : x ∈ l) : x ∈+ x :: l := duplicate.cons_mem h

lemma duplicate.duplicate_cons (h : x ∈+ l) (y : α) : x ∈+ y :: l := duplicate.cons_duplicate h

lemma duplicate.mem (h : x ∈+ l) : x ∈ l :=
begin
  induction h with l' h y l' h hm,
  { exact mem_cons_self _ _ },
  { exact mem_cons_of_mem _ hm }
end

lemma duplicate.mem_cons_self (h : x ∈+ x :: l) : x ∈ l :=
begin
  cases h with _ h _ _ h,
  { exact h },
  { exact h.mem }
end

@[simp] lemma duplicate_cons_self_iff : x ∈+ x :: l ↔ x ∈ l :=
⟨duplicate.mem_cons_self, mem.duplicate_cons_self⟩

lemma duplicate.ne_nil (h : x ∈+ l) : l ≠ [] :=
λ H, (mem_nil_iff x).mp (H ▸ h.mem)

@[simp] lemma not_duplicate_nil (x : α) : ¬ x ∈+ [] :=
λ H, H.ne_nil rfl

lemma duplicate.ne_singleton (h : x ∈+ l) (y : α) : l ≠ [y] :=
begin
  induction h with l' h z l' h hm,
  { simp [ne_nil_of_mem h] },
  { simp [ne_nil_of_mem h.mem] }
end

@[simp] lemma not_duplicate_singleton (x y : α) : ¬ x ∈+ [y] :=
λ H, H.ne_singleton _ rfl

lemma duplicate.elim_nil (h : x ∈+ []) : false :=
not_duplicate_nil x h

lemma duplicate.elim_singleton {y : α} (h : x ∈+ [y]) : false :=
not_duplicate_singleton x y h

lemma duplicate_cons_iff {y : α} : x ∈+ y :: l ↔ (y = x ∧ x ∈ l) ∨ x ∈+ l :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { cases h with _ hm _ _ hm,
    { exact or.inl ⟨rfl, hm⟩ },
    { exact or.inr hm } },
  { rcases h with ⟨rfl|h⟩|h,
    { simpa },
    { exact h.cons_duplicate } }
end

lemma duplicate.of_duplicate_cons {y : α} (h : x ∈+ y :: l) (hx : x ≠ y) : x ∈+ l :=
by simpa [duplicate_cons_iff, hx.symm] using h

lemma duplicate_cons_iff_of_ne {y : α} (hne : x ≠ y) : x ∈+ y :: l ↔ x ∈+ l :=
by simp [duplicate_cons_iff, hne.symm]

lemma duplicate.mono_sublist {l' : list α} (hx : x ∈+ l) (h : l <+ l') : x ∈+ l' :=
begin
  induction h with l₁ l₂ y h IH l₁ l₂ y h IH,
  { exact hx },
  { exact (IH hx).duplicate_cons _ },
  { rw duplicate_cons_iff at hx ⊢,
    rcases hx with ⟨rfl, hx⟩|hx,
    { simp [h.subset hx] },
    { simp [IH hx] } }
end

/-- The contrapositive of `list.nodup_iff_sublist`. -/
lemma duplicate_iff_sublist : x ∈+ l ↔ [x, x] <+ l :=
begin
  induction l with y l IH,
  { simp },
  { by_cases hx : x = y,
    { simp [hx, cons_sublist_cons_iff, singleton_sublist] },
    { rw [duplicate_cons_iff_of_ne hx, IH],
      refine ⟨sublist_cons_of_sublist y, λ h, _⟩,
      cases h,
      { assumption },
      { contradiction } } }
end

lemma nodup_iff_forall_not_duplicate : nodup l ↔ ∀ (x : α), ¬ x ∈+ l :=
by simp_rw [nodup_iff_sublist, duplicate_iff_sublist]

lemma exists_duplicate_iff_not_nodup : (∃ (x : α), x ∈+ l) ↔ ¬ nodup l :=
by simp [nodup_iff_forall_not_duplicate]

lemma duplicate.not_nodup (h : x ∈+ l) : ¬ nodup l :=
λ H, nodup_iff_forall_not_duplicate.mp H _ h

lemma duplicate_iff_two_le_count [decidable_eq α] : (x ∈+ l) ↔ 2 ≤ count x l :=
by simp [duplicate_iff_sublist, le_count_iff_replicate_sublist]

instance decidable_duplicate [decidable_eq α] (x : α) : ∀ (l : list α), decidable (x ∈+ l)
| []       := is_false (not_duplicate_nil x)
| (y :: l) := match decidable_duplicate l with
  | is_true  h := is_true (h.duplicate_cons y)
  | is_false h := if hx : y = x ∧ x ∈ l
      then is_true (hx.left.symm ▸ hx.right.duplicate_cons_self)
      else is_false (by simpa [duplicate_cons_iff, h] using hx)
  end

end list