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

! This file was ported from Lean 3 source module category_theory.sites.sheaf_of_types
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Sites.Pretopology
import Mathbin.CategoryTheory.Limits.Shapes.Types

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

-/

universe w v₁ v₂ u₁ u₂

namespace CategoryTheory

open Opposite CategoryTheory Category Limits Sieve

namespace Presieve

variable {C : Type u₁} [Category.{v₁} C]

variable {P Q U : Cᵒᵖ ⥤ Type w}

variable {X Y : C} {S : Sieve X} {R : Presieve X}

variable (J J₂ : GrothendieckTopology 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 FamilyOfElements (P : Cᵒᵖ ⥤ Type w) (R : Presieve X) :=
  ∀ ⦃Y : C⦄ (f : Y ⟶ X), R f → P.obj (op Y)
#align category_theory.presieve.family_of_elements CategoryTheory.Presieve.FamilyOfElements

instance : Inhabited (FamilyOfElements P (⊥ : Presieve X)) :=
  ⟨fun Y f => False.elim⟩

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

/-- 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 FamilyOfElements.Compatible (x : FamilyOfElements 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₂)
#align category_theory.presieve.family_of_elements.compatible CategoryTheory.Presieve.FamilyOfElements.Compatible

/--
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 FamilyOfElements.PullbackCompatible (x : FamilyOfElements P R) [HasPullbacks 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₂)
#align category_theory.presieve.family_of_elements.pullback_compatible CategoryTheory.Presieve.FamilyOfElements.PullbackCompatible

theorem pullbackCompatible_iff (x : FamilyOfElements P R) [HasPullbacks C] :
    x.Compatible ↔ x.PullbackCompatible := by
  constructor
  · intro t Y₁ Y₂ f₁ f₂ hf₁ hf₂
    apply t
    apply pullback.condition
  · intro 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]
#align category_theory.presieve.pullback_compatible_iff CategoryTheory.Presieve.pullbackCompatible_iff

/-- The restriction of a compatible family is compatible. -/
theorem FamilyOfElements.Compatible.restrict {R₁ R₂ : Presieve X} (h : R₁ ≤ R₂)
    {x : FamilyOfElements P R₂} : x.Compatible → (x.restrict h).Compatible :=
  fun q Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ comm => q g₁ g₂ (h _ h₁) (h _ h₂) comm
#align category_theory.presieve.family_of_elements.compatible.restrict CategoryTheory.Presieve.FamilyOfElements.Compatible.restrict

/-- 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 FamilyOfElements.sieveExtend (x : FamilyOfElements P R) :
    FamilyOfElements P (generate R) := fun Z f hf =>
  P.map hf.choose_spec.some.op (x _ hf.choose_spec.choose_spec.choose_spec.1)
#align category_theory.presieve.family_of_elements.sieve_extend CategoryTheory.Presieve.FamilyOfElements.sieveExtend

/-- The extension of a compatible family to the generated sieve is compatible. -/
theorem FamilyOfElements.Compatible.sieveExtend {x : FamilyOfElements P R} (hx : x.Compatible) :
    x.sieveExtend.Compatible := by
  intro _ _ _ _ _ _ _ h₁ h₂ comm
  iterate 2 erw [← functor_to_types.map_comp_apply]; rw [← op_comp]; apply hx
  simp [comm, h₁.some_spec.some_spec.some_spec.2, h₂.some_spec.some_spec.some_spec.2]
#align category_theory.presieve.family_of_elements.compatible.sieve_extend CategoryTheory.Presieve.FamilyOfElements.Compatible.sieveExtend

/-- The extension of a family agrees with the original family. -/
theorem extend_agrees {x : FamilyOfElements P R} (t : x.Compatible) {f : Y ⟶ X} (hf : R f) :
    x.sieveExtend f (le_generate R Y hf) = x f hf :=
  by
  have h := (le_generate R Y hf).choose_spec
  unfold family_of_elements.sieve_extend
  rw [t h.some (𝟙 _) _ hf _]
  · simp;
  · rw [id_comp]
    exact h.some_spec.some_spec.2
#align category_theory.presieve.extend_agrees CategoryTheory.Presieve.extend_agrees

/-- The restriction of an extension is the original. -/
@[simp]
theorem restrict_extend {x : FamilyOfElements P R} (t : x.Compatible) :
    x.sieveExtend.restrict (le_generate R) = x :=
  by
  ext (Y f hf)
  exact extend_agrees t hf
#align category_theory.presieve.restrict_extend CategoryTheory.Presieve.restrict_extend

/--
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 FamilyOfElements.SieveCompatible (x : FamilyOfElements 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)
#align category_theory.presieve.family_of_elements.sieve_compatible CategoryTheory.Presieve.FamilyOfElements.SieveCompatible

theorem compatible_iff_sieveCompatible (x : FamilyOfElements P S) :
    x.Compatible ↔ x.SieveCompatible := by
  constructor
  · intro h Y Z f g hf
    simpa using h (𝟙 _) g (S.downward_closed hf g) hf (id_comp _)
  · intro h Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ k
    simp_rw [← h f₁ g₁ h₁, k, h f₂ g₂ h₂]
#align category_theory.presieve.compatible_iff_sieve_compatible CategoryTheory.Presieve.compatible_iff_sieveCompatible

theorem FamilyOfElements.Compatible.to_sieveCompatible {x : FamilyOfElements P S}
    (t : x.Compatible) : x.SieveCompatible :=
  (compatible_iff_sieveCompatible x).1 t
#align category_theory.presieve.family_of_elements.compatible.to_sieve_compatible CategoryTheory.Presieve.FamilyOfElements.Compatible.to_sieveCompatible

/--
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]
theorem extend_restrict {x : FamilyOfElements P (generate R)} (t : x.Compatible) :
    (x.restrict (le_generate R)).sieveExtend = x :=
  by
  rw [compatible_iff_sieve_compatible] at t
  ext (_ _ h); apply (t _ _ _).symm.trans; congr
  exact h.some_spec.some_spec.some_spec.2
#align category_theory.presieve.extend_restrict CategoryTheory.Presieve.extend_restrict

/--
Two compatible families on the sieve generated by a presieve `R` are equal if and only if they are
equal when restricted to `R`.
-/
theorem restrict_inj {x₁ x₂ : FamilyOfElements P (generate R)} (t₁ : x₁.Compatible)
    (t₂ : x₂.Compatible) : x₁.restrict (le_generate R) = x₂.restrict (le_generate R) → x₁ = x₂ :=
  fun h => by
  rw [← extend_restrict t₁, ← extend_restrict t₂]
  congr
  exact h
#align category_theory.presieve.restrict_inj CategoryTheory.Presieve.restrict_inj

/-- Compatible families of elements for a presheaf of types `P` and a presieve `R`
    are in 1-1 correspondence with compatible families for the same presheaf and
    the sieve generated by `R`, through extension and restriction. -/
@[simps]
noncomputable def compatibleEquivGenerateSieveCompatible :
    { x : FamilyOfElements P R // x.Compatible } ≃
      { x : FamilyOfElements P (generate R) // x.Compatible }
    where
  toFun x := ⟨x.1.sieveExtend, x.2.sieveExtend⟩
  invFun x := ⟨x.1.restrict (le_generate R), x.2.restrict _⟩
  left_inv x := Subtype.ext (restrict_extend x.2)
  right_inv x := Subtype.ext (extend_restrict x.2)
#align category_theory.presieve.compatible_equiv_generate_sieve_compatible CategoryTheory.Presieve.compatibleEquivGenerateSieveCompatible

theorem FamilyOfElements.comp_of_compatible (S : Sieve X) {x : FamilyOfElements P S}
    (t : x.Compatible) {f : Y ⟶ X} (hf : S f) {Z} (g : Z ⟶ Y) :
    x (g ≫ f) (S.downward_closed hf g) = P.map g.op (x f hf) := by
  simpa using t (𝟙 _) g (S.downward_closed hf g) hf (id_comp _)
#align category_theory.presieve.family_of_elements.comp_of_compatible CategoryTheory.Presieve.FamilyOfElements.comp_of_compatible

section FunctorPullback

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

variable {T : Presieve (F.obj Z)} {x : FamilyOfElements P T}

/--
Given a family of elements of a sieve `S` on `F(X)`, we can realize it as a family of elements of
`S.functor_pullback F`.
-/
def FamilyOfElements.functorPullback (x : FamilyOfElements P T) :
    FamilyOfElements (F.op ⋙ P) (T.functorPullback F) := fun Y f hf => x (F.map f) hf
#align category_theory.presieve.family_of_elements.functor_pullback CategoryTheory.Presieve.FamilyOfElements.functorPullback

theorem FamilyOfElements.Compatible.functorPullback (h : x.Compatible) :
    (x.functorPullback F).Compatible :=
  by
  intro Z₁ Z₂ W g₁ g₂ f₁ f₂ h₁ h₂ eq
  exact h (F.map g₁) (F.map g₂) h₁ h₂ (by simp only [← F.map_comp, Eq])
#align category_theory.presieve.family_of_elements.compatible.functor_pullback CategoryTheory.Presieve.FamilyOfElements.Compatible.functorPullback

end FunctorPullback

/-- Given a family of elements of a sieve `S` on `X` whose values factors through `F`, we can
realize it as a family of elements of `S.functor_pushforward F`. Since the preimage is obtained by
choice, this is not well-defined generally.
-/
noncomputable def FamilyOfElements.functorPushforward {D : Type u₂} [Category.{v₂} D] (F : D ⥤ C)
    {X : D} {T : Presieve X} (x : FamilyOfElements (F.op ⋙ P) T) :
    FamilyOfElements P (T.functorPushforward F) := fun Y f h =>
  by
  obtain ⟨Z, g, h, h₁, _⟩ := get_functor_pushforward_structure h
  exact P.map h.op (x g h₁)
#align category_theory.presieve.family_of_elements.functor_pushforward CategoryTheory.Presieve.FamilyOfElements.functorPushforward

section Pullback

/-- Given a family of elements of a sieve `S` on `X`, and a map `Y ⟶ X`, we can obtain a
family of elements of `S.pullback f` by taking the same elements.
-/
def FamilyOfElements.pullback (f : Y ⟶ X) (x : FamilyOfElements P S) :
    FamilyOfElements P (S.pullback f) := fun _ g hg => x (g ≫ f) hg
#align category_theory.presieve.family_of_elements.pullback CategoryTheory.Presieve.FamilyOfElements.pullback

theorem FamilyOfElements.Compatible.pullback (f : Y ⟶ X) {x : FamilyOfElements P S}
    (h : x.Compatible) : (x.pullback f).Compatible :=
  by
  simp only [compatible_iff_sieve_compatible] at h⊢
  intro W Z f₁ f₂ hf
  unfold family_of_elements.pullback
  rw [← h (f₁ ≫ f) f₂ hf]
  simp only [assoc]
#align category_theory.presieve.family_of_elements.compatible.pullback CategoryTheory.Presieve.FamilyOfElements.Compatible.pullback

end Pullback

/-- Given a morphism of presheaves `f : P ⟶ Q`, we can take a family of elements valued in `P` to a
family of elements valued in `Q` by composing with `f`.
-/
def FamilyOfElements.compPresheafMap (f : P ⟶ Q) (x : FamilyOfElements P R) :
    FamilyOfElements Q R := fun Y g hg => f.app (op Y) (x g hg)
#align category_theory.presieve.family_of_elements.comp_presheaf_map CategoryTheory.Presieve.FamilyOfElements.compPresheafMap

@[simp]
theorem FamilyOfElements.compPresheafMap_id (x : FamilyOfElements P R) :
    x.compPresheafMap (𝟙 P) = x :=
  rfl
#align category_theory.presieve.family_of_elements.comp_presheaf_map_id CategoryTheory.Presieve.FamilyOfElements.compPresheafMap_id

@[simp]
theorem FamilyOfElements.comp_prersheaf_map_comp (x : FamilyOfElements P R) (f : P ⟶ Q)
    (g : Q ⟶ U) : (x.compPresheafMap f).compPresheafMap g = x.compPresheafMap (f ≫ g) :=
  rfl
#align category_theory.presieve.family_of_elements.comp_prersheaf_map_comp CategoryTheory.Presieve.FamilyOfElements.comp_prersheaf_map_comp

theorem FamilyOfElements.Compatible.compPresheafMap (f : P ⟶ Q) {x : FamilyOfElements P R}
    (h : x.Compatible) : (x.compPresheafMap f).Compatible :=
  by
  intro Z₁ Z₂ W g₁ g₂ f₁ f₂ h₁ h₂ eq
  unfold family_of_elements.comp_presheaf_map
  rwa [← functor_to_types.naturality, ← functor_to_types.naturality, h]
#align category_theory.presieve.family_of_elements.compatible.comp_presheaf_map CategoryTheory.Presieve.FamilyOfElements.Compatible.compPresheafMap

/--
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 FamilyOfElements.IsAmalgamation (x : FamilyOfElements P R) (t : P.obj (op X)) : Prop :=
  ∀ ⦃Y : C⦄ (f : Y ⟶ X) (h : R f), P.map f.op t = x f h
#align category_theory.presieve.family_of_elements.is_amalgamation CategoryTheory.Presieve.FamilyOfElements.IsAmalgamation

theorem FamilyOfElements.IsAmalgamation.compPresheafMap {x : FamilyOfElements P R} {t} (f : P ⟶ Q)
    (h : x.IsAmalgamation t) : (x.compPresheafMap f).IsAmalgamation (f.app (op X) t) :=
  by
  intro Y g hg
  dsimp [family_of_elements.comp_presheaf_map]
  change (f.app _ ≫ Q.map _) _ = _
  simp [← f.naturality, h g hg]
#align category_theory.presieve.family_of_elements.is_amalgamation.comp_presheaf_map CategoryTheory.Presieve.FamilyOfElements.IsAmalgamation.compPresheafMap

theorem is_compatible_of_exists_amalgamation (x : FamilyOfElements P R)
    (h : ∃ t, x.IsAmalgamation t) : x.Compatible :=
  by
  cases' h with t ht
  intro 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
#align category_theory.presieve.is_compatible_of_exists_amalgamation CategoryTheory.Presieve.is_compatible_of_exists_amalgamation

theorem isAmalgamation_restrict {R₁ R₂ : Presieve X} (h : R₁ ≤ R₂) (x : FamilyOfElements P R₂)
    (t : P.obj (op X)) (ht : x.IsAmalgamation t) : (x.restrict h).IsAmalgamation t := fun Y f hf =>
  ht f (h Y hf)
#align category_theory.presieve.is_amalgamation_restrict CategoryTheory.Presieve.isAmalgamation_restrict

theorem isAmalgamation_sieveExtend {R : Presieve X} (x : FamilyOfElements P R) (t : P.obj (op X))
    (ht : x.IsAmalgamation t) : x.sieveExtend.IsAmalgamation t :=
  by
  intro Y f hf
  dsimp [family_of_elements.sieve_extend]
  rw [← ht _, ← functor_to_types.map_comp_apply, ← op_comp, hf.some_spec.some_spec.some_spec.2]
#align category_theory.presieve.is_amalgamation_sieve_extend CategoryTheory.Presieve.isAmalgamation_sieveExtend

/-- A presheaf is separated for a presieve if there is at most one amalgamation. -/
def IsSeparatedFor (P : Cᵒᵖ ⥤ Type w) (R : Presieve X) : Prop :=
  ∀ (x : FamilyOfElements P R) (t₁ t₂), x.IsAmalgamation t₁ → x.IsAmalgamation t₂ → t₁ = t₂
#align category_theory.presieve.is_separated_for CategoryTheory.Presieve.IsSeparatedFor

theorem IsSeparatedFor.ext {R : Presieve X} (hR : IsSeparatedFor 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 (fun Y f hf => P.map f.op t₂) t₁ t₂ (fun Y f hf => h hf) fun Y f hf => rfl
#align category_theory.presieve.is_separated_for.ext CategoryTheory.Presieve.IsSeparatedFor.ext

theorem isSeparatedFor_iff_generate : IsSeparatedFor P R ↔ IsSeparatedFor P (generate R) :=
  by
  constructor
  · intro 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₂
  · intro 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₂
#align category_theory.presieve.is_separated_for_iff_generate CategoryTheory.Presieve.isSeparatedFor_iff_generate

theorem isSeparatedFor_top (P : Cᵒᵖ ⥤ Type w) : IsSeparatedFor P (⊤ : Presieve X) :=
  fun x t₁ t₂ h₁ h₂ => by
  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₂]
#align category_theory.presieve.is_separated_for_top CategoryTheory.Presieve.isSeparatedFor_top

/-- 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 IsSheafFor (P : Cᵒᵖ ⥤ Type w) (R : Presieve X) : Prop :=
  ∀ x : FamilyOfElements P R, x.Compatible → ∃! t, x.IsAmalgamation t
#align category_theory.presieve.is_sheaf_for CategoryTheory.Presieve.IsSheafFor

/-- 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 YonedaSheafCondition (P : Cᵒᵖ ⥤ Type v₁) (S : Sieve X) : Prop :=
  ∀ f : S.Functor ⟶ P, ∃! g, S.functorInclusion ≫ g = f
#align category_theory.presieve.yoneda_sheaf_condition CategoryTheory.Presieve.YonedaSheafCondition

-- TODO: We can generalize the universe parameter v₁ above by composing with
-- appropriate `ulift_functor`s.
/-- (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 natTransEquivCompatibleFamily {P : Cᵒᵖ ⥤ Type v₁} :
    (S.Functor ⟶ P) ≃ { x : FamilyOfElements P S // x.Compatible }
    where
  toFun α := by
    refine' ⟨fun Y f hf => _, _⟩
    · apply α.app (op Y) ⟨_, hf⟩
    · rw [compatible_iff_sieve_compatible]
      intro Y Z f g hf
      dsimp
      rw [← functor_to_types.naturality _ _ α g.op]
      rfl
  invFun t :=
    { app := fun Y f => t.1 _ f.2
      naturality' := fun Y Z g => by
        ext ⟨f, hf⟩
        apply t.2.to_sieveCompatible _ }
  left_inv α := by
    ext (X⟨_, _⟩)
    rfl
  right_inv := by
    rintro ⟨x, hx⟩
    rfl
#align category_theory.presieve.nat_trans_equiv_compatible_family CategoryTheory.Presieve.natTransEquivCompatibleFamily

/-- (Implementation). A lemma useful to prove `yoneda_condition_iff_sheaf_condition`. -/
theorem extension_iff_amalgamation {P : Cᵒᵖ ⥤ Type v₁} (x : S.Functor ⟶ P) (g : yoneda.obj X ⟶ P) :
    S.functorInclusion ≫ g = x ↔
      (natTransEquivCompatibleFamily x).1.IsAmalgamation (yonedaEquiv g) :=
  by
  change _ ↔ ∀ ⦃Y : C⦄ (f : Y ⟶ X) (h : S f), P.map f.op (yoneda_equiv g) = x.app (op Y) ⟨f, h⟩
  constructor
  · 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
#align category_theory.presieve.extension_iff_amalgamation CategoryTheory.Presieve.extension_iff_amalgamation

-- See note [dsimp, simp].
/-- The yoneda version of the sheaf condition is equivalent to the sheaf condition.

C2.1.4 of [Elephant].
-/
theorem isSheafFor_iff_yonedaSheafCondition {P : Cᵒᵖ ⥤ Type v₁} :
    IsSheafFor P S ↔ YonedaSheafCondition P S :=
  by
  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
  intro x hx
  rw [Equiv.exists_unique_congr_left _]
  simp
#align category_theory.presieve.is_sheaf_for_iff_yoneda_sheaf_condition CategoryTheory.Presieve.isSheafFor_iff_yonedaSheafCondition

/--
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 IsSheafFor.extend {P : Cᵒᵖ ⥤ Type v₁} (h : IsSheafFor P S) (f : S.Functor ⟶ P) :
    yoneda.obj X ⟶ P :=
  (isSheafFor_iff_yonedaSheafCondition.1 h f).exists.some
#align category_theory.presieve.is_sheaf_for.extend CategoryTheory.Presieve.IsSheafFor.extend

/--
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.1]
theorem IsSheafFor.functorInclusion_comp_extend {P : Cᵒᵖ ⥤ Type v₁} (h : IsSheafFor P S)
    (f : S.Functor ⟶ P) : S.functorInclusion ≫ h.extend f = f :=
  (isSheafFor_iff_yonedaSheafCondition.1 h f).exists.choose_spec
#align category_theory.presieve.is_sheaf_for.functor_inclusion_comp_extend CategoryTheory.Presieve.IsSheafFor.functorInclusion_comp_extend

/-- The extension of `f` to `yoneda.obj X` is unique. -/
theorem IsSheafFor.unique_extend {P : Cᵒᵖ ⥤ Type v₁} (h : IsSheafFor P S) {f : S.Functor ⟶ P}
    (t : yoneda.obj X ⟶ P) (ht : S.functorInclusion ≫ t = f) : t = h.extend f :=
  (isSheafFor_iff_yonedaSheafCondition.1 h f).unique ht (h.functorInclusion_comp_extend f)
#align category_theory.presieve.is_sheaf_for.unique_extend CategoryTheory.Presieve.IsSheafFor.unique_extend

/--
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.
-/
theorem IsSheafFor.hom_ext {P : Cᵒᵖ ⥤ Type v₁} (h : IsSheafFor P S) (t₁ t₂ : yoneda.obj X ⟶ P)
    (ht : S.functorInclusion ≫ t₁ = S.functorInclusion ≫ t₂) : t₁ = t₂ :=
  (h.unique_extend t₁ ht).trans (h.unique_extend t₂ rfl).symm
#align category_theory.presieve.is_sheaf_for.hom_ext CategoryTheory.Presieve.IsSheafFor.hom_ext

/-- `P` is a sheaf for `R` iff it is separated for `R` and there exists an amalgamation. -/
theorem isSeparatedFor_and_exists_isAmalgamation_iff_sheaf_for :
    (IsSeparatedFor P R ∧ ∀ x : FamilyOfElements P R, x.Compatible → ∃ t, x.IsAmalgamation t) ↔
      IsSheafFor P R :=
  by
  rw [is_separated_for, ← forall_and]
  apply forall_congr'
  intro x
  constructor
  · intro z hx
    exact existsUnique_of_exists_of_unique (z.2 hx) z.1
  · intro h
    refine' ⟨_, ExistsUnique.exists ∘ h⟩
    intro t₁ t₂ ht₁ ht₂
    apply (h _).unique ht₁ ht₂
    exact is_compatible_of_exists_amalgamation x ⟨_, ht₂⟩
#align category_theory.presieve.is_separated_for_and_exists_is_amalgamation_iff_sheaf_for CategoryTheory.Presieve.isSeparatedFor_and_exists_isAmalgamation_iff_sheaf_for

/-- If `P` is separated for `R` and every family has an amalgamation, then `P` is a sheaf for `R`.
-/
theorem IsSeparatedFor.isSheafFor (t : IsSeparatedFor P R) :
    (∀ x : FamilyOfElements P R, x.Compatible → ∃ t, x.IsAmalgamation t) → IsSheafFor P R :=
  by
  rw [← is_separated_for_and_exists_is_amalgamation_iff_sheaf_for]
  exact And.intro t
#align category_theory.presieve.is_separated_for.is_sheaf_for CategoryTheory.Presieve.IsSeparatedFor.isSheafFor

/-- If `P` is a sheaf for `R`, it is separated for `R`. -/
theorem IsSheafFor.isSeparatedFor : IsSheafFor P R → IsSeparatedFor P R := fun q =>
  (isSeparatedFor_and_exists_isAmalgamation_iff_sheaf_for.2 q).1
#align category_theory.presieve.is_sheaf_for.is_separated_for CategoryTheory.Presieve.IsSheafFor.isSeparatedFor

/-- Get the amalgamation of the given compatible family, provided we have a sheaf. -/
noncomputable def IsSheafFor.amalgamate (t : IsSheafFor P R) (x : FamilyOfElements P R)
    (hx : x.Compatible) : P.obj (op X) :=
  (t x hx).exists.some
#align category_theory.presieve.is_sheaf_for.amalgamate CategoryTheory.Presieve.IsSheafFor.amalgamate

theorem IsSheafFor.isAmalgamation (t : IsSheafFor P R) {x : FamilyOfElements P R}
    (hx : x.Compatible) : x.IsAmalgamation (t.amalgamate x hx) :=
  (t x hx).exists.choose_spec
#align category_theory.presieve.is_sheaf_for.is_amalgamation CategoryTheory.Presieve.IsSheafFor.isAmalgamation

@[simp]
theorem IsSheafFor.valid_glue (t : IsSheafFor P R) {x : FamilyOfElements P R} (hx : x.Compatible)
    (f : Y ⟶ X) (Hf : R f) : P.map f.op (t.amalgamate x hx) = x f Hf :=
  t.IsAmalgamation hx f Hf
#align category_theory.presieve.is_sheaf_for.valid_glue CategoryTheory.Presieve.IsSheafFor.valid_glue

/-- C2.1.3 in [Elephant] -/
theorem isSheafFor_iff_generate (R : Presieve X) : IsSheafFor P R ↔ IsSheafFor P (generate R) :=
  by
  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 _)
  constructor
  · intro q x hx
    apply Exists.imp _ (q _ (hx.restrict (le_generate R)))
    intro t ht
    simpa [hx] using is_amalgamation_sieve_extend _ _ ht
  · intro q x hx
    apply Exists.imp _ (q _ hx.sieve_extend)
    intro t ht
    simpa [hx] using is_amalgamation_restrict (le_generate R) _ _ ht
#align category_theory.presieve.is_sheaf_for_iff_generate CategoryTheory.Presieve.isSheafFor_iff_generate

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

[Elephant] C2.1.5(i)
-/
theorem isSheafFor_singleton_iso (P : Cᵒᵖ ⥤ Type w) : IsSheafFor P (Presieve.singleton (𝟙 X)) :=
  by
  intro x hx
  refine' ⟨x _ (presieve.singleton_self _), _, _⟩
  · rintro _ _ ⟨rfl, rfl⟩
    simp
  · intro t ht
    simpa using ht _ (presieve.singleton_self _)
#align category_theory.presieve.is_sheaf_for_singleton_iso CategoryTheory.Presieve.isSheafFor_singletonₓ_iso

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

[Elephant] C2.1.5(ii)
-/
theorem isSheafFor_top_sieve (P : Cᵒᵖ ⥤ Type w) : IsSheafFor P ((⊤ : Sieve X) : Presieve X) :=
  by
  rw [← generate_of_singleton_is_split_epi (𝟙 X)]
  rw [← is_sheaf_for_iff_generate]
  apply is_sheaf_for_singleton_iso
#align category_theory.presieve.is_sheaf_for_top_sieve CategoryTheory.Presieve.isSheafFor_top_sieve

/-- 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.
-/
theorem isSheafFor_iso {P' : Cᵒᵖ ⥤ Type w} (i : P ≅ P') : IsSheafFor P R → IsSheafFor P' R :=
  by
  intro h x hx
  let x' := x.comp_presheaf_map i.inv
  have : x'.compatible := family_of_elements.compatible.comp_presheaf_map i.inv hx
  obtain ⟨t, ht1, ht2⟩ := h x' this
  use i.hom.app _ t
  fconstructor
  · convert family_of_elements.is_amalgamation.comp_presheaf_map i.hom ht1
    dsimp [x']
    simp
  · intro y hy
    rw [show y = (i.inv.app (op X) ≫ i.hom.app (op X)) y by simp]
    simp [ht2 (i.inv.app _ y) (family_of_elements.is_amalgamation.comp_presheaf_map i.inv hy)]
#align category_theory.presieve.is_sheaf_for_iso CategoryTheory.Presieve.isSheafFor_iso

/-- 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).
-/
theorem isSheafFor_subsieve_aux (P : Cᵒᵖ ⥤ Type w) {S : Sieve X} {R : Presieve X}
    (h : (S : Presieve X) ≤ R) (hS : IsSheafFor P S)
    (trans : ∀ ⦃Y⦄ ⦃f : Y ⟶ X⦄, R f → IsSeparatedFor P (S.pullback f)) : IsSheafFor P R :=
  by
  rw [← is_separated_for_and_exists_is_amalgamation_iff_sheaf_for]
  constructor
  · intro x t₁ t₂ ht₁ ht₂
    exact
      hS.is_separated_for _ _ _ (is_amalgamation_restrict h x t₁ ht₁)
        (is_amalgamation_restrict h x t₂ ht₂)
  · intro x hx
    use hS.amalgamate _ (hx.restrict h)
    intro W j hj
    apply (trans hj).ext
    intro 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
#align category_theory.presieve.is_sheaf_for_subsieve_aux CategoryTheory.Presieve.isSheafFor_subsieve_aux

/--
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.
-/
theorem isSheafFor_subsieve (P : Cᵒᵖ ⥤ Type w) {S : Sieve X} {R : Presieve X}
    (h : (S : Presieve X) ≤ R) (trans : ∀ ⦃Y⦄ (f : Y ⟶ X), IsSheafFor P (S.pullback f)) :
    IsSheafFor P R :=
  isSheafFor_subsieve_aux P h (by simpa using trans (𝟙 _)) fun Y f hf => (trans f).IsSeparatedFor
#align category_theory.presieve.is_sheaf_for_subsieve CategoryTheory.Presieve.isSheafFor_subsieve

/-- A presheaf is separated for a topology if it is separated for every sieve in the topology. -/
def IsSeparated (P : Cᵒᵖ ⥤ Type w) : Prop :=
  ∀ {X} (S : Sieve X), S ∈ J X → IsSeparatedFor P S
#align category_theory.presieve.is_separated CategoryTheory.Presieve.IsSeparated

/-- 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 IsSheaf (P : Cᵒᵖ ⥤ Type w) : Prop :=
  ∀ ⦃X⦄ (S : Sieve X), S ∈ J X → IsSheafFor P S
#align category_theory.presieve.is_sheaf CategoryTheory.Presieve.IsSheaf

theorem IsSheaf.isSheafFor {P : Cᵒᵖ ⥤ Type w} (hp : IsSheaf J P) (R : Presieve X)
    (hr : generate R ∈ J X) : IsSheafFor P R :=
  (isSheafFor_iff_generate R).2 <| hp _ hr
#align category_theory.presieve.is_sheaf.is_sheaf_for CategoryTheory.Presieve.IsSheaf.isSheafFor

theorem isSheaf_of_le (P : Cᵒᵖ ⥤ Type w) {J₁ J₂ : GrothendieckTopology C} :
    J₁ ≤ J₂ → IsSheaf J₂ P → IsSheaf J₁ P := fun h t X S hS => t S (h _ hS)
#align category_theory.presieve.is_sheaf_of_le CategoryTheory.Presieve.isSheaf_of_le

theorem isSeparated_of_isSheaf (P : Cᵒᵖ ⥤ Type w) (h : IsSheaf J P) : IsSeparated J P :=
  fun X S hS => (h S hS).IsSeparatedFor
#align category_theory.presieve.is_separated_of_is_sheaf CategoryTheory.Presieve.isSeparated_of_isSheaf

/-- The property of being a sheaf is preserved by isomorphism. -/
theorem isSheaf_iso {P' : Cᵒᵖ ⥤ Type w} (i : P ≅ P') (h : IsSheaf J P) : IsSheaf J P' :=
  fun X S hS => isSheafFor_iso i (h S hS)
#align category_theory.presieve.is_sheaf_iso CategoryTheory.Presieve.isSheaf_iso

theorem isSheaf_of_yoneda {P : Cᵒᵖ ⥤ Type v₁}
    (h : ∀ {X} (S : Sieve X), S ∈ J X → YonedaSheafCondition P S) : IsSheaf J P := fun X S hS =>
  isSheafFor_iff_yonedaSheafCondition.2 (h _ hS)
#align category_theory.presieve.is_sheaf_of_yoneda CategoryTheory.Presieve.isSheaf_of_yoneda

/-- For a topology generated by a basis, it suffices to check the sheaf condition on the basis
presieves only.
-/
theorem isSheaf_pretopology [HasPullbacks C] (K : Pretopology C) :
    IsSheaf (K.toGrothendieck C) P ↔ ∀ {X : C} (R : Presieve X), R ∈ K X → IsSheafFor P R :=
  by
  constructor
  · intro 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 := by
      apply gi_generate.gc.monotone_u
      rwa [sets_iff_generate]
    apply is_sheaf_for_subsieve P gRS _
    intro Y f
    rw [← pullback_arrows_comm, ← is_sheaf_for_iff_generate]
    exact PK (pullback_arrows f R) (K.pullbacks f R hR)
#align category_theory.presieve.is_sheaf_pretopology CategoryTheory.Presieve.isSheaf_pretopology

/-- Any presheaf is a sheaf for the bottom (trivial) grothendieck topology. -/
theorem isSheaf_bot : IsSheaf (⊥ : GrothendieckTopology C) P := fun X => by
  simp [is_sheaf_for_top_sieve]
#align category_theory.presieve.is_sheaf_bot CategoryTheory.Presieve.isSheaf_bot

end Presieve

namespace Equalizer

variable {C : Type u₁} [Category.{v₁} C] (P : Cᵒᵖ ⥤ Type max v₁ u₁) {X : C} (R : Presieve X)
  (S : Sieve X)

noncomputable section

/--
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 FirstObj : Type max v₁ u₁ :=
  ∏ fun f : ΣY, { f : Y ⟶ X // R f } => P.obj (op f.1)
#align category_theory.equalizer.first_obj CategoryTheory.Equalizer.FirstObj

/-- Show that `first_obj` is isomorphic to `family_of_elements`. -/
@[simps]
def firstObjEqFamily : FirstObj P R ≅ R.FamilyOfElements P
    where
  Hom t Y f hf := Pi.π (fun f : ΣY, { f : Y ⟶ X // R f } => P.obj (op f.1)) ⟨_, _, hf⟩ t
  inv := Pi.lift fun f x => x _ f.2.2
  hom_inv_id' := by
    ext (⟨Y, f, hf⟩p)
    simpa
  inv_hom_id' := by
    ext (x Y f hf)
    apply limits.types.limit.lift_π_apply'
#align category_theory.equalizer.first_obj_eq_family CategoryTheory.Equalizer.firstObjEqFamily

instance : Inhabited (FirstObj P (⊥ : Presieve X)) :=
  (firstObjEqFamily P _).toEquiv.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 forkMap : P.obj (op X) ⟶ FirstObj P R :=
  Pi.lift fun f => P.map f.2.1.op
#align category_theory.equalizer.fork_map CategoryTheory.Equalizer.forkMap

/-!
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 SecondObj : Type max v₁ u₁ :=
  ∏ fun f : Σ(Y Z : _)(g : Z ⟶ Y), { f' : Y ⟶ X // S f' } => P.obj (op f.2.1)
#align category_theory.equalizer.sieve.second_obj CategoryTheory.Equalizer.Sieve.SecondObj

/-- The map `p` of Equations (3,4) [MM92]. -/
def firstMap : FirstObj P S ⟶ SecondObj P S :=
  Pi.lift fun fg =>
    Pi.π _ (⟨_, _, S.downward_closed fg.2.2.2.2 fg.2.2.1⟩ : ΣY, { f : Y ⟶ X // S f })
#align category_theory.equalizer.sieve.first_map CategoryTheory.Equalizer.Sieve.firstMap

instance : Inhabited (SecondObj P (⊥ : Sieve X)) :=
  ⟨firstMap _ _ default⟩

/-- The map `a` of Equations (3,4) [MM92]. -/
def secondMap : FirstObj P S ⟶ SecondObj P S :=
  Pi.lift fun fg => Pi.π _ ⟨_, fg.2.2.2⟩ ≫ P.map fg.2.2.1.op
#align category_theory.equalizer.sieve.second_map CategoryTheory.Equalizer.Sieve.secondMap

theorem w : forkMap P S ≫ firstMap P S = forkMap P S ≫ secondMap P S :=
  by
  apply limit.hom_ext
  rintro ⟨Y, Z, g, f, hf⟩
  simp [first_map, second_map, fork_map]
#align category_theory.equalizer.sieve.w CategoryTheory.Equalizer.Sieve.w

/--
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.
-/
theorem compatible_iff (x : FirstObj P S) :
    ((firstObjEqFamily P S).Hom x).Compatible ↔ firstMap P S x = secondMap P S x :=
  by
  rw [presieve.compatible_iff_sieve_compatible]
  constructor
  · intro t
    ext ⟨Y, Z, g, f, hf⟩
    simpa [first_map, second_map] using t _ g hf
  · intro 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⟩⟩
#align category_theory.equalizer.sieve.compatible_iff CategoryTheory.Equalizer.Sieve.compatible_iff

/-- `P` is a sheaf for `S`, iff the fork given by `w` is an equalizer. -/
theorem equalizer_sheaf_condition :
    Presieve.IsSheafFor P S ↔ Nonempty (IsLimit (Fork.ofι _ (w P S))) :=
  by
  rw [types.type_equalizer_iff_unique, ←
    Equiv.forall_congr_left (first_obj_eq_family P S).toEquiv.symm]
  simp_rw [← compatible_iff]
  simp only [inv_hom_id_apply, iso.to_equiv_symm_fun]
  apply ball_congr
  intro x tx
  apply existsUnique_congr
  intro t
  rw [← iso.to_equiv_symm_fun]
  rw [Equiv.eq_symm_apply]
  constructor
  · intro q
    ext (Y f hf)
    simpa [first_obj_eq_family, fork_map] using q _ _
  · intro q Y f hf
    rw [← q]
    simp [first_obj_eq_family, fork_map]
#align category_theory.equalizer.sieve.equalizer_sheaf_condition CategoryTheory.Equalizer.Sieve.equalizer_sheaf_condition

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

variable [HasPullbacks 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 SecondObj : Type max v₁ u₁ :=
  ∏ fun 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))
#align category_theory.equalizer.presieve.second_obj CategoryTheory.Equalizer.Presieve.SecondObj

/-- The map `pr₀*` of <https://stacks.math.columbia.edu/tag/00VL>. -/
def firstMap : FirstObj P R ⟶ SecondObj P R :=
  Pi.lift fun fg => Pi.π _ _ ≫ P.map pullback.fst.op
#align category_theory.equalizer.presieve.first_map CategoryTheory.Equalizer.Presieve.firstMap

instance : Inhabited (SecondObj P (⊥ : Presieve X)) :=
  ⟨firstMap _ _ default⟩

/-- The map `pr₁*` of <https://stacks.math.columbia.edu/tag/00VL>. -/
def secondMap : FirstObj P R ⟶ SecondObj P R :=
  Pi.lift fun fg => Pi.π _ _ ≫ P.map pullback.snd.op
#align category_theory.equalizer.presieve.second_map CategoryTheory.Equalizer.Presieve.secondMap

theorem w : forkMap P R ≫ firstMap P R = forkMap P R ≫ secondMap P R :=
  by
  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
#align category_theory.equalizer.presieve.w CategoryTheory.Equalizer.Presieve.w

/--
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.
-/
theorem compatible_iff (x : FirstObj P R) :
    ((firstObjEqFamily P R).Hom x).Compatible ↔ firstMap P R x = secondMap P R x :=
  by
  rw [presieve.pullback_compatible_iff]
  constructor
  · intro t
    ext ⟨⟨Y, f, hf⟩, Z, g, hg⟩
    simpa [first_map, second_map] using t hf hg
  · intro 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⟩⟩
#align category_theory.equalizer.presieve.compatible_iff CategoryTheory.Equalizer.Presieve.compatible_iff

/-- `P` is a sheaf for `R`, iff the fork given by `w` is an equalizer.
See <https://stacks.math.columbia.edu/tag/00VM>.
-/
theorem sheaf_condition : R.IsSheafFor P ↔ Nonempty (IsLimit (Fork.ofι _ (w P R))) :=
  by
  rw [types.type_equalizer_iff_unique]
  erw [← Equiv.forall_congr_left (first_obj_eq_family P R).toEquiv.symm]
  simp_rw [← compatible_iff, ← iso.to_equiv_fun, Equiv.apply_symm_apply]
  apply ball_congr
  intro x hx
  apply existsUnique_congr
  intro t
  rw [Equiv.eq_symm_apply]
  constructor
  · intro q
    ext (Y f hf)
    simpa [fork_map] using q _ _
  · intro q Y f hf
    rw [← q]
    simp [fork_map]
#align category_theory.equalizer.presieve.sheaf_condition CategoryTheory.Equalizer.Presieve.sheaf_condition

end Presieve

end Equalizer

variable {C : Type u₁} [Category.{v₁} C]

variable (J : GrothendieckTopology C)

/-- The category of sheaves on a grothendieck topology. -/
structure SheafOfTypes (J : GrothendieckTopology C) : Type max u₁ v₁ (w + 1) where
  val : Cᵒᵖ ⥤ Type w
  cond : Presieve.IsSheaf J val
#align category_theory.SheafOfTypes CategoryTheory.SheafOfTypes

namespace SheafOfTypes

variable {J}

/-- Morphisms between sheaves of types are just morphisms between the underlying presheaves. -/
@[ext]
structure Hom (X Y : SheafOfTypes J) where
  val : X.val ⟶ Y.val
#align category_theory.SheafOfTypes.hom CategoryTheory.SheafOfTypes.Hom

@[simps]
instance : Category (SheafOfTypes J) where
  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 : SheafOfTypes J) : Inhabited (Hom X X) :=
  ⟨𝟙 X⟩

end SheafOfTypes

/-- The inclusion functor from sheaves to presheaves. -/
@[simps]
def sheafOfTypesToPresheaf : SheafOfTypes J ⥤ Cᵒᵖ ⥤ Type w
    where
  obj := SheafOfTypes.val
  map X Y f := f.val
  map_id' X := rfl
  map_comp' X Y Z f g := rfl
#align category_theory.SheafOfTypes_to_presheaf CategoryTheory.sheafOfTypesToPresheaf

instance : Full (sheafOfTypesToPresheaf J) where Preimage X Y f := ⟨f⟩

instance : Faithful (sheafOfTypesToPresheaf J) where

/--
The category of sheaves on the bottom (trivial) grothendieck topology is equivalent to the category
of presheaves.
-/
@[simps]
def sheafOfTypesBotEquiv : SheafOfTypes (⊥ : GrothendieckTopology C) ≌ Cᵒᵖ ⥤ Type w
    where
  Functor := sheafOfTypesToPresheaf _
  inverse :=
    { obj := fun P => ⟨P, Presieve.isSheaf_bot⟩
      map := fun P₁ P₂ f => (sheafOfTypesToPresheaf _).Preimage f }
  unitIso :=
    { Hom := { app := fun _ => ⟨𝟙 _⟩ }
      inv := { app := fun _ => ⟨𝟙 _⟩ } }
  counitIso := Iso.refl _
#align category_theory.SheafOfTypes_bot_equiv CategoryTheory.sheafOfTypesBotEquiv

instance : Inhabited (SheafOfTypes (⊥ : GrothendieckTopology C)) :=
  ⟨sheafOfTypesBotEquiv.inverse.obj ((Functor.const _).obj PUnit)⟩

end CategoryTheory


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

import data.polynomial.algebra_map
import algebra.algebra.subalgebra
import algebra.polynomial.big_operators
import data.polynomial.erase_lead

/-!
# Polynomials that lift

Given semirings `R` and `S` with a morphism `f : R →+* S`, we define a subsemiring `lifts` of
`polynomial S` by the image of `ring_hom.of (map f)`.
Then, we prove that a polynomial that lifts can always be lifted to a polynomial of the same degree
and that a monic polynomial that lifts can be lifted to a monic polynomial (of the same degree).

## Main definition

* `lifts (f : R →+* S)` : the subsemiring of polynomials that lift.

## Main results

* `lifts_and_degree_eq` : A polynomial lifts if and only if it can be lifted to a polynomial
of the same degree.
* `lifts_and_degree_eq_and_monic` : A monic polynomial lifts if and only if it can be lifted to a
monic polynomial of the same degree.
* `lifts_iff_alg` : if `R` is commutative, a polynomial lifts if and only if it is in the image of
`map_alg`, where `map_alg : polynomial R →ₐ[R] polynomial S` is the only `R`-algebra map
that sends `X` to `X`.

## Implementation details

In general `R` and `S` are semiring, so `lifts` is a semiring. In the case of rings, see
`lifts_iff_lifts_ring`.

Since we do not assume `R` to be commutative, we cannot say in general that the set of polynomials
that lift is a subalgebra. (By `lift_iff` this is true if `R` is commutative.)

-/

open_locale classical big_operators
noncomputable theory

namespace polynomial
universes u v w

section semiring

variables {R : Type u} [semiring R] {S : Type v} [semiring S] {f : R →+* S}

/-- We define the subsemiring of polynomials that lifts as the image of `ring_hom.of (map f)`. -/
def lifts (f : R →+* S) : subsemiring (polynomial S) := ring_hom.srange (ring_hom.of (map f))

lemma mem_lifts (p : polynomial S) : p ∈ lifts f ↔ ∃ (q : polynomial R), map f q = p :=
by simp only [lifts, ring_hom.coe_of, ring_hom.mem_srange]

lemma lifts_iff_coeff_lifts (p : polynomial S) : p ∈ lifts f ↔ ∀ (n : ℕ), p.coeff n ∈ set.range f :=
by rw [lifts_iff_set_range, mem_map_range]

/--If `(r : R)`, then `C (f r)` lifts. -/
lemma C_mem_lifts (f : R →+* S) (r : R) : (C (f r)) ∈ lifts f :=
⟨C r, by simp only [map_C, set.mem_univ, subsemiring.coe_top, eq_self_iff_true,
  ring_hom.coe_of, and_self]⟩

/-- If `(s : S)` is in the image of `f`, then `C s` lifts. -/
lemma C'_mem_lifts {f : R →+* S} {s : S} (h : s ∈ set.range f) : (C s) ∈ lifts f :=
begin
  obtain ⟨r, rfl⟩ := set.mem_range.1 h,
  use C r,
  simp only [map_C, set.mem_univ, subsemiring.coe_top, eq_self_iff_true, ring_hom.coe_of, and_self]
end

/-- The polynomial `X` lifts. -/
lemma X_mem_lifts (f : R →+* S) : (X : polynomial S) ∈ lifts f :=
⟨X, by simp only [set.mem_univ, subsemiring.coe_top, eq_self_iff_true, map_X,
  ring_hom.coe_of, and_self]⟩

/-- The polynomial `X ^ n` lifts. -/
lemma X_pow_mem_lifts (f : R →+* S) (n : ℕ) : (X ^ n : polynomial S) ∈ lifts f :=
⟨X ^ n, by simp only [map_pow, set.mem_univ, subsemiring.coe_top, eq_self_iff_true, map_X,
  ring_hom.coe_of, and_self]⟩

/-- If `p` lifts and `(r : R)` then `r * p` lifts. -/
lemma base_mul_mem_lifts {p : polynomial S} (r : R) (hp : p ∈ lifts f) : C (f r) * p ∈ lifts f :=
begin
  simp only [lifts, ring_hom.coe_of, ring_hom.mem_srange] at hp ⊢,
  obtain ⟨p₁, rfl⟩ := hp,
  use C r * p₁,
  simp only [map_C, map_mul]
end

/-- If `(s : S)` is in the image of `f`, then `monomial n s` lifts. -/
lemma monomial_mem_lifts {s : S} (n : ℕ) (h : s ∈ set.range f) : (monomial n s) ∈ lifts f :=
begin
  obtain ⟨r, rfl⟩ := set.mem_range.1 h,
  use monomial n r,
  simp only [set.mem_univ, map_monomial, subsemiring.coe_top, eq_self_iff_true, ring_hom.coe_of,
  and_self],
end

/-- If `p` lifts then `p.erase n` lifts. -/
lemma erase_mem_lifts {p : polynomial S} (n : ℕ) (h : p ∈ lifts f) : p.erase n ∈ lifts f :=
begin
  rw [lifts_iff_set_range, mem_map_range, coeff] at h ⊢,
  intros k,
  by_cases hk : k = n,
  { use 0,
    simp only [hk, ring_hom.map_zero, finsupp.erase_same] },
  obtain ⟨i, hi⟩ := h k,
  use i,
  simp only [hi, hk, finsupp.erase_ne, ne.def, not_false_iff],
end

section lift_deg

lemma monomial_mem_lifts_and_degree_eq {s : S} {n : ℕ} (hl : monomial n s ∈ lifts f) :
  ∃ (q : polynomial R), map f q = (monomial n s) ∧ q.degree = (monomial n s).degree :=
begin
  by_cases hzero : s = 0,
  { use 0,
    simp only [hzero, degree_zero, eq_self_iff_true, and_self, monomial_zero_right, map_zero] },
  rw lifts_iff_set_range at hl,
  obtain ⟨q, hq⟩ := hl,
  replace hq := (ext_iff.1 hq) n,
  have hcoeff : f (q.coeff n) = s,
  { simp [coeff_monomial] at hq,
    exact hq },
  use (monomial n (q.coeff n)),
  split,
  { simp only [hcoeff, map_monomial] },
  have hqzero : q.coeff n ≠ 0,
  { intro habs,
    simp only [habs, ring_hom.map_zero] at hcoeff,
    exact hzero hcoeff.symm },
  repeat {rw single_eq_C_mul_X},
  simp only [hzero, hqzero, ne.def, not_false_iff, degree_C_mul_X_pow],
end

/-- A polynomial lifts if and only if it can be lifted to a polynomial of the same degree. -/
lemma mem_lifts_and_degree_eq {p : polynomial S} (hlifts : p ∈ lifts f) :
  ∃ (q : polynomial R), map f q = p ∧ q.degree = p.degree :=
begin
  generalize' hd : p.nat_degree = d,
  revert hd p,
  apply nat.strong_induction_on d,
  intros n hn p hlifts hdeg,
  by_cases erase_zero : p.erase_lead = 0,
  { rw [← erase_lead_add_monomial_nat_degree_leading_coeff p, erase_zero, zero_add, leading_coeff],
    exact monomial_mem_lifts_and_degree_eq (monomial_mem_lifts p.nat_degree
    ((lifts_iff_coeff_lifts p).1 hlifts p.nat_degree)) },
  have deg_erase := or.resolve_right (erase_lead_nat_degree_lt_or_erase_lead_eq_zero p) erase_zero,
  have pzero : p ≠ 0,
  { intro habs,
    exfalso,
    rw [habs, erase_lead_zero, eq_self_iff_true, not_true] at erase_zero,
    exact erase_zero },
  have lead_zero : p.coeff p.nat_degree ≠ 0,
  { rw [← leading_coeff, ne.def, leading_coeff_eq_zero]; exact pzero },
  obtain ⟨lead, hlead⟩ := monomial_mem_lifts_and_degree_eq (monomial_mem_lifts p.nat_degree
    ((lifts_iff_coeff_lifts p).1 hlifts p.nat_degree)),
  have deg_lead : lead.degree = p.nat_degree,
  { rw [hlead.2, single_eq_C_mul_X, degree_C_mul_X_pow p.nat_degree lead_zero] },
  rw hdeg at deg_erase,
  obtain ⟨erase, herase⟩ := hn p.erase_lead.nat_degree deg_erase
    (erase_mem_lifts p.nat_degree hlifts) (refl p.erase_lead.nat_degree),
  use erase + lead,
  split,
  { simp only [hlead, herase, map_add],
    nth_rewrite 0 erase_lead_add_monomial_nat_degree_leading_coeff p },
  rw [←hdeg, erase_lead] at deg_erase,
  replace deg_erase := lt_of_le_of_lt degree_le_nat_degree (with_bot.coe_lt_coe.2 deg_erase),
  rw [← deg_lead, ← herase.2] at deg_erase,
  rw [degree_add_eq_right_of_degree_lt deg_erase, deg_lead, degree_eq_nat_degree pzero]
end

end lift_deg

section monic

/-- A monic polynomial lifts if and only if it can be lifted to a monic polynomial
of the same degree. -/
lemma lifts_and_degree_eq_and_monic [nontrivial S] {p : polynomial S} (hlifts :p ∈ lifts f)
  (hmonic : p.monic) : ∃ (q : polynomial R), map f q = p ∧ q.degree = p.degree ∧ q.monic :=
begin
  by_cases Rtrivial : nontrivial R,
  swap,
  { rw not_nontrivial_iff_subsingleton at Rtrivial,
    obtain ⟨q, hq⟩ := mem_lifts_and_degree_eq hlifts,
    use q,
    exact ⟨hq.1, hq.2, @monic_of_subsingleton _ _ Rtrivial q⟩ },
  by_cases er_zero : p.erase_lead = 0,
  { rw [← erase_lead_add_C_mul_X_pow p, er_zero, zero_add, monic.def.1 hmonic, C_1, one_mul],
    use X ^ p.nat_degree,
    repeat {split},
    { simp only [map_pow, map_X] },
    { rw [@degree_X_pow R _ Rtrivial, degree_X_pow] },
    {exact monic_pow monic_X p.nat_degree } },
  obtain ⟨q, hq⟩ := mem_lifts_and_degree_eq (erase_mem_lifts p.nat_degree hlifts),
  have deg_er : p.erase_lead.nat_degree < p.nat_degree :=
    or.resolve_right (erase_lead_nat_degree_lt_or_erase_lead_eq_zero p) er_zero,
  replace deg_er := with_bot.coe_lt_coe.2 deg_er,
  rw [← degree_eq_nat_degree er_zero, erase_lead, ← hq.2,
    ← @degree_X_pow R _ Rtrivial p.nat_degree] at deg_er,
  use q + X ^ p.nat_degree,
  repeat {split},
  { simp only [hq, map_add, map_pow, map_X],
    nth_rewrite 3 [← erase_lead_add_C_mul_X_pow p],
    rw [erase_lead, monic.leading_coeff hmonic, C_1, one_mul] },
  { rw [degree_add_eq_right_of_degree_lt deg_er, @degree_X_pow R _ Rtrivial p.nat_degree,
    degree_eq_nat_degree (monic.ne_zero hmonic)] },
  { rw [monic.def, leading_coeff_add_of_degree_lt deg_er],
    exact monic_pow monic_X p.nat_degree }
end

end monic

end semiring

section ring

variables {R : Type u} [ring R] {S : Type v} [ring S] (f : R →+* S)

/-- The subring of polynomials that lift. -/
def lifts_ring (f : R →+* S) : subring (polynomial S) := ring_hom.range (ring_hom.of (map f))

/-- If `R` and `S` are rings, `p` is in the subring of polynomials that lift if and only if it is in
the subsemiring of polynomials that lift. -/
lemma lifts_iff_lifts_ring (p : polynomial S) : p ∈ lifts f ↔ p ∈ lifts_ring f :=
by simp only [lifts, lifts_ring, ring_hom.mem_range, ring_hom.mem_srange]

end ring

section algebra

variables {R : Type u} [comm_semiring R] {S : Type v} [semiring S] [algebra R S]

/-- The map `polynomial R → polynomial S` as an algebra homomorphism. -/
def map_alg (R : Type u) [comm_semiring R] (S : Type v) [semiring S] [algebra R S] :
  polynomial R →ₐ[R] polynomial S := @aeval _ (polynomial S) _ _ _ (X : polynomial S)

/-- `map_alg` is the morphism induced by `R → S`. -/
lemma map_alg_eq_map (p : polynomial R) : map_alg R S p = map (algebra_map R S) p :=
by simp only [map_alg, aeval_def, eval₂, map, algebra_map_apply, ring_hom.coe_comp]

/-- A polynomial `p` lifts if and only if it is in the image of `map_alg`. -/
lemma mem_lifts_iff_mem_alg (R : Type u) [comm_semiring R] {S : Type v} [semiring S] [algebra R S]
  (p : polynomial S) :p ∈ lifts (algebra_map R S) ↔ p ∈ (alg_hom.range (@map_alg R _ S _ _)) :=
by simp only [lifts, map_alg_eq_map, alg_hom.mem_range, ring_hom.coe_of, ring_hom.mem_srange]

/-- If `p` lifts and `(r : R)` then `r • p` lifts. -/
lemma smul_mem_lifts {p : polynomial S} (r : R) (hp : p ∈ lifts (algebra_map R S)) :
  r • p ∈ lifts (algebra_map R S) :=
by { rw mem_lifts_iff_mem_alg at hp ⊢, exact subalgebra.smul_mem (map_alg R S).range hp r }

end algebra

end polynomial


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import ring_theory.int.basic
import algebra.field_power
import ring_theory.multiplicity
import data.real.cau_seq
import tactic.ring_exp
import tactic.basic

/-!
# p-adic norm

This file defines the p-adic valuation and the p-adic norm on ℚ.

The p-adic valuation on ℚ is the difference of the multiplicities of `p` in the numerator and
denominator of `q`. This function obeys the standard properties of a valuation, with the appropriate
assumptions on p.

The valuation induces a norm on ℚ. This norm is a nonarchimedean absolute value.
It takes values in {0} ∪ {1/p^k | k ∈ ℤ}.

## Notations

This file uses the local notation `/.` for `rat.mk`.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[fact (prime p)]` as a type class argument.

## References

* [F. Q. Gouêva, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, norm, valuation
-/

universe u

open nat

open_locale rat

open multiplicity

/--
For `p ≠ 1`, the p-adic valuation of an integer `z ≠ 0` is the largest natural number `n` such that
p^n divides z.

`padic_val_rat` defines the valuation of a rational `q` to be the valuation of `q.num` minus the
valuation of `q.denom`.
If `q = 0` or `p = 1`, then `padic_val_rat p q` defaults to 0.
-/
def padic_val_rat (p : ℕ) (q : ℚ) : ℤ :=
if h : q ≠ 0 ∧ p ≠ 1
then (multiplicity (p : ℤ) q.num).get
    (multiplicity.finite_int_iff.2 ⟨h.2, rat.num_ne_zero_of_ne_zero h.1⟩) -
  (multiplicity (p : ℤ) q.denom).get
    (multiplicity.finite_int_iff.2 ⟨h.2, by exact_mod_cast rat.denom_ne_zero _⟩)
else 0

/--
A simplification of the definition of `padic_val_rat p q` when `q ≠ 0` and `p` is prime.
-/
lemma padic_val_rat_def (p : ℕ) [hp : fact p.prime] {q : ℚ} (hq : q ≠ 0) : padic_val_rat p q =
  (multiplicity (p : ℤ) q.num).get (finite_int_iff.2 ⟨hp.1.ne_one, rat.num_ne_zero_of_ne_zero hq⟩) -
  (multiplicity (p : ℤ) q.denom).get
    (finite_int_iff.2 ⟨hp.1.ne_one, by exact_mod_cast rat.denom_ne_zero _⟩) :=
dif_pos ⟨hq, hp.1.ne_one⟩

namespace padic_val_rat
open multiplicity
variables {p : ℕ}

/--
`padic_val_rat p q` is symmetric in `q`.
-/
@[simp] protected lemma neg (q : ℚ) : padic_val_rat p (-q) = padic_val_rat p q :=
begin
  unfold padic_val_rat,
  split_ifs,
  { simp [-add_comm]; refl },
  { exfalso, simp * at * },
  { exfalso, simp * at * },
  { refl }
end

/--
`padic_val_rat p 1` is 0 for any `p`.
-/
@[simp] protected lemma one : padic_val_rat p 1 = 0 :=
by unfold padic_val_rat; split_ifs; simp *

/--
For `p ≠ 0, p ≠ 1, `padic_val_rat p p` is 1.
-/
@[simp] lemma padic_val_rat_self (hp : 1 < p) : padic_val_rat p p = 1 :=
by unfold padic_val_rat; split_ifs; simp [*, nat.one_lt_iff_ne_zero_and_ne_one] at *

/--
The p-adic value of an integer `z ≠ 0` is the multiplicity of `p` in `z`.
-/
lemma padic_val_rat_of_int (z : ℤ) (hp : p ≠ 1) (hz : z ≠ 0) :
  padic_val_rat p (z : ℚ) = (multiplicity (p : ℤ) z).get
    (finite_int_iff.2 ⟨hp, hz⟩) :=
by rw [padic_val_rat, dif_pos]; simp *; refl

end padic_val_rat

/--
A convenience function for the case of `padic_val_rat` when both inputs are natural numbers.
-/
def padic_val_nat (p : ℕ) (n : ℕ) : ℕ :=
int.to_nat (padic_val_rat p n)

section padic_val_nat

/--
`padic_val_nat` is defined as an `int.to_nat` cast;
this lemma ensures that the cast is well-behaved.
-/
lemma zero_le_padic_val_rat_of_nat (p n : ℕ) : 0 ≤ padic_val_rat p n :=
begin
  unfold padic_val_rat,
  split_ifs,
  { simp, },
  { trivial, },
end

/--
`padic_val_rat` coincides with `padic_val_nat`.
-/
@[simp, norm_cast] lemma padic_val_rat_of_nat (p n : ℕ) :
  ↑(padic_val_nat p n) = padic_val_rat p n :=
begin
  unfold padic_val_nat,
  rw int.to_nat_of_nonneg (zero_le_padic_val_rat_of_nat p n),
end

/--
A simplification of `padic_val_nat` when one input is prime, by analogy with `padic_val_rat_def`.
-/
lemma padic_val_nat_def {p : ℕ} [hp : fact p.prime] {n : ℕ} (hn : n ≠ 0) :
  padic_val_nat p n =
  (multiplicity p n).get
    (multiplicity.finite_nat_iff.2 ⟨nat.prime.ne_one hp.1, bot_lt_iff_ne_bot.mpr hn⟩) :=
begin
  have n_nonzero : (n : ℚ) ≠ 0, by simpa only [cast_eq_zero, ne.def],
  -- Infinite loop with @simp padic_val_rat_of_nat unless we restrict the available lemmas here,
  -- hence the very long list
  simpa only
    [ int.coe_nat_multiplicity p n, rat.coe_nat_denom n, (padic_val_rat_of_nat p n).symm,
      int.coe_nat_zero, int.coe_nat_inj', sub_zero, get_one_right, int.coe_nat_succ, zero_add,
      rat.coe_nat_num ]
    using padic_val_rat_def p n_nonzero,
end

lemma one_le_padic_val_nat_of_dvd
  {n p : nat} [prime : fact p.prime] (nonzero : n ≠ 0) (div : p ∣ n) :
  1 ≤ padic_val_nat p n :=
begin
  rw @padic_val_nat_def _ prime _ nonzero,
  let one_le_mul : _ ≤ multiplicity p n :=
    @multiplicity.le_multiplicity_of_pow_dvd _ _ _ p n 1 (begin norm_num, exact div end),
  simp only [enat.coe_one] at one_le_mul,
  rcases one_le_mul with ⟨_, q⟩,
  dsimp at q,
  solve_by_elim,
end

@[simp]
lemma padic_val_nat_zero (m : nat) : padic_val_nat m 0 = 0 := by simpa

@[simp]
lemma padic_val_nat_one (m : nat) : padic_val_nat m 1 = 0 := by simp [padic_val_nat]

end padic_val_nat

namespace padic_val_rat
open multiplicity
variables (p : ℕ) [p_prime : fact p.prime]
include p_prime

/--
The multiplicity of `p : ℕ` in `a : ℤ` is finite exactly when `a ≠ 0`.
-/
lemma finite_int_prime_iff {p : ℕ} [p_prime : fact p.prime] {a : ℤ} : finite (p : ℤ) a ↔ a ≠ 0 :=
by simp [finite_int_iff, ne.symm (ne_of_lt (p_prime.1.one_lt))]

/--
A rewrite lemma for `padic_val_rat p q` when `q` is expressed in terms of `rat.mk`.
-/
protected lemma defn {q : ℚ} {n d : ℤ} (hqz : q ≠ 0) (qdf : q = n /. d) :
  padic_val_rat p q = (multiplicity (p : ℤ) n).get (finite_int_iff.2
    ⟨ne.symm $ ne_of_lt p_prime.1.one_lt, λ hn, by simp * at *⟩) -
  (multiplicity (p : ℤ) d).get (finite_int_iff.2 ⟨ne.symm $ ne_of_lt p_prime.1.one_lt,
    λ hd, by simp * at *⟩) :=
have hn : n ≠ 0, from rat.mk_num_ne_zero_of_ne_zero hqz qdf,
have hd : d ≠ 0, from rat.mk_denom_ne_zero_of_ne_zero hqz qdf,
let ⟨c, hc1, hc2⟩ := rat.num_denom_mk hn hd qdf in
by rw [padic_val_rat, dif_pos];
  simp [hc1, hc2, multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1),
    (ne.symm (ne_of_lt p_prime.1.one_lt)), hqz]

/--
A rewrite lemma for `padic_val_rat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected lemma mul {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_rat p (q * r) = padic_val_rat p q + padic_val_rat p r :=
have q*r = (q.num * r.num) /. (↑q.denom * ↑r.denom), by rw_mod_cast rat.mul_num_denom,
have hq' : q.num /. q.denom ≠ 0, by rw rat.num_denom; exact hq,
have hr' : r.num /. r.denom ≠ 0, by rw rat.num_denom; exact hr,
have hp' : _root_.prime (p : ℤ), from nat.prime_iff_prime_int.1 p_prime.1,
begin
  rw [padic_val_rat.defn p (mul_ne_zero hq hr) this],
  conv_rhs { rw [←(@rat.num_denom q), padic_val_rat.defn p hq',
    ←(@rat.num_denom r), padic_val_rat.defn p hr'] },
  rw [multiplicity.mul' hp', multiplicity.mul' hp']; simp [add_comm, add_left_comm, sub_eq_add_neg]
end

/--
A rewrite lemma for `padic_val_rat p (q^k) with condition `q ≠ 0`.
-/
protected lemma pow {q : ℚ} (hq : q ≠ 0) {k : ℕ} :
    padic_val_rat p (q ^ k) = k * padic_val_rat p q :=
by induction k; simp [*, padic_val_rat.mul _ hq (pow_ne_zero _ hq),
  pow_succ, add_mul, add_comm]

/--
A rewrite lemma for `padic_val_rat p (q⁻¹)` with condition `q ≠ 0`.
-/
protected lemma inv {q : ℚ} (hq : q ≠ 0) :
  padic_val_rat p (q⁻¹) = -padic_val_rat p q :=
by rw [eq_neg_iff_add_eq_zero, ← padic_val_rat.mul p (inv_ne_zero hq) hq,
    inv_mul_cancel hq, padic_val_rat.one]

/--
A rewrite lemma for `padic_val_rat p (q / r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected lemma div {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_rat p (q / r) = padic_val_rat p q - padic_val_rat p r :=
by rw [div_eq_mul_inv, padic_val_rat.mul p hq (inv_ne_zero hr),
    padic_val_rat.inv p hr, sub_eq_add_neg]

/--
A condition for `padic_val_rat p (n₁ / d₁) ≤ padic_val_rat p (n₂ / d₂),
in terms of divisibility by `p^n`.
-/
lemma padic_val_rat_le_padic_val_rat_iff {n₁ n₂ d₁ d₂ : ℤ}
  (hn₁ : n₁ ≠ 0) (hn₂ : n₂ ≠ 0) (hd₁ : d₁ ≠ 0) (hd₂ : d₂ ≠ 0) :
  padic_val_rat p (n₁ /. d₁) ≤ padic_val_rat p (n₂ /. d₂) ↔
  ∀ (n : ℕ), ↑p ^ n ∣ n₁ * d₂ → ↑p ^ n ∣ n₂ * d₁ :=
have hf1 : finite (p : ℤ) (n₁ * d₂),
  from finite_int_prime_iff.2 (mul_ne_zero hn₁ hd₂),
have hf2 : finite (p : ℤ) (n₂ * d₁),
  from finite_int_prime_iff.2 (mul_ne_zero hn₂ hd₁),
  by conv {
    to_lhs,
    rw [padic_val_rat.defn p (rat.mk_ne_zero_of_ne_zero hn₁ hd₁) rfl,
      padic_val_rat.defn p (rat.mk_ne_zero_of_ne_zero hn₂ hd₂) rfl,
      sub_le_iff_le_add',
      ← add_sub_assoc,
      le_sub_iff_add_le],
    norm_cast,
    rw [← multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1) hf1, add_comm,
      ← multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1) hf2,
      enat.get_le_get, multiplicity_le_multiplicity_iff]
  }

/--
Sufficient conditions to show that the p-adic valuation of `q` is less than or equal to the
p-adic vlauation of `q + r`.
-/
theorem le_padic_val_rat_add_of_le {q r : ℚ}
  (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q + r ≠ 0)
  (h : padic_val_rat p q ≤ padic_val_rat p r) :
  padic_val_rat p q ≤ padic_val_rat p (q + r) :=
have hqn : q.num ≠ 0, from rat.num_ne_zero_of_ne_zero hq,
have hqd : (q.denom : ℤ) ≠ 0, by exact_mod_cast rat.denom_ne_zero _,
have hrn : r.num ≠ 0, from rat.num_ne_zero_of_ne_zero hr,
have hrd : (r.denom : ℤ) ≠ 0, by exact_mod_cast rat.denom_ne_zero _,
have hqreq : q + r = (((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ)),
  from rat.add_num_denom _ _,
have hqrd : q.num * ↑(r.denom) + ↑(q.denom) * r.num ≠ 0,
  from rat.mk_num_ne_zero_of_ne_zero hqr hqreq,
begin
  conv_lhs { rw ←(@rat.num_denom q) },
  rw [hqreq, padic_val_rat_le_padic_val_rat_iff p hqn hqrd hqd (mul_ne_zero hqd hrd),
    ← multiplicity_le_multiplicity_iff, mul_left_comm,
    multiplicity.mul (nat.prime_iff_prime_int.1 p_prime.1), add_mul],
  rw [←(@rat.num_denom q), ←(@rat.num_denom r),
    padic_val_rat_le_padic_val_rat_iff p hqn hrn hqd hrd, ← multiplicity_le_multiplicity_iff] at h,
  calc _ ≤ min (multiplicity ↑p (q.num * ↑(r.denom) * ↑(q.denom)))
    (multiplicity ↑p (↑(q.denom) * r.num * ↑(q.denom))) : (le_min
    (by rw [@multiplicity.mul _ _ _ _ (_ * _) _ (nat.prime_iff_prime_int.1 p_prime.1), add_comm])
    (by rw [mul_assoc, @multiplicity.mul _ _ _ _ (q.denom : ℤ)
        (_ * _) (nat.prime_iff_prime_int.1 p_prime.1)];
      exact add_le_add_left h _))
    ... ≤ _ : min_le_multiplicity_add
end

/--
The minimum of the valuations of `q` and `r` is less than or equal to the valuation of `q + r`.
-/
theorem min_le_padic_val_rat_add {q r : ℚ}
  (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q + r ≠ 0) :
  min (padic_val_rat p q) (padic_val_rat p r) ≤ padic_val_rat p (q + r) :=
(le_total (padic_val_rat p q) (padic_val_rat p r)).elim
  (λ h, by rw [min_eq_left h]; exact le_padic_val_rat_add_of_le _ hq hr hqr h)
  (λ h, by rw [min_eq_right h, add_comm]; exact le_padic_val_rat_add_of_le _ hr hq
    (by rwa add_comm) h)

open_locale big_operators

/-- A finite sum of rationals with positive p-adic valuation has positive p-adic valuation
  (if the sum is non-zero). -/
theorem sum_pos_of_pos {n : ℕ} {F : ℕ → ℚ}
  (hF : ∀ i, i < n → 0 < padic_val_rat p (F i)) (hn0 : ∑ i in finset.range n, F i ≠ 0) :
  0 < padic_val_rat p (∑ i in finset.range n, F i) :=
begin
  induction n with d hd,
  { exact false.elim (hn0 rfl) },
  { rw finset.sum_range_succ at hn0 ⊢,
    by_cases h : ∑ (x : ℕ) in finset.range d, F x = 0,
    { rw [h, zero_add],
      exact hF d (lt_add_one _) },
    { refine lt_of_lt_of_le _ (min_le_padic_val_rat_add p h (λ h1, _) hn0),
      { refine lt_min (hd (λ i hi, _) h) (hF d (lt_add_one _)),
        exact hF _ (lt_trans hi (lt_add_one _)) },
      { have h2 := hF d (lt_add_one _),
        rw h1 at h2,
        exact lt_irrefl _ h2 } } }
end

end padic_val_rat

namespace padic_val_nat

/--
A rewrite lemma for `padic_val_nat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected lemma mul (p : ℕ) [p_prime : fact p.prime] {q r : ℕ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_nat p (q * r) = padic_val_nat p q + padic_val_nat p r :=
begin
  apply int.coe_nat_inj,
  simp only [padic_val_rat_of_nat, nat.cast_mul],
  rw padic_val_rat.mul,
  norm_cast,
  exact cast_ne_zero.mpr hq,
  exact cast_ne_zero.mpr hr,
end

/--
Dividing out by a prime factor reduces the padic_val_nat by 1.
-/
protected lemma div {p : ℕ} [p_prime : fact p.prime] {b : ℕ} (dvd : p ∣ b) :
  (padic_val_nat p (b / p)) = (padic_val_nat p b) - 1 :=
begin
  by_cases b_split : (b = 0),
  { simp [b_split], },
  { have split_frac : padic_val_rat p (b / p) = padic_val_rat p b - padic_val_rat p p :=
      padic_val_rat.div p (nat.cast_ne_zero.mpr b_split)
        (nat.cast_ne_zero.mpr (nat.prime.ne_zero p_prime.1)),
    rw padic_val_rat.padic_val_rat_self (nat.prime.one_lt p_prime.1) at split_frac,
    have r : 1 ≤ padic_val_nat p b := one_le_padic_val_nat_of_dvd b_split dvd,
    exact_mod_cast split_frac, }
end

end padic_val_nat

section padic_val_nat

/--
If a prime doesn't appear in `n`, `padic_val_nat p n` is `0`.
-/
lemma padic_val_nat_of_not_dvd {p : ℕ} [fact p.prime] {n : ℕ} (not_dvd : ¬(p ∣ n)) :
  padic_val_nat p n = 0 :=
begin
  by_cases hn : n = 0,
  { subst hn, simp at not_dvd, trivial, },
  { rw padic_val_nat_def hn,
    exact (@multiplicity.unique' _ _ _ p n 0 (by simp) (by simpa using not_dvd)).symm,
    assumption, },
end

lemma dvd_of_one_le_padic_val_nat {n p : nat} [prime : fact p.prime] (hp : 1 ≤ padic_val_nat p n) :
  p ∣ n :=
begin
  by_contra h,
  rw padic_val_nat_of_not_dvd h at hp,
  exact lt_irrefl 0 (lt_of_lt_of_le zero_lt_one hp),
end

lemma padic_val_nat_primes {p q : ℕ} [p_prime : fact p.prime] [q_prime : fact q.prime]
  (neq : p ≠ q) : padic_val_nat p q = 0 :=
@padic_val_nat_of_not_dvd p p_prime q $
(not_congr (iff.symm (prime_dvd_prime_iff_eq p_prime.1 q_prime.1))).mp neq

protected lemma padic_val_nat.div' {p : ℕ} [p_prime : fact p.prime] :
  ∀ {m : ℕ} (cpm : coprime p m) {b : ℕ} (dvd : m ∣ b), padic_val_nat p (b / m) = padic_val_nat p b
| 0 := λ cpm b dvd, by { rw zero_dvd_iff at dvd, rw [dvd, nat.zero_div], }
| (n + 1) :=
  λ cpm b dvd,
  begin
    rcases dvd with ⟨c, rfl⟩,
    rw [mul_div_right c (nat.succ_pos _)],by_cases hc : c = 0,
    { rw [hc, mul_zero] },
    { rw padic_val_nat.mul,
      { suffices : ¬ p ∣ (n+1),
        { rw [padic_val_nat_of_not_dvd this, zero_add] },
        contrapose! cpm,
        exact p_prime.1.dvd_iff_not_coprime.mp cpm },
      { exact nat.succ_ne_zero _ },
      { exact hc } },
  end

lemma padic_val_nat_eq_factors_count (p : ℕ) [hp : fact p.prime] :
  ∀ (n : ℕ), padic_val_nat p n = (factors n).count p
| 0 := by simp
| 1 := by simp
| (m + 2) :=
let n := m + 2 in
let q := min_fac n in
have hq : fact q.prime := ⟨min_fac_prime (show m + 2 ≠ 1, by linarith)⟩,
have wf : n / q < n := nat.div_lt_self (nat.succ_pos _) hq.1.one_lt,
begin
  rw factors_add_two,
  show padic_val_nat p n = list.count p (q :: (factors (n / q))),
  rw [list.count_cons', ← padic_val_nat_eq_factors_count],
  split_ifs with h,
  have p_dvd_n : p ∣ n,
    { have: q ∣ n := nat.min_fac_dvd n,
      cc },
  { rw [←h, padic_val_nat.div],
    { have: 1 ≤ padic_val_nat p n := one_le_padic_val_nat_of_dvd (by linarith) p_dvd_n,
      exact (nat.sub_eq_iff_eq_add this).mp rfl, },
    { exact p_dvd_n, }, },
  { suffices : p.coprime q,
    { rw [padic_val_nat.div' this (min_fac_dvd n), add_zero], },
    rwa nat.coprime_primes hp.1 hq.1, },
end

open_locale big_operators

lemma prod_pow_prime_padic_val_nat (n : nat) (hn : n ≠ 0) (m : nat) (pr : n < m) :
  ∏ p in finset.filter nat.prime (finset.range m), p ^ (padic_val_nat p n) = n :=
begin
  rw ← pos_iff_ne_zero at hn,
  have H : (factors n : multiset ℕ).prod = n,
  { rw [multiset.coe_prod, prod_factors hn], },
  rw finset.prod_multiset_count at H,
  conv_rhs { rw ← H, },
  refine finset.prod_bij_ne_one (λ p hp hp', p) _ _ _ _,
  { rintro p hp hpn,
    rw [finset.mem_filter, finset.mem_range] at hp,
    rw [multiset.mem_to_finset, multiset.mem_coe, mem_factors_iff_dvd hn hp.2],
    contrapose! hpn,
    haveI Hp : fact p.prime := ⟨hp.2⟩,
    rw [padic_val_nat_of_not_dvd hpn, pow_zero], },
  { intros, assumption },
  { intros p hp hpn,
    rw [multiset.mem_to_finset, multiset.mem_coe] at hp,
    haveI Hp : fact p.prime := ⟨prime_of_mem_factors hp⟩,
    simp only [exists_prop, ne.def, finset.mem_filter, finset.mem_range],
    refine ⟨p, ⟨_, Hp.1⟩, ⟨_, rfl⟩⟩,
    { rw mem_factors_iff_dvd hn Hp.1 at hp, exact lt_of_le_of_lt (le_of_dvd hn hp) pr },
    { rw padic_val_nat_eq_factors_count,
      simpa [ne.def, multiset.coe_count] using hpn } },
  { intros p hp hpn,
    rw [finset.mem_filter, finset.mem_range] at hp,
    haveI Hp : fact p.prime := ⟨hp.2⟩,
    rw [padic_val_nat_eq_factors_count, multiset.coe_count] }
end

end padic_val_nat

/--
If `q ≠ 0`, the p-adic norm of a rational `q` is `p ^ (-(padic_val_rat p q))`.
If `q = 0`, the p-adic norm of `q` is 0.
-/
def padic_norm (p : ℕ) (q : ℚ) : ℚ :=
if q = 0 then 0 else (↑p : ℚ) ^ (-(padic_val_rat p q))

namespace padic_norm

section padic_norm
open padic_val_rat
variables (p : ℕ)

/--
Unfolds the definition of the p-adic norm of `q` when `q ≠ 0`.
-/
@[simp] protected lemma eq_fpow_of_nonzero {q : ℚ} (hq : q ≠ 0) :
  padic_norm p q = p ^ (-(padic_val_rat p q)) :=
by simp [hq, padic_norm]

/--
The p-adic norm is nonnegative.
-/
protected lemma nonneg (q : ℚ) : 0 ≤ padic_norm p q :=
if hq : q = 0 then by simp [hq, padic_norm]
else
  begin
    unfold padic_norm; split_ifs,
    apply fpow_nonneg,
    exact_mod_cast nat.zero_le _
  end

/--
The p-adic norm of 0 is 0.
-/
@[simp] protected lemma zero : padic_norm p 0 = 0 := by simp [padic_norm]

/--
The p-adic norm of 1 is 1.
-/
@[simp] protected lemma one : padic_norm p 1 = 1 := by simp [padic_norm]

/--
The p-adic norm of `p` is `1/p` if `p > 1`.

See also `padic_norm.padic_norm_p_of_prime` for a version that assumes `p` is prime.
-/
lemma padic_norm_p {p : ℕ} (hp : 1 < p) : padic_norm p p = 1 / p :=
by simp [padic_norm, (show p ≠ 0, by linarith), padic_val_rat.padic_val_rat_self hp]

/--
The p-adic norm of `p` is `1/p` if `p` is prime.

See also `padic_norm.padic_norm_p` for a version that assumes `1 < p`.
-/
@[simp] lemma padic_norm_p_of_prime (p : ℕ) [fact p.prime] : padic_norm p p = 1 / p :=
padic_norm_p $ nat.prime.one_lt (fact.out _)

/-- The p-adic norm of `q` is `1` if `q` is prime and not equal to `p`. -/
lemma padic_norm_of_prime_of_ne {p q : ℕ} [p_prime : fact p.prime] [q_prime : fact q.prime]
  (neq : p ≠ q) : padic_norm p q = 1 :=
begin
  have p : padic_val_rat p q = 0,
  { exact_mod_cast @padic_val_nat_primes p q p_prime q_prime neq },
  simp [padic_norm, p, q_prime.1.1, q_prime.1.ne_zero],
end

/--
The p-adic norm of `p` is less than 1 if `1 < p`.

See also `padic_norm.padic_norm_p_lt_one_of_prime` for a version assuming `prime p`.
-/
lemma padic_norm_p_lt_one {p : ℕ} (hp : 1 < p) : padic_norm p p < 1 :=
begin
  rw [padic_norm_p hp, div_lt_iff, one_mul],
  { exact_mod_cast hp },
  { exact_mod_cast zero_lt_one.trans hp },
end

/--
The p-adic norm of `p` is less than 1 if `p` is prime.

See also `padic_norm.padic_norm_p_lt_one` for a version assuming `1 < p`.
-/
lemma padic_norm_p_lt_one_of_prime (p : ℕ) [fact p.prime] : padic_norm p p < 1 :=
padic_norm_p_lt_one $ nat.prime.one_lt (fact.out _)

/--
`padic_norm p q` takes discrete values `p ^ -z` for `z : ℤ`.
-/
protected theorem values_discrete {q : ℚ} (hq : q ≠ 0) : ∃ z : ℤ, padic_norm p q = p ^ (-z) :=
⟨ (padic_val_rat p q), by simp [padic_norm, hq] ⟩

/--
`padic_norm p` is symmetric.
-/
@[simp] protected lemma neg (q : ℚ) : padic_norm p (-q) = padic_norm p q :=
if hq : q = 0 then by simp [hq]
else by simp [padic_norm, hq]

variable [hp : fact p.prime]
include hp

/--
If `q ≠ 0`, then `padic_norm p q ≠ 0`.
-/
protected lemma nonzero {q : ℚ} (hq : q ≠ 0) : padic_norm p q ≠ 0 :=
begin
  rw padic_norm.eq_fpow_of_nonzero p hq,
  apply fpow_ne_zero_of_ne_zero,
  exact_mod_cast ne_of_gt hp.1.pos
end

/--
If the p-adic norm of `q` is 0, then `q` is 0.
-/
lemma zero_of_padic_norm_eq_zero {q : ℚ} (h : padic_norm p q = 0) : q = 0 :=
begin
  apply by_contradiction, intro hq,
  unfold padic_norm at h, rw if_neg hq at h,
  apply absurd h,
  apply fpow_ne_zero_of_ne_zero,
  exact_mod_cast hp.1.ne_zero
end

/--
The p-adic norm is multiplicative.
-/
@[simp] protected theorem mul (q r : ℚ) : padic_norm p (q*r) = padic_norm p q * padic_norm p r :=
if hq : q = 0 then
  by simp [hq]
else if hr : r = 0 then
  by simp [hr]
else
  have q*r ≠ 0, from mul_ne_zero hq hr,
  have (↑p : ℚ) ≠ 0, by simp [hp.1.ne_zero],
  by simp [padic_norm, *, padic_val_rat.mul, fpow_add this, mul_comm]

/--
The p-adic norm respects division.
-/
@[simp] protected theorem div (q r : ℚ) : padic_norm p (q / r) = padic_norm p q / padic_norm p r :=
if hr : r = 0 then by simp [hr] else
eq_div_of_mul_eq (padic_norm.nonzero _ hr) (by rw [←padic_norm.mul, div_mul_cancel _ hr])

/--
The p-adic norm of an integer is at most 1.
-/
protected theorem of_int (z : ℤ) : padic_norm p ↑z ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one] else
begin
  unfold padic_norm,
  rw [if_neg _],
  { refine fpow_le_one_of_nonpos _ _,
    { exact_mod_cast le_of_lt hp.1.one_lt, },
    { rw [padic_val_rat_of_int _ hp.1.ne_one hz, neg_nonpos],
      norm_cast, simp }},
  exact_mod_cast hz
end

private lemma nonarchimedean_aux {q r : ℚ} (h : padic_val_rat p q ≤ padic_val_rat p r) :
  padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
have hnqp : padic_norm p q ≥ 0, from padic_norm.nonneg _ _,
have hnrp : padic_norm p r ≥ 0, from padic_norm.nonneg _ _,
if hq : q = 0 then
  by simp [hq, max_eq_right hnrp, le_max_right]
else if hr : r = 0 then
  by simp [hr, max_eq_left hnqp, le_max_left]
else if hqr : q + r = 0 then
  le_trans (by simpa [hqr] using hnqp) (le_max_left _ _)
else
  begin
    unfold padic_norm, split_ifs,
    apply le_max_iff.2,
    left,
    apply fpow_le_of_le,
    { exact_mod_cast le_of_lt hp.1.one_lt },
    { apply neg_le_neg,
      have : padic_val_rat p q =
              min (padic_val_rat p q) (padic_val_rat p r),
        from (min_eq_left h).symm,
      rw this,
      apply min_le_padic_val_rat_add; assumption }
  end

/--
The p-adic norm is nonarchimedean: the norm of `p + q` is at most the max of the norm of `p` and
the norm of `q`.
-/
protected theorem nonarchimedean {q r : ℚ} :
  padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
begin
    wlog hle := le_total (padic_val_rat p q) (padic_val_rat p r) using [q r],
    exact nonarchimedean_aux p hle
end

/--
The p-adic norm respects the triangle inequality: the norm of `p + q` is at most the norm of `p`
plus the norm of `q`.
-/
theorem triangle_ineq (q r : ℚ) : padic_norm p (q + r) ≤ padic_norm p q + padic_norm p r :=
calc padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) : padic_norm.nonarchimedean p
                       ... ≤ padic_norm p q + padic_norm p r :
                         max_le_add_of_nonneg (padic_norm.nonneg p _) (padic_norm.nonneg p _)

/--
The p-adic norm of a difference is at most the max of each component. Restates the archimedean
property of the p-adic norm.
-/
protected theorem sub {q r : ℚ} : padic_norm p (q - r) ≤ max (padic_norm p q) (padic_norm p r) :=
by rw [sub_eq_add_neg, ←padic_norm.neg p r]; apply padic_norm.nonarchimedean

/--
If the p-adic norms of `q` and `r` are different, then the norm of `q + r` is equal to the max of
the norms of `q` and `r`.
-/
lemma add_eq_max_of_ne {q r : ℚ} (hne : padic_norm p q ≠ padic_norm p r) :
  padic_norm p (q + r) = max (padic_norm p q) (padic_norm p r) :=
begin
  wlog hle := le_total (padic_norm p r) (padic_norm p q) using [q r],
  have hlt : padic_norm p r < padic_norm p q, from lt_of_le_of_ne hle hne.symm,
  have : padic_norm p q ≤ max (padic_norm p (q + r)) (padic_norm p r), from calc
   padic_norm p q = padic_norm p (q + r - r) : by congr; ring
               ... ≤ max (padic_norm p (q + r)) (padic_norm p (-r)) : padic_norm.nonarchimedean p
               ... = max (padic_norm p (q + r)) (padic_norm p r) : by simp,
  have hnge : padic_norm p r ≤ padic_norm p (q + r),
  { apply le_of_not_gt,
    intro hgt,
    rw max_eq_right_of_lt hgt at this,
    apply not_lt_of_ge this,
    assumption },
  have : padic_norm p q ≤ padic_norm p (q + r), by rwa [max_eq_left hnge] at this,
  apply _root_.le_antisymm,
  { apply padic_norm.nonarchimedean p },
  { rw max_eq_left_of_lt hlt,
    assumption }
end

/--
The p-adic norm is an absolute value: positive-definite and multiplicative, satisfying the triangle
inequality.
-/
instance : is_absolute_value (padic_norm p) :=
{ abv_nonneg := padic_norm.nonneg p,
  abv_eq_zero :=
    begin
      intros,
      constructor; intro,
      { apply zero_of_padic_norm_eq_zero p, assumption },
      { simp [*] }
    end,
  abv_add := padic_norm.triangle_ineq p,
  abv_mul := padic_norm.mul p }

variable {p}

lemma dvd_iff_norm_le {n : ℕ} {z : ℤ} : ↑(p^n) ∣ z ↔ padic_norm p z ≤ ↑p ^ (-n : ℤ) :=
begin
  unfold padic_norm, split_ifs with hz,
  { norm_cast at hz,
    have : 0 ≤ (p^n : ℚ), {apply pow_nonneg, exact_mod_cast le_of_lt hp.1.pos },
    simp [hz, this] },
  { rw [fpow_le_iff_le, neg_le_neg_iff, padic_val_rat_of_int _ hp.1.ne_one _],
    { norm_cast,
      rw [← enat.coe_le_coe, enat.coe_get, ← multiplicity.pow_dvd_iff_le_multiplicity],
      simp },
    { exact_mod_cast hz },
    { exact_mod_cast hp.1.one_lt } }
end

end padic_norm
end padic_norm