/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov
-/
import algebra.order.monoid.cancel.basic
import group_theory.group_action.defs
import group_theory.submonoid.basic
import group_theory.subsemigroup.operations

/-!
# Operations on `submonoid`s

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

In this file we define various operations on `submonoid`s and `monoid_hom`s.

## Main definitions

### Conversion between multiplicative and additive definitions

* `submonoid.to_add_submonoid`, `submonoid.to_add_submonoid'`, `add_submonoid.to_submonoid`,
  `add_submonoid.to_submonoid'`: convert between multiplicative and additive submonoids of `M`,
  `multiplicative M`, and `additive M`. These are stated as `order_iso`s.

### (Commutative) monoid structure on a submonoid

* `submonoid.to_monoid`, `submonoid.to_comm_monoid`: a submonoid inherits a (commutative) monoid
  structure.

### Group actions by submonoids

* `submonoid.mul_action`, `submonoid.distrib_mul_action`: a submonoid inherits (distributive)
  multiplicative actions.

### Operations on submonoids

* `submonoid.comap`: preimage of a submonoid under a monoid homomorphism as a submonoid of the
  domain;
* `submonoid.map`: image of a submonoid under a monoid homomorphism as a submonoid of the codomain;
* `submonoid.prod`: product of two submonoids `s : submonoid M` and `t : submonoid N` as a submonoid
  of `M × N`;

### Monoid homomorphisms between submonoid

* `submonoid.subtype`: embedding of a submonoid into the ambient monoid.
* `submonoid.inclusion`: given two submonoids `S`, `T` such that `S ≤ T`, `S.inclusion T` is the
  inclusion of `S` into `T` as a monoid homomorphism;
* `mul_equiv.submonoid_congr`: converts a proof of `S = T` into a monoid isomorphism between `S`
  and `T`.
* `submonoid.prod_equiv`: monoid isomorphism between `s.prod t` and `s × t`;

### Operations on `monoid_hom`s

* `monoid_hom.mrange`: range of a monoid homomorphism as a submonoid of the codomain;
* `monoid_hom.mker`: kernel of a monoid homomorphism as a submonoid of the domain;
* `monoid_hom.restrict`: restrict a monoid homomorphism to a submonoid;
* `monoid_hom.cod_restrict`: restrict the codomain of a monoid homomorphism to a submonoid;
* `monoid_hom.mrange_restrict`: restrict a monoid homomorphism to its range;

## Tags

submonoid, range, product, map, comap
-/

variables {M N P : Type*} [mul_one_class M] [mul_one_class N] [mul_one_class P] (S : submonoid M)

/-!
### Conversion to/from `additive`/`multiplicative`
-/

section

/-- Submonoids of monoid `M` are isomorphic to additive submonoids of `additive M`. -/
@[simps]
def submonoid.to_add_submonoid : submonoid M ≃o add_submonoid (additive M) :=
{ to_fun := λ S,
  { carrier := additive.to_mul ⁻¹' S,
    zero_mem' := S.one_mem',
    add_mem' := λ _ _, S.mul_mem' },
  inv_fun := λ S,
  { carrier := additive.of_mul ⁻¹' S,
    one_mem' := S.zero_mem',
    mul_mem' := λ _ _, S.add_mem' },
  left_inv := λ x, by cases x; refl,
  right_inv := λ x, by cases x; refl,
  map_rel_iff' := λ a b, iff.rfl, }

/-- Additive submonoids of an additive monoid `additive M` are isomorphic to submonoids of `M`. -/
abbreviation add_submonoid.to_submonoid' : add_submonoid (additive M) ≃o submonoid M :=
submonoid.to_add_submonoid.symm

lemma submonoid.to_add_submonoid_closure (S : set M) :
  (submonoid.closure S).to_add_submonoid = add_submonoid.closure (additive.to_mul ⁻¹' S) :=
le_antisymm
  (submonoid.to_add_submonoid.le_symm_apply.1 $
    submonoid.closure_le.2 add_submonoid.subset_closure)
  (add_submonoid.closure_le.2 submonoid.subset_closure)

lemma add_submonoid.to_submonoid'_closure (S : set (additive M)) :
  (add_submonoid.closure S).to_submonoid' = submonoid.closure (multiplicative.of_add ⁻¹' S) :=
le_antisymm
  (add_submonoid.to_submonoid'.le_symm_apply.1 $
    add_submonoid.closure_le.2 submonoid.subset_closure)
  (submonoid.closure_le.2 add_submonoid.subset_closure)

end

section

variables {A : Type*} [add_zero_class A]

/-- Additive submonoids of an additive monoid `A` are isomorphic to
multiplicative submonoids of `multiplicative A`. -/
@[simps]
def add_submonoid.to_submonoid : add_submonoid A ≃o submonoid (multiplicative A) :=
{ to_fun := λ S,
  { carrier := multiplicative.to_add ⁻¹' S,
    one_mem' := S.zero_mem',
    mul_mem' := λ _ _, S.add_mem' },
  inv_fun := λ S,
  { carrier := multiplicative.of_add ⁻¹' S,
    zero_mem' := S.one_mem',
    add_mem' := λ _ _, S.mul_mem' },
  left_inv := λ x, by cases x; refl,
  right_inv := λ x, by cases x; refl,
  map_rel_iff' := λ a b, iff.rfl, }

/-- Submonoids of a monoid `multiplicative A` are isomorphic to additive submonoids of `A`. -/
abbreviation submonoid.to_add_submonoid' : submonoid (multiplicative A) ≃o add_submonoid A :=
add_submonoid.to_submonoid.symm

lemma add_submonoid.to_submonoid_closure (S : set A) :
  (add_submonoid.closure S).to_submonoid = submonoid.closure (multiplicative.to_add ⁻¹' S) :=
le_antisymm
  (add_submonoid.to_submonoid.to_galois_connection.l_le $
    add_submonoid.closure_le.2 submonoid.subset_closure)
  (submonoid.closure_le.2 add_submonoid.subset_closure)

lemma submonoid.to_add_submonoid'_closure (S : set (multiplicative A)) :
  (submonoid.closure S).to_add_submonoid' = add_submonoid.closure (additive.of_mul ⁻¹' S) :=
le_antisymm
  (submonoid.to_add_submonoid'.to_galois_connection.l_le $
    submonoid.closure_le.2 add_submonoid.subset_closure)
  (add_submonoid.closure_le.2 submonoid.subset_closure)

end

namespace submonoid
variables {F : Type*} [mc : monoid_hom_class F M N]

open set

/-!
### `comap` and `map`
-/

include mc
/-- The preimage of a submonoid along a monoid homomorphism is a submonoid. -/
@[to_additive "The preimage of an `add_submonoid` along an `add_monoid` homomorphism is an
`add_submonoid`."]
def comap (f : F) (S : submonoid N) : submonoid M :=
{ carrier := (f ⁻¹' S),
  one_mem' := show f 1 ∈ S, by rw map_one; exact S.one_mem,
  mul_mem' := λ a b ha hb,
    show f (a * b) ∈ S, by rw map_mul; exact S.mul_mem ha hb }

@[simp, to_additive]
lemma coe_comap (S : submonoid N) (f : F) : (S.comap f : set M) = f ⁻¹' S := rfl

@[simp, to_additive]
lemma mem_comap {S : submonoid N} {f : F} {x : M} : x ∈ S.comap f ↔ f x ∈ S := iff.rfl
omit mc

@[to_additive]
lemma comap_comap (S : submonoid P) (g : N →* P) (f : M →* N) :
  (S.comap g).comap f = S.comap (g.comp f) :=
rfl

@[simp, to_additive]
lemma comap_id (S : submonoid P) : S.comap (monoid_hom.id P) = S :=
ext (by simp)

include mc
/-- The image of a submonoid along a monoid homomorphism is a submonoid. -/
@[to_additive "The image of an `add_submonoid` along an `add_monoid` homomorphism is
an `add_submonoid`."]
def map (f : F) (S : submonoid M) : submonoid N :=
{ carrier := (f '' S),
  one_mem' := ⟨1, S.one_mem, map_one f⟩,
  mul_mem' := begin rintros _ _ ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩, exact ⟨x * y, S.mul_mem hx hy,
    by rw map_mul; refl⟩ end }

@[simp, to_additive]
lemma coe_map (f : F) (S : submonoid M) :
  (S.map f : set N) = f '' S := rfl

@[simp, to_additive]
lemma mem_map {f : F} {S : submonoid M} {y : N} :
  y ∈ S.map f ↔ ∃ x ∈ S, f x = y :=
mem_image_iff_bex

@[to_additive]
lemma mem_map_of_mem (f : F) {S : submonoid M} {x : M} (hx : x ∈ S) : f x ∈ S.map f :=
mem_image_of_mem f hx

@[to_additive]
lemma apply_coe_mem_map (f : F) (S : submonoid M) (x : S) : f x ∈ S.map f :=
mem_map_of_mem f x.prop
omit mc

@[to_additive]
lemma map_map (g : N →* P) (f : M →* N) : (S.map f).map g = S.map (g.comp f) :=
set_like.coe_injective $ image_image _ _ _

include mc
@[to_additive]
lemma mem_map_iff_mem {f : F} (hf : function.injective f) {S : submonoid M} {x : M} :
  f x ∈ S.map f ↔ x ∈ S :=
hf.mem_set_image

@[to_additive]
lemma map_le_iff_le_comap {f : F} {S : submonoid M} {T : submonoid N} :
  S.map f ≤ T ↔ S ≤ T.comap f :=
image_subset_iff

@[to_additive]
lemma gc_map_comap (f : F) : galois_connection (map f) (comap f) :=
λ S T, map_le_iff_le_comap

@[to_additive]
lemma map_le_of_le_comap {T : submonoid N} {f : F} : S ≤ T.comap f → S.map f ≤ T :=
(gc_map_comap f).l_le

@[to_additive]
lemma le_comap_of_map_le {T : submonoid N} {f : F} : S.map f ≤ T → S ≤ T.comap f :=
(gc_map_comap f).le_u

@[to_additive]
lemma le_comap_map {f : F} : S ≤ (S.map f).comap f :=
(gc_map_comap f).le_u_l _

@[to_additive]
lemma map_comap_le {S : submonoid N} {f : F} : (S.comap f).map f ≤ S :=
(gc_map_comap f).l_u_le _

@[to_additive]
lemma monotone_map {f : F} : monotone (map f) :=
(gc_map_comap f).monotone_l

@[to_additive]
lemma monotone_comap {f : F} : monotone (comap f) :=
(gc_map_comap f).monotone_u

@[simp, to_additive]
lemma map_comap_map {f : F} : ((S.map f).comap f).map f = S.map f :=
(gc_map_comap f).l_u_l_eq_l _

@[simp, to_additive]
lemma comap_map_comap {S : submonoid N} {f : F} : ((S.comap f).map f).comap f = S.comap f :=
(gc_map_comap f).u_l_u_eq_u _

@[to_additive]
lemma map_sup (S T : submonoid M) (f : F) : (S ⊔ T).map f = S.map f ⊔ T.map f :=
(gc_map_comap f : galois_connection (map f) (comap f)).l_sup

@[to_additive]
lemma map_supr {ι : Sort*} (f : F) (s : ι → submonoid M) :
  (supr s).map f = ⨆ i, (s i).map f :=
(gc_map_comap f : galois_connection (map f) (comap f)).l_supr

@[to_additive]
lemma comap_inf (S T : submonoid N) (f : F) : (S ⊓ T).comap f = S.comap f ⊓ T.comap f :=
(gc_map_comap f : galois_connection (map f) (comap f)).u_inf

@[to_additive]
lemma comap_infi {ι : Sort*} (f : F) (s : ι → submonoid N) :
  (infi s).comap f = ⨅ i, (s i).comap f :=
(gc_map_comap f : galois_connection (map f) (comap f)).u_infi

@[simp, to_additive] lemma map_bot (f : F) : (⊥ : submonoid M).map f = ⊥ :=
(gc_map_comap f).l_bot

@[simp, to_additive]

@[simp, to_additive] lemma map_id (S : submonoid M) : S.map (monoid_hom.id M) = S :=
ext (λ x, ⟨λ ⟨_, h, rfl⟩, h, λ h, ⟨_, h, rfl⟩⟩)

section galois_coinsertion

variables {ι : Type*} {f : F} (hf : function.injective f)

include hf

/-- `map f` and `comap f` form a `galois_coinsertion` when `f` is injective. -/
@[to_additive /-" `map f` and `comap f` form a `galois_coinsertion` when `f` is injective. "-/]
def gci_map_comap : galois_coinsertion (map f) (comap f) :=
(gc_map_comap f).to_galois_coinsertion
  (λ S x, by simp [mem_comap, mem_map, hf.eq_iff])

@[to_additive]
lemma comap_map_eq_of_injective (S : submonoid M) : (S.map f).comap f = S :=
(gci_map_comap hf).u_l_eq _

@[to_additive]
lemma comap_surjective_of_injective : function.surjective (comap f) :=
(gci_map_comap hf).u_surjective

@[to_additive]
lemma map_injective_of_injective : function.injective (map f) :=
(gci_map_comap hf).l_injective

@[to_additive]
lemma comap_inf_map_of_injective (S T : submonoid M) : (S.map f ⊓ T.map f).comap f = S ⊓ T :=
(gci_map_comap hf).u_inf_l _ _

@[to_additive]
lemma comap_infi_map_of_injective (S : ι → submonoid M) : (⨅ i, (S i).map f).comap f = infi S :=
(gci_map_comap hf).u_infi_l _

@[to_additive]
lemma comap_sup_map_of_injective (S T : submonoid M) : (S.map f ⊔ T.map f).comap f = S ⊔ T :=
(gci_map_comap hf).u_sup_l _ _

@[to_additive]
lemma comap_supr_map_of_injective (S : ι → submonoid M) : (⨆ i, (S i).map f).comap f = supr S :=
(gci_map_comap hf).u_supr_l _

@[to_additive]
lemma map_le_map_iff_of_injective {S T : submonoid M} : S.map f ≤ T.map f ↔ S ≤ T :=
(gci_map_comap hf).l_le_l_iff

@[to_additive]
lemma map_strict_mono_of_injective : strict_mono (map f) :=
(gci_map_comap hf).strict_mono_l

end galois_coinsertion

section galois_insertion

variables {ι : Type*} {f : F} (hf : function.surjective f)

include hf

/-- `map f` and `comap f` form a `galois_insertion` when `f` is surjective. -/
@[to_additive /-" `map f` and `comap f` form a `galois_insertion` when `f` is surjective. "-/]
def gi_map_comap : galois_insertion (map f) (comap f) :=
(gc_map_comap f).to_galois_insertion
  (λ S x h, let ⟨y, hy⟩ := hf x in mem_map.2 ⟨y, by simp [hy, h]⟩)

@[to_additive]
lemma map_comap_eq_of_surjective (S : submonoid N) : (S.comap f).map f = S :=
(gi_map_comap hf).l_u_eq _

@[to_additive]
lemma map_surjective_of_surjective : function.surjective (map f) :=
(gi_map_comap hf).l_surjective

@[to_additive]
lemma comap_injective_of_surjective : function.injective (comap f) :=
(gi_map_comap hf).u_injective

@[to_additive]
lemma map_inf_comap_of_surjective (S T : submonoid N) : (S.comap f ⊓ T.comap f).map f = S ⊓ T :=
(gi_map_comap hf).l_inf_u _ _

@[to_additive]
lemma map_infi_comap_of_surjective (S : ι → submonoid N) : (⨅ i, (S i).comap f).map f = infi S :=
(gi_map_comap hf).l_infi_u _

@[to_additive]
lemma map_sup_comap_of_surjective (S T : submonoid N) : (S.comap f ⊔ T.comap f).map f = S ⊔ T :=
(gi_map_comap hf).l_sup_u _ _

@[to_additive]
lemma map_supr_comap_of_surjective (S : ι → submonoid N) : (⨆ i, (S i).comap f).map f = supr S :=
(gi_map_comap hf).l_supr_u _

@[to_additive]
lemma comap_le_comap_iff_of_surjective {S T : submonoid N} : S.comap f ≤ T.comap f ↔ S ≤ T :=
(gi_map_comap hf).u_le_u_iff

@[to_additive]
lemma comap_strict_mono_of_surjective : strict_mono (comap f) :=
(gi_map_comap hf).strict_mono_u

end galois_insertion

end submonoid

namespace one_mem_class

variables {A M₁ : Type*} [set_like A M₁] [has_one M₁] [hA : one_mem_class A M₁] (S' : A)
include hA

/-- A submonoid of a monoid inherits a 1. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits a zero."]
instance has_one : has_one S' := ⟨⟨1, one_mem_class.one_mem S'⟩⟩

@[simp, norm_cast, to_additive] lemma coe_one : ((1 : S') : M₁) = 1 := rfl

variables {S'}
@[simp, norm_cast, to_additive] lemma coe_eq_one {x : S'} : (↑x : M₁) = 1 ↔ x = 1 :=
(subtype.ext_iff.symm : (x : M₁) = (1 : S') ↔ x = 1)
variables (S')

@[to_additive] lemma one_def : (1 : S') = ⟨1, one_mem_class.one_mem S'⟩ := rfl

end one_mem_class

namespace submonoid_class

variables {A : Type*} [set_like A M] [hA : submonoid_class A M] (S' : A)

/-- An `add_submonoid` of an `add_monoid` inherits a scalar multiplication. -/
instance _root_.add_submonoid_class.has_nsmul {M} [add_monoid M] {A : Type*} [set_like A M]
  [add_submonoid_class A M] (S : A) :
  has_smul ℕ S :=
⟨λ n a, ⟨n • a.1, nsmul_mem a.2 n⟩⟩

/-- A submonoid of a monoid inherits a power operator. -/
instance has_pow {M} [monoid M] {A : Type*} [set_like A M] [submonoid_class A M] (S : A) :
  has_pow S ℕ :=
⟨λ a n, ⟨a.1 ^ n, pow_mem a.2 n⟩⟩

attribute [to_additive] submonoid_class.has_pow

@[simp, norm_cast, to_additive] lemma coe_pow {M} [monoid M] {A : Type*} [set_like A M]
  [submonoid_class A M] {S : A} (x : S) (n : ℕ) :
  (↑(x ^ n) : M) = ↑x ^ n :=
rfl

@[simp, to_additive] lemma mk_pow {M} [monoid M] {A : Type*} [set_like A M]
  [submonoid_class A M] {S : A} (x : M) (hx : x ∈ S) (n : ℕ) :
  (⟨x, hx⟩ : S) ^ n = ⟨x ^ n, pow_mem hx n⟩ :=
rfl

/-- A submonoid of a unital magma inherits a unital magma structure. -/
@[to_additive "An `add_submonoid` of an unital additive magma inherits an unital additive magma
structure.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_mul_one_class {M : Type*} [mul_one_class M] {A : Type*} [set_like A M]
  [submonoid_class A M] (S : A) : mul_one_class S :=
subtype.coe_injective.mul_one_class _ rfl (λ _ _, rfl)

/-- A submonoid of a monoid inherits a monoid structure. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits an `add_monoid`
structure.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_monoid {M : Type*} [monoid M] {A : Type*} [set_like A M] [submonoid_class A M]
  (S : A) : monoid S :=
subtype.coe_injective.monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `comm_monoid` is a `comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `add_comm_monoid` is
an `add_comm_monoid`.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_comm_monoid {M} [comm_monoid M] {A : Type*} [set_like A M] [submonoid_class A M]
  (S : A) : comm_monoid S :=
subtype.coe_injective.comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of an `ordered_comm_monoid` is an `ordered_comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `ordered_add_comm_monoid` is
an `ordered_add_comm_monoid`.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_ordered_comm_monoid {M} [ordered_comm_monoid M] {A : Type*} [set_like A M]
  [submonoid_class A M] (S : A) : ordered_comm_monoid S :=
subtype.coe_injective.ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `linear_ordered_comm_monoid` is a `linear_ordered_comm_monoid`. -/
@[to_additive "An `add_submonoid` of a `linear_ordered_add_comm_monoid` is
a `linear_ordered_add_comm_monoid`.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_linear_ordered_comm_monoid {M} [linear_ordered_comm_monoid M] {A : Type*}
  [set_like A M] [submonoid_class A M] (S : A) :
  linear_ordered_comm_monoid S :=
subtype.coe_injective.linear_ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of an `ordered_cancel_comm_monoid` is an `ordered_cancel_comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `ordered_cancel_add_comm_monoid` is
an `ordered_cancel_add_comm_monoid`.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_ordered_cancel_comm_monoid {M} [ordered_cancel_comm_monoid M] {A : Type*}
  [set_like A M] [submonoid_class A M] (S : A) :
  ordered_cancel_comm_monoid S :=
subtype.coe_injective.ordered_cancel_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `linear_ordered_cancel_comm_monoid` is a `linear_ordered_cancel_comm_monoid`.
-/
@[to_additive "An `add_submonoid` of a `linear_ordered_cancel_add_comm_monoid` is
a `linear_ordered_cancel_add_comm_monoid`.",
priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_class`.
instance to_linear_ordered_cancel_comm_monoid {M} [linear_ordered_cancel_comm_monoid M]
  {A : Type*} [set_like A M] [submonoid_class A M] (S : A) : linear_ordered_cancel_comm_monoid S :=
subtype.coe_injective.linear_ordered_cancel_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl)

include hA

/-- The natural monoid hom from a submonoid of monoid `M` to `M`. -/
@[to_additive "The natural monoid hom from an `add_submonoid` of `add_monoid` `M` to `M`."]
def subtype : S' →* M := ⟨coe, rfl, λ _ _, rfl⟩

@[simp, to_additive] theorem coe_subtype : (submonoid_class.subtype S' : S' → M) = coe := rfl

end submonoid_class

namespace submonoid

/-- A submonoid of a monoid inherits a multiplication. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits an addition."]
instance has_mul : has_mul S := ⟨λ a b, ⟨a.1 * b.1, S.mul_mem a.2 b.2⟩⟩

/-- A submonoid of a monoid inherits a 1. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits a zero."]
instance has_one : has_one S := ⟨⟨_, S.one_mem⟩⟩

@[simp, norm_cast, to_additive] lemma coe_mul (x y : S) : (↑(x * y) : M) = ↑x * ↑y := rfl
@[simp, norm_cast, to_additive] lemma coe_one : ((1 : S) : M) = 1 := rfl

@[simp, to_additive] lemma mk_mul_mk (x y : M) (hx : x ∈ S) (hy : y ∈ S) :
  (⟨x, hx⟩ : S) * ⟨y, hy⟩ = ⟨x * y, S.mul_mem hx hy⟩ := rfl

@[to_additive] lemma mul_def (x y : S) : x * y = ⟨x * y, S.mul_mem x.2 y.2⟩ := rfl
@[to_additive] lemma one_def : (1 : S) = ⟨1, S.one_mem⟩ := rfl

/-- A submonoid of a unital magma inherits a unital magma structure. -/
@[to_additive "An `add_submonoid` of an unital additive magma inherits an unital additive magma
structure."]
instance to_mul_one_class {M : Type*} [mul_one_class M] (S : submonoid M) : mul_one_class S :=
subtype.coe_injective.mul_one_class coe rfl (λ _ _, rfl)

@[to_additive] protected lemma pow_mem {M : Type*} [monoid M] (S : submonoid M) {x : M}
  (hx : x ∈ S) (n : ℕ) : x ^ n ∈ S :=
pow_mem hx n

@[simp, norm_cast, to_additive] theorem coe_pow  {M : Type*} [monoid M] {S : submonoid M}
  (x : S) (n : ℕ) : ↑(x ^ n) = (x ^ n : M) :=
rfl

/-- A submonoid of a monoid inherits a monoid structure. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits an `add_monoid`
structure."]
instance to_monoid {M : Type*} [monoid M] (S : submonoid M) : monoid S :=
subtype.coe_injective.monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `comm_monoid` is a `comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `add_comm_monoid` is
an `add_comm_monoid`."]
instance to_comm_monoid {M} [comm_monoid M] (S : submonoid M) : comm_monoid S :=
subtype.coe_injective.comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of an `ordered_comm_monoid` is an `ordered_comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `ordered_add_comm_monoid` is
an `ordered_add_comm_monoid`."]
instance to_ordered_comm_monoid {M} [ordered_comm_monoid M] (S : submonoid M) :
  ordered_comm_monoid S :=
subtype.coe_injective.ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `linear_ordered_comm_monoid` is a `linear_ordered_comm_monoid`. -/
@[to_additive "An `add_submonoid` of a `linear_ordered_add_comm_monoid` is
a `linear_ordered_add_comm_monoid`."]
instance to_linear_ordered_comm_monoid {M} [linear_ordered_comm_monoid M] (S : submonoid M) :
  linear_ordered_comm_monoid S :=
subtype.coe_injective.linear_ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl)

/-- A submonoid of an `ordered_cancel_comm_monoid` is an `ordered_cancel_comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `ordered_cancel_add_comm_monoid` is
an `ordered_cancel_add_comm_monoid`."]
instance to_ordered_cancel_comm_monoid {M} [ordered_cancel_comm_monoid M] (S : submonoid M) :
  ordered_cancel_comm_monoid S :=
subtype.coe_injective.ordered_cancel_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A submonoid of a `linear_ordered_cancel_comm_monoid` is a `linear_ordered_cancel_comm_monoid`.
-/
@[to_additive "An `add_submonoid` of a `linear_ordered_cancel_add_comm_monoid` is
a `linear_ordered_cancel_add_comm_monoid`."]
instance to_linear_ordered_cancel_comm_monoid {M} [linear_ordered_cancel_comm_monoid M]
  (S : submonoid M) : linear_ordered_cancel_comm_monoid S :=
subtype.coe_injective.linear_ordered_cancel_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl)

/-- The natural monoid hom from a submonoid of monoid `M` to `M`. -/
@[to_additive "The natural monoid hom from an `add_submonoid` of `add_monoid` `M` to `M`."]
def subtype : S →* M := ⟨coe, rfl, λ _ _, rfl⟩

@[simp, to_additive] theorem coe_subtype : ⇑S.subtype = coe := rfl

/-- The top submonoid is isomorphic to the monoid. -/
@[to_additive "The top additive submonoid is isomorphic to the additive monoid.", simps]
def top_equiv : (⊤ : submonoid M) ≃* M :=
{ to_fun    := λ x, x,
  inv_fun   := λ x, ⟨x, mem_top x⟩,
  left_inv  := λ x, x.eta _,
  right_inv := λ _, rfl,
  map_mul'  := λ _ _, rfl }

@[simp, to_additive] lemma top_equiv_to_monoid_hom :
  (top_equiv : _ ≃* M).to_monoid_hom = (⊤ : submonoid M).subtype :=
rfl

/-- A subgroup is isomorphic to its image under an injective function. If you have an isomorphism,
use `mul_equiv.submonoid_map` for better definitional equalities. -/
@[to_additive  "An additive subgroup is isomorphic to its image under an injective function. If you
have an isomorphism, use `add_equiv.add_submonoid_map` for better definitional equalities."]
noncomputable def equiv_map_of_injective
  (f : M →* N) (hf : function.injective f) : S ≃* S.map f :=
{ map_mul' := λ _ _, subtype.ext (f.map_mul _ _), ..equiv.set.image f S hf }

@[simp, to_additive] lemma coe_equiv_map_of_injective_apply
  (f : M →* N) (hf : function.injective f) (x : S) :
  (equiv_map_of_injective S f hf x : N) = f x := rfl

@[simp, to_additive]
lemma closure_closure_coe_preimage {s : set M} : closure ((coe : closure s → M) ⁻¹' s) = ⊤ :=
eq_top_iff.2 $ λ x, subtype.rec_on x $ λ x hx _, begin
  refine closure_induction' _ (λ g hg, _) _ (λ g₁ g₂ hg₁ hg₂, _) hx,
  { exact subset_closure hg },
  { exact submonoid.one_mem _ },
  { exact submonoid.mul_mem _ },
end

/-- Given `submonoid`s `s`, `t` of monoids `M`, `N` respectively, `s × t` as a submonoid
of `M × N`. -/
@[to_additive prod "Given `add_submonoid`s `s`, `t` of `add_monoid`s `A`, `B` respectively, `s × t`
as an `add_submonoid` of `A × B`."]
def prod (s : submonoid M) (t : submonoid N) : submonoid (M × N) :=
{ carrier := s ×ˢ t,
  one_mem' := ⟨s.one_mem, t.one_mem⟩,
  mul_mem' := λ p q hp hq, ⟨s.mul_mem hp.1 hq.1, t.mul_mem hp.2 hq.2⟩ }

@[to_additive coe_prod]
lemma coe_prod (s : submonoid M) (t : submonoid N) : (s.prod t : set (M × N)) = s ×ˢ t := rfl

@[to_additive mem_prod]
lemma mem_prod {s : submonoid M} {t : submonoid N} {p : M × N} :
  p ∈ s.prod t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl

@[to_additive prod_mono]
lemma prod_mono {s₁ s₂ : submonoid M} {t₁ t₂ : submonoid N} (hs : s₁ ≤ s₂) (ht : t₁ ≤ t₂) :
  s₁.prod t₁ ≤ s₂.prod t₂ :=
set.prod_mono hs ht

@[to_additive prod_top]
lemma prod_top (s : submonoid M) :
  s.prod (⊤ : submonoid N) = s.comap (monoid_hom.fst M N) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_fst]

@[to_additive top_prod]
lemma top_prod (s : submonoid N) :
  (⊤ : submonoid M).prod s = s.comap (monoid_hom.snd M N) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_snd]

@[simp, to_additive top_prod_top]
lemma top_prod_top : (⊤ : submonoid M).prod (⊤ : submonoid N) = ⊤ :=
(top_prod _).trans $ comap_top _

@[to_additive] lemma bot_prod_bot : (⊥ : submonoid M).prod (⊥ : submonoid N) = ⊥ :=
set_like.coe_injective $ by simp [coe_prod, prod.one_eq_mk]

/-- The product of submonoids is isomorphic to their product as monoids. -/
@[to_additive prod_equiv "The product of additive submonoids is isomorphic to their product
as additive monoids"]
def prod_equiv (s : submonoid M) (t : submonoid N) : s.prod t ≃* s × t :=
{ map_mul' := λ x y, rfl, .. equiv.set.prod ↑s ↑t }

open monoid_hom

@[to_additive]
lemma map_inl (s : submonoid M) : s.map (inl M N) = s.prod ⊥ :=
ext $ λ p, ⟨λ ⟨x, hx, hp⟩, hp ▸ ⟨hx, set.mem_singleton 1⟩,
  λ ⟨hps, hp1⟩, ⟨p.1, hps, prod.ext rfl $ (set.eq_of_mem_singleton hp1).symm⟩⟩

@[to_additive]
lemma map_inr (s : submonoid N) : s.map (inr M N) = prod ⊥ s :=
ext $ λ p, ⟨λ ⟨x, hx, hp⟩, hp ▸ ⟨set.mem_singleton 1, hx⟩,
  λ ⟨hp1, hps⟩, ⟨p.2, hps, prod.ext (set.eq_of_mem_singleton hp1).symm rfl⟩⟩

@[simp, to_additive prod_bot_sup_bot_prod]
lemma prod_bot_sup_bot_prod (s : submonoid M) (t : submonoid N) :
  (s.prod ⊥) ⊔ (prod ⊥ t) = s.prod t :=
le_antisymm (sup_le (prod_mono (le_refl s) bot_le) (prod_mono bot_le (le_refl t))) $
assume p hp, prod.fst_mul_snd p ▸ mul_mem
  ((le_sup_left : s.prod ⊥ ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨hp.1, set.mem_singleton 1⟩)
  ((le_sup_right : prod ⊥ t ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨set.mem_singleton 1, hp.2⟩)

@[to_additive]
lemma mem_map_equiv {f : M ≃* N} {K : submonoid M} {x : N} :
  x ∈ K.map f.to_monoid_hom ↔ f.symm x ∈ K :=
@set.mem_image_equiv _ _ ↑K f.to_equiv x

@[to_additive]
lemma map_equiv_eq_comap_symm (f : M ≃* N) (K : submonoid M) :
  K.map f.to_monoid_hom = K.comap f.symm.to_monoid_hom :=
set_like.coe_injective (f.to_equiv.image_eq_preimage K)

@[to_additive]
lemma comap_equiv_eq_map_symm (f : N ≃* M) (K : submonoid M) :
  K.comap f.to_monoid_hom = K.map f.symm.to_monoid_hom :=
(map_equiv_eq_comap_symm f.symm K).symm

@[simp, to_additive]
lemma map_equiv_top (f : M ≃* N) : (⊤ : submonoid M).map f.to_monoid_hom = ⊤ :=
set_like.coe_injective $ set.image_univ.trans f.surjective.range_eq

@[to_additive le_prod_iff]
lemma le_prod_iff {s : submonoid M} {t : submonoid N} {u : submonoid (M × N)} :
  u ≤ s.prod t ↔ u.map (fst M N) ≤ s ∧ u.map (snd M N) ≤ t :=
begin
  split,
  { intros h,
    split,
    { rintros x ⟨⟨y1,y2⟩, ⟨hy1,rfl⟩⟩, exact (h hy1).1 },
    { rintros x ⟨⟨y1,y2⟩, ⟨hy1,rfl⟩⟩, exact (h hy1).2 }, },
  { rintros ⟨hH, hK⟩ ⟨x1, x2⟩ h, exact ⟨hH ⟨_ , h, rfl⟩, hK ⟨ _, h, rfl⟩⟩, }
end

@[to_additive prod_le_iff]
lemma prod_le_iff {s : submonoid M} {t : submonoid N} {u : submonoid (M × N)} :
  s.prod t ≤ u ↔ s.map (inl M N) ≤ u ∧ t.map (inr M N) ≤ u :=
begin
  split,
  { intros h,
    split,
    { rintros _ ⟨x, hx, rfl⟩, apply h, exact ⟨hx, (submonoid.one_mem _)⟩, },
    { rintros _ ⟨x, hx, rfl⟩, apply h, exact ⟨submonoid.one_mem _, hx⟩, }, },
  { rintros ⟨hH, hK⟩ ⟨x1, x2⟩ ⟨h1, h2⟩,
    have h1' : inl M N x1 ∈ u, { apply hH, simpa using h1, },
    have h2' : inr M N x2 ∈ u, { apply hK, simpa using h2, },
    simpa using submonoid.mul_mem _ h1' h2', }
end

end submonoid

namespace monoid_hom
variables {F : Type*} [mc : monoid_hom_class F M N]

open submonoid

/-- For many categories (monoids, modules, rings, ...) the set-theoretic image of a morphism `f` is
a subobject of the codomain. When this is the case, it is useful to define the range of a morphism
in such a way that the underlying carrier set of the range subobject is definitionally
`set.range f`. In particular this means that the types `↥(set.range f)` and `↥f.range` are
interchangeable without proof obligations.

A convenient candidate definition for range which is mathematically correct is `map ⊤ f`, just as
`set.range` could have been defined as `f '' set.univ`. However, this lacks the desired definitional
convenience, in that it both does not match `set.range`, and that it introduces a redudant `x ∈ ⊤`
term which clutters proofs. In such a case one may resort to the `copy`
pattern. A `copy` function converts the definitional problem for the carrier set of a subobject
into a one-off propositional proof obligation which one discharges while writing the definition of
the definitionally convenient range (the parameter `hs` in the example below).

A good example is the case of a morphism of monoids. A convenient definition for
`monoid_hom.mrange` would be `(⊤ : submonoid M).map f`. However since this lacks the required
definitional convenience, we first define `submonoid.copy` as follows:
```lean
protected def copy (S : submonoid M) (s : set M) (hs : s = S) : submonoid M :=
{ carrier  := s,
  one_mem' := hs.symm ▸ S.one_mem',
  mul_mem' := hs.symm ▸ S.mul_mem' }
```
and then finally define:
```lean
def mrange (f : M →* N) : submonoid N :=
((⊤ : submonoid M).map f).copy (set.range f) set.image_univ.symm
```
-/
library_note "range copy pattern"

include mc
/-- The range of a monoid homomorphism is a submonoid. See Note [range copy pattern]. -/
@[to_additive "The range of an `add_monoid_hom` is an `add_submonoid`."]
def mrange (f : F) : submonoid N :=
((⊤ : submonoid M).map f).copy (set.range f) set.image_univ.symm

@[simp, to_additive]
lemma coe_mrange (f : F) :
  (mrange f : set N) = set.range f :=
rfl

@[simp, to_additive] lemma mem_mrange {f : F} {y : N} :
  y ∈ mrange f ↔ ∃ x, f x = y :=
iff.rfl

@[to_additive] lemma mrange_eq_map (f : F) : mrange f = (⊤ : submonoid M).map f :=
submonoid.copy_eq _
omit mc

@[to_additive]
lemma map_mrange (g : N →* P) (f : M →* N) : f.mrange.map g = (g.comp f).mrange :=
by simpa only [mrange_eq_map] using (⊤ : submonoid M).map_map g f

include mc
@[to_additive]
lemma mrange_top_iff_surjective {f : F} :
  mrange f = (⊤ : submonoid N) ↔ function.surjective f :=
set_like.ext'_iff.trans $ iff.trans (by rw [coe_mrange, coe_top]) set.range_iff_surjective

/-- The range of a surjective monoid hom is the whole of the codomain. -/
@[to_additive "The range of a surjective `add_monoid` hom is the whole of the codomain."]
lemma mrange_top_of_surjective (f : F) (hf : function.surjective f) :
  mrange f = (⊤ : submonoid N) :=
mrange_top_iff_surjective.2 hf

@[to_additive]
lemma mclosure_preimage_le (f : F) (s : set N) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

/-- The image under a monoid hom of the submonoid generated by a set equals the submonoid generated
    by the image of the set. -/
@[to_additive "The image under an `add_monoid` hom of the `add_submonoid` generated by a set equals
the `add_submonoid` generated by the image of the set."]
lemma map_mclosure (f : F) (s : set M) :
  (closure s).map f = closure (f '' s) :=
le_antisymm
  (map_le_iff_le_comap.2 $ le_trans (closure_mono $ set.subset_preimage_image _ _)
    (mclosure_preimage_le _ _))
  (closure_le.2 $ set.image_subset _ subset_closure)
omit mc

/-- Restriction of a monoid hom to a submonoid of the domain. -/
@[to_additive "Restriction of an add_monoid hom to an `add_submonoid` of the domain."]
def restrict {N S : Type*} [mul_one_class N] [set_like S M] [submonoid_class S M]
  (f : M →* N) (s : S) : s →* N :=
f.comp (submonoid_class.subtype _)

@[simp, to_additive]
lemma restrict_apply {N S : Type*} [mul_one_class N] [set_like S M] [submonoid_class S M]
  (f : M →* N) (s : S) (x : s) : f.restrict s x = f x :=
rfl

@[simp, to_additive] lemma restrict_mrange (f : M →* N) : (f.restrict S).mrange = S.map f :=
by simp_rw [set_like.ext_iff, mem_mrange, mem_map, restrict_apply, set_like.exists, subtype.coe_mk,
  iff_self, forall_const]

/-- Restriction of a monoid hom to a submonoid of the codomain. -/
@[to_additive "Restriction of an `add_monoid` hom to an `add_submonoid` of the codomain.",
  simps apply]
def cod_restrict {S} [set_like S N] [submonoid_class S N] (f : M →* N) (s : S)
  (h : ∀ x, f x ∈ s) : M →* s :=
{ to_fun := λ n, ⟨f n, h n⟩,
  map_one' := subtype.eq f.map_one,
  map_mul' := λ x y, subtype.eq (f.map_mul x y) }

/-- Restriction of a monoid hom to its range interpreted as a submonoid. -/
@[to_additive "Restriction of an `add_monoid` hom to its range interpreted as a submonoid."]
def mrange_restrict {N} [mul_one_class N] (f : M →* N) : M →* f.mrange :=
f.cod_restrict f.mrange $ λ x, ⟨x, rfl⟩

@[simp, to_additive]
lemma coe_mrange_restrict {N} [mul_one_class N] (f : M →* N) (x : M) :
  (f.mrange_restrict x : N) = f x :=
rfl

@[to_additive]
lemma mrange_restrict_surjective (f : M →* N) : function.surjective f.mrange_restrict :=
λ ⟨_, ⟨x, rfl⟩⟩, ⟨x, rfl⟩

include mc
/-- The multiplicative kernel of a monoid homomorphism is the submonoid of elements `x : G` such
that `f x = 1` -/
@[to_additive "The additive kernel of an `add_monoid` homomorphism is the `add_submonoid` of
elements such that `f x = 0`"]
def mker (f : F) : submonoid M := (⊥ : submonoid N).comap f

@[to_additive]
lemma mem_mker (f : F) {x : M} : x ∈ mker f ↔ f x = 1 := iff.rfl

@[to_additive]
lemma coe_mker (f : F) : (mker f : set M) = (f : M → N) ⁻¹' {1} := rfl

@[to_additive]
instance decidable_mem_mker [decidable_eq N] (f : F) :
  decidable_pred (∈ mker f) :=
λ x, decidable_of_iff (f x = 1) (mem_mker f)
omit mc

@[to_additive]
lemma comap_mker (g : N →* P) (f : M →* N) : g.mker.comap f = (g.comp f).mker := rfl

include mc
@[simp, to_additive] lemma comap_bot' (f : F) :
  (⊥ : submonoid N).comap f = mker f := rfl
omit mc

@[simp, to_additive]
lemma restrict_mker (f : M →* N) : (f.restrict S).mker = f.mker.comap S.subtype :=
rfl

@[to_additive] lemma range_restrict_mker (f : M →* N) : mker (mrange_restrict f) = mker f :=
begin
  ext,
  change (⟨f x, _⟩ : mrange f) = ⟨1, _⟩ ↔ f x = 1,
  simp only [],
end

@[simp, to_additive]
lemma mker_one : (1 : M →* N).mker = ⊤ :=
by { ext, simp [mem_mker] }

@[to_additive]
lemma prod_map_comap_prod' {M' : Type*} {N' : Type*} [mul_one_class M'] [mul_one_class N']
  (f : M →* N) (g : M' →* N') (S : submonoid N) (S' : submonoid N') :
  (S.prod S').comap (prod_map f g) = (S.comap f).prod (S'.comap g) :=
set_like.coe_injective $ set.preimage_prod_map_prod f g _ _

@[to_additive]
lemma mker_prod_map {M' : Type*} {N' : Type*} [mul_one_class M'] [mul_one_class N'] (f : M →* N)
  (g : M' →* N') : (prod_map f g).mker = f.mker.prod g.mker :=
by rw [←comap_bot', ←comap_bot', ←comap_bot', ←prod_map_comap_prod', bot_prod_bot]

@[simp, to_additive]
lemma mker_inl : (inl M N).mker = ⊥ := by { ext x, simp [mem_mker] }

@[simp, to_additive]
lemma mker_inr : (inr M N).mker = ⊥ := by { ext x, simp [mem_mker] }

/-- The `monoid_hom` from the preimage of a submonoid to itself. -/
@[to_additive "the `add_monoid_hom` from the preimage of an additive submonoid to itself.", simps]
def submonoid_comap (f : M →* N) (N' : submonoid N) :
  N'.comap f →* N' :=
{ to_fun := λ x, ⟨f x, x.prop⟩,
  map_one' := subtype.eq f.map_one,
  map_mul' := λ x y, subtype.eq (f.map_mul x y) }

/-- The `monoid_hom` from a submonoid to its image.
See `mul_equiv.submonoid_map` for a variant for `mul_equiv`s. -/
@[to_additive "the `add_monoid_hom` from an additive submonoid to its image. See
`add_equiv.add_submonoid_map` for a variant for `add_equiv`s.", simps]
def submonoid_map (f : M →* N) (M' : submonoid M) :
  M' →* M'.map f :=
{ to_fun := λ x, ⟨f x, ⟨x, x.prop, rfl⟩⟩,
  map_one' := subtype.eq $ f.map_one,
  map_mul' := λ x y, subtype.eq $ f.map_mul x y }

@[to_additive]
lemma submonoid_map_surjective (f : M →* N) (M' : submonoid M) :
  function.surjective (f.submonoid_map M') :=
by { rintro ⟨_, x, hx, rfl⟩, exact ⟨⟨x, hx⟩, rfl⟩ }

end monoid_hom

namespace submonoid
open monoid_hom

@[to_additive]
lemma mrange_inl : (inl M N).mrange = prod ⊤ ⊥ :=
by simpa only [mrange_eq_map] using map_inl ⊤

@[to_additive]
lemma mrange_inr : (inr M N).mrange = prod ⊥ ⊤ :=
by simpa only [mrange_eq_map] using map_inr ⊤

@[to_additive]
lemma mrange_inl' : (inl M N).mrange = comap (snd M N) ⊥ := mrange_inl.trans (top_prod _)

@[to_additive]
lemma mrange_inr' : (inr M N).mrange = comap (fst M N) ⊥ := mrange_inr.trans (prod_top _)

@[simp, to_additive]
lemma mrange_fst : (fst M N).mrange = ⊤ :=
mrange_top_of_surjective (fst M N) $ @prod.fst_surjective _ _ ⟨1⟩

@[simp, to_additive]
lemma mrange_snd : (snd M N).mrange = ⊤ :=
mrange_top_of_surjective (snd M N) $ @prod.snd_surjective _ _ ⟨1⟩

@[to_additive]
lemma prod_eq_bot_iff {s : submonoid M} {t : submonoid N} :
  s.prod t = ⊥ ↔ s = ⊥ ∧ t = ⊥ :=
by simp only [eq_bot_iff, prod_le_iff, (gc_map_comap _).le_iff_le, comap_bot', mker_inl, mker_inr]

@[to_additive]
lemma prod_eq_top_iff {s : submonoid M} {t : submonoid N} :
  s.prod t = ⊤ ↔ s = ⊤ ∧ t = ⊤ :=
by simp only [eq_top_iff, le_prod_iff, ← (gc_map_comap _).le_iff_le, ← mrange_eq_map,
  mrange_fst, mrange_snd]

@[simp, to_additive]
lemma mrange_inl_sup_mrange_inr : (inl M N).mrange ⊔ (inr M N).mrange = ⊤ :=
by simp only [mrange_inl, mrange_inr, prod_bot_sup_bot_prod, top_prod_top]

/-- The monoid hom associated to an inclusion of submonoids. -/
@[to_additive "The `add_monoid` hom associated to an inclusion of submonoids."]
def inclusion {S T : submonoid M} (h : S ≤ T) : S →* T :=
S.subtype.cod_restrict _ (λ x, h x.2)

@[simp, to_additive]
lemma range_subtype (s : submonoid M) : s.subtype.mrange = s :=
set_like.coe_injective $ (coe_mrange _).trans $ subtype.range_coe

@[to_additive] lemma eq_top_iff' : S = ⊤ ↔ ∀ x : M, x ∈ S :=
eq_top_iff.trans ⟨λ h m, h $ mem_top m, λ h m _, h m⟩

@[to_additive] lemma eq_bot_iff_forall : S = ⊥ ↔ ∀ x ∈ S, x = (1 : M) :=
set_like.ext_iff.trans $ by simp [iff_def, S.one_mem] { contextual := tt }

@[to_additive] lemma nontrivial_iff_exists_ne_one (S : submonoid M) :
  nontrivial S ↔ ∃ x ∈ S, x ≠ (1:M) :=
calc nontrivial S ↔ ∃ x : S, x ≠ 1                                   : nontrivial_iff_exists_ne 1
              ... ↔ ∃ x (hx : x ∈ S), (⟨x, hx⟩ : S) ≠ ⟨1, S.one_mem⟩ : subtype.exists
              ... ↔ ∃ x ∈ S, x ≠ (1 : M)                             : by simp only [ne.def]

/-- A submonoid is either the trivial submonoid or nontrivial. -/
@[to_additive "An additive submonoid is either the trivial additive submonoid or nontrivial."]
lemma bot_or_nontrivial (S : submonoid M) : S = ⊥ ∨ nontrivial S :=
by simp only [eq_bot_iff_forall, nontrivial_iff_exists_ne_one, ← not_forall, classical.em]

/-- A submonoid is either the trivial submonoid or contains a nonzero element. -/
@[to_additive "An additive submonoid is either the trivial additive submonoid or contains a nonzero
element."]
lemma bot_or_exists_ne_one (S : submonoid M) : S = ⊥ ∨ ∃ x ∈ S, x ≠ (1:M) :=
S.bot_or_nontrivial.imp_right S.nontrivial_iff_exists_ne_one.mp

end submonoid

namespace mul_equiv

variables {S} {T : submonoid M}

/-- Makes the identity isomorphism from a proof that two submonoids of a multiplicative
    monoid are equal. -/
@[to_additive "Makes the identity additive isomorphism from a proof two
submonoids of an additive monoid are equal."]
def submonoid_congr (h : S = T) : S ≃* T :=
{ map_mul' :=  λ _ _, rfl, ..equiv.set_congr $ congr_arg _ h }

-- this name is primed so that the version to `f.range` instead of `f.mrange` can be unprimed.
/-- A monoid homomorphism `f : M →* N` with a left-inverse `g : N → M` defines a multiplicative
equivalence between `M` and `f.mrange`.

This is a bidirectional version of `monoid_hom.mrange_restrict`. -/
@[to_additive /-"
An additive monoid homomorphism `f : M →+ N` with a left-inverse `g : N → M` defines an additive
equivalence between `M` and `f.mrange`.

This is a bidirectional version of `add_monoid_hom.mrange_restrict`. "-/, simps {simp_rhs := tt}]
def of_left_inverse' (f : M →* N) {g : N → M} (h : function.left_inverse g f) : M ≃* f.mrange :=
{ to_fun := f.mrange_restrict,
  inv_fun := g ∘ f.mrange.subtype,
  left_inv := h,
  right_inv := λ x, subtype.ext $
    let ⟨x', hx'⟩ := monoid_hom.mem_mrange.mp x.prop in
    show f (g x) = x, by rw [←hx', h x'],
  .. f.mrange_restrict }

/-- A `mul_equiv` `φ` between two monoids `M` and `N` induces a `mul_equiv` between
a submonoid `S ≤ M` and the submonoid `φ(S) ≤ N`.
See `monoid_hom.submonoid_map` for a variant for `monoid_hom`s. -/
@[to_additive "An `add_equiv` `φ` between two additive monoids `M` and `N` induces an `add_equiv`
between a submonoid `S ≤ M` and the submonoid `φ(S) ≤ N`. See `add_monoid_hom.add_submonoid_map`
for a variant for `add_monoid_hom`s."]
def submonoid_map (e : M ≃* N) (S : submonoid M) : S ≃* S.map e.to_monoid_hom :=
{ map_mul' := λ _ _, subtype.ext (map_mul e _ _), ..(e : M ≃ N).image S }

@[simp, to_additive]
lemma coe_submonoid_map_apply (e : M ≃* N) (S : submonoid M) (g : S) :
  ((submonoid_map e S g : S.map (e : M →* N)) : N) = e g := rfl

@[simp, to_additive add_equiv.add_submonoid_map_symm_apply]
lemma submonoid_map_symm_apply (e : M ≃* N) (S : submonoid M) (g : S.map (e : M →* N)) :
  (e.submonoid_map S).symm g = ⟨e.symm g, set_like.mem_coe.1 $ set.mem_image_equiv.1 g.2⟩ := rfl

end mul_equiv

@[simp, to_additive]
lemma submonoid.equiv_map_of_injective_coe_mul_equiv (e : M ≃* N) :
  S.equiv_map_of_injective (e : M →* N) (equiv_like.injective e) = e.submonoid_map S :=
by { ext, refl }

section actions
/-! ### Actions by `submonoid`s

These instances tranfer the action by an element `m : M` of a monoid `M` written as `m • a` onto the
action by an element `s : S` of a submonoid `S : submonoid M` such that `s • a = (s : M) • a`.

These instances work particularly well in conjunction with `monoid.to_mul_action`, enabling
`s • m` as an alias for `↑s * m`.
-/

namespace submonoid
variables {M' : Type*} {α β : Type*}

section mul_one_class
variables [mul_one_class M']

@[to_additive]
instance [has_smul M' α] (S : submonoid M') : has_smul S α := has_smul.comp _ S.subtype

@[to_additive]
instance smul_comm_class_left
  [has_smul M' β] [has_smul α β] [smul_comm_class M' α β] (S : submonoid M') :
  smul_comm_class S α β :=
⟨λ a, (smul_comm (a : M') : _)⟩

@[to_additive]
instance smul_comm_class_right
  [has_smul α β] [has_smul M' β] [smul_comm_class α M' β] (S : submonoid M') :
  smul_comm_class α S β :=
⟨λ a s, (smul_comm a (s : M') : _)⟩

/-- Note that this provides `is_scalar_tower S M' M'` which is needed by `smul_mul_assoc`. -/
instance
  [has_smul α β] [has_smul M' α] [has_smul M' β] [is_scalar_tower M' α β] (S : submonoid M') :
  is_scalar_tower S α β :=
⟨λ a, (smul_assoc (a : M') : _)⟩

@[to_additive]
lemma smul_def [has_smul M' α] {S : submonoid M'} (g : S) (m : α) : g • m = (g : M') • m := rfl

instance [has_smul M' α] [has_faithful_smul M' α] (S : submonoid M') :
  has_faithful_smul S α :=
⟨λ x y h, subtype.ext $ eq_of_smul_eq_smul h⟩

end mul_one_class

variables [monoid M']

/-- The action by a submonoid is the action by the underlying monoid. -/
@[to_additive /-"The additive action by an add_submonoid is the action by the underlying
add_monoid. "-/]
instance [mul_action M' α] (S : submonoid M') : mul_action S α := mul_action.comp_hom _ S.subtype

/-- The action by a submonoid is the action by the underlying monoid. -/
instance [add_monoid α] [distrib_mul_action M' α] (S : submonoid M') : distrib_mul_action S α :=
distrib_mul_action.comp_hom _ S.subtype

/-- The action by a submonoid is the action by the underlying monoid. -/
instance [monoid α] [mul_distrib_mul_action M' α] (S : submonoid M') : mul_distrib_mul_action S α :=
mul_distrib_mul_action.comp_hom _ S.subtype

example {S : submonoid M'} : is_scalar_tower S M' M' := by apply_instance

end submonoid

end actions


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland
-/
import algebra.ring.defs
import algebra.hom.group
import algebra.opposites

/-!
# Semirings and rings

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

This file gives lemmas about semirings, rings and domains.
This is analogous to `algebra.group.basic`,
the difference being that the former is about `+` and `*` separately, while
the present file is about their interaction.

For the definitions of semirings and rings see `algebra.ring.defs`.

-/
universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {R : Type x}

open function

namespace add_hom

/-- Left multiplication by an element of a type with distributive multiplication is an `add_hom`. -/
@[simps { fully_applied := ff}] def mul_left {R : Type*} [distrib R] (r : R) : add_hom R R :=
⟨(*) r, mul_add r⟩

/-- Left multiplication by an element of a type with distributive multiplication is an `add_hom`. -/
@[simps { fully_applied := ff}] def mul_right {R : Type*} [distrib R] (r : R) : add_hom R R :=
⟨λ a, a * r, λ _ _, add_mul _ _ r⟩

end add_hom

section add_hom_class

variables {F : Type*} [non_assoc_semiring α] [non_assoc_semiring β] [add_hom_class F α β]

/-- Additive homomorphisms preserve `bit0`. -/
@[simp] lemma map_bit0 (f : F) (a : α) : (f (bit0 a) : β) = bit0 (f a) :=
map_add _ _ _

end add_hom_class

namespace add_monoid_hom

/-- Left multiplication by an element of a (semi)ring is an `add_monoid_hom` -/
def mul_left {R : Type*} [non_unital_non_assoc_semiring R] (r : R) : R →+ R :=
{ to_fun := (*) r,
  map_zero' := mul_zero r,
  map_add' := mul_add r }

@[simp] lemma coe_mul_left {R : Type*} [non_unital_non_assoc_semiring R] (r : R) :
  ⇑(mul_left r) = (*) r := rfl

/-- Right multiplication by an element of a (semi)ring is an `add_monoid_hom` -/
def mul_right {R : Type*} [non_unital_non_assoc_semiring R] (r : R) : R →+ R :=
{ to_fun := λ a, a * r,
  map_zero' := zero_mul r,
  map_add' := λ _ _, add_mul _ _ r }

@[simp] lemma coe_mul_right {R : Type*} [non_unital_non_assoc_semiring R] (r : R) :
  ⇑(mul_right r) = (* r) := rfl

lemma mul_right_apply {R : Type*} [non_unital_non_assoc_semiring R] (a r : R) :
  mul_right r a = a * r := rfl

end add_monoid_hom

section has_distrib_neg

section has_mul
variables [has_mul α] [has_distrib_neg α]

open mul_opposite

instance : has_distrib_neg αᵐᵒᵖ :=
{ neg_mul := λ _ _, unop_injective $ mul_neg _ _,
  mul_neg := λ _ _, unop_injective $ neg_mul _ _,
  ..mul_opposite.has_involutive_neg _ }

end has_mul

section group
variables [group α] [has_distrib_neg α]

@[simp] lemma inv_neg' (a : α) : (- a)⁻¹ = - a⁻¹ :=
by rw [eq_comm, eq_inv_iff_mul_eq_one, neg_mul, mul_neg,neg_neg, mul_left_inv]

end group

end has_distrib_neg

section non_unital_comm_ring
variables [non_unital_comm_ring α] {a b c : α}

local attribute [simp] add_assoc add_comm add_left_comm mul_comm

/-- Vieta's formula for a quadratic equation, relating the coefficients of the polynomial with
  its roots. This particular version states that if we have a root `x` of a monic quadratic
  polynomial, then there is another root `y` such that `x + y` is negative the `a_1` coefficient
  and `x * y` is the `a_0` coefficient. -/
lemma Vieta_formula_quadratic {b c x : α} (h : x * x - b * x + c = 0) :
  ∃ y : α, y * y - b * y + c = 0 ∧ x + y = b ∧ x * y = c :=
begin
  have : c = x * (b - x) := (eq_neg_of_add_eq_zero_right h).trans (by simp [mul_sub, mul_comm]),
  refine ⟨b - x, _, by simp, by rw this⟩,
  rw [this, sub_add, ← sub_mul, sub_self]
end

end non_unital_comm_ring

lemma succ_ne_self [non_assoc_ring α] [nontrivial α] (a : α) : a + 1 ≠ a :=
λ h, one_ne_zero ((add_right_inj a).mp (by simp [h]))

lemma pred_ne_self [non_assoc_ring α] [nontrivial α] (a : α) : a - 1 ≠ a :=
λ h, one_ne_zero (neg_injective ((add_right_inj a).mp (by simpa [sub_eq_add_neg] using h)))

section no_zero_divisors

variable (α)

lemma is_left_cancel_mul_zero.to_no_zero_divisors [ring α] [is_left_cancel_mul_zero α] :
  no_zero_divisors α :=
begin
  refine ⟨λ x y h, _⟩,
  by_cases hx : x = 0,
  { left, exact hx },
  { right,
    rw [← sub_zero (x * y), ← mul_zero x, ← mul_sub] at h,
    convert (is_left_cancel_mul_zero.mul_left_cancel_of_ne_zero) hx h,
    rw [sub_zero] }
end

lemma is_right_cancel_mul_zero.to_no_zero_divisors [ring α] [is_right_cancel_mul_zero α] :
  no_zero_divisors α :=
begin
  refine ⟨λ x y h, _⟩,
  by_cases hy : y = 0,
  { right, exact hy },
  { left,
    rw [← sub_zero (x * y), ← zero_mul y, ← sub_mul] at h,
    convert (is_right_cancel_mul_zero.mul_right_cancel_of_ne_zero) hy h,
    rw [sub_zero] }
end

@[priority 100]
instance no_zero_divisors.to_is_cancel_mul_zero [ring α] [no_zero_divisors α] :
  is_cancel_mul_zero α :=
{ mul_left_cancel_of_ne_zero := λ a b c ha h,
  begin
    rw [← sub_eq_zero, ← mul_sub] at h,
    exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_left ha)
  end,
  mul_right_cancel_of_ne_zero := λ a b c hb h,
  begin
    rw [← sub_eq_zero, ← sub_mul] at h,
    exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_right hb)
  end }

lemma no_zero_divisors.to_is_domain [ring α] [h : nontrivial α] [no_zero_divisors α] :
  is_domain α :=
{ .. no_zero_divisors.to_is_cancel_mul_zero α, .. h }

@[priority 100]
instance is_domain.to_no_zero_divisors [ring α] [is_domain α] : no_zero_divisors α :=
is_right_cancel_mul_zero.to_no_zero_divisors α

end no_zero_divisors


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.list.sublists
import data.multiset.nodup

/-!
# The powerset of a multiset

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

namespace multiset
open list

variables {α : Type*}

/-! ### powerset -/

/-- A helper function for the powerset of a multiset. Given a list `l`, returns a list
of sublists of `l` (using `sublists_aux`), as multisets. -/
def powerset_aux (l : list α) : list (multiset α) :=
0 :: sublists_aux l (λ x y, x :: y)

theorem powerset_aux_eq_map_coe {l : list α} :
  powerset_aux l = (sublists l).map coe :=
by simp [powerset_aux, sublists];
   rw [← show @sublists_aux₁ α (multiset α) l (λ x, [↑x]) =
              sublists_aux l (λ x, list.cons ↑x),
         from sublists_aux₁_eq_sublists_aux _ _,
       sublists_aux_cons_eq_sublists_aux₁,
       ← bind_ret_eq_map, sublists_aux₁_bind]; refl

@[simp] theorem mem_powerset_aux {l : list α} {s} :
  s ∈ powerset_aux l ↔ s ≤ ↑l :=
quotient.induction_on s $
by simp [powerset_aux_eq_map_coe, subperm, and.comm]

/-- Helper function for the powerset of a multiset. Given a list `l`, returns a list
of sublists of `l` (using `sublists'`), as multisets. -/
def powerset_aux' (l : list α) : list (multiset α) := (sublists' l).map coe

theorem powerset_aux_perm_powerset_aux' {l : list α} :
  powerset_aux l ~ powerset_aux' l :=
by rw powerset_aux_eq_map_coe; exact (sublists_perm_sublists' _).map _

@[simp] theorem powerset_aux'_nil : powerset_aux' (@nil α) = [0] := rfl

@[simp] theorem powerset_aux'_cons (a : α) (l : list α) :
  powerset_aux' (a::l) = powerset_aux' l ++ list.map (cons a) (powerset_aux' l) :=
by simp [powerset_aux']; refl

theorem powerset_aux'_perm {l₁ l₂ : list α} (p : l₁ ~ l₂) :
  powerset_aux' l₁ ~ powerset_aux' l₂ :=
begin
  induction p with a l₁ l₂ p IH a b l l₁ l₂ l₃ p₁ p₂ IH₁ IH₂, {simp},
  { simp, exact IH.append (IH.map _) },
  { simp, apply perm.append_left,
    rw [← append_assoc, ← append_assoc,
        (by funext s; simp [cons_swap] : cons b ∘ cons a = cons a ∘ cons b)],
    exact perm_append_comm.append_right _ },
  { exact IH₁.trans IH₂ }
end

theorem powerset_aux_perm {l₁ l₂ : list α} (p : l₁ ~ l₂) :
  powerset_aux l₁ ~ powerset_aux l₂ :=
powerset_aux_perm_powerset_aux'.trans $
(powerset_aux'_perm p).trans powerset_aux_perm_powerset_aux'.symm

/-- The power set of a multiset. -/
def powerset (s : multiset α) : multiset (multiset α) :=
quot.lift_on s
  (λ l, (powerset_aux l : multiset (multiset α)))
  (λ l₁ l₂ h, quot.sound (powerset_aux_perm h))

theorem powerset_coe (l : list α) :
  @powerset α l = ((sublists l).map coe : list (multiset α)) :=
congr_arg coe powerset_aux_eq_map_coe

@[simp] theorem powerset_coe' (l : list α) :
  @powerset α l = ((sublists' l).map coe : list (multiset α)) :=
quot.sound powerset_aux_perm_powerset_aux'

@[simp] theorem powerset_zero : @powerset α 0 = {0} := rfl

@[simp] theorem powerset_cons (a : α) (s) :
  powerset (a ::ₘ s) = powerset s + map (cons a) (powerset s) :=
quotient.induction_on s $ λ l, by simp; refl

@[simp] theorem mem_powerset {s t : multiset α} :
  s ∈ powerset t ↔ s ≤ t :=
quotient.induction_on₂ s t $ by simp [subperm, and.comm]

theorem map_single_le_powerset (s : multiset α) :
  s.map singleton ≤ powerset s :=
quotient.induction_on s $ λ l, begin
  simp only [powerset_coe, quot_mk_to_coe, coe_le, coe_map],
  show l.map (coe ∘ list.ret) <+~ (sublists l).map coe,
  rw ← list.map_map,
  exact ((map_ret_sublist_sublists _).map _).subperm
end

@[simp] theorem card_powerset (s : multiset α) :
  card (powerset s) = 2 ^ card s :=
quotient.induction_on s $ by simp

theorem revzip_powerset_aux {l : list α} ⦃x⦄
  (h : x ∈ revzip (powerset_aux l)) : x.1 + x.2 = ↑l :=
begin
  rw [revzip, powerset_aux_eq_map_coe, ← map_reverse, zip_map, ← revzip] at h,
  simp at h, rcases h with ⟨l₁, l₂, h, rfl, rfl⟩,
  exact quot.sound (revzip_sublists _ _ _ h)
end

theorem revzip_powerset_aux' {l : list α} ⦃x⦄
  (h : x ∈ revzip (powerset_aux' l)) : x.1 + x.2 = ↑l :=
begin
  rw [revzip, powerset_aux', ← map_reverse, zip_map, ← revzip] at h,
  simp at h, rcases h with ⟨l₁, l₂, h, rfl, rfl⟩,
  exact quot.sound (revzip_sublists' _ _ _ h)
end

theorem revzip_powerset_aux_lemma [decidable_eq α] (l : list α)
  {l' : list (multiset α)} (H : ∀ ⦃x : _ × _⦄, x ∈ revzip l' → x.1 + x.2 = ↑l) :
  revzip l' = l'.map (λ x, (x, ↑l - x)) :=
begin
  have : forall₂ (λ (p : multiset α × multiset α) (s : multiset α), p = (s, ↑l - s))
    (revzip l') ((revzip l').map prod.fst),
  { rw [forall₂_map_right_iff, forall₂_same],
    rintro ⟨s, t⟩ h,
    dsimp, rw [← H h, add_tsub_cancel_left] },
  rw [← forall₂_eq_eq_eq, forall₂_map_right_iff], simpa
end

theorem revzip_powerset_aux_perm {l₁ l₂ : list α} (p : l₁ ~ l₂) :
  revzip (powerset_aux l₁) ~ revzip (powerset_aux l₂) :=
begin
  haveI := classical.dec_eq α,
  simp [λ l:list α, revzip_powerset_aux_lemma l revzip_powerset_aux, coe_eq_coe.2 p],
  exact (powerset_aux_perm p).map _
end

/-! ### powerset_len -/

/-- Helper function for `powerset_len`. Given a list `l`, `powerset_len_aux n l` is the list
of sublists of length `n`, as multisets. -/
def powerset_len_aux (n : ℕ) (l : list α) : list (multiset α) :=
sublists_len_aux n l coe []

theorem powerset_len_aux_eq_map_coe {n} {l : list α} :
  powerset_len_aux n l = (sublists_len n l).map coe :=
by rw [powerset_len_aux, sublists_len_aux_eq, append_nil]

@[simp] theorem mem_powerset_len_aux {n} {l : list α} {s} :
  s ∈ powerset_len_aux n l ↔ s ≤ ↑l ∧ card s = n :=
quotient.induction_on s $
by simp [powerset_len_aux_eq_map_coe, subperm]; exact
  λ l₁, ⟨λ ⟨l₂, ⟨s, e⟩, p⟩, ⟨⟨_, p, s⟩, p.symm.length_eq.trans e⟩,
    λ ⟨⟨l₂, p, s⟩, e⟩, ⟨_, ⟨s, p.length_eq.trans e⟩, p⟩⟩

@[simp] theorem powerset_len_aux_zero (l : list α) :
  powerset_len_aux 0 l = [0] :=
by simp [powerset_len_aux_eq_map_coe]

@[simp] theorem powerset_len_aux_nil (n : ℕ) :
  powerset_len_aux (n+1) (@nil α) = [] := rfl

@[simp] theorem powerset_len_aux_cons (n : ℕ) (a : α) (l : list α) :
  powerset_len_aux (n+1) (a::l) =
  powerset_len_aux (n+1) l ++ list.map (cons a) (powerset_len_aux n l) :=
by simp [powerset_len_aux_eq_map_coe]; refl

theorem powerset_len_aux_perm {n} {l₁ l₂ : list α} (p : l₁ ~ l₂) :
  powerset_len_aux n l₁ ~ powerset_len_aux n l₂ :=
begin
  induction n with n IHn generalizing l₁ l₂, {simp},
  induction p with a l₁ l₂ p IH a b l l₁ l₂ l₃ p₁ p₂ IH₁ IH₂, {refl},
  { simp, exact IH.append ((IHn p).map _) },
  { simp, apply perm.append_left,
    cases n, {simp, apply perm.swap},
    simp,
    rw [← append_assoc, ← append_assoc,
        (by funext s; simp [cons_swap] : cons b ∘ cons a = cons a ∘ cons b)],
    exact perm_append_comm.append_right _ },
  { exact IH₁.trans IH₂ }
end

/-- `powerset_len n s` is the multiset of all submultisets of `s` of length `n`. -/
def powerset_len (n : ℕ) (s : multiset α) : multiset (multiset α) :=
quot.lift_on s
  (λ l, (powerset_len_aux n l : multiset (multiset α)))
  (λ l₁ l₂ h, quot.sound (powerset_len_aux_perm h))

theorem powerset_len_coe' (n) (l : list α) :
  @powerset_len α n l = powerset_len_aux n l := rfl

theorem powerset_len_coe (n) (l : list α) :
  @powerset_len α n l = ((sublists_len n l).map coe : list (multiset α)) :=
congr_arg coe powerset_len_aux_eq_map_coe

@[simp] theorem powerset_len_zero_left (s : multiset α) :
  powerset_len 0 s = {0} :=
quotient.induction_on s $ λ l, by simp [powerset_len_coe']; refl

theorem powerset_len_zero_right (n : ℕ) :
  @powerset_len α (n + 1) 0 = 0 := rfl

@[simp] theorem powerset_len_cons (n : ℕ) (a : α) (s) :
  powerset_len (n + 1) (a ::ₘ s) =
  powerset_len (n + 1) s + map (cons a) (powerset_len n s) :=
quotient.induction_on s $ λ l, by simp [powerset_len_coe']; refl

@[simp] theorem mem_powerset_len {n : ℕ} {s t : multiset α} :
  s ∈ powerset_len n t ↔ s ≤ t ∧ card s = n :=
quotient.induction_on t $ λ l, by simp [powerset_len_coe']

@[simp] theorem card_powerset_len (n : ℕ) (s : multiset α) :
  card (powerset_len n s) = nat.choose (card s) n :=
quotient.induction_on s $ by simp [powerset_len_coe]

theorem powerset_len_le_powerset (n : ℕ) (s : multiset α) :
  powerset_len n s ≤ powerset s :=
quotient.induction_on s $ λ l, by simp [powerset_len_coe]; exact
  ((sublists_len_sublist_sublists' _ _).map _).subperm

theorem powerset_len_mono (n : ℕ) {s t : multiset α} (h : s ≤ t) :
  powerset_len n s ≤ powerset_len n t :=
le_induction_on h $ λ l₁ l₂ h, by simp [powerset_len_coe]; exact
  ((sublists_len_sublist_of_sublist _ h).map _).subperm

@[simp] theorem powerset_len_empty {α : Type*} (n : ℕ) {s : multiset α} (h : s.card < n) :
  powerset_len n s = 0 :=
card_eq_zero.mp (nat.choose_eq_zero_of_lt h ▸ card_powerset_len _ _)

@[simp]
lemma powerset_len_card_add (s : multiset α) {i : ℕ} (hi : 0 < i) :
  s.powerset_len (s.card + i) = 0 :=
powerset_len_empty _ (lt_add_of_pos_right (card s) hi)

theorem powerset_len_map {β : Type*} (f : α → β) (n : ℕ) (s : multiset α) :
  powerset_len n (s.map f) = (powerset_len n s).map (map f) :=
begin
  induction s using multiset.induction with t s ih generalizing n,
  { cases n; simp [powerset_len_zero_left, powerset_len_zero_right], },
  { cases n; simp [ih, map_comp_cons], },
end

lemma pairwise_disjoint_powerset_len (s : multiset α) :
  _root_.pairwise (λ i j, multiset.disjoint (s.powerset_len i) (s.powerset_len j)) :=
λ i j h x hi hj, h (eq.trans (multiset.mem_powerset_len.mp hi).right.symm
  (multiset.mem_powerset_len.mp hj).right)

lemma bind_powerset_len {α : Type*} (S : multiset α) :
  bind (multiset.range (S.card + 1)) (λ k, S.powerset_len k) = S.powerset :=
begin
  induction S using quotient.induction_on,
  simp_rw [quot_mk_to_coe, powerset_coe', powerset_len_coe, ←coe_range, coe_bind, ←list.bind_map,
    coe_card],
  exact coe_eq_coe.mpr ((list.range_bind_sublists_len_perm S).map _),
end

@[simp] theorem nodup_powerset {s : multiset α} : nodup (powerset s) ↔ nodup s :=
⟨λ h, (nodup_of_le (map_single_le_powerset _) h).of_map _,
  quotient.induction_on s $ λ l h,
  by simp; refine (nodup_sublists'.2 h).map_on _ ; exact
  λ x sx y sy e,
    (h.sublist_ext (mem_sublists'.1 sx) (mem_sublists'.1 sy)).1
      (quotient.exact e)⟩

alias nodup_powerset ↔ nodup.of_powerset nodup.powerset

protected lemma nodup.powerset_len {n : ℕ} {s : multiset α} (h : nodup s) :
  nodup (powerset_len n s) :=
nodup_of_le (powerset_len_le_powerset _ _) (nodup_powerset.2 h)

end multiset


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johannes Hölzl, Yury Kudryashov

! This file was ported from Lean 3 source module algebra.category.Ring.basic
! leanprover-community/mathlib commit 34b2a989ad80bce3a5de749d935a4f23726e26e9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Category.Group.Basic
import Mathbin.CategoryTheory.ConcreteCategory.ReflectsIsomorphisms
import Mathbin.CategoryTheory.Elementwise
import Mathbin.Algebra.Ring.Equiv

/-!
# Category instances for semiring, ring, comm_semiring, and comm_ring.

We introduce the bundled categories:
* `SemiRing`
* `Ring`
* `CommSemiRing`
* `CommRing`
along with the relevant forgetful functors between them.
-/

universe u v

open CategoryTheory

/-- The category of semirings. -/
def SemiRing : Type (u + 1) :=
  Bundled Semiring
#align SemiRing SemiRing

namespace SemiRing

/-- `ring_hom` doesn't actually assume associativity. This alias is needed to make the category
theory machinery work. We use the same trick in `category_theory.Mon.assoc_monoid_hom`. -/
abbrev AssocRingHom (M N : Type _) [Semiring M] [Semiring N] :=
  RingHom M N
#align SemiRing.assoc_ring_hom SemiRing.AssocRingHom

instance bundledHom : BundledHom AssocRingHom :=
  ⟨fun M N [Semiring M] [Semiring N] => @RingHom.toFun M N _ _, fun M [Semiring M] =>
    @RingHom.id M _, fun M N P [Semiring M] [Semiring N] [Semiring P] => @RingHom.comp M N P _ _ _,
    fun M N [Semiring M] [Semiring N] => @RingHom.coe_inj M N _ _⟩
#align SemiRing.bundled_hom SemiRing.bundledHom

deriving instance LargeCategory, ConcreteCategory for SemiRing

instance : CoeSort SemiRing (Type _) :=
  Bundled.hasCoeToSort

/-- Construct a bundled SemiRing from the underlying type and typeclass. -/
def of (R : Type u) [Semiring R] : SemiRing :=
  Bundled.of R
#align SemiRing.of SemiRing.of

/-- Typecheck a `ring_hom` as a morphism in `SemiRing`. -/
def ofHom {R S : Type u} [Semiring R] [Semiring S] (f : R →+* S) : of R ⟶ of S :=
  f
#align SemiRing.of_hom SemiRing.ofHom

@[simp]
theorem ofHom_apply {R S : Type u} [Semiring R] [Semiring S] (f : R →+* S) (x : R) :
    ofHom f x = f x :=
  rfl
#align SemiRing.of_hom_apply SemiRing.ofHom_apply

instance : Inhabited SemiRing :=
  ⟨of PUnit⟩

instance (R : SemiRing) : Semiring R :=
  R.str

@[simp]
theorem coe_of (R : Type u) [Semiring R] : (SemiRing.of R : Type u) = R :=
  rfl
#align SemiRing.coe_of SemiRing.coe_of

instance hasForgetToMon : HasForget₂ SemiRing MonCat :=
  BundledHom.mkHasForget₂ (fun R hR => @MonoidWithZero.toMonoid R (@Semiring.toMonoidWithZero R hR))
    (fun R₁ R₂ => RingHom.toMonoidHom) fun _ _ _ => rfl
#align SemiRing.has_forget_to_Mon SemiRing.hasForgetToMon

instance hasForgetToAddCommMon : HasForget₂ SemiRing AddCommMonCat
    where-- can't use bundled_hom.mk_has_forget₂, since AddCommMon is an induced category
  forget₂ :=
    { obj := fun R => AddCommMonCat.of R
      map := fun R₁ R₂ f => RingHom.toAddMonoidHom f }
#align SemiRing.has_forget_to_AddCommMon SemiRing.hasForgetToAddCommMon

end SemiRing

/-- The category of rings. -/
def RingCat : Type (u + 1) :=
  Bundled Ring
#align Ring RingCat

namespace RingCat

instance : BundledHom.ParentProjection @Ring.toSemiring :=
  ⟨⟩

/- ./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler λ Ring,
has_coe_to_sort[has_coe_to_sort] Ring (Type*) -/
deriving instance
  «./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler λ Ring,
  has_coe_to_sort[has_coe_to_sort] Ring (Type*)», LargeCategory, ConcreteCategory for RingCat

/-- Construct a bundled Ring from the underlying type and typeclass. -/
def of (R : Type u) [Ring R] : RingCat :=
  Bundled.of R
#align Ring.of RingCat.of

/-- Typecheck a `ring_hom` as a morphism in `Ring`. -/
def ofHom {R S : Type u} [Ring R] [Ring S] (f : R →+* S) : of R ⟶ of S :=
  f
#align Ring.of_hom RingCat.ofHom

@[simp]
theorem ofHom_apply {R S : Type u} [Ring R] [Ring S] (f : R →+* S) (x : R) : ofHom f x = f x :=
  rfl
#align Ring.of_hom_apply RingCat.ofHom_apply

instance : Inhabited RingCat :=
  ⟨of PUnit⟩

instance (R : RingCat) : Ring R :=
  R.str

@[simp]
theorem coe_of (R : Type u) [Ring R] : (RingCat.of R : Type u) = R :=
  rfl
#align Ring.coe_of RingCat.coe_of

instance hasForgetToSemiRing : HasForget₂ RingCat SemiRing :=
  BundledHom.forget₂ _ _
#align Ring.has_forget_to_SemiRing RingCat.hasForgetToSemiRing

instance hasForgetToAddCommGroup : HasForget₂ RingCat AddCommGroupCat
    where-- can't use bundled_hom.mk_has_forget₂, since AddCommGroup is an induced category
  forget₂ :=
    { obj := fun R => AddCommGroupCat.of R
      map := fun R₁ R₂ f => RingHom.toAddMonoidHom f }
#align Ring.has_forget_to_AddCommGroup RingCat.hasForgetToAddCommGroup

end RingCat

/-- The category of commutative semirings. -/
def CommSemiRing : Type (u + 1) :=
  Bundled CommSemiring
#align CommSemiRing CommSemiRing

namespace CommSemiRing

instance : BundledHom.ParentProjection @CommSemiring.toSemiring :=
  ⟨⟩

deriving instance LargeCategory, ConcreteCategory for CommSemiRing

instance : CoeSort CommSemiRing (Type _) :=
  Bundled.hasCoeToSort

/-- Construct a bundled CommSemiRing from the underlying type and typeclass. -/
def of (R : Type u) [CommSemiring R] : CommSemiRing :=
  Bundled.of R
#align CommSemiRing.of CommSemiRing.of

/-- Typecheck a `ring_hom` as a morphism in `CommSemiRing`. -/
def ofHom {R S : Type u} [CommSemiring R] [CommSemiring S] (f : R →+* S) : of R ⟶ of S :=
  f
#align CommSemiRing.of_hom CommSemiRing.ofHom

@[simp]
theorem ofHom_apply {R S : Type u} [CommSemiring R] [CommSemiring S] (f : R →+* S) (x : R) :
    ofHom f x = f x :=
  rfl
#align CommSemiRing.of_hom_apply CommSemiRing.ofHom_apply

instance : Inhabited CommSemiRing :=
  ⟨of PUnit⟩

instance (R : CommSemiRing) : CommSemiring R :=
  R.str

@[simp]
theorem coe_of (R : Type u) [CommSemiring R] : (CommSemiRing.of R : Type u) = R :=
  rfl
#align CommSemiRing.coe_of CommSemiRing.coe_of

instance hasForgetToSemiRing : HasForget₂ CommSemiRing SemiRing :=
  BundledHom.forget₂ _ _
#align CommSemiRing.has_forget_to_SemiRing CommSemiRing.hasForgetToSemiRing

/-- The forgetful functor from commutative rings to (multiplicative) commutative monoids. -/
instance hasForgetToCommMon : HasForget₂ CommSemiRing CommMonCat :=
  HasForget₂.mk' (fun R : CommSemiRing => CommMonCat.of R) (fun R => rfl)
    (fun R₁ R₂ f => f.toMonoidHom) (by tidy)
#align CommSemiRing.has_forget_to_CommMon CommSemiRing.hasForgetToCommMon

end CommSemiRing

/-- The category of commutative rings. -/
def CommRingCat : Type (u + 1) :=
  Bundled CommRing
#align CommRing CommRingCat

namespace CommRingCat

instance : BundledHom.ParentProjection @CommRing.toRing :=
  ⟨⟩

deriving instance LargeCategory, ConcreteCategory for CommRingCat

instance : CoeSort CommRingCat (Type _) :=
  Bundled.hasCoeToSort

/-- Construct a bundled CommRing from the underlying type and typeclass. -/
def of (R : Type u) [CommRing R] : CommRingCat :=
  Bundled.of R
#align CommRing.of CommRingCat.of

/-- Typecheck a `ring_hom` as a morphism in `CommRing`. -/
def ofHom {R S : Type u} [CommRing R] [CommRing S] (f : R →+* S) : of R ⟶ of S :=
  f
#align CommRing.of_hom CommRingCat.ofHom

@[simp]
theorem ofHom_apply {R S : Type u} [CommRing R] [CommRing S] (f : R →+* S) (x : R) :
    ofHom f x = f x :=
  rfl
#align CommRing.of_hom_apply CommRingCat.ofHom_apply

instance : Inhabited CommRingCat :=
  ⟨of PUnit⟩

instance (R : CommRingCat) : CommRing R :=
  R.str

@[simp]
theorem coe_of (R : Type u) [CommRing R] : (CommRingCat.of R : Type u) = R :=
  rfl
#align CommRing.coe_of CommRingCat.coe_of

instance hasForgetToRing : HasForget₂ CommRingCat RingCat :=
  BundledHom.forget₂ _ _
#align CommRing.has_forget_to_Ring CommRingCat.hasForgetToRing

/-- The forgetful functor from commutative rings to (multiplicative) commutative monoids. -/
instance hasForgetToCommSemiRing : HasForget₂ CommRingCat CommSemiRing :=
  HasForget₂.mk' (fun R : CommRingCat => CommSemiRing.of R) (fun R => rfl) (fun R₁ R₂ f => f)
    (by tidy)
#align CommRing.has_forget_to_CommSemiRing CommRingCat.hasForgetToCommSemiRing

instance : Full (forget₂ CommRingCat CommSemiRing) where preimage X Y f := f

end CommRingCat

-- This example verifies an improvement possible in Lean 3.8.
-- Before that, to have `add_ring_hom.map_zero` usable by `simp` here,
-- we had to mark all the concrete category `has_coe_to_sort` instances reducible.
-- Now, it just works.
example {R S : CommRingCat} (i : R ⟶ S) (r : R) (h : r = 0) : i r = 0 := by simp [h]

namespace RingEquiv

variable {X Y : Type u}

/-- Build an isomorphism in the category `Ring` from a `ring_equiv` between `ring`s. -/
@[simps]
def toRingIso [Ring X] [Ring Y] (e : X ≃+* Y) : RingCat.of X ≅ RingCat.of Y
    where
  Hom := e.toRingHom
  inv := e.symm.toRingHom
#align ring_equiv.to_Ring_iso RingEquiv.toRingIso

/-- Build an isomorphism in the category `CommRing` from a `ring_equiv` between `comm_ring`s. -/
@[simps]
def toCommRingIso [CommRing X] [CommRing Y] (e : X ≃+* Y) : CommRingCat.of X ≅ CommRingCat.of Y
    where
  Hom := e.toRingHom
  inv := e.symm.toRingHom
#align ring_equiv.to_CommRing_iso RingEquiv.toCommRingIso

end RingEquiv

namespace CategoryTheory.Iso

/-- Build a `ring_equiv` from an isomorphism in the category `Ring`. -/
def ringIsoToRingEquiv {X Y : RingCat} (i : X ≅ Y) : X ≃+* Y
    where
  toFun := i.Hom
  invFun := i.inv
  left_inv := by tidy
  right_inv := by tidy
  map_add' := by tidy
  map_mul' := by tidy
#align category_theory.iso.Ring_iso_to_ring_equiv CategoryTheory.Iso.ringIsoToRingEquiv

/-- Build a `ring_equiv` from an isomorphism in the category `CommRing`. -/
def commRingIsoToRingEquiv {X Y : CommRingCat} (i : X ≅ Y) : X ≃+* Y
    where
  toFun := i.Hom
  invFun := i.inv
  left_inv := by tidy
  right_inv := by tidy
  map_add' := by tidy
  map_mul' := by tidy
#align category_theory.iso.CommRing_iso_to_ring_equiv CategoryTheory.Iso.commRingIsoToRingEquiv

@[simp]
theorem commRingIsoToRingEquiv_toRingHom {X Y : CommRingCat} (i : X ≅ Y) :
    i.commRingIsoToRingEquiv.toRingHom = i.Hom :=
  by
  ext
  rfl
#align category_theory.iso.CommRing_iso_to_ring_equiv_to_ring_hom CategoryTheory.Iso.commRingIsoToRingEquiv_toRingHom

@[simp]
theorem commRingIsoToRingEquiv_symm_toRingHom {X Y : CommRingCat} (i : X ≅ Y) :
    i.commRingIsoToRingEquiv.symm.toRingHom = i.inv :=
  by
  ext
  rfl
#align category_theory.iso.CommRing_iso_to_ring_equiv_symm_to_ring_hom CategoryTheory.Iso.commRingIsoToRingEquiv_symm_toRingHom

end CategoryTheory.Iso

/-- Ring equivalences between `ring`s are the same as (isomorphic to) isomorphisms in `Ring`. -/
def ringEquivIsoRingIso {X Y : Type u} [Ring X] [Ring Y] : X ≃+* Y ≅ RingCat.of X ≅ RingCat.of Y
    where
  Hom e := e.toRingIso
  inv i := i.ringIsoToRingEquiv
#align ring_equiv_iso_Ring_iso ringEquivIsoRingIso

/-- Ring equivalences between `comm_ring`s are the same as (isomorphic to) isomorphisms
in `CommRing`. -/
def ringEquivIsoCommRingIso {X Y : Type u} [CommRing X] [CommRing Y] :
    X ≃+* Y ≅ CommRingCat.of X ≅ CommRingCat.of Y
    where
  Hom e := e.toCommRingIso
  inv i := i.commRingIsoToRingEquiv
#align ring_equiv_iso_CommRing_iso ringEquivIsoCommRingIso

instance RingCat.forget_reflects_isos : ReflectsIsomorphisms (forget RingCat.{u})
    where reflects X Y f _ := by
    skip
    let i := as_iso ((forget RingCat).map f)
    let e : X ≃+* Y := { f, i.to_equiv with }
    exact ⟨(is_iso.of_iso e.to_Ring_iso).1⟩
#align Ring.forget_reflects_isos RingCat.forget_reflects_isos

instance CommRingCat.forget_reflects_isos : ReflectsIsomorphisms (forget CommRingCat.{u})
    where reflects X Y f _ := by
    skip
    let i := as_iso ((forget CommRingCat).map f)
    let e : X ≃+* Y := { f, i.to_equiv with }
    exact ⟨(is_iso.of_iso e.to_CommRing_iso).1⟩
#align CommRing.forget_reflects_isos CommRingCat.forget_reflects_isos

theorem CommRingCat.comp_eq_ring_hom_comp {R S T : CommRingCat} (f : R ⟶ S) (g : S ⟶ T) :
    f ≫ g = g.comp f :=
  rfl
#align CommRing.comp_eq_ring_hom_comp CommRingCat.comp_eq_ring_hom_comp

theorem CommRingCat.ringHom_comp_eq_comp {R S T : Type _} [CommRing R] [CommRing S] [CommRing T]
    (f : R →+* S) (g : S →+* T) : g.comp f = CommRingCat.ofHom f ≫ CommRingCat.ofHom g :=
  rfl
#align CommRing.ring_hom_comp_eq_comp CommRingCat.ringHom_comp_eq_comp

-- It would be nice if we could have the following,
-- but it requires making `reflects_isomorphisms_forget₂` an instance,
-- which can cause typeclass loops:
attribute [local instance] reflects_isomorphisms_forget₂

example : ReflectsIsomorphisms (forget₂ RingCat AddCommGroupCat) := by infer_instance


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

import category_theory.limits.preserves.shapes.equalizers
import category_theory.limits.preserves.shapes.products
import category_theory.limits.yoneda
import category_theory.sites.sheaf_of_types

/-!
# Sheaves taking values in a category

If C is a category with a Grothendieck topology, we define the notion of a sheaf taking values in
an arbitrary category `A`. We follow the definition in https://stacks.math.columbia.edu/tag/00VR,
noting that the presheaf of sets "defined above" can be seen in the comments between tags 00VQ and
00VR on the page https://stacks.math.columbia.edu/tag/00VL. The advantage of this definition is
that we need no assumptions whatsoever on `A` other than the assumption that the morphisms in `C`
and `A` live in the same universe.

* An `A`-valued presheaf `P : Cᵒᵖ ⥤ A` is defined to be a sheaf (for the topology `J`) iff for
  every `E : A`, the type-valued presheaves of sets given by sending `U : Cᵒᵖ` to `Hom_{A}(E, P U)`
  are all sheaves of sets, see `category_theory.presheaf.is_sheaf`.
* When `A = Type`, this recovers the basic definition of sheaves of sets, see
  `category_theory.is_sheaf_iff_is_sheaf_of_type`.
* An alternate definition when `C` is small, has pullbacks and `A` has products is given by an
  equalizer condition `category_theory.presheaf.is_sheaf'`. This is equivalent to the earlier
  definition, shown in `category_theory.presheaf.is_sheaf_iff_is_sheaf'`.
* When `A = Type`, this is *definitionally* equal to the equalizer condition for presieves in
  `category_theory.sites.sheaf_of_types`.
* When `A` has limits and there is a functor `s : A ⥤ Type` which is faithful, reflects isomorphisms
  and preserves limits, then `P : Cᵒᵖ ⥤ A` is a sheaf iff the underlying presheaf of types
  `P ⋙ s : Cᵒᵖ ⥤ Type` is a sheaf (`category_theory.presheaf.is_sheaf_iff_is_sheaf_forget`).
  Cf https://stacks.math.columbia.edu/tag/0073, which is a weaker version of this statement (it's
  only over spaces, not sites) and https://stacks.math.columbia.edu/tag/00YR (a), which
  additionally assumes filtered colimits.
-/

universes w v₁ v₂ u₁ u₂

noncomputable theory

namespace category_theory

open opposite category_theory category limits sieve

namespace presheaf

variables {C : Type u₁} [category.{v₁} C]
variables {A : Type u₂} [category.{v₂} A]
variables (J : grothendieck_topology C)

-- We follow https://stacks.math.columbia.edu/tag/00VL definition 00VR

/--
A sheaf of A is a presheaf P : Cᵒᵖ => A such that for every E : A, the
presheaf of types given by sending U : C to Hom_{A}(E, P U) is a sheaf of types.

https://stacks.math.columbia.edu/tag/00VR
-/
def is_sheaf (P : Cᵒᵖ ⥤ A) : Prop :=
∀ E : A, presieve.is_sheaf J (P ⋙ coyoneda.obj (op E))

section limit_sheaf_condition
open presieve presieve.family_of_elements limits
variables (P : Cᵒᵖ ⥤ A) {X : C} (S : sieve X) (R : presieve X) (E : Aᵒᵖ)

/-- Given a sieve `S` on `X : C`, a presheaf `P : Cᵒᵖ ⥤ A`, and an object `E` of `A`,
    the cones over the natural diagram `S.arrows.diagram.op ⋙ P` associated to `S` and `P`
    with cone point `E` are in 1-1 correspondence with sieve_compatible family of elements
    for the sieve `S` and the presheaf of types `Hom (E, P -)`. -/
@[simps] def cones_equiv_sieve_compatible_family :
  (S.arrows.diagram.op ⋙ P).cones.obj E ≃
  {x : family_of_elements (P ⋙ coyoneda.obj E) S // x.sieve_compatible} :=
{ to_fun := λ π, ⟨λ Y f h, π.app (op ⟨over.mk f, h⟩), λ _, by
    { intros, apply (id_comp _).symm.trans, dsimp,
      convert π.naturality (quiver.hom.op (over.hom_mk _ _)); dsimp; refl }⟩,
  inv_fun := λ x, { app := λ f, x.1 f.unop.1.hom f.unop.2,
    naturality' := λ f f' g, by
    { refine eq.trans _ (x.2 f.unop.1.hom g.unop.left f.unop.2),
      erw id_comp, congr, rw over.w g.unop } },
  left_inv := λ π, by { ext, dsimp, congr,
    rw op_eq_iff_eq_unop, ext, symmetry, apply costructured_arrow.eq_mk },
  right_inv := λ x, by { ext, refl } }

variables {P S E} {x : family_of_elements (P ⋙ coyoneda.obj E) S} (hx : x.sieve_compatible)

/-- The cone corresponding to a sieve_compatible family of elements, dot notation enabled. -/
@[simp] def _root_.category_theory.presieve.family_of_elements.sieve_compatible.cone :
  cone (S.arrows.diagram.op ⋙ P) :=
{ X := E.unop, π := (cones_equiv_sieve_compatible_family P S E).inv_fun ⟨x,hx⟩ }

/-- Cone morphisms from the cone corresponding to a sieve_compatible family to the natural
    cone associated to a sieve `S` and a presheaf `P` are in 1-1 correspondence with amalgamations
    of the family. -/
def hom_equiv_amalgamation :
  (hx.cone ⟶ P.map_cone S.arrows.cocone.op) ≃ {t // x.is_amalgamation t} :=
{ to_fun := λ l, ⟨l.hom, λ Y f hf, l.w (op ⟨over.mk f, hf⟩)⟩,
  inv_fun := λ t, ⟨t.1, λ f, t.2 f.unop.1.hom f.unop.2⟩,
  left_inv := λ l, by { ext, refl },
  right_inv := λ t, by { ext, refl } }

variables (P S)

/-- Given sieve `S` and presheaf `P : Cᵒᵖ ⥤ A`, their natural associated cone is a limit cone
    iff `Hom (E, P -)` is a sheaf of types for the sieve `S` and all `E : A`. -/
lemma is_limit_iff_is_sheaf_for :
  nonempty (is_limit (P.map_cone S.arrows.cocone.op)) ↔
  ∀ E : Aᵒᵖ, is_sheaf_for (P ⋙ coyoneda.obj E) S :=
begin
  dsimp [is_sheaf_for], simp_rw compatible_iff_sieve_compatible,
  rw ((cone.is_limit_equiv_is_terminal _).trans (is_terminal_equiv_unique _ _)).nonempty_congr,
  rw classical.nonempty_pi, split,
  { intros hu E x hx, specialize hu hx.cone,
    erw (hom_equiv_amalgamation hx).unique_congr.nonempty_congr at hu,
    exact (unique_subtype_iff_exists_unique _).1 hu },
  { rintros h ⟨E,π⟩, let eqv := cones_equiv_sieve_compatible_family P S (op E),
    rw ← eqv.left_inv π, erw (hom_equiv_amalgamation (eqv π).2).unique_congr.nonempty_congr,
    rw unique_subtype_iff_exists_unique, exact h _ _ (eqv π).2 },
end

/-- Given sieve `S` and presheaf `P : Cᵒᵖ ⥤ A`, their natural associated cone admits at most one
    morphism from every cone in the same category (i.e. over the same diagram),
    iff `Hom (E, P -)`is separated for the sieve `S` and all `E : A`. -/
lemma subsingleton_iff_is_separated_for :
  (∀ c, subsingleton (c ⟶ P.map_cone S.arrows.cocone.op)) ↔
  ∀ E : Aᵒᵖ, is_separated_for (P ⋙ coyoneda.obj E) S :=
begin
  split,
  { intros hs E x t₁ t₂ h₁ h₂, have hx := is_compatible_of_exists_amalgamation x ⟨t₁,h₁⟩,
    rw compatible_iff_sieve_compatible at hx, specialize hs hx.cone, cases hs,
    have := (hom_equiv_amalgamation hx).symm.injective,
    exact subtype.ext_iff.1 (@this ⟨t₁,h₁⟩ ⟨t₂,h₂⟩ (hs _ _)) },
  { rintros h ⟨E,π⟩, let eqv := cones_equiv_sieve_compatible_family P S (op E), split,
    rw ← eqv.left_inv π, intros f₁ f₂, let eqv' := hom_equiv_amalgamation (eqv π).2,
    apply eqv'.injective, ext, apply h _ (eqv π).1; exact (eqv' _).2 },
end

/-- A presheaf `P` is a sheaf for the Grothendieck topology `J` iff for every covering sieve
    `S` of `J`, the natural cone associated to `P` and `S` is a limit cone. -/
lemma is_sheaf_iff_is_limit : is_sheaf J P ↔
  ∀ ⦃X : C⦄ (S : sieve X), S ∈ J X → nonempty (is_limit (P.map_cone S.arrows.cocone.op)) :=
⟨λ h X S hS, (is_limit_iff_is_sheaf_for P S).2 (λ E, h E.unop S hS),
 λ h E X S hS, (is_limit_iff_is_sheaf_for P S).1 (h S hS) (op E)⟩

/-- A presheaf `P` is separated for the Grothendieck topology `J` iff for every covering sieve
    `S` of `J`, the natural cone associated to `P` and `S` admits at most one morphism from every
    cone in the same category. -/
lemma is_separated_iff_subsingleton :
  (∀ E : A, is_separated J (P ⋙ coyoneda.obj (op E))) ↔
  ∀ ⦃X : C⦄ (S : sieve X), S ∈ J X → ∀ c, subsingleton (c ⟶ P.map_cone S.arrows.cocone.op) :=
⟨λ h X S hS, (subsingleton_iff_is_separated_for P S).2 (λ E, h E.unop S hS),
 λ h E X S hS, (subsingleton_iff_is_separated_for P S).1 (h S hS) (op E)⟩

/-- Given presieve `R` and presheaf `P : Cᵒᵖ ⥤ A`, the natural cone associated to `P` and
    the sieve `sieve.generate R` generated by `R` is a limit cone iff `Hom (E, P -)` is a
    sheaf of types for the presieve `R` and all `E : A`. -/
lemma is_limit_iff_is_sheaf_for_presieve :
  nonempty (is_limit (P.map_cone (generate R).arrows.cocone.op)) ↔
  ∀ E : Aᵒᵖ, is_sheaf_for (P ⋙ coyoneda.obj E) R :=
(is_limit_iff_is_sheaf_for P _).trans (forall_congr (λ _, (is_sheaf_for_iff_generate _).symm))

/-- A presheaf `P` is a sheaf for the Grothendieck topology generated by a pretopology `K`
    iff for every covering presieve `R` of `K`, the natural cone associated to `P` and
    `sieve.generate R` is a limit cone. -/
lemma is_sheaf_iff_is_limit_pretopology [has_pullbacks C] (K : pretopology C) :
  is_sheaf (K.to_grothendieck C) P ↔ ∀ ⦃X : C⦄ (R : presieve X), R ∈ K X →
    nonempty (is_limit (P.map_cone (generate R).arrows.cocone.op)) :=
by { dsimp [is_sheaf], simp_rw is_sheaf_pretopology, exact
  ⟨λ h X R hR, (is_limit_iff_is_sheaf_for_presieve P R).2 (λ E, h E.unop R hR),
   λ h E X R hR, (is_limit_iff_is_sheaf_for_presieve P R).1 (h R hR) (op E)⟩ }

end limit_sheaf_condition

variable {J}

/-- This is a wrapper around `presieve.is_sheaf_for.amalgamate` to be used below.
  If `P`s a sheaf, `S` is a cover of `X`, and `x` is a collection of morphisms from `E`
  to `P` evaluated at terms in the cover which are compatible, then we can amalgamate
  the `x`s to obtain a single morphism `E ⟶ P.obj (op X)`. -/
def is_sheaf.amalgamate {A : Type u₂} [category.{max v₁ u₁} A]
  {E : A} {X : C} {P : Cᵒᵖ ⥤ A} (hP : presheaf.is_sheaf J P) (S : J.cover X)
  (x : Π (I : S.arrow), E ⟶ P.obj (op I.Y))
  (hx : ∀ (I : S.relation), x I.fst ≫ P.map I.g₁.op = x I.snd ≫ P.map I.g₂.op) :
  E ⟶ P.obj (op X) :=
(hP _ _ S.condition).amalgamate (λ Y f hf, x ⟨Y,f,hf⟩) $
  λ Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ w, hx ⟨Y₁, Y₂, Z, g₁, g₂, f₁, f₂, h₁, h₂, w⟩

@[simp, reassoc]
lemma is_sheaf.amalgamate_map {A : Type u₂} [category.{max v₁ u₁} A]
  {E : A} {X : C} {P : Cᵒᵖ ⥤ A} (hP : presheaf.is_sheaf J P) (S : J.cover X)
  (x : Π (I : S.arrow), E ⟶ P.obj (op I.Y))
  (hx : ∀ (I : S.relation), x I.fst ≫ P.map I.g₁.op = x I.snd ≫ P.map I.g₂.op)
  (I : S.arrow) : hP.amalgamate S x hx ≫ P.map I.f.op = x _ :=
begin
  rcases I with ⟨Y,f,hf⟩,
  apply @presieve.is_sheaf_for.valid_glue _ _ _ _ _ _ (hP _ _ S.condition)
    (λ Y f hf, x ⟨Y,f,hf⟩)
    (λ Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ w, hx ⟨Y₁, Y₂, Z, g₁, g₂, f₁, f₂, h₁, h₂, w⟩) f hf,
end

lemma is_sheaf.hom_ext {A : Type u₂} [category.{max v₁ u₁} A]
  {E : A} {X : C} {P : Cᵒᵖ ⥤ A} (hP : presheaf.is_sheaf J P) (S : J.cover X)
  (e₁ e₂ : E ⟶ P.obj (op X)) (h : ∀ (I : S.arrow), e₁ ≫ P.map I.f.op = e₂ ≫ P.map I.f.op) :
  e₁ = e₂ :=
(hP _ _ S.condition).is_separated_for.ext (λ Y f hf, h ⟨Y,f,hf⟩)

variable (J)

end presheaf

variables {C : Type u₁} [category.{v₁} C]
variables (J : grothendieck_topology C)
variables (A : Type u₂) [category.{v₂} A]

/-- The category of sheaves taking values in `A` on a grothendieck topology. -/
structure Sheaf :=
(val : Cᵒᵖ ⥤ A)
(cond : presheaf.is_sheaf J val)

namespace Sheaf

variables {J A}

/-- Morphisms between sheaves are just morphisms of presheaves. -/
@[ext]
structure hom (X Y : Sheaf J A) :=
(val : X.val ⟶ Y.val)

@[simps]
instance : category (Sheaf J A) :=
{ hom := hom,
  id := λ X, ⟨𝟙 _⟩,
  comp := λ X Y Z f g, ⟨f.val ≫ g.val⟩,
  id_comp' := λ X Y f, hom.ext _ _ $ id_comp _,
  comp_id' := λ X Y f, hom.ext _ _ $ comp_id _,
  assoc' := λ X Y Z W f g h, hom.ext _ _ $ assoc _ _ _ }

-- Let's make the inhabited linter happy...
instance (X : Sheaf J A) : inhabited (hom X X) := ⟨𝟙 X⟩

end Sheaf

/-- The inclusion functor from sheaves to presheaves. -/
@[simps]
def Sheaf_to_presheaf : Sheaf J A ⥤ (Cᵒᵖ ⥤ A) :=
{ obj := Sheaf.val,
  map := λ _ _ f, f.val,
  map_id' := λ X, rfl,
  map_comp' := λ X Y Z f g, rfl }

instance : full (Sheaf_to_presheaf J A) := { preimage := λ X Y f, ⟨f⟩ }
instance : faithful (Sheaf_to_presheaf J A) := {}

/-- The sheaf of sections guaranteed by the sheaf condition. -/
@[simps] def sheaf_over {A : Type u₂} [category.{v₂} A] {J : grothendieck_topology C}
  (ℱ : Sheaf J A) (E : A) : SheafOfTypes J := ⟨ℱ.val ⋙ coyoneda.obj (op E), ℱ.cond E⟩

lemma is_sheaf_iff_is_sheaf_of_type (P : Cᵒᵖ ⥤ Type w) :
  presheaf.is_sheaf J P ↔ presieve.is_sheaf J P :=
begin
  split,
  { intros hP,
    refine presieve.is_sheaf_iso J _ (hP punit),
    exact iso_whisker_left _ coyoneda.punit_iso ≪≫ P.right_unitor },
  { intros hP X Y S hS z hz,
    refine ⟨λ x, (hP S hS).amalgamate (λ Z f hf, z f hf x) _, _, _⟩,
    { intros Y₁ Y₂ Z g₁ g₂ f₁ f₂ hf₁ hf₂ h,
      exact congr_fun (hz g₁ g₂ hf₁ hf₂ h) x },
    { intros Z f hf,
      ext x,
      apply presieve.is_sheaf_for.valid_glue },
    { intros y hy,
      ext x,
      apply (hP S hS).is_separated_for.ext,
      intros Y' f hf,
      rw [presieve.is_sheaf_for.valid_glue _ _ _ hf, ← hy _ hf],
      refl } }
end

/--
The category of sheaves taking values in Type is the same as the category of set-valued sheaves.
-/
@[simps]
def Sheaf_equiv_SheafOfTypes : Sheaf J (Type w) ≌ SheafOfTypes J :=
{ functor :=
  { obj := λ S, ⟨S.val, (is_sheaf_iff_is_sheaf_of_type _ _).1 S.2⟩,
    map := λ S T f, ⟨f.val⟩ },
  inverse :=
  { obj := λ S, ⟨S.val, (is_sheaf_iff_is_sheaf_of_type _ _ ).2 S.2⟩,
    map := λ S T f, ⟨f.val⟩ },
  unit_iso := nat_iso.of_components (λ X, ⟨⟨𝟙 _⟩, ⟨𝟙 _⟩, by tidy, by tidy⟩) (by tidy),
  counit_iso := nat_iso.of_components (λ X, ⟨⟨𝟙 _⟩, ⟨𝟙 _⟩, by tidy, by tidy⟩) (by tidy) }

instance : inhabited (Sheaf (⊥ : grothendieck_topology C) (Type w)) :=
⟨(Sheaf_equiv_SheafOfTypes _).inverse.obj default⟩

variables {J} {A}

/-- If the empty sieve is a cover of `X`, then `F(X)` is terminal. -/
def Sheaf.is_terminal_of_bot_cover (F : Sheaf J A) (X : C) (H : ⊥ ∈ J X) :
  is_terminal (F.1.obj (op X)) :=
begin
  apply_with is_terminal.of_unique { instances := ff },
  intro Y,
  choose t h using F.2 Y _ H (by tidy) (by tidy),
  exact ⟨⟨t⟩, λ a, h.2 a (by tidy)⟩
end

end category_theory

namespace category_theory

open opposite category_theory category limits sieve

namespace presheaf

-- Under here is the equalizer story, which is equivalent if A has products (and doesn't
-- make sense otherwise). It's described in https://stacks.math.columbia.edu/tag/00VL,
-- between 00VQ and 00VR.

variables {C : Type u₁} [category.{v₁} C]
variables {A : Type u₂} [category.{max v₁ u₁} A]
variables (J : grothendieck_topology C)
variables {U : C} (R : presieve U)
variables (P : Cᵒᵖ ⥤ A)

section multiequalizer_conditions

/-- When `P` is a sheaf and `S` is a cover, the associated multifork is a limit. -/
def is_limit_of_is_sheaf {X : C} (S : J.cover X) (hP : is_sheaf J P) :
  is_limit (S.multifork P) :=
{ lift := λ (E : multifork _), hP.amalgamate S (λ I, E.ι _) (λ I, E.condition _),
  fac' := begin
    rintros (E : multifork _) (a|b),
    { apply hP.amalgamate_map },
    { rw [← E.w (walking_multicospan.hom.fst b),
        ← (S.multifork P).w (walking_multicospan.hom.fst b), ← assoc],
      congr' 1,
      apply hP.amalgamate_map }
  end,
  uniq' := begin
    rintros (E : multifork _) m hm,
    apply hP.hom_ext S,
    intros I,
    erw hm (walking_multicospan.left I),
    symmetry,
    apply hP.amalgamate_map
  end }

lemma is_sheaf_iff_multifork : is_sheaf J P ↔
  (∀ (X : C) (S : J.cover X), nonempty (is_limit (S.multifork P))) :=
begin
  refine ⟨λ hP X S, ⟨is_limit_of_is_sheaf _ _ _ hP⟩, _⟩,
  intros h E X S hS x hx,
  let T : J.cover X := ⟨S,hS⟩,
  obtain ⟨hh⟩ := h _ T,
  let K : multifork (T.index P) :=
    multifork.of_ι _ E (λ I, x I.f I.hf) (λ I, hx _ _ _ _ I.w),
  use hh.lift K,
  dsimp, split,
  { intros Y f hf,
    apply hh.fac K (walking_multicospan.left ⟨Y,f,hf⟩) },
  { intros e he,
    apply hh.uniq K,
    rintros (a|b),
    { apply he },
    { rw [← K.w (walking_multicospan.hom.fst b),
        ← (T.multifork P).w (walking_multicospan.hom.fst b), ← assoc],
      congr' 1,
      apply he } }
end

lemma is_sheaf_iff_multiequalizer
  [∀ (X : C) (S : J.cover X), has_multiequalizer (S.index P)] : is_sheaf J P ↔
  (∀ (X : C) (S : J.cover X), is_iso (S.to_multiequalizer P)) :=
begin
  rw is_sheaf_iff_multifork,
  refine forall₂_congr (λ X S, ⟨_, _⟩),
  { rintros ⟨h⟩,
    let e : P.obj (op X) ≅ multiequalizer (S.index P) :=
      h.cone_point_unique_up_to_iso (limit.is_limit _),
    exact (infer_instance : is_iso e.hom) },
  { introsI h,
    refine ⟨is_limit.of_iso_limit (limit.is_limit _) (cones.ext _ _)⟩,
    { apply (@as_iso _ _ _ _ _ h).symm },
    { intros a,
      symmetry,
      erw is_iso.inv_comp_eq,
      change _ = limit.lift _ _ ≫ _,
      simp } }
end

end multiequalizer_conditions

section

variables [has_products A]

/--
The middle object of the fork diagram given in Equation (3) of [MM92], as well as the fork diagram
of https://stacks.math.columbia.edu/tag/00VM.
-/
def first_obj : A :=
∏ (λ (f : Σ V, {f : V ⟶ U // R f}), P.obj (op f.1))

/--
The left morphism of the fork diagram given in Equation (3) of [MM92], as well as the fork diagram
of https://stacks.math.columbia.edu/tag/00VM.
-/
def fork_map : P.obj (op U) ⟶ first_obj R P :=
pi.lift (λ f, P.map f.2.1.op)

variables [has_pullbacks C]

/--
The rightmost object of the fork diagram of https://stacks.math.columbia.edu/tag/00VM, which
contains the data used to check a family of elements for a presieve is compatible.
-/
def second_obj : A :=
∏ (λ (fg : (Σ V, {f : V ⟶ U // R f}) × (Σ W, {g : W ⟶ U // R g})),
  P.obj (op (pullback fg.1.2.1 fg.2.2.1)))

/-- The map `pr₀*` of https://stacks.math.columbia.edu/tag/00VM. -/
def first_map : first_obj R P ⟶ second_obj R P :=
pi.lift (λ fg, pi.π _ _ ≫ P.map pullback.fst.op)

/-- The map `pr₁*` of https://stacks.math.columbia.edu/tag/00VM. -/
def second_map : first_obj R P ⟶ second_obj R P :=
pi.lift (λ fg, pi.π _ _ ≫ P.map pullback.snd.op)

lemma w : fork_map R P ≫ first_map R P = fork_map R P ≫ second_map R P :=
begin
  apply limit.hom_ext,
  rintro ⟨⟨Y, f, hf⟩, ⟨Z, g, hg⟩⟩,
  simp only [first_map, second_map, fork_map, limit.lift_π, limit.lift_π_assoc, assoc,
    fan.mk_π_app, subtype.coe_mk, subtype.val_eq_coe],
  rw [← P.map_comp, ← op_comp, pullback.condition],
  simp,
end

/--
An alternative definition of the sheaf condition in terms of equalizers. This is shown to be
equivalent in `category_theory.presheaf.is_sheaf_iff_is_sheaf'`.
-/
def is_sheaf' (P : Cᵒᵖ ⥤ A) : Prop := ∀ (U : C) (R : presieve U) (hR : generate R ∈ J U),
nonempty (is_limit (fork.of_ι _ (w R P)))

/-- (Implementation). An auxiliary lemma to convert between sheaf conditions. -/
def is_sheaf_for_is_sheaf_for' (P : Cᵒᵖ ⥤ A) (s : A ⥤ Type (max v₁ u₁))
  [Π J, preserves_limits_of_shape (discrete.{max v₁ u₁} J) s] (U : C) (R : presieve U) :
  is_limit (s.map_cone (fork.of_ι _ (w R P))) ≃
    is_limit (fork.of_ι _ (equalizer.presieve.w (P ⋙ s) R)) :=
begin
  apply equiv.trans (is_limit_map_cone_fork_equiv _ _) _,
  apply (is_limit.postcompose_hom_equiv _ _).symm.trans (is_limit.equiv_iso_limit _),
  { apply nat_iso.of_components _ _,
    { rintro (_ | _),
      { apply preserves_product.iso s },
      { apply preserves_product.iso s } },
    { rintro _ _ (_ | _),
      { ext : 1,
        dsimp [equalizer.presieve.first_map, first_map],
        simp only [limit.lift_π, map_lift_pi_comparison, assoc, fan.mk_π_app, functor.map_comp],
        erw pi_comparison_comp_π_assoc },
      { ext : 1,
        dsimp [equalizer.presieve.second_map, second_map],
        simp only [limit.lift_π, map_lift_pi_comparison, assoc, fan.mk_π_app, functor.map_comp],
        erw pi_comparison_comp_π_assoc },
      { dsimp,
        simp } } },
  { refine fork.ext (iso.refl _) _,
    dsimp [equalizer.fork_map, fork_map],
    simp }
end

/-- The equalizer definition of a sheaf given by `is_sheaf'` is equivalent to `is_sheaf`. -/
theorem is_sheaf_iff_is_sheaf' :
  is_sheaf J P ↔ is_sheaf' J P :=
begin
  split,
  { intros h U R hR,
    refine ⟨_⟩,
    apply coyoneda_jointly_reflects_limits,
    intro X,
    have q : presieve.is_sheaf_for (P ⋙ coyoneda.obj X) _ := h X.unop _ hR,
    rw ←presieve.is_sheaf_for_iff_generate at q,
    rw equalizer.presieve.sheaf_condition at q,
    replace q := classical.choice q,
    apply (is_sheaf_for_is_sheaf_for' _ _ _ _).symm q },
  { intros h U X S hS,
    rw equalizer.presieve.sheaf_condition,
    refine ⟨_⟩,
    refine is_sheaf_for_is_sheaf_for' _ _ _ _ _,
    apply is_limit_of_preserves,
    apply classical.choice (h _ S _),
    simpa }
end

end

section concrete

variables [has_pullbacks C]

/--
For a concrete category `(A, s)` where the forgetful functor `s : A ⥤ Type v` preserves limits and
reflects isomorphisms, and `A` has limits, an `A`-valued presheaf `P : Cᵒᵖ ⥤ A` is a sheaf iff its
underlying `Type`-valued presheaf `P ⋙ s : Cᵒᵖ ⥤ Type` is a sheaf.

Note this lemma applies for "algebraic" categories, eg groups, abelian groups and rings, but not
for the category of topological spaces, topological rings, etc since reflecting isomorphisms doesn't
hold.
-/
lemma is_sheaf_iff_is_sheaf_forget (s : A ⥤ Type (max v₁ u₁))
  [has_limits A] [preserves_limits s] [reflects_isomorphisms s] :
  is_sheaf J P ↔ is_sheaf J (P ⋙ s) :=
begin
  rw [is_sheaf_iff_is_sheaf', is_sheaf_iff_is_sheaf'],
  apply forall_congr (λ U, _),
  apply ball_congr (λ R hR, _),
  letI : reflects_limits s := reflects_limits_of_reflects_isomorphisms,
  have : is_limit (s.map_cone (fork.of_ι _ (w R P))) ≃ is_limit (fork.of_ι _ (w R (P ⋙ s))) :=
    is_sheaf_for_is_sheaf_for' P s U R,
  rw ←equiv.nonempty_congr this,
  split,
  { exact nonempty.map (λ t, is_limit_of_preserves s t) },
  { exact nonempty.map (λ t, is_limit_of_reflects s t) }
end

end concrete

end presheaf

end category_theory