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

import category_theory.sites.pretopology
import category_theory.limits.shapes.types
import category_theory.full_subcategory

/-!
# Sheaves of types on a Grothendieck topology

Defines the notion of a sheaf of types (usually called a sheaf of sets by mathematicians)
on a category equipped with a Grothendieck topology, as well as a range of equivalent
conditions useful in different situations.

First define what it means for a presheaf `P : Cᵒᵖ ⥤ Type v` to be a sheaf *for* a particular
presieve `R` on `X`:
* A *family of elements* `x` for `P` at `R` is an element `x_f` of `P Y` for every `f : Y ⟶ X` in
  `R`. See `family_of_elements`.
* The family `x` is *compatible* if, for any `f₁ : Y₁ ⟶ X` and `f₂ : Y₂ ⟶ X` both in `R`,
  and any `g₁ : Z ⟶ Y₁` and `g₂ : Z ⟶ Y₂` such that `g₁ ≫ f₁ = g₂ ≫ f₂`, the restriction of
  `x_f₁` along `g₁` agrees with the restriction of `x_f₂` along `g₂`.
  See `family_of_elements.compatible`.
* An *amalgamation* `t` for the family is an element of `P X` such that for every `f : Y ⟶ X` in
  `R`, the restriction of `t` on `f` is `x_f`.
  See `family_of_elements.is_amalgamation`.
We then say `P` is *separated* for `R` if every compatible family has at most one amalgamation,
and it is a *sheaf* for `R` if every compatible family has a unique amalgamation.
See `is_separated_for` and `is_sheaf_for`.

In the special case where `R` is a sieve, the compatibility condition can be simplified:
* The family `x` is *compatible* if, for any `f : Y ⟶ X` in `R` and `g : Z ⟶ Y`, the restriction of
  `x_f` along `g` agrees with `x_(g ≫ f)` (which is well defined since `g ≫ f` is in `R`).
See `family_of_elements.sieve_compatible` and `compatible_iff_sieve_compatible`.

In the special case where `C` has pullbacks, the compatibility condition can be simplified:
* The family `x` is *compatible* if, for any `f : Y ⟶ X` and `g : Z ⟶ X` both in `R`,
  the restriction of `x_f` along `π₁ : pullback f g ⟶ Y` agrees with the restriction of `x_g`
  along `π₂ : pullback f g ⟶ Z`.
See `family_of_elements.pullback_compatible` and `pullback_compatible_iff`.

Now given a Grothendieck topology `J`, `P` is a sheaf if it is a sheaf for every sieve in the
topology. See `is_sheaf`.

In the case where the topology is generated by a basis, it suffices to check `P` is a sheaf for
every sieve in the pretopology. See `is_sheaf_pretopology`.

We also provide equivalent conditions to satisfy alternate definitions given in the literature.

* Stacks: In `equalizer.presieve.sheaf_condition`, the sheaf condition at a presieve is shown to be
  equivalent to that of https://stacks.math.columbia.edu/tag/00VM (and combined with
  `is_sheaf_pretopology`, this shows the notions of `is_sheaf` are exactly equivalent.)

  The condition of https://stacks.math.columbia.edu/tag/00Z8 is virtually identical to the
  statement of `yoneda_condition_iff_sheaf_condition` (since the bijection described there carries
  the same information as the unique existence.)

* Maclane-Moerdijk [MM92]: Using `compatible_iff_sieve_compatible`, the definitions of `is_sheaf`
  are equivalent. There are also alternate definitions given:
  - Yoneda condition: Defined in `yoneda_sheaf_condition` and equivalence in
    `yoneda_condition_iff_sheaf_condition`.
  - Equalizer condition (Equation 3): Defined in the `equalizer.sieve` namespace, and equivalence
    in `equalizer.sieve.sheaf_condition`.
  - Matching family for presieves with pullback: `pullback_compatible_iff`.
  - Sheaf for a pretopology (Prop 1): `is_sheaf_pretopology` combined with the previous.
  - Sheaf for a pretopology as equalizer (Prop 1, bis): `equalizer.presieve.sheaf_condition`
    combined with the previous.

## Implementation

The sheaf condition is given as a proposition, rather than a subsingleton in `Type (max u v)`.
This doesn't seem to make a big difference, other than making a couple of definitions noncomputable,
but it means that equivalent conditions can be given as `↔` statements rather than `≃` statements,
which can be convenient.

## References

* [MM92]: *Sheaves in geometry and logic*, Saunders MacLane, and Ieke Moerdijk:
  Chapter III, Section 4.
* [Elephant]: *Sketches of an Elephant*, P. T. Johnstone: C2.1.
* https://stacks.math.columbia.edu/tag/00VL (sheaves on a pretopology or site)
* https://stacks.math.columbia.edu/tag/00ZB (sheaves on a topology)

-/

universes v u
namespace category_theory

open opposite category_theory category limits sieve classical

namespace presieve

variables {C : Type u} [category.{v} C]

variables {P : Cᵒᵖ ⥤ Type v}
variables {X Y : C} {S : sieve X} {R : presieve X}
variables (J J₂ : grothendieck_topology C)

/--
A family of elements for a presheaf `P` given a collection of arrows `R` with fixed codomain `X`
consists of an element of `P Y` for every `f : Y ⟶ X` in `R`.
A presheaf is a sheaf (resp, separated) if every *compatible* family of elements has exactly one
(resp, at most one) amalgamation.

This data is referred to as a `family` in [MM92], Chapter III, Section 4. It is also a concrete
version of the elements of the middle object in https://stacks.math.columbia.edu/tag/00VM which is
more useful for direct calculations. It is also used implicitly in Definition C2.1.2 in [Elephant].
-/
def family_of_elements (P : Cᵒᵖ ⥤ Type v) (R : presieve X) :=
Π ⦃Y : C⦄ (f : Y ⟶ X), R f → P.obj (op Y)

instance : inhabited (family_of_elements P (⊥ : presieve X)) := ⟨λ Y f, false.elim⟩

/--
A family of elements for a presheaf on the presieve `R₂` can be restricted to a smaller presieve
`R₁`.
-/
def family_of_elements.restrict {R₁ R₂ : presieve X} (h : R₁ ≤ R₂) :
  family_of_elements P R₂ → family_of_elements P R₁ :=
λ x Y f hf, x f (h _ hf)

/--
A family of elements for the arrow set `R` is *compatible* if for any `f₁ : Y₁ ⟶ X` and
`f₂ : Y₂ ⟶ X` in `R`, and any `g₁ : Z ⟶ Y₁` and `g₂ : Z ⟶ Y₂`, if the square `g₁ ≫ f₁ = g₂ ≫ f₂`
commutes then the elements of `P Z` obtained by restricting the element of `P Y₁` along `g₁` and
restricting the element of `P Y₂` along `g₂` are the same.

In special cases, this condition can be simplified, see `pullback_compatible_iff` and
`compatible_iff_sieve_compatible`.

This is referred to as a "compatible family" in Definition C2.1.2 of [Elephant], and on nlab:
https://ncatlab.org/nlab/show/sheaf#GeneralDefinitionInComponents
-/
def family_of_elements.compatible (x : family_of_elements P R) : Prop :=
∀ ⦃Y₁ Y₂ Z⦄ (g₁ : Z ⟶ Y₁) (g₂ : Z ⟶ Y₂) ⦃f₁ : Y₁ ⟶ X⦄ ⦃f₂ : Y₂ ⟶ X⦄
  (h₁ : R f₁) (h₂ : R f₂), g₁ ≫ f₁ = g₂ ≫ f₂ → P.map g₁.op (x f₁ h₁) = P.map g₂.op (x f₂ h₂)

/--
If the category `C` has pullbacks, this is an alternative condition for a family of elements to be
compatible: For any `f : Y ⟶ X` and `g : Z ⟶ X` in the presieve `R`, the restriction of the
given elements for `f` and `g` to the pullback agree.
This is equivalent to being compatible (provided `C` has pullbacks), shown in
`pullback_compatible_iff`.

This is the definition for a "matching" family given in [MM92], Chapter III, Section 4,
Equation (5). Viewing the type `family_of_elements` as the middle object of the fork in
https://stacks.math.columbia.edu/tag/00VM, this condition expresses that `pr₀* (x) = pr₁* (x)`,
using the notation defined there.
-/
def family_of_elements.pullback_compatible (x : family_of_elements P R) [has_pullbacks C] : Prop :=
∀ ⦃Y₁ Y₂⦄ ⦃f₁ : Y₁ ⟶ X⦄ ⦃f₂ : Y₂ ⟶ X⦄ (h₁ : R f₁) (h₂ : R f₂),
  P.map (pullback.fst : pullback f₁ f₂ ⟶ _).op (x f₁ h₁) = P.map pullback.snd.op (x f₂ h₂)

lemma pullback_compatible_iff (x : family_of_elements P R) [has_pullbacks C] :
  x.compatible ↔ x.pullback_compatible :=
begin
  split,
  { intros t Y₁ Y₂ f₁ f₂ hf₁ hf₂,
    apply t,
    apply pullback.condition },
  { intros t Y₁ Y₂ Z g₁ g₂ f₁ f₂ hf₁ hf₂ comm,
    rw [←pullback.lift_fst _ _ comm, op_comp, functor_to_types.map_comp_apply, t hf₁ hf₂,
        ←functor_to_types.map_comp_apply, ←op_comp, pullback.lift_snd] }
end

/-- The restriction of a compatible family is compatible. -/
lemma family_of_elements.compatible.restrict {R₁ R₂ : presieve X} (h : R₁ ≤ R₂)
  {x : family_of_elements P R₂} : x.compatible → (x.restrict h).compatible :=
λ q Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ comm, q g₁ g₂ (h _ h₁) (h _ h₂) comm

/--
Extend a family of elements to the sieve generated by an arrow set.
This is the construction described as "easy" in Lemma C2.1.3 of [Elephant].
-/
noncomputable def family_of_elements.sieve_extend (x : family_of_elements P R) :
  family_of_elements P (generate R) :=
λ Z f hf, P.map (some (some_spec hf)).op (x _ (some_spec (some_spec (some_spec hf))).1)

/-- The extension of a compatible family to the generated sieve is compatible. -/
lemma family_of_elements.compatible.sieve_extend (x : family_of_elements P R) (hx : x.compatible) :
  x.sieve_extend.compatible :=
begin
  intros Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ comm,
  rw [←(some_spec (some_spec (some_spec h₁))).2, ←(some_spec (some_spec (some_spec h₂))).2,
      ←assoc, ←assoc] at comm,
  dsimp [family_of_elements.sieve_extend],
  rw [← functor_to_types.map_comp_apply, ← functor_to_types.map_comp_apply],
  apply hx _ _ _ _ comm,
end

/-- The extension of a family agrees with the original family. -/
lemma extend_agrees {x : family_of_elements P R} (t : x.compatible) {f : Y ⟶ X} (hf : R f) :
  x.sieve_extend f ⟨_, 𝟙 _, f, hf, id_comp _⟩ = x f hf :=
begin
  have h : (generate R) f := ⟨_, _, _, hf, id_comp _⟩,
  change P.map (some (some_spec h)).op (x _ _) = x f hf,
  rw t (some (some_spec h)) (𝟙 _) _ hf _,
  { simp },
  simp_rw [id_comp],
  apply (some_spec (some_spec (some_spec h))).2,
end

/-- The restriction of an extension is the original. -/
@[simp]
lemma restrict_extend {x : family_of_elements P R} (t : x.compatible) :
  x.sieve_extend.restrict (le_generate R) = x :=
begin
  ext Y f hf,
  exact extend_agrees t hf,
end

/--
If the arrow set for a family of elements is actually a sieve (i.e. it is downward closed) then the
consistency condition can be simplified.
This is an equivalent condition, see `compatible_iff_sieve_compatible`.

This is the notion of "matching" given for families on sieves given in [MM92], Chapter III,
Section 4, Equation 1, and nlab: https://ncatlab.org/nlab/show/matching+family.
See also the discussion before Lemma C2.1.4 of [Elephant].
-/
def family_of_elements.sieve_compatible (x : family_of_elements P S) : Prop :=
∀ ⦃Y Z⦄ (f : Y ⟶ X) (g : Z ⟶ Y) (hf), x (g ≫ f) (S.downward_closed hf g) = P.map g.op (x f hf)

lemma compatible_iff_sieve_compatible (x : family_of_elements P S) :
  x.compatible ↔ x.sieve_compatible :=
begin
  split,
  { intros h Y Z f g hf,
    simpa using h (𝟙 _) g (S.downward_closed hf g) hf (id_comp _) },
  { intros h Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ k,
    simp_rw [← h f₁ g₁ h₁, k, h f₂ g₂ h₂] }
end

lemma family_of_elements.compatible.to_sieve_compatible {x : family_of_elements P S}
  (t : x.compatible) : x.sieve_compatible :=
(compatible_iff_sieve_compatible x).1 t

/--
Two compatible families on the sieve generated by a presieve `R` are equal if and only if they are
equal when restricted to `R`.
-/

/--
Given a family of elements `x` for the sieve `S` generated by a presieve `R`, if `x` is restricted
to `R` and then extended back up to `S`, the resulting extension equals `x`.
-/
@[simp]
lemma extend_restrict {x : family_of_elements P (generate R)} (t : x.compatible) :
  (x.restrict (le_generate R)).sieve_extend = x :=
begin
  apply restrict_inj,
  { exact (t.restrict (le_generate R)).sieve_extend _ },
  { exact t },
  rw restrict_extend,
  exact t.restrict (le_generate R),
end

/--
The given element `t` of `P.obj (op X)` is an *amalgamation* for the family of elements `x` if every
restriction `P.map f.op t = x_f` for every arrow `f` in the presieve `R`.

This is the definition given in  https://ncatlab.org/nlab/show/sheaf#GeneralDefinitionInComponents,
and https://ncatlab.org/nlab/show/matching+family, as well as [MM92], Chapter III, Section 4,
equation (2).
-/
def family_of_elements.is_amalgamation (x : family_of_elements P R)
  (t : P.obj (op X)) : Prop :=
∀ ⦃Y : C⦄ (f : Y ⟶ X) (h : R f), P.map f.op t = x f h

lemma is_compatible_of_exists_amalgamation (x : family_of_elements P R)
  (h : ∃ t, x.is_amalgamation t) : x.compatible :=
begin
  cases h with t ht,
  intros Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ comm,
  rw [←ht _ h₁, ←ht _ h₂, ←functor_to_types.map_comp_apply, ←op_comp, comm],
  simp,
end

lemma is_amalgamation_restrict {R₁ R₂ : presieve X} (h : R₁ ≤ R₂)
  (x : family_of_elements P R₂) (t : P.obj (op X)) (ht : x.is_amalgamation t) :
  (x.restrict h).is_amalgamation t :=
λ Y f hf, ht f (h Y hf)

lemma is_amalgamation_sieve_extend {R : presieve X}
  (x : family_of_elements P R) (t : P.obj (op X)) (ht : x.is_amalgamation t) :
  x.sieve_extend.is_amalgamation  t :=
begin
  intros Y f hf,
  dsimp [family_of_elements.sieve_extend],
  rw [←ht _, ←functor_to_types.map_comp_apply, ←op_comp, (some_spec (some_spec (some_spec hf))).2],
end

/-- A presheaf is separated for a presieve if there is at most one amalgamation. -/
def is_separated_for (P : Cᵒᵖ ⥤ Type v) (R : presieve X) : Prop :=
∀ (x : family_of_elements P R) (t₁ t₂),
  x.is_amalgamation t₁ → x.is_amalgamation t₂ → t₁ = t₂

lemma is_separated_for.ext {R : presieve X} (hR : is_separated_for P R)
  {t₁ t₂ : P.obj (op X)} (h : ∀ ⦃Y⦄ ⦃f : Y ⟶ X⦄ (hf : R f), P.map f.op t₁ = P.map f.op t₂) :
t₁ = t₂ :=
hR (λ Y f hf, P.map f.op t₂) t₁ t₂ (λ Y f hf, h hf) (λ Y f hf, rfl)

lemma is_separated_for_iff_generate :
  is_separated_for P R ↔ is_separated_for P (generate R) :=
begin
  split,
  { intros h x t₁ t₂ ht₁ ht₂,
    apply h (x.restrict (le_generate R)) t₁ t₂ _ _,
    { exact is_amalgamation_restrict _ x t₁ ht₁ },
    { exact is_amalgamation_restrict _ x t₂ ht₂ } },
  { intros h x t₁ t₂ ht₁ ht₂,
    apply h (x.sieve_extend),
    { exact is_amalgamation_sieve_extend x t₁ ht₁ },
    { exact is_amalgamation_sieve_extend x t₂ ht₂ } }
end

lemma is_separated_for_top (P : Cᵒᵖ ⥤ Type v) : is_separated_for P (⊤ : presieve X) :=
λ x t₁ t₂ h₁ h₂,
begin
  have q₁ := h₁ (𝟙 X) (by simp),
  have q₂ := h₂ (𝟙 X) (by simp),
  simp only [op_id, functor_to_types.map_id_apply] at q₁ q₂,
  rw [q₁, q₂],
end

/--
We define `P` to be a sheaf for the presieve `R` if every compatible family has a unique
amalgamation.

This is the definition of a sheaf for the given presieve given in C2.1.2 of [Elephant], and
https://ncatlab.org/nlab/show/sheaf#GeneralDefinitionInComponents.
Using `compatible_iff_sieve_compatible`,
this is equivalent to the definition of a sheaf in [MM92], Chapter III, Section 4.
-/
def is_sheaf_for (P : Cᵒᵖ ⥤ Type v) (R : presieve X) : Prop :=
∀ (x : family_of_elements P R), x.compatible → ∃! t, x.is_amalgamation t

/--
This is an equivalent condition to be a sheaf, which is useful for the abstraction to local
operators on elementary toposes. However this definition is defined only for sieves, not presieves.
The equivalence between this and `is_sheaf_for` is given in `yoneda_condition_iff_sheaf_condition`.
This version is also useful to establish that being a sheaf is preserved under isomorphism of
presheaves.

See the discussion before Equation (3) of [MM92], Chapter III, Section 4. See also C2.1.4 of
[Elephant]. This is also a direct reformulation of https://stacks.math.columbia.edu/tag/00Z8.
-/
def yoneda_sheaf_condition (P : Cᵒᵖ ⥤ Type v) (S : sieve X) : Prop :=
∀ (f : S.functor ⟶ P), ∃! g, S.functor_inclusion ≫ g = f

/--
(Implementation). This is a (primarily internal) equivalence between natural transformations
and compatible families.

Cf the discussion after Lemma 7.47.10 in https://stacks.math.columbia.edu/tag/00YW. See also
the proof of C2.1.4 of [Elephant], and the discussion in [MM92], Chapter III, Section 4.
-/
def nat_trans_equiv_compatible_family :
  (S.functor ⟶ P) ≃ {x : family_of_elements P S // x.compatible} :=
{ to_fun := λ α,
  begin
    refine ⟨λ Y f hf, _, _⟩,
    { apply α.app (op Y) ⟨_, hf⟩ },
    { rw compatible_iff_sieve_compatible,
      intros Y Z f g hf,
      dsimp,
      rw ← functor_to_types.naturality _ _ α g.op,
      refl }
  end,
  inv_fun := λ t,
  { app := λ Y f, t.1 _ f.2,
    naturality' := λ Y Z g,
    begin
      ext ⟨f, hf⟩,
      apply t.2.to_sieve_compatible _,
    end },
  left_inv := λ α,
  begin
    ext X ⟨_, _⟩,
    refl
  end,
  right_inv :=
  begin
    rintro ⟨x, hx⟩,
    refl,
  end }

/-- (Implementation). A lemma useful to prove `yoneda_condition_iff_sheaf_condition`. -/
lemma extension_iff_amalgamation (x : S.functor ⟶ P) (g : yoneda.obj X ⟶ P) :
  S.functor_inclusion ≫ g = x ↔
  (nat_trans_equiv_compatible_family x).1.is_amalgamation (yoneda_equiv g) :=
begin
  change _ ↔ ∀ ⦃Y : C⦄ (f : Y ⟶ X) (h : S f), P.map f.op (yoneda_equiv g) = x.app (op Y) ⟨f, h⟩,
  split,
  { rintro rfl Y f hf,
    rw yoneda_equiv_naturality,
    dsimp,
    simp },  -- See note [dsimp, simp].
  { intro h,
    ext Y ⟨f, hf⟩,
    have : _ = x.app Y _ := h f hf,
    rw yoneda_equiv_naturality at this,
    rw ← this,
    dsimp,
    simp }, -- See note [dsimp, simp].
end

/--
The yoneda version of the sheaf condition is equivalent to the sheaf condition.

C2.1.4 of [Elephant].
-/
lemma is_sheaf_for_iff_yoneda_sheaf_condition :
  is_sheaf_for P S ↔ yoneda_sheaf_condition P S :=
begin
  rw [is_sheaf_for, yoneda_sheaf_condition],
  simp_rw [extension_iff_amalgamation],
  rw equiv.forall_congr_left' nat_trans_equiv_compatible_family,
  rw subtype.forall,
  apply ball_congr,
  intros x hx,
  rw equiv.exists_unique_congr_left _,
  simp,
end

/--
If `P` is a sheaf for the sieve `S` on `X`, a natural transformation from `S` (viewed as a functor)
to `P` can be (uniquely) extended to all of `yoneda.obj X`.

      f
   S  →  P
   ↓  ↗
   yX

-/
noncomputable def is_sheaf_for.extend (h : is_sheaf_for P S) (f : S.functor ⟶ P) :
  yoneda.obj X ⟶ P :=
classical.some (is_sheaf_for_iff_yoneda_sheaf_condition.1 h f).exists

/--
Show that the extension of `f : S.functor ⟶ P` to all of `yoneda.obj X` is in fact an extension, ie
that the triangle below commutes, provided `P` is a sheaf for `S`

      f
   S  →  P
   ↓  ↗
   yX

-/
@[simp, reassoc]
lemma is_sheaf_for.functor_inclusion_comp_extend (h : is_sheaf_for P S) (f : S.functor ⟶ P) :
  S.functor_inclusion ≫ h.extend f = f :=
classical.some_spec (is_sheaf_for_iff_yoneda_sheaf_condition.1 h f).exists

/-- The extension of `f` to `yoneda.obj X` is unique. -/
lemma is_sheaf_for.unique_extend (h : is_sheaf_for P S) {f : S.functor ⟶ P} (t : yoneda.obj X ⟶ P)
  (ht : S.functor_inclusion ≫ t = f) :
  t = h.extend f :=
((is_sheaf_for_iff_yoneda_sheaf_condition.1 h f).unique ht (h.functor_inclusion_comp_extend f))

/--
If `P` is a sheaf for the sieve `S` on `X`, then if two natural transformations from `yoneda.obj X`
to `P` agree when restricted to the subfunctor given by `S`, they are equal.
-/
lemma is_sheaf_for.hom_ext (h : is_sheaf_for P S) (t₁ t₂ : yoneda.obj X ⟶ P)
  (ht : S.functor_inclusion ≫ t₁ = S.functor_inclusion ≫ t₂) :
  t₁ = t₂ :=
(h.unique_extend t₁ ht).trans (h.unique_extend t₂ rfl).symm

/-- `P` is a sheaf for `R` iff it is separated for `R` and there exists an amalgamation. -/
lemma is_separated_for_and_exists_is_amalgamation_iff_sheaf_for :
  is_separated_for P R ∧ (∀ (x : family_of_elements P R), x.compatible → ∃ t, x.is_amalgamation t) ↔
  is_sheaf_for P R :=
begin
  rw [is_separated_for, ←forall_and_distrib],
  apply forall_congr,
  intro x,
  split,
  { intros z hx, exact exists_unique_of_exists_of_unique (z.2 hx) z.1 },
  { intros h,
    refine ⟨_, (exists_of_exists_unique ∘ h)⟩,
    intros t₁ t₂ ht₁ ht₂,
    apply (h _).unique ht₁ ht₂,
    exact is_compatible_of_exists_amalgamation x ⟨_, ht₂⟩ }
end

/--
If `P` is separated for `R` and every family has an amalgamation, then `P` is a sheaf for `R`.
-/
lemma is_separated_for.is_sheaf_for (t : is_separated_for P R) :
  (∀ (x : family_of_elements P R), x.compatible → ∃ t, x.is_amalgamation t) →
  is_sheaf_for P R :=
begin
  rw ← is_separated_for_and_exists_is_amalgamation_iff_sheaf_for,
  exact and.intro t,
end

/-- If `P` is a sheaf for `R`, it is separated for `R`. -/
lemma is_sheaf_for.is_separated_for : is_sheaf_for P R → is_separated_for P R :=
λ q, (is_separated_for_and_exists_is_amalgamation_iff_sheaf_for.2 q).1

/-- Get the amalgamation of the given compatible family, provided we have a sheaf. -/
noncomputable def is_sheaf_for.amalgamate
  (t : is_sheaf_for P R) (x : family_of_elements P R) (hx : x.compatible) :
  P.obj (op X) :=
classical.some (t x hx).exists

lemma is_sheaf_for.is_amalgamation
  (t : is_sheaf_for P R) {x : family_of_elements P R} (hx : x.compatible) :
  x.is_amalgamation (t.amalgamate x hx) :=
classical.some_spec (t x hx).exists

@[simp]
lemma is_sheaf_for.valid_glue
  (t : is_sheaf_for P R) {x : family_of_elements P R} (hx : x.compatible) (f : Y ⟶ X) (Hf : R f) :
  P.map f.op (t.amalgamate x hx) = x f Hf :=
t.is_amalgamation hx f Hf

/-- C2.1.3 in [Elephant] -/
lemma is_sheaf_for_iff_generate (R : presieve X) :
  is_sheaf_for P R ↔ is_sheaf_for P (generate R) :=
begin
  rw ← is_separated_for_and_exists_is_amalgamation_iff_sheaf_for,
  rw ← is_separated_for_and_exists_is_amalgamation_iff_sheaf_for,
  rw ← is_separated_for_iff_generate,
  apply and_congr (iff.refl _),
  split,
  { intros q x hx,
    apply exists_imp_exists _ (q _ (hx.restrict (le_generate R))),
    intros t ht,
    simpa [hx] using is_amalgamation_sieve_extend _ _ ht },
  { intros q x hx,
    apply exists_imp_exists _ (q _ (hx.sieve_extend _)),
    intros t ht,
    simpa [hx] using is_amalgamation_restrict (le_generate R) _ _ ht },
end

/--
Every presheaf is a sheaf for the family {𝟙 X}.

[Elephant] C2.1.5(i)
-/
lemma is_sheaf_for_singleton_iso (P : Cᵒᵖ ⥤ Type v) :
  is_sheaf_for P (presieve.singleton (𝟙 X)) :=
begin
  intros x hx,
  refine ⟨x _ (presieve.singleton_self _), _, _⟩,
  { rintro _ _ ⟨rfl, rfl⟩,
    simp },
  { intros t ht,
    simpa using ht _ (presieve.singleton_self _) }
end

/--
Every presheaf is a sheaf for the maximal sieve.

[Elephant] C2.1.5(ii)
-/
lemma is_sheaf_for_top_sieve (P : Cᵒᵖ ⥤ Type v) :
  is_sheaf_for P ((⊤ : sieve X) : presieve X) :=
begin
  rw ← generate_of_singleton_split_epi (𝟙 X),
  rw ← is_sheaf_for_iff_generate,
  apply is_sheaf_for_singleton_iso,
end

/--
If `P` is a sheaf for `S`, and it is iso to `P'`, then `P'` is a sheaf for `S`. This shows that
"being a sheaf for a presieve" is a mathematical or hygenic property.
-/
lemma is_sheaf_for_iso {P' : Cᵒᵖ ⥤ Type v} (i : P ≅ P') : is_sheaf_for P R → is_sheaf_for P' R :=
begin
  rw [is_sheaf_for_iff_generate R, is_sheaf_for_iff_generate R],
  intro h,
  rw [is_sheaf_for_iff_yoneda_sheaf_condition],
  intro f,
  refine ⟨h.extend (f ≫ i.inv) ≫ i.hom, by simp, _⟩,
  intros g' hg',
  rw [← i.comp_inv_eq, h.unique_extend (g' ≫ i.inv) (by rw reassoc_of hg')],
end

/--
If a presieve `R` on `X` has a subsieve `S` such that:

* `P` is a sheaf for `S`.
* For every `f` in `R`, `P` is separated for the pullback of `S` along `f`,

then `P` is a sheaf for `R`.

This is closely related to [Elephant] C2.1.6(i).
-/
lemma is_sheaf_for_subsieve_aux (P : Cᵒᵖ ⥤ Type v) {S : sieve X} {R : presieve X}
  (h : (S : presieve X) ≤ R)
  (hS : is_sheaf_for P S)
  (trans : ∀ ⦃Y⦄ ⦃f : Y ⟶ X⦄, R f → is_separated_for P (S.pullback f)) :
  is_sheaf_for P R :=
begin
  rw ← is_separated_for_and_exists_is_amalgamation_iff_sheaf_for,
  split,
  { intros x t₁ t₂ ht₁ ht₂,
    exact hS.is_separated_for _ _ _ (is_amalgamation_restrict h x t₁ ht₁)
                                    (is_amalgamation_restrict h x t₂ ht₂) },
  { intros x hx,
    use hS.amalgamate _ (hx.restrict h),
    intros W j hj,
    apply (trans hj).ext,
    intros Y f hf,
    rw [←functor_to_types.map_comp_apply, ←op_comp,
        hS.valid_glue (hx.restrict h) _ hf, family_of_elements.restrict,
        ←hx (𝟙 _) f _ _ (id_comp _)],
    simp },
end

/--
If `P` is a sheaf for every pullback of the sieve `S`, then `P` is a sheaf for any presieve which
contains `S`.
This is closely related to [Elephant] C2.1.6.
-/
lemma is_sheaf_for_subsieve (P : Cᵒᵖ ⥤ Type v) {S : sieve X} {R : presieve X}
  (h : (S : presieve X) ≤ R)
  (trans : Π ⦃Y⦄ (f : Y ⟶ X), is_sheaf_for P (S.pullback f)) :
  is_sheaf_for P R :=
is_sheaf_for_subsieve_aux P h (by simpa using trans (𝟙 _)) (λ Y f hf, (trans f).is_separated_for)

/-- A presheaf is separated for a topology if it is separated for every sieve in the topology. -/
def is_separated (P : Cᵒᵖ ⥤ Type v) : Prop :=
∀ {X} (S : sieve X), S ∈ J X → is_separated_for P S

/--
A presheaf is a sheaf for a topology if it is a sheaf for every sieve in the topology.

If the given topology is given by a pretopology, `is_sheaf_for_pretopology` shows it suffices to
check the sheaf condition at presieves in the pretopology.
-/
def is_sheaf (P : Cᵒᵖ ⥤ Type v) : Prop :=
∀ ⦃X⦄ (S : sieve X), S ∈ J X → is_sheaf_for P S

lemma is_sheaf.is_sheaf_for {P : Cᵒᵖ ⥤ Type v} (hp : is_sheaf J P)
  (R : presieve X) (hr : generate R ∈ J X) : is_sheaf_for P R :=
(is_sheaf_for_iff_generate R).2 $ hp _ hr

lemma is_sheaf_of_le (P : Cᵒᵖ ⥤ Type v) {J₁ J₂ : grothendieck_topology C} :
  J₁ ≤ J₂ → is_sheaf J₂ P → is_sheaf J₁ P :=
λ h t X S hS, t S (h _ hS)

lemma is_separated_of_is_sheaf (P : Cᵒᵖ ⥤ Type v) (h : is_sheaf J P) : is_separated J P :=
λ X S hS, (h S hS).is_separated_for

/-- The property of being a sheaf is preserved by isomorphism. -/
lemma is_sheaf_iso {P' : Cᵒᵖ ⥤ Type v} (i : P ≅ P') (h : is_sheaf J P) : is_sheaf J P' :=
λ X S hS, is_sheaf_for_iso i (h S hS)

lemma is_sheaf_of_yoneda (h : ∀ {X} (S : sieve X), S ∈ J X → yoneda_sheaf_condition P S) :
  is_sheaf J P :=
λ X S hS, is_sheaf_for_iff_yoneda_sheaf_condition.2 (h _ hS)

/--
For a topology generated by a basis, it suffices to check the sheaf condition on the basis
presieves only.
-/
lemma is_sheaf_pretopology [has_pullbacks C] (K : pretopology C) :
  is_sheaf (K.to_grothendieck C) P ↔ (∀ {X : C} (R : presieve X), R ∈ K X → is_sheaf_for P R) :=
begin
  split,
  { intros PJ X R hR,
    rw is_sheaf_for_iff_generate,
    apply PJ (sieve.generate R) ⟨_, hR, le_generate R⟩ },
  { rintro PK X S ⟨R, hR, RS⟩,
    have gRS : ⇑(generate R) ≤ S,
    { apply gi_generate.gc.monotone_u,
      rwa sets_iff_generate },
    apply is_sheaf_for_subsieve P gRS _,
    intros Y f,
    rw [← pullback_arrows_comm, ← is_sheaf_for_iff_generate],
    exact PK (pullback_arrows f R) (K.pullbacks f R hR) }
end

/-- Any presheaf is a sheaf for the bottom (trivial) grothendieck topology. -/
lemma is_sheaf_bot : is_sheaf (⊥ : grothendieck_topology C) P :=
λ X, by simp [is_sheaf_for_top_sieve]

end presieve

namespace equalizer

variables {C : Type v} [small_category C] (P : Cᵒᵖ ⥤ Type v) {X : C} (R : presieve X) (S : sieve X)

noncomputable theory

/--
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 : Type v :=
∏ (λ (f : Σ Y, {f : Y ⟶ X // R f}), P.obj (op f.1))

/-- Show that `first_obj` is isomorphic to `family_of_elements`. -/
@[simps]
def first_obj_eq_family : first_obj P R ≅ R.family_of_elements P :=
{ hom := λ t Y f hf, pi.π (λ (f : Σ Y, {f : Y ⟶ X // R f}), P.obj (op f.1)) ⟨_, _, hf⟩ t,
  inv := pi.lift (λ f x, x _ f.2.2),
  hom_inv_id' :=
  begin
    ext ⟨Y, f, hf⟩ p,
    simpa,
  end,
  inv_hom_id' :=
  begin
    ext x Y f hf,
    apply limits.types.limit.lift_π_apply,
  end }

instance : inhabited (first_obj P (⊥ : presieve X)) :=
((first_obj_eq_family P _).to_equiv).inhabited

/--
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 X) ⟶ first_obj P R :=
pi.lift (λ f, P.map f.2.1.op)

/-!
This section establishes the equivalence between the sheaf condition of Equation (3) [MM92] and
the definition of `is_sheaf_for`.
-/
namespace sieve

/--
The rightmost object of the fork diagram of Equation (3) [MM92], which contains the data used
to check a family is compatible.
-/
def second_obj : Type v :=
∏ (λ (f : Σ Y Z (g : Z ⟶ Y), {f' : Y ⟶ X // S f'}), P.obj (op f.2.1))

/-- The map `p` of Equations (3,4) [MM92]. -/
def first_map : first_obj P S ⟶ second_obj P S :=
pi.lift (λ fg, pi.π _ (⟨_, _, S.downward_closed fg.2.2.2.2 fg.2.2.1⟩ : Σ Y, {f : Y ⟶ X // S f}))

instance : inhabited (second_obj P (⊥ : sieve X)) := ⟨first_map _ _ (default _)⟩

/-- The map `a` of Equations (3,4) [MM92]. -/
def second_map : first_obj P S ⟶ second_obj P S :=
pi.lift (λ fg, pi.π _ ⟨_, fg.2.2.2⟩ ≫ P.map fg.2.2.1.op)

lemma w : fork_map P S ≫ first_map P S = fork_map P S ≫ second_map P S :=
begin
  apply limit.hom_ext,
  rintro ⟨Y, Z, g, f, hf⟩,
  simp [first_map, second_map, fork_map],
end

/--
The family of elements given by `x : first_obj P S` is compatible iff `first_map` and `second_map`
map it to the same point.
-/
lemma compatible_iff (x : first_obj P S) :
  ((first_obj_eq_family P S).hom x).compatible ↔ first_map P S x = second_map P S x :=
begin
  rw presieve.compatible_iff_sieve_compatible,
  split,
  { intro t,
    ext ⟨Y, Z, g, f, hf⟩,
    simpa [first_map, second_map] using t _ g hf },
  { intros t Y Z f g hf,
    rw types.limit_ext_iff at t,
    simpa [first_map, second_map] using t ⟨Y, Z, g, f, hf⟩ }
end

/-- `P` is a sheaf for `S`, iff the fork given by `w` is an equalizer. -/
lemma equalizer_sheaf_condition :
  presieve.is_sheaf_for P S ↔ nonempty (is_limit (fork.of_ι _ (w P S))) :=
begin
  rw [types.type_equalizer_iff_unique,
      ← equiv.forall_congr_left (first_obj_eq_family P S).to_equiv.symm],
  simp_rw ← compatible_iff,
  simp only [inv_hom_id_apply, iso.to_equiv_symm_fun],
  apply ball_congr,
  intros x tx,
  apply exists_unique_congr,
  intro t,
  rw ← iso.to_equiv_symm_fun,
  rw equiv.eq_symm_apply,
  split,
  { intros q,
    ext Y f hf,
    simpa [first_obj_eq_family, fork_map] using q _ _ },
  { intros q Y f hf,
    rw ← q,
    simp [first_obj_eq_family, fork_map] }
end

end sieve

/-!
This section establishes the equivalence between the sheaf condition of
https://stacks.math.columbia.edu/tag/00VM and the definition of `is_sheaf_for`.
-/
namespace presieve

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 : Type v :=
∏ (λ (fg : (Σ Y, {f : Y ⟶ X // R f}) × (Σ Z, {g : Z ⟶ X // R g})),
  P.obj (op (pullback fg.1.2.1 fg.2.2.1)))

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

instance : inhabited (second_obj P (⊥ : presieve X)) := ⟨first_map _ _ (default _)⟩

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

lemma w : fork_map P R ≫ first_map P R = fork_map P R ≫ second_map P R :=
begin
  apply limit.hom_ext,
  rintro ⟨⟨Y, f, hf⟩, ⟨Z, g, hg⟩⟩,
  simp only [first_map, second_map, fork_map],
  simp only [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

/--
The family of elements given by `x : first_obj P S` is compatible iff `first_map` and `second_map`
map it to the same point.
-/
lemma compatible_iff (x : first_obj P R) :
  ((first_obj_eq_family P R).hom x).compatible ↔ first_map P R x = second_map P R x :=
begin
  rw presieve.pullback_compatible_iff,
  split,
  { intro t,
    ext ⟨⟨Y, f, hf⟩, Z, g, hg⟩,
    simpa [first_map, second_map] using t hf hg },
  { intros t Y Z f g hf hg,
    rw types.limit_ext_iff at t,
    simpa [first_map, second_map] using t ⟨⟨Y, f, hf⟩, Z, g, hg⟩ }
end

/--
`P` is a sheaf for `R`, iff the fork given by `w` is an equalizer.
See https://stacks.math.columbia.edu/tag/00VM.
-/
lemma sheaf_condition :
  R.is_sheaf_for P ↔ nonempty (is_limit (fork.of_ι _ (w P R))) :=
begin
  rw types.type_equalizer_iff_unique,
  erw ← equiv.forall_congr_left (first_obj_eq_family P R).to_equiv.symm,
  simp_rw [← compatible_iff, ← iso.to_equiv_fun, equiv.apply_symm_apply],
  apply ball_congr,
  intros x hx,
  apply exists_unique_congr,
  intros t,
  rw equiv.eq_symm_apply,
  split,
  { intros q,
    ext Y f hf,
    simpa [fork_map] using q _ _ },
  { intros q Y f hf,
    rw ← q,
    simp [fork_map] }
end

end presieve
end equalizer

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

/-- The category of sheaves on a grothendieck topology. -/
@[derive category]
def SheafOfTypes (J : grothendieck_topology C) : Type (max u (v+1)) :=
{P : Cᵒᵖ ⥤ Type v // presieve.is_sheaf J P}

/-- The inclusion functor from sheaves to presheaves. -/
@[simps {rhs_md := semireducible}, derive [full, faithful]]
def SheafOfTypes_to_presheaf : SheafOfTypes J ⥤ (Cᵒᵖ ⥤ Type v) :=
full_subcategory_inclusion (presieve.is_sheaf J)

/--
The category of sheaves on the bottom (trivial) grothendieck topology is equivalent to the category
of presheaves.
-/
@[simps]
def SheafOfTypes_bot_equiv : SheafOfTypes (⊥ : grothendieck_topology C) ≌ (Cᵒᵖ ⥤ Type v) :=
{ functor := SheafOfTypes_to_presheaf _,
  inverse :=
  { obj := λ P, ⟨P, presieve.is_sheaf_bot⟩,
    map := λ P₁ P₂ f, (SheafOfTypes_to_presheaf _).preimage f },
  unit_iso :=
  { hom := { app := λ _, 𝟙 _ },
    inv := { app := λ _, 𝟙 _ } },
  counit_iso := iso.refl _ }

instance : inhabited (SheafOfTypes (⊥ : grothendieck_topology C)) :=
⟨SheafOfTypes_bot_equiv.inverse.obj ((functor.const _).obj punit)⟩

end category_theory


import data.nat.basic
import pfin.basic pfin.ops

universe u
open pfin nat function

/-- `pfin 0` is empty -/
def pfin_zero_elim {C : Sort*} : pfin 0 → C :=
λ x, false.elim $ nat.not_lt_zero x.val x.is_lt

def pfin_zero_elim' {α : pfin 0 → Sort u} : ∀(x : pfin 0), α x
| ⟨n, hn⟩ := false.elim (nat.not_lt_zero n hn)

namespace pfin
variables {n m : ℕ} {a b : pfin.{u} n}

@[simp] protected lemma eta (a : pfin n) (h : a.val < n) : (⟨a.val, h⟩ : pfin n) = a :=
by cases a; refl

protected lemma ext_iff (a b : pfin n) : a = b ↔ a.val = b.val :=
iff.intro (congr_arg _) pfin.eq_of_veq

lemma injective_val {n : ℕ} : injective (val : pfin n → ℕ) := λ _ _, pfin.eq_of_veq

lemma eq_iff_veq (a b : pfin n) : a = b ↔ a.val = b.val :=
⟨veq_of_eq, eq_of_veq⟩

@[simp] protected lemma mk.inj_iff {n a b : ℕ} {ha : a < n} {hb : b < n} :
  pfin.mk a ha = pfin.mk b hb ↔ a = b :=
⟨pfin.mk.inj, λ h, by subst h⟩

instance pfin_to_nat (n : ℕ) : has_coe (pfin n) nat := ⟨pfin.val⟩

@[simp] lemma mk_val {m n : ℕ} (h : m < n) : (⟨m, h⟩ : pfin n).val = m := rfl

@[simp] lemma coe_mk {m n : ℕ} (h : m < n) : ((⟨m, h⟩ : pfin n) : ℕ) = m := rfl

lemma coe_eq_val (a : pfin n) : (a : ℕ) = a.val := rfl

@[simp] lemma val_one  {n : ℕ} : (1 : pfin (n+2)).val = 1 := rfl
@[simp] lemma val_two  {n : ℕ} : (2 : pfin (n+3)).val = 2 := rfl
@[simp] lemma coe_zero {n : ℕ} : ((0 : pfin (n+1)) : ℕ) = 0 := rfl
@[simp] lemma coe_one  {n : ℕ} : ((1 : pfin (n+2)) : ℕ) = 1 := rfl
@[simp] lemma coe_two  {n : ℕ} : ((2 : pfin (n+3)) : ℕ) = 2 := rfl

instance {n : ℕ} : decidable_linear_order (pfin n) :=
decidable_linear_order.lift pfin.val (@pfin.eq_of_veq _) (by apply_instance)

lemma exists_iff {p : pfin n → Prop} : (∃ i, p i) ↔ ∃ i h, p ⟨i, h⟩ :=
⟨λ h, exists.elim h (λ ⟨i, hi⟩ hpi, ⟨i, hi, hpi⟩),
  λ h, exists.elim h (λ i hi, ⟨⟨i, hi.fst⟩, hi.snd⟩)⟩

lemma forall_iff {p : pfin n → Prop} : (∀ i, p i) ↔ ∀ i h, p ⟨i, h⟩ :=
⟨λ h i hi, h ⟨i, hi⟩, λ h ⟨i, hi⟩, h i hi⟩

lemma zero_le (a : pfin (n + 1)) : 0 ≤ a := zero_le a.val

lemma lt_iff_val_lt_val : a < b ↔ a.val < b.val := iff.rfl

lemma le_iff_val_le_val : a ≤ b ↔ a.val ≤ b.val := iff.rfl

@[simp] lemma succ_val (j : pfin n) : j.succ.val = j.val.succ :=
by cases j; simp [pfin.succ]

protected theorem succ.inj (p : pfin.succ a = pfin.succ b) : a = b :=
by cases a; cases b; exact eq_of_veq (nat.succ.inj (veq_of_eq p))

@[simp] lemma succ_inj {a b : pfin n} : a.succ = b.succ ↔ a = b :=
⟨λh, succ.inj h, λh, by rw h⟩

lemma injective_succ (n : ℕ) : injective (@pfin.succ n) :=
λa b, succ.inj

lemma succ_ne_zero {n} : ∀ k : pfin n, pfin.succ k ≠ 0
| ⟨k, hk⟩ heq := nat.succ_ne_zero k $ (pfin.ext_iff _ _).1 heq

@[simp] lemma pred_val (j : pfin (n+1)) (h : j ≠ 0) : (j.pred h).val = j.val.pred :=
by cases j; simp [pfin.pred]

@[simp] lemma succ_pred : ∀(i : pfin (n+1)) (h : i ≠ 0), (i.pred h).succ = i
| ⟨0,     h⟩ hi := by contradiction
| ⟨n + 1, h⟩ hi := rfl

@[simp] lemma pred_succ (i : pfin n) {h : i.succ ≠ 0} : i.succ.pred h = i :=
by cases i; refl

@[simp] lemma pred_inj :
  ∀ {a b : pfin (n + 1)} {ha : a ≠ 0} {hb : b ≠ 0}, a.pred ha = b.pred hb ↔ a = b
| ⟨0,   _⟩  b         ha hb := by contradiction
| ⟨i+1, _⟩  ⟨0,   _⟩  ha hb := by contradiction
| ⟨i+1, hi⟩ ⟨j+1, hj⟩ ha hb := by simp [pfin.eq_iff_veq]

/-- The greatest value of `pfin (n+1)` -/
def last (n : ℕ) : pfin (n+1) := ⟨_, n.lt_succ_self⟩

/-- `cast_lt i h` embeds `i` into a `pfin` where `h` proves it belongs into.  -/
def cast_lt (i : pfin m) (h : i.val < n) : pfin n := ⟨i.val, h⟩

/-- `cast_le h i` embeds `i` into a larger `pfin` type.  -/
def cast_le (h : n ≤ m) (a : pfin n) : pfin m := cast_lt a (lt_of_lt_of_le a.is_lt h)

/-- `cast eq i` embeds `i` into a equal `pfin` type. -/
def cast (eq : n = m) : pfin n → pfin m := cast_le $ le_of_eq eq

/-- `cast_add m i` embeds `i : pfin n` in `pfin (n+m)`. -/
def cast_add (m) : pfin n → pfin (n + m) := cast_le $ le_add_right n m

/-- `cast_succ i` embeds `i : pfin n` in `pfin (n+1)`. -/
def cast_succ : pfin n → pfin (n + 1) := cast_add 1

/-- `succ_above p i` embeds `pfin n` into `pfin (n + 1)` with a hole around `p`. -/
def succ_above (p : pfin (n+1)) (i : pfin n) : pfin (n+1) :=
if i.val < p.val then i.cast_succ else i.succ

/-- `pred_above p i h` embeds `i : pfin (n+1)` into `pfin n` by ignoring `p`. -/
def pred_above (p : pfin (n+1)) (i : pfin (n+1)) (hi : i ≠ p) : pfin n :=
if h : i < p
then i.cast_lt (lt_of_lt_of_le h $ nat.le_of_lt_succ p.is_lt)
else i.pred $
  have p < i, from lt_of_le_of_ne (le_of_not_gt h) hi.symm,
  ne_of_gt (lt_of_le_of_lt (zero_le p) this)

/-- `sub_nat i h` subtracts `m` from `i`, generalizes `pfin.pred`. -/
def sub_nat (m) (i : pfin (n + m)) (h : m ≤ i.val) : pfin n :=
⟨i.val - m, by simp [nat.sub_lt_right_iff_lt_add h, i.is_lt]⟩

/-- `add_nat i h` adds `m` on `i`, generalizes `pfin.succ`. -/
def add_nat (m) (i : pfin n) : pfin (n + m) :=
⟨i.val + m, add_lt_add_right i.is_lt _⟩

/-- `nat_add i h` adds `n` on `i` -/
def nat_add (n) {m} (i : pfin m) : pfin (n + m) :=
⟨n + i.val, add_lt_add_left i.is_lt _⟩

theorem le_last (i : pfin (n+1)) : i ≤ last n :=
le_of_lt_succ i.is_lt

@[simp] lemma cast_val (k : pfin n) (h : n = m) : (pfin.cast h k).val = k.val := rfl

@[simp] lemma cast_succ_val (k : pfin n) : k.cast_succ.val = k.val := rfl

@[simp] lemma cast_lt_val (k : pfin m) (h : k.val < n) : (k.cast_lt h).val = k.val := rfl

@[simp] lemma cast_le_val (k : pfin m) (h : m ≤ n) : (k.cast_le h).val = k.val := rfl

@[simp] lemma cast_add_val (k : pfin m) : (k.cast_add n).val = k.val := rfl

@[simp] lemma last_val (n : ℕ) : (last n).val = n := rfl

@[simp] lemma succ_last (n : ℕ) : (last n).succ = last (n.succ) := rfl

@[simp] lemma cast_succ_cast_lt (i : pfin (n + 1)) (h : i.val < n) : cast_succ (cast_lt i h) = i :=
pfin.eq_of_veq rfl

@[simp] lemma cast_lt_cast_succ {n : ℕ} (a : pfin n) (h : a.val < n) : cast_lt (cast_succ a) h = a :=
by cases a; refl

@[simp] lemma sub_nat_val (i : pfin (n + m)) (h : m ≤ i.val) : (i.sub_nat m h).val = i.val - m :=
rfl

@[simp] lemma add_nat_val (i : pfin (n + m)) (h : m ≤ i.val) : (i.add_nat m).val = i.val + m :=
rfl

@[simp] lemma cast_succ_inj {a b : pfin n} : a.cast_succ = b.cast_succ ↔ a = b :=
by simp [eq_iff_veq]

lemma cast_succ_ne_last (a : pfin n) : cast_succ a ≠ last n :=
by simp [eq_iff_veq, ne_of_lt a.is_lt]

lemma eq_last_of_not_lt {i : pfin (n+1)} (h : ¬ i.val < n) : i = last n :=
le_antisymm (le_last i) (not_lt.1 h)

lemma cast_succ_pfin_succ (n : ℕ) (j : pfin n) :
  cast_succ (pfin.succ j) = pfin.succ (cast_succ j) :=
by simp [pfin.ext_iff]

def clamp (n m : ℕ) : pfin (m + 1) := pfin.of_nat $ min n m

@[simp] lemma clamp_val (n m : ℕ) : (clamp n m).val = min n m :=
nat.mod_eq_of_lt $ nat.lt_succ_iff.mpr $ min_le_right _ _

lemma injective_cast_le {n₁ n₂ : ℕ} (h : n₁ ≤ n₂) : injective (pfin.cast_le h)
| ⟨i₁, h₁⟩ ⟨i₂, h₂⟩ eq := pfin.eq_of_veq $ show i₁ = i₂, from pfin.veq_of_eq eq

lemma injective_cast_succ (n : ℕ) : injective (@pfin.cast_succ n) :=
injective_cast_le (le_add_right n 1)

theorem succ_above_ne (p : pfin (n+1)) (i : pfin n) : p.succ_above i ≠ p :=
begin
  assume eq,
  unfold pfin.succ_above at eq,
  split_ifs at eq with h;
    simpa [lt_irrefl, nat.lt_succ_self, eq.symm] using h
end

@[simp] lemma succ_above_descend : ∀(p i : pfin (n+1)) (h : i ≠ p), p.succ_above (p.pred_above i h) = i
| ⟨p, hp⟩ ⟨0,   hi⟩ h := pfin.eq_of_veq $ by simp [succ_above, pred_above]; split_ifs; simp * at *
| ⟨p, hp⟩ ⟨i+1, hi⟩ h := pfin.eq_of_veq
  begin
    have : i + 1 ≠ p, by rwa [(≠), pfin.ext_iff] at h,
    unfold succ_above pred_above,
    split_ifs with h1 h2;
      simp only [pfin.cast_succ_cast_lt, add_right_inj, pred_val, ne.def, cast_succ_val,
                 nat.pred_succ, pfin.succ_pred, add_right_inj] at *,
    exact (this (le_antisymm h2 (le_of_not_gt h1))).elim
  end

@[simp] lemma pred_above_succ_above (p : pfin (n+1)) (i : pfin n) (h : p.succ_above i ≠ p) :
  p.pred_above (p.succ_above i) h = i :=
begin
  unfold pfin.succ_above,
  apply eq_of_veq,
  split_ifs with h₀,
  { simp [pred_above, h₀, lt_iff_val_lt_val], },
  { unfold pred_above,
    split_ifs with h₁,
    { exfalso,
      rw [lt_iff_val_lt_val, succ_val] at h₁,
      exact h₀ (lt_trans (nat.lt_succ_self _) h₁) },
    { rw [pred_succ] } }
end

section rec

@[elab_as_eliminator] def succ_rec
  {C : ∀ n, pfin n → Sort*}
  (H0 : ∀ n, C (succ n) 0)
  (Hs : ∀ n i, C n i → C (succ n) i.succ) : ∀ {n : ℕ} (i : pfin n), C n i
| 0        i           := i.elim0
| (succ n) ⟨0, _⟩      := H0 _
| (succ n) ⟨succ i, h⟩ := Hs _ _ (succ_rec ⟨i, lt_of_succ_lt_succ h⟩)

@[elab_as_eliminator] def succ_rec_on {n : ℕ} (i : pfin n)
  {C : ∀ n, pfin n → Sort*}
  (H0 : ∀ n, C (succ n) 0)
  (Hs : ∀ n i, C n i → C (succ n) i.succ) : C n i :=
i.succ_rec H0 Hs

@[simp] theorem succ_rec_on_zero {C : ∀ n, pfin n → Sort*} {H0 Hs} (n) :
  @pfin.succ_rec_on (succ n) 0 C H0 Hs = H0 n :=
rfl

@[simp] theorem succ_rec_on_succ {C : ∀ n, pfin n → Sort*} {H0 Hs} {n} (i : pfin n) :
  @pfin.succ_rec_on (succ n) i.succ C H0 Hs = Hs n i (pfin.succ_rec_on i H0 Hs) :=
by cases i; refl

@[elab_as_eliminator] def cases
  {C : pfin (succ n) → Sort*} (H0 : C 0) (Hs : ∀ i : pfin n, C (i.succ)) :
  ∀ (i : pfin (succ n)), C i
| ⟨0, h⟩ := H0
| ⟨succ i, h⟩ := Hs ⟨i, lt_of_succ_lt_succ h⟩

@[simp] theorem cases_zero {n} {C : pfin (succ n) → Sort*} {H0 Hs} : @pfin.cases n C H0 Hs 0 = H0 :=
rfl

@[simp] theorem cases_succ {n} {C : pfin (succ n) → Sort*} {H0 Hs} (i : pfin n) :
  @pfin.cases n C H0 Hs i.succ = Hs i :=
by cases i; refl

lemma forall_pfin_succ {P : pfin (n+1) → Prop} :
  (∀ i, P i) ↔ P 0 ∧ (∀ i:pfin n, P i.succ) :=
⟨λ H, ⟨H 0, λ i, H _⟩, λ ⟨H0, H1⟩ i, pfin.cases H0 H1 i⟩

lemma exists_pfin_succ {P : pfin (n+1) → Prop} :
  (∃ i, P i) ↔ P 0 ∨ (∃i:pfin n, P i.succ) :=
⟨λ ⟨i, h⟩, pfin.cases or.inl (λ i hi, or.inr ⟨i, hi⟩) i h,
  λ h, or.elim h (λ h, ⟨0, h⟩) $ λ⟨i, hi⟩, ⟨i.succ, hi⟩⟩

end rec

end pfin


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

! This file was ported from Lean 3 source module data.mv_polynomial.comap
! leanprover-community/mathlib commit aba31c938d3243cc671be7091b28a1e0814647ee
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.MvPolynomial.Rename

/-!
# `comap` operation on `MvPolynomial`

This file defines the `comap` function on `MvPolynomial`.

`MvPolynomial.comap` is a low-tech example of a map of "algebraic varieties," modulo the fact that
`mathlib` does not yet define varieties.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ : Type _` (indexing the variables)

+ `R : Type _` `[CommSemiring R]` (the coefficients)

-/

namespace MvPolynomial

variable {σ : Type _} {τ : Type _} {υ : Type _} {R : Type _} [CommSemiring R]

/-- Given an algebra hom `f : MvPolynomial σ R →ₐ[R] MvPolynomial τ R`
and a variable evaluation `v : τ → R`,
`comap f v` produces a variable evaluation `σ → R`.
-/
noncomputable def comap (f : MvPolynomial σ R →ₐ[R] MvPolynomial τ R) : (τ → R) → σ → R :=
  fun x i => aeval x (f (X i))
#align mv_polynomial.comap MvPolynomial.comap

@[simp]
theorem comap_apply (f : MvPolynomial σ R →ₐ[R] MvPolynomial τ R) (x : τ → R) (i : σ) :
    comap f x i = aeval x (f (X i)) :=
  rfl
#align mv_polynomial.comap_apply MvPolynomial.comap_apply

@[simp]
theorem comap_id_apply (x : σ → R) : comap (AlgHom.id R (MvPolynomial σ R)) x = x := by
  funext i
  simp only [comap, AlgHom.id_apply, id.def, aeval_X]
#align mv_polynomial.comap_id_apply MvPolynomial.comap_id_apply

variable (σ R)

theorem comap_id : comap (AlgHom.id R (MvPolynomial σ R)) = id := by
  funext x
  exact comap_id_apply x
#align mv_polynomial.comap_id MvPolynomial.comap_id

variable {σ R}

theorem comap_comp_apply (f : MvPolynomial σ R →ₐ[R] MvPolynomial τ R)
    (g : MvPolynomial τ R →ₐ[R] MvPolynomial υ R) (x : υ → R) :
    comap (g.comp f) x = comap f (comap g x) := by
  funext i
  trans aeval x (aeval (fun i => g (X i)) (f (X i)))
  · apply eval₂Hom_congr rfl rfl
    rw [AlgHom.comp_apply]
    suffices g = aeval fun i => g (X i) by rw [← this]
    exact aeval_unique g
  · simp only [comap, aeval_eq_eval₂Hom, map_eval₂Hom, AlgHom.comp_apply]
    refine' eval₂Hom_congr _ rfl rfl
    ext r
    apply aeval_C
#align mv_polynomial.comap_comp_apply MvPolynomial.comap_comp_apply

theorem comap_comp (f : MvPolynomial σ R →ₐ[R] MvPolynomial τ R)
    (g : MvPolynomial τ R →ₐ[R] MvPolynomial υ R) : comap (g.comp f) = comap f ∘ comap g := by
  funext x
  exact comap_comp_apply _ _ _
#align mv_polynomial.comap_comp MvPolynomial.comap_comp

theorem comap_eq_id_of_eq_id (f : MvPolynomial σ R →ₐ[R] MvPolynomial σ R) (hf : ∀ φ, f φ = φ)
    (x : σ → R) : comap f x = x := by
  convert comap_id_apply x
  ext1 φ
  simp [hf, AlgHom.id_apply]
#align mv_polynomial.comap_eq_id_of_eq_id MvPolynomial.comap_eq_id_of_eq_id

theorem comap_rename (f : σ → τ) (x : τ → R) : comap (rename f) x = x ∘ f := by
  funext
  simp [rename_X, comap_apply, aeval_X]
#align mv_polynomial.comap_rename MvPolynomial.comap_rename

/-- If two polynomial types over the same coefficient ring `R` are equivalent,
there is a bijection between the types of functions from their variable types to `R`.
-/
noncomputable def comapEquiv (f : MvPolynomial σ R ≃ₐ[R] MvPolynomial τ R) : (τ → R) ≃ (σ → R) where
  toFun := comap f
  invFun := comap f.symm
  left_inv := by
    intro x
    rw [← comap_comp_apply]
    apply comap_eq_id_of_eq_id
    intro
    simp only [AlgHom.id_apply, AlgEquiv.comp_symm]
  right_inv := by
    intro x
    rw [← comap_comp_apply]
    apply comap_eq_id_of_eq_id
    intro
    simp only [AlgHom.id_apply, AlgEquiv.symm_comp]
#align mv_polynomial.comap_equiv MvPolynomial.comapEquiv

@[simp]
theorem comapEquiv_coe (f : MvPolynomial σ R ≃ₐ[R] MvPolynomial τ R) :
    (comapEquiv f : (τ → R) → σ → R) = comap f :=
  rfl
#align mv_polynomial.comap_equiv_coe MvPolynomial.comapEquiv_coe

@[simp]
theorem comapEquiv_symm_coe (f : MvPolynomial σ R ≃ₐ[R] MvPolynomial τ R) :
    ((comapEquiv f).symm : (σ → R) → τ → R) = comap f.symm :=
  rfl
#align mv_polynomial.comap_equiv_symm_coe MvPolynomial.comapEquiv_symm_coe

end MvPolynomial


import Init.Data.Nat.Basic

#eval "Hello, world!"

def m : Nat := 1
#check 1

#check Nat ⊕ Nat

#check fun (α β γ : Type) (g : β → γ) (f : α → β) (x : α) => g (f x)

open Classical

variable (p: Prop)
#check em p

def double (x : Nat) : Nat := x * x
def add (x y : Nat) : Nat := x + y

variable (p q : Prop)

def Set (α : Type u) := α → Prop

namespace Set

def mem (x : α) (a : Set α) := a x
infix:50 (priority := high) "∈" => mem

theorem setext {a b : Set α} (h : ∀ x, x ∈ a ↔ x ∈ b) : a = b :=
funext (fun x => propext (h x))

def empty : Set α := fun x => False
notation (priority := high) "∅" => empty

def inter (a b : Set α) : Set α := fun x => x ∈ a ∧ x ∈ b
infix:70 " ∩ " => inter

end Set