/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import algebraic_geometry.morphisms.quasi_compact
import topology.quasi_separated

/-!
# Quasi-separated morphisms

A morphism of schemes `f : X ⟶ Y` is quasi-separated if the diagonal morphism `X ⟶ X ×[Y] X` is
quasi-compact.

A scheme is quasi-separated if the intersections of any two affine open sets is quasi-compact.
(`algebraic_geometry.quasi_separated_space_iff_affine`)

We show that a morphism is quasi-separated if the preimage of every affine open is quasi-separated.

We also show that this property is local at the target,
and is stable under compositions and base-changes.

## Main result
- `is_localization_basic_open_of_qcqs` (**Qcqs lemma**):
  If `U` is qcqs, then `Γ(X, D(f)) ≃ Γ(X, U)_f` for every `f : Γ(X, U)`.

-/

noncomputable theory

open category_theory category_theory.limits opposite topological_space

universe u

open_locale algebraic_geometry

namespace algebraic_geometry

variables {X Y : Scheme.{u}} (f : X ⟶ Y)

/-- A morphism is `quasi_separated` if diagonal map is quasi-compact. -/
@[mk_iff]
class quasi_separated (f : X ⟶ Y) : Prop :=
(diagonal_quasi_compact : quasi_compact (pullback.diagonal f))

/-- The `affine_target_morphism_property` corresponding to `quasi_separated`, asserting that the
domain is a quasi-separated scheme. -/
def quasi_separated.affine_property : affine_target_morphism_property :=
(λ X Y f _, quasi_separated_space X.carrier)

lemma quasi_separated_space_iff_affine (X : Scheme) :
  quasi_separated_space X.carrier ↔ ∀ (U V : X.affine_opens), is_compact (U ∩ V : set X.carrier) :=
begin
  rw quasi_separated_space_iff,
  split,
  { intros H U V, exact H U V U.1.2 U.2.is_compact V.1.2 V.2.is_compact },
  { intros H,
    suffices : ∀ (U : opens X.carrier) (hU : is_compact U.1) (V : opens X.carrier)
      (hV : is_compact V.1), is_compact (U ⊓ V).1,
    { intros U V hU hU' hV hV', exact this ⟨U, hU⟩ hU' ⟨V, hV⟩ hV' },
    intros U hU V hV,
    apply compact_open_induction_on V hV,
    { simp },
    { intros S hS V hV,
      change is_compact (U.1 ∩ (S.1 ∪ V.1)),
      rw set.inter_union_distrib_left,
      apply hV.union,
      clear hV,
      apply compact_open_induction_on U hU,
      { simp },
      { intros S hS W hW,
      change is_compact ((S.1 ∪ W.1) ∩ V.1),
        rw set.union_inter_distrib_right,
        apply hW.union,
        apply H } } }
end

lemma quasi_compact_affine_property_iff_quasi_separated_space {X Y : Scheme} [is_affine Y]
  (f : X ⟶ Y) :
  quasi_compact.affine_property.diagonal f ↔ quasi_separated_space X.carrier :=
begin
  delta affine_target_morphism_property.diagonal,
  rw quasi_separated_space_iff_affine,
  split,
  { intros H U V,
    haveI : is_affine _ := U.2,
    haveI : is_affine _ := V.2,
    let g : pullback (X.of_restrict U.1.open_embedding) (X.of_restrict V.1.open_embedding) ⟶ X :=
      pullback.fst ≫ X.of_restrict _,
    have : is_open_immersion g := infer_instance,
    have e := homeomorph.of_embedding _ this.base_open.to_embedding,
    rw is_open_immersion.range_pullback_to_base_of_left at e,
    erw [subtype.range_coe, subtype.range_coe] at e,
    rw is_compact_iff_compact_space,
    exact @@homeomorph.compact_space _ _ (H _ _) e },
  { introv H h₁ h₂,
    resetI,
    let g : pullback f₁ f₂ ⟶ X := pullback.fst ≫ f₁,
    have : is_open_immersion g := infer_instance,
    have e := homeomorph.of_embedding _ this.base_open.to_embedding,
    rw is_open_immersion.range_pullback_to_base_of_left at e,
    simp_rw is_compact_iff_compact_space at H,
    exact @@homeomorph.compact_space _ _
      (H ⟨⟨_, h₁.base_open.open_range⟩, range_is_affine_open_of_open_immersion _⟩
        ⟨⟨_, h₂.base_open.open_range⟩, range_is_affine_open_of_open_immersion _⟩) e.symm },
end

lemma quasi_separated_eq_diagonal_is_quasi_compact :
  @quasi_separated = morphism_property.diagonal @quasi_compact :=
by { ext, exact quasi_separated_iff _ }

lemma quasi_compact_affine_property_diagonal_eq :
  quasi_compact.affine_property.diagonal = quasi_separated.affine_property :=
by { ext, rw quasi_compact_affine_property_iff_quasi_separated_space, refl }

lemma quasi_separated_eq_affine_property_diagonal :
  @quasi_separated =
    target_affine_locally quasi_compact.affine_property.diagonal :=
begin
  rw [quasi_separated_eq_diagonal_is_quasi_compact, quasi_compact_eq_affine_property],
  exact diagonal_target_affine_locally_eq_target_affine_locally
    _ quasi_compact.affine_property_is_local
end

lemma quasi_separated_eq_affine_property :
  @quasi_separated =
    target_affine_locally quasi_separated.affine_property :=
by rw [quasi_separated_eq_affine_property_diagonal, quasi_compact_affine_property_diagonal_eq]

lemma quasi_separated.affine_property_is_local :
  quasi_separated.affine_property.is_local :=
quasi_compact_affine_property_diagonal_eq ▸
quasi_compact.affine_property_is_local.diagonal

@[priority 900]
instance quasi_separated_of_mono {X Y : Scheme} (f : X ⟶ Y) [mono f] : quasi_separated f :=
⟨infer_instance⟩

lemma quasi_separated_stable_under_composition :
  morphism_property.stable_under_composition @quasi_separated :=
quasi_separated_eq_diagonal_is_quasi_compact.symm ▸
  quasi_compact_stable_under_composition.diagonal
    quasi_compact_respects_iso
    quasi_compact_stable_under_base_change

lemma quasi_separated_stable_under_base_change :
  morphism_property.stable_under_base_change @quasi_separated :=
quasi_separated_eq_diagonal_is_quasi_compact.symm ▸
  quasi_compact_stable_under_base_change.diagonal
    quasi_compact_respects_iso

instance quasi_separated_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z)
  [quasi_separated f] [quasi_separated g] : quasi_separated (f ≫ g) :=
quasi_separated_stable_under_composition f g infer_instance infer_instance

lemma quasi_separated_respects_iso : morphism_property.respects_iso @quasi_separated :=
quasi_separated_eq_diagonal_is_quasi_compact.symm ▸
  quasi_compact_respects_iso.diagonal

lemma quasi_separated.affine_open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) :
  tfae [quasi_separated f,
    ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)],
      ∀ (i : 𝒰.J), quasi_separated_space (pullback f (𝒰.map i)).carrier,
    ∀ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] (i : 𝒰.J),
      quasi_separated_space (pullback f (𝒰.map i)).carrier,
    ∀ {U : Scheme} (g : U ⟶ Y) [is_affine U] [is_open_immersion g],
      quasi_separated_space (pullback f g).carrier,
    ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)]
      (𝒰' : Π (i : 𝒰.J), Scheme.open_cover.{u} (pullback f (𝒰.map i)))
      [∀ i j, is_affine ((𝒰' i).obj j)], by exactI ∀ (i : 𝒰.J) (j k : (𝒰' i).J),
        compact_space (pullback ((𝒰' i).map j) ((𝒰' i).map k)).carrier] :=
begin
  have := quasi_compact.affine_property_is_local.diagonal_affine_open_cover_tfae f,
  simp_rw [← quasi_compact_eq_affine_property,
    ← quasi_separated_eq_diagonal_is_quasi_compact,
    quasi_compact_affine_property_diagonal_eq] at this,
  exact this
end

lemma quasi_separated.is_local_at_target :
  property_is_local_at_target @quasi_separated :=
quasi_separated_eq_affine_property_diagonal.symm ▸
  quasi_compact.affine_property_is_local.diagonal.target_affine_locally_is_local

lemma quasi_separated.open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) :
  tfae [quasi_separated f,
    ∃ (𝒰 : Scheme.open_cover.{u} Y), ∀ (i : 𝒰.J),
      quasi_separated (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i),
    ∀ (𝒰 : Scheme.open_cover.{u} Y) (i : 𝒰.J),
      quasi_separated (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i),
    ∀ (U : opens Y.carrier), quasi_separated (f ∣_ U),
    ∀ {U : Scheme} (g : U ⟶ Y) [is_open_immersion g],
      quasi_separated (pullback.snd : pullback f g ⟶ _),
    ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤),
      ∀ i, quasi_separated (f ∣_ (U i))] :=
quasi_separated.is_local_at_target.open_cover_tfae f

lemma quasi_separated_over_affine_iff {X Y : Scheme} (f : X ⟶ Y) [is_affine Y] :
  quasi_separated f ↔ quasi_separated_space X.carrier :=
by rw [quasi_separated_eq_affine_property,
  quasi_separated.affine_property_is_local.affine_target_iff f,
  quasi_separated.affine_property]

lemma quasi_separated_space_iff_quasi_separated (X : Scheme) :
  quasi_separated_space X.carrier ↔ quasi_separated (terminal.from X) :=
(quasi_separated_over_affine_iff _).symm

lemma quasi_separated.affine_open_cover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.open_cover.{u} Y)
  [∀ i, is_affine (𝒰.obj i)] (f : X ⟶ Y) :
  quasi_separated f ↔ ∀ i, quasi_separated_space (pullback f (𝒰.map i)).carrier :=
begin
  rw [quasi_separated_eq_affine_property,
    quasi_separated.affine_property_is_local.affine_open_cover_iff f 𝒰],
  refl,
end

lemma quasi_separated.open_cover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.open_cover.{u} Y)
  (f : X ⟶ Y) :
  quasi_separated f ↔ ∀ i, quasi_separated (pullback.snd : pullback f (𝒰.map i) ⟶ _) :=
quasi_separated.is_local_at_target.open_cover_iff f 𝒰

instance {X Y S : Scheme} (f : X ⟶ S) (g : Y ⟶ S) [quasi_separated g] :
  quasi_separated (pullback.fst : pullback f g ⟶ X) :=
quasi_separated_stable_under_base_change.fst f g infer_instance

instance {X Y S : Scheme} (f : X ⟶ S) (g : Y ⟶ S) [quasi_separated f] :
  quasi_separated (pullback.snd : pullback f g ⟶ Y) :=
quasi_separated_stable_under_base_change.snd f g infer_instance

instance {X Y Z: Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) [quasi_separated f] [quasi_separated g] :
  quasi_separated (f ≫ g) :=
quasi_separated_stable_under_composition f g infer_instance infer_instance

lemma quasi_separated_space_of_quasi_separated {X Y : Scheme} (f : X ⟶ Y)
  [hY : quasi_separated_space Y.carrier] [quasi_separated f] : quasi_separated_space X.carrier :=
begin
  rw quasi_separated_space_iff_quasi_separated at hY ⊢,
  have : f ≫ terminal.from Y = terminal.from X := terminal_is_terminal.hom_ext _ _,
  rw ← this,
  resetI, apply_instance
end

instance quasi_separated_space_of_is_affine (X : Scheme) [is_affine X] :
  quasi_separated_space X.carrier :=
begin
  constructor,
  intros U V hU hU' hV hV',
  obtain ⟨s, hs, e⟩ := (is_compact_open_iff_eq_basic_open_union _).mp ⟨hU', hU⟩,
  obtain ⟨s', hs', e'⟩ := (is_compact_open_iff_eq_basic_open_union _).mp ⟨hV', hV⟩,
  rw [e, e', set.Union₂_inter],
  simp_rw [set.inter_Union₂],
  apply hs.is_compact_bUnion,
  { intros i hi,
    apply hs'.is_compact_bUnion,
    intros i' hi',
    change is_compact (X.basic_open i ⊓ X.basic_open i').1,
    rw ← Scheme.basic_open_mul,
    exact ((top_is_affine_open _).basic_open_is_affine _).is_compact }
end

lemma is_affine_open.is_quasi_separated {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U) :
  is_quasi_separated (U : set X.carrier)  :=
begin
  rw is_quasi_separated_iff_quasi_separated_space,
  exacts [@@algebraic_geometry.quasi_separated_space_of_is_affine _ hU, U.is_open],
end

lemma quasi_separated_of_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z)
  [H : quasi_separated (f ≫ g)] : quasi_separated f :=
begin
  rw (quasi_separated.affine_open_cover_tfae f).out 0 1,
  rw (quasi_separated.affine_open_cover_tfae (f ≫ g)).out 0 2 at H,
  use (Z.affine_cover.pullback_cover g).bind (λ x, Scheme.affine_cover _),
  split, { intro i, dsimp, apply_instance },
  rintro ⟨i, j⟩, dsimp at *,
  specialize H _ i,
  refine @@quasi_separated_space_of_quasi_separated _ H _,
  { exact pullback.map _ _ _ _ (𝟙 _) _ _ (by simp) (category.comp_id _) ≫
      (pullback_right_pullback_fst_iso g (Z.affine_cover.map i) f).hom },
  { apply algebraic_geometry.quasi_separated_of_mono }
end

lemma exists_eq_pow_mul_of_is_affine_open (X : Scheme) (U : opens X.carrier) (hU : is_affine_open U)
  (f : X.presheaf.obj (op U)) (x : X.presheaf.obj (op $ X.basic_open f)) :
  ∃ (n : ℕ) (y : X.presheaf.obj (op U)),
    y |_ X.basic_open f = (f |_ X.basic_open f) ^ n * x :=
begin
  have := (is_localization_basic_open hU f).2,
  obtain ⟨⟨y, _, n, rfl⟩, d⟩ := this x,
  use [n, y],
  delta Top.presheaf.restrict_open Top.presheaf.restrict,
  simpa [mul_comm x] using d.symm,
end

lemma exists_eq_pow_mul_of_is_compact_of_quasi_separated_space_aux (X : Scheme)
  (S : X.affine_opens) (U₁ U₂ : opens X.carrier)
  {n₁ n₂ : ℕ} {y₁ : X.presheaf.obj (op U₁)}
  {y₂ : X.presheaf.obj (op U₂)} {f : X.presheaf.obj (op $ U₁ ⊔ U₂)}
  {x : X.presheaf.obj (op $ X.basic_open f)}
  (h₁ : S.1 ≤ U₁) (h₂ : S.1 ≤ U₂)
  (e₁ : X.presheaf.map (hom_of_le $ X.basic_open_le
    (X.presheaf.map (hom_of_le le_sup_left).op f) : _ ⟶ U₁).op y₁ =
      X.presheaf.map (hom_of_le (by { erw X.basic_open_res, exact inf_le_left })).op
        (X.presheaf.map (hom_of_le le_sup_left).op f) ^ n₁ *
      (X.presheaf.map (hom_of_le (by { erw X.basic_open_res, exact inf_le_right })).op) x)
  (e₂ : X.presheaf.map (hom_of_le $ X.basic_open_le
    (X.presheaf.map (hom_of_le le_sup_right).op f) : _ ⟶ U₂).op y₂ =
      X.presheaf.map (hom_of_le (by { rw X.basic_open_res, exact inf_le_left })).op
        (X.presheaf.map (hom_of_le le_sup_right).op f) ^ n₂ *
      (X.presheaf.map (hom_of_le (by { rw X.basic_open_res, exact inf_le_right })).op) x) :
  ∃ n : ℕ, X.presheaf.map (hom_of_le $ h₁).op
    ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ (n + n₂) * y₁) =
    X.presheaf.map (hom_of_le $ h₂).op
      ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ (n + n₁) * y₂) :=
begin
  have := (is_localization_basic_open S.2
    (X.presheaf.map (hom_of_le $ le_trans h₁ le_sup_left).op f)),
  obtain ⟨⟨_, n, rfl⟩, e⟩ :=
    (@is_localization.eq_iff_exists _ _ _ _ _ _ this (X.presheaf.map (hom_of_le $ h₁).op
      ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ n₂ * y₁))
    (X.presheaf.map (hom_of_le $ h₂).op
      ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ n₁ * y₂))).mp _,
  swap,
  { simp only [map_pow, ring_hom.algebra_map_to_algebra, map_mul, ← comp_apply,
      ← functor.map_comp, ← op_comp, hom_of_le_comp],
    have h₃ : X.basic_open ((X.presheaf.map (hom_of_le (h₁.trans le_sup_left)).op) f) ≤ S.val,
    { simpa only [X.basic_open_res] using inf_le_left, },
    transitivity
      X.presheaf.map (hom_of_le $ h₃.trans $ h₁.trans le_sup_left).op f ^ (n₂ + n₁) *
      X.presheaf.map (hom_of_le $ (X.basic_open_res f _).trans_le inf_le_right).op x,
    { rw [pow_add, mul_assoc], congr' 1,
      convert congr_arg (X.presheaf.map (hom_of_le _).op) e₁,
      { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr },
      { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr },
      { rw [X.basic_open_res, X.basic_open_res], rintros x ⟨H₁, H₂⟩, exact ⟨h₁ H₁, H₂⟩ } },
    { rw [add_comm, pow_add, mul_assoc], congr' 1,
      convert congr_arg (X.presheaf.map (hom_of_le _).op) e₂.symm,
      { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr },
      { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr },
      { simp only [X.basic_open_res],
        rintros x ⟨H₁, H₂⟩, exact ⟨h₂ H₁, H₂⟩ } } },
  use n,
  simp only [pow_add, map_pow, map_mul, ← comp_apply, ← mul_assoc,
    ← functor.map_comp, subtype.coe_mk] at e ⊢,
  exact e
end

lemma exists_eq_pow_mul_of_is_compact_of_is_quasi_separated (X : Scheme)
  (U : opens X.carrier) (hU : is_compact U.1) (hU' : is_quasi_separated U.1)
  (f : X.presheaf.obj (op U)) (x : X.presheaf.obj (op $ X.basic_open f)) :
  ∃ (n : ℕ) (y : X.presheaf.obj (op U)), y |_ X.basic_open f = (f |_ X.basic_open f) ^ n * x :=
begin
  delta Top.presheaf.restrict_open Top.presheaf.restrict,
  revert hU' f x,
  apply compact_open_induction_on U hU,
  { intros hU' f x,
    use [0, f],
    refine @@subsingleton.elim (CommRing.subsingleton_of_is_terminal
      (X.sheaf.is_terminal_of_eq_empty _)) _ _,
    erw eq_bot_iff,
    exact X.basic_open_le f },
  { -- Given `f : 𝒪(S ∪ U), x : 𝒪(X_f)`, we need to show that `f ^ n * x` is the restriction of
    -- some `y : 𝒪(S ∪ U)` for some `n : ℕ`.
    intros S hS U hU hSU f x,
    -- We know that such `y₁, n₁` exists on `S` by the induction hypothesis.
    obtain ⟨n₁, y₁, hy₁⟩ := hU (hSU.of_subset $ set.subset_union_left _ _)
      (X.presheaf.map (hom_of_le le_sup_left).op f) (X.presheaf.map (hom_of_le _).op x),
    swap, { rw X.basic_open_res, exact inf_le_right },
    -- We know that such `y₂, n₂` exists on `U` since `U` is affine.
    obtain ⟨n₂, y₂, hy₂⟩ := exists_eq_pow_mul_of_is_affine_open X _ U.2
      (X.presheaf.map (hom_of_le le_sup_right).op f) (X.presheaf.map (hom_of_le _).op x),
    delta Top.presheaf.restrict_open Top.presheaf.restrict at hy₂,
    swap, { rw X.basic_open_res, exact inf_le_right },
    -- Since `S ∪ U` is quasi-separated, `S ∩ U` can be covered by finite affine opens.
    obtain ⟨s, hs', hs⟩ := (is_compact_open_iff_eq_finset_affine_union _).mp
      ⟨hSU _ _ (set.subset_union_left _ _) S.2 hS
        (set.subset_union_right _ _) U.1.2 U.2.is_compact, (S ⊓ U.1).2⟩,
    haveI := hs'.to_subtype,
    casesI nonempty_fintype s,
    replace hs : S ⊓ U.1 = supr (λ i : s, (i : opens X.carrier)) := by { ext1, simpa using hs },
    have hs₁ : ∀ i : s, i.1.1 ≤ S,
    { intro i, change (i : opens X.carrier) ≤ S,
      refine le_trans _ inf_le_left, use U.1, erw hs, exact le_supr _ _ },
    have hs₂ : ∀ i : s, i.1.1 ≤ U.1,
    { intro i, change (i : opens X.carrier) ≤ U,
      refine le_trans _ inf_le_right, use S, erw hs, exact le_supr _ _ },
    -- On each affine open in the intersection, we have `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂`
    -- for some `n` since `f ^ n₂ * y₁ = f ^ (n₁ + n₂) * x = f ^ n₁ * y₂` on `X_f`.
    have : ∀ i : s, ∃ n : ℕ,
      X.presheaf.map (hom_of_le $ hs₁ i).op
        ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ (n + n₂) * y₁) =
      X.presheaf.map (hom_of_le $ hs₂ i).op
        ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ (n + n₁) * y₂),
    { intro i,
      exact exists_eq_pow_mul_of_is_compact_of_quasi_separated_space_aux X i.1 S U (hs₁ i) (hs₂ i)
        hy₁ hy₂ },
    choose n hn using this,
    -- We can thus choose a big enough `n` such that `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂`
    -- on `S ∩ U`.
    have : X.presheaf.map (hom_of_le $ inf_le_left).op
      ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ (finset.univ.sup n + n₂) * y₁) =
        X.presheaf.map (hom_of_le $ inf_le_right).op
          ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ (finset.univ.sup n + n₁) * y₂),
    { fapply X.sheaf.eq_of_locally_eq' (λ i : s, i.1.1),
      { refine λ i, hom_of_le _, erw hs, exact le_supr _ _ },
      { exact le_of_eq hs },
      { intro i,
        replace hn := congr_arg (λ x, X.presheaf.map (hom_of_le
          (le_trans (hs₁ i) le_sup_left)).op f ^ (finset.univ.sup n - n i) * x) (hn i),
        dsimp only at hn,
        delta Scheme.sheaf SheafedSpace.sheaf,
        simp only [← map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, ← mul_assoc]
          at hn ⊢,
        erw [← map_mul, ← map_mul] at hn,
        rw [← pow_add, ← pow_add, ← add_assoc, ← add_assoc, tsub_add_cancel_of_le] at hn,
        convert hn,
        exact finset.le_sup (finset.mem_univ _) } },
    use finset.univ.sup n + n₁ + n₂,
    -- By the sheaf condition, since `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂`, it can be glued into
    -- the desired section on `S ∪ U`.
    use (X.sheaf.obj_sup_iso_prod_eq_locus S U.1).inv ⟨⟨_ * _, _ * _⟩, this⟩,
    refine X.sheaf.eq_of_locally_eq₂
      (hom_of_le (_ : X.basic_open (X.presheaf.map (hom_of_le le_sup_left).op f) ≤ _))
      (hom_of_le (_ : X.basic_open (X.presheaf.map (hom_of_le le_sup_right).op f) ≤ _)) _ _ _ _ _,
    { rw X.basic_open_res, exact inf_le_right },
    { rw X.basic_open_res, exact inf_le_right },
    { rw [X.basic_open_res, X.basic_open_res],
      erw ← inf_sup_right,
      refine le_inf_iff.mpr ⟨X.basic_open_le f, le_of_eq rfl⟩ },
    { convert congr_arg (X.presheaf.map (hom_of_le _).op)
        (X.sheaf.obj_sup_iso_prod_eq_locus_inv_fst S U.1 ⟨⟨_ * _, _ * _⟩, this⟩) using 1,
      { delta Scheme.sheaf SheafedSpace.sheaf,
        simp only [← comp_apply (X.presheaf.map _) (X.presheaf.map _),
          ← functor.map_comp, ← op_comp],
        congr },
      { delta Scheme.sheaf SheafedSpace.sheaf,
        simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, mul_assoc,
          pow_add], erw hy₁, congr' 1, rw [← mul_assoc, ← mul_assoc], congr' 1,
        rw [mul_comm, ← comp_apply, ← functor.map_comp], congr } },
    { convert congr_arg (X.presheaf.map (hom_of_le _).op)
        (X.sheaf.obj_sup_iso_prod_eq_locus_inv_snd S U.1 ⟨⟨_ * _, _ * _⟩, this⟩) using 1,
      { delta Scheme.sheaf SheafedSpace.sheaf,
        simp only [← comp_apply (X.presheaf.map _) (X.presheaf.map _),
          ← functor.map_comp, ← op_comp],
        congr },
      { delta Scheme.sheaf SheafedSpace.sheaf,
        simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, mul_assoc,
          pow_add], erw hy₂, rw [← comp_apply, ← functor.map_comp], congr } } }
end

/-- If `U` is qcqs, then `Γ(X, D(f)) ≃ Γ(X, U)_f` for every `f : Γ(X, U)`.
This is known as the **Qcqs lemma** in [R. Vakil, *The rising sea*][RisingSea]. -/
lemma is_localization_basic_open_of_qcqs {X : Scheme} {U : opens X.carrier}
  (hU : is_compact U.1) (hU' : is_quasi_separated U.1)
  (f : X.presheaf.obj (op U)) :
  is_localization.away f (X.presheaf.obj (op $ X.basic_open f)) :=
begin
  constructor,
  { rintro ⟨_, n, rfl⟩,
    simp only [map_pow, subtype.coe_mk, ring_hom.algebra_map_to_algebra],
    exact is_unit.pow _ (RingedSpace.is_unit_res_basic_open _ f), },
  { intro z,
    obtain ⟨n, y, e⟩ := exists_eq_pow_mul_of_is_compact_of_is_quasi_separated X U hU hU' f z,
    refine ⟨⟨y, _, n, rfl⟩, _⟩,
    simpa only [map_pow, subtype.coe_mk, ring_hom.algebra_map_to_algebra, mul_comm z]
      using e.symm },
  { intros x y,
    rw [← sub_eq_zero, ← map_sub, ring_hom.algebra_map_to_algebra],
    simp_rw [← @sub_eq_zero _ _ (_ * x) (_ * y), ← mul_sub],
    generalize : x - y = z,
    split,
    { intro H,
      obtain ⟨n, e⟩ := exists_pow_mul_eq_zero_of_res_basic_open_eq_zero_of_is_compact X hU _ _ H,
      refine ⟨⟨_, n, rfl⟩, _⟩,
      simpa [mul_comm z] using e },
    { rintro ⟨⟨_, n, rfl⟩, e : f ^ n * z = 0⟩,
      rw [← ((RingedSpace.is_unit_res_basic_open _ f).pow n).mul_right_inj, mul_zero, ← map_pow,
        ← map_mul, e, map_zero] } }
end

end algebraic_geometry


import AutograderTests.Util

in_exercise

  inductive Example
    | ctor (h : False)

  theorem exercise : Example :=
    sorry

in_solution

  inductive Example
    | ctor (h : True) -- clever change

  theorem exercise : Example :=
    ⟨⟨⟩⟩


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.number_theory.pell
import Mathlib.data.pfun
import Mathlib.data.fin2
import Mathlib.PostPort

universes u u_1 u_2 u_3

namespace Mathlib

namespace int

theorem eq_nat_abs_iff_mul (x : ℤ) (n : ℕ) : nat_abs x = n ↔ (x - ↑n) * (x + ↑n) = 0 := sorry

end int

/-- Alternate definition of `vector` based on `fin2`. -/
def vector3 (α : Type u) (n : ℕ) := fin2 n → α

namespace vector3

/-- The empty vector -/
def nil {α : Type u_1} : vector3 α 0 := sorry

/-- The vector cons operation -/
def cons {α : Type u_1} {n : ℕ} (a : α) (v : vector3 α n) : vector3 α (Nat.succ n) :=
  fun (i : fin2 (Nat.succ n)) => fin2.cases' a v i

infixr:67 " :: " => Mathlib.vector3.cons

/- We do not want to make the following notation global, because then these expressions will be
overloaded, and only the expected type will be able to disambiguate the meaning. Worse: Lean will
try to insert a coercion from `vector3 α _` to `list α`, if a list is expected. -/

@[simp] theorem cons_fz {α : Type u_1} {n : ℕ} (a : α) (v : vector3 α n) : cons a v fin2.fz = a :=
  rfl

@[simp] theorem cons_fs {α : Type u_1} {n : ℕ} (a : α) (v : vector3 α n) (i : fin2 n) :
    cons a v (fin2.fs i) = v i :=
  rfl

/-- Get the `i`th element of a vector -/
def nth {α : Type u_1} {n : ℕ} (i : fin2 n) (v : vector3 α n) : α := v i

/-- Construct a vector from a function on `fin2`. -/
def of_fn {α : Type u_1} {n : ℕ} (f : fin2 n → α) : vector3 α n := f

/-- Get the head of a nonempty vector. -/
def head {α : Type u_1} {n : ℕ} (v : vector3 α (Nat.succ n)) : α := v fin2.fz

/-- Get the tail of a nonempty vector. -/
def tail {α : Type u_1} {n : ℕ} (v : vector3 α (Nat.succ n)) : vector3 α n :=
  fun (i : fin2 n) => v (fin2.fs i)

theorem eq_nil {α : Type u_1} (v : vector3 α 0) : v = nil := sorry

theorem cons_head_tail {α : Type u_1} {n : ℕ} (v : vector3 α (Nat.succ n)) : head v :: tail v = v :=
  funext fun (i : fin2 (Nat.succ n)) => fin2.cases' rfl (fun (_x : fin2 n) => rfl) i

def nil_elim {α : Type u_1} {C : vector3 α 0 → Sort u} (H : C nil) (v : vector3 α 0) : C v :=
  eq.mpr sorry H

def cons_elim {α : Type u_1} {n : ℕ} {C : vector3 α (Nat.succ n) → Sort u}
    (H : (a : α) → (t : vector3 α n) → C (a :: t)) (v : vector3 α (Nat.succ n)) : C v :=
  eq.mpr sorry (H (head v) (tail v))

@[simp] theorem cons_elim_cons {α : Type u_1} {n : ℕ} {C : vector3 α (Nat.succ n) → Sort u_2}
    {H : (a : α) → (t : vector3 α n) → C (a :: t)} {a : α} {t : vector3 α n} :
    cons_elim H (a :: t) = H a t :=
  rfl

protected def rec_on {α : Type u_1} {C : {n : ℕ} → vector3 α n → Sort u} {n : ℕ} (v : vector3 α n)
    (H0 : C nil) (Hs : {n : ℕ} → (a : α) → (w : vector3 α n) → C w → C (a :: w)) : C v :=
  nat.rec_on n (fun (v : vector3 α 0) => nil_elim H0 v)
    (fun (n : ℕ) (IH : (_a : vector3 α n) → C _a) (v : vector3 α (Nat.succ n)) =>
      cons_elim (fun (a : α) (t : vector3 α n) => Hs a t (IH t)) v)
    v

@[simp] theorem rec_on_nil {α : Type u_1} {C : {n : ℕ} → vector3 α n → Sort u_2} {H0 : C nil}
    {Hs : {n : ℕ} → (a : α) → (w : vector3 α n) → C w → C (a :: w)} :
    vector3.rec_on nil H0 Hs = H0 :=
  rfl

@[simp] theorem rec_on_cons {α : Type u_1} {C : {n : ℕ} → vector3 α n → Sort u_2} {H0 : C nil}
    {Hs : {n : ℕ} → (a : α) → (w : vector3 α n) → C w → C (a :: w)} {n : ℕ} {a : α}
    {v : vector3 α n} : vector3.rec_on (a :: v) H0 Hs = Hs a v (vector3.rec_on v H0 Hs) :=
  rfl

/-- Append two vectors -/
def append {α : Type u_1} {m : ℕ} (v : vector3 α m) {n : ℕ} (w : vector3 α n) : vector3 α (n + m) :=
  nat.rec_on m (fun (_x : vector3 α 0) => w)
    (fun (m : ℕ) (IH : vector3 α m → vector3 α (n + m)) (v : vector3 α (Nat.succ m)) =>
      cons_elim (fun (a : α) (t : vector3 α m) => fin2.cases' a (IH t)) v)
    v

@[simp] theorem append_nil {α : Type u_1} {n : ℕ} (w : vector3 α n) : append nil w = w := rfl

@[simp] theorem append_cons {α : Type u_1} (a : α) {m : ℕ} (v : vector3 α m) {n : ℕ}
    (w : vector3 α n) : append (a :: v) w = a :: append v w :=
  rfl

@[simp] theorem append_left {α : Type u_1} {m : ℕ} (i : fin2 m) (v : vector3 α m) {n : ℕ}
    (w : vector3 α n) : append v w (fin2.left n i) = v i :=
  sorry

@[simp] theorem append_add {α : Type u_1} {m : ℕ} (v : vector3 α m) {n : ℕ} (w : vector3 α n)
    (i : fin2 n) : append v w (fin2.add i m) = w i :=
  sorry

/-- Insert `a` into `v` at index `i`. -/
def insert {α : Type u_1} (a : α) {n : ℕ} (v : vector3 α n) (i : fin2 (Nat.succ n)) :
    vector3 α (Nat.succ n) :=
  fun (j : fin2 (Nat.succ n)) => cons a v (fin2.insert_perm i j)

@[simp] theorem insert_fz {α : Type u_1} (a : α) {n : ℕ} (v : vector3 α n) :
    insert a v fin2.fz = a :: v :=
  sorry

@[simp] theorem insert_fs {α : Type u_1} (a : α) {n : ℕ} (b : α) (v : vector3 α n)
    (i : fin2 (Nat.succ n)) : insert a (b :: v) (fin2.fs i) = b :: insert a v i :=
  sorry

theorem append_insert {α : Type u_1} (a : α) {k : ℕ} (t : vector3 α k) {n : ℕ} (v : vector3 α n)
    (i : fin2 (Nat.succ n)) (e : Nat.succ n + k = Nat.succ (n + k)) :
    insert a (append t v) (eq.rec_on e (fin2.add i k)) = eq.rec_on e (append t (insert a v i)) :=
  sorry

end vector3

/-- "Curried" exists, i.e. ∃ x1 ... xn, f [x1, ..., xn] -/
def vector_ex {α : Type u_1} (k : ℕ) : (vector3 α k → Prop) → Prop := sorry

/-- "Curried" forall, i.e. ∀ x1 ... xn, f [x1, ..., xn] -/
def vector_all {α : Type u_1} (k : ℕ) : (vector3 α k → Prop) → Prop := sorry

theorem exists_vector_zero {α : Type u_1} (f : vector3 α 0 → Prop) : Exists f ↔ f vector3.nil :=
  sorry

theorem exists_vector_succ {α : Type u_1} {n : ℕ} (f : vector3 α (Nat.succ n) → Prop) :
    Exists f ↔ ∃ (x : α), ∃ (v : vector3 α n), f (x :: v) :=
  sorry

theorem vector_ex_iff_exists {α : Type u_1} {n : ℕ} (f : vector3 α n → Prop) :
    vector_ex n f ↔ Exists f :=
  sorry

theorem vector_all_iff_forall {α : Type u_1} {n : ℕ} (f : vector3 α n → Prop) :
    vector_all n f ↔ ∀ (v : vector3 α n), f v :=
  sorry

/-- `vector_allp p v` is equivalent to `∀ i, p (v i)`, but unfolds directly to a conjunction,
  i.e. `vector_allp p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
def vector_allp {α : Type u_1} (p : α → Prop) {n : ℕ} (v : vector3 α n) :=
  vector3.rec_on v True
    fun (n : ℕ) (a : α) (v : vector3 α n) (IH : Prop) =>
      vector3.rec_on v (p a) fun (n : ℕ) (b : α) (v' : vector3 α n) (_x : Prop) => p a ∧ IH

@[simp] theorem vector_allp_nil {α : Type u_1} (p : α → Prop) : vector_allp p vector3.nil = True :=
  rfl

@[simp] theorem vector_allp_singleton {α : Type u_1} (p : α → Prop) (x : α) :
    vector_allp p (x :: vector3.nil) = p x :=
  rfl

@[simp] theorem vector_allp_cons {α : Type u_1} (p : α → Prop) {n : ℕ} (x : α) (v : vector3 α n) :
    vector_allp p (x :: v) ↔ p x ∧ vector_allp p v :=
  vector3.rec_on v (iff.symm (and_true (vector_allp p (x :: vector3.nil))))
    fun (n : ℕ) (a : α) (v : vector3 α n) (IH : vector_allp p (x :: v) ↔ p x ∧ vector_allp p v) =>
      iff.rfl

theorem vector_allp_iff_forall {α : Type u_1} (p : α → Prop) {n : ℕ} (v : vector3 α n) :
    vector_allp p v ↔ ∀ (i : fin2 n), p (v i) :=
  sorry

theorem vector_allp.imp {α : Type u_1} {p : α → Prop} {q : α → Prop} (h : ∀ (x : α), p x → q x)
    {n : ℕ} {v : vector3 α n} (al : vector_allp p v) : vector_allp q v :=
  iff.mpr (vector_allp_iff_forall q v)
    fun (i : fin2 n) => h (v i) (iff.mp (vector_allp_iff_forall p v) al i)

/-- `list_all p l` is equivalent to `∀ a ∈ l, p a`, but unfolds directly to a conjunction,
  i.e. `list_all p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
@[simp] def list_all {α : Type u_1} (p : α → Prop) : List α → Prop := sorry

@[simp] theorem list_all_cons {α : Type u_1} (p : α → Prop) (x : α) (l : List α) :
    list_all p (x :: l) ↔ p x ∧ list_all p l :=
  list.cases_on l
    (idRhs (list_all p [x] ↔ list_all p [x] ∧ True) (iff.symm (and_true (list_all p [x]))))
    fun (l_hd : α) (l_tl : List α) =>
      idRhs (list_all p (x :: l_hd :: l_tl) ↔ list_all p (x :: l_hd :: l_tl)) iff.rfl

theorem list_all_iff_forall {α : Type u_1} (p : α → Prop) (l : List α) :
    list_all p l ↔ ∀ (x : α), x ∈ l → p x :=
  sorry

theorem list_all.imp {α : Type u_1} {p : α → Prop} {q : α → Prop} (h : ∀ (x : α), p x → q x)
    {l : List α} : list_all p l → list_all q l :=
  sorry

@[simp] theorem list_all_map {α : Type u_1} {β : Type u_2} {p : β → Prop} (f : α → β) {l : List α} :
    list_all p (list.map f l) ↔ list_all (p ∘ f) l :=
  sorry

theorem list_all_congr {α : Type u_1} {p : α → Prop} {q : α → Prop} (h : ∀ (x : α), p x ↔ q x)
    {l : List α} : list_all p l ↔ list_all q l :=
  { mp := list_all.imp fun (x : α) => iff.mp (h x),
    mpr := list_all.imp fun (x : α) => iff.mpr (h x) }

protected instance decidable_list_all {α : Type u_1} (p : α → Prop) [decidable_pred p]
    (l : List α) : Decidable (list_all p l) :=
  decidable_of_decidable_of_iff (list.decidable_ball (fun (x : α) => p x) l) sorry

/- poly -/

/-- A predicate asserting that a function is a multivariate integer polynomial.
  (We are being a bit lazy here by allowing many representations for multiplication,
  rather than only allowing monomials and addition, but the definition is equivalent
  and this is easier to use.) -/
inductive is_poly {α : Sort u_1} : ((α → ℕ) → ℤ) → Prop where
| proj : ∀ (i : α), is_poly fun (x : α → ℕ) => ↑(x i)
| const : ∀ (n : ℤ), is_poly fun (x : α → ℕ) => n
| sub : ∀ {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly fun (x : α → ℕ) => f x - g x
| mul : ∀ {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly fun (x : α → ℕ) => f x * g x

/-- The type of multivariate integer polynomials -/
def poly (α : Type u) := Subtype fun (f : (α → ℕ) → ℤ) => is_poly f

namespace poly

protected instance has_coe_to_fun {α : Type u} : has_coe_to_fun (poly α) :=
  has_coe_to_fun.mk (fun (f : poly α) => (α → ℕ) → ℤ) fun (f : poly α) => subtype.val f

/-- The underlying function of a `poly` is a polynomial -/
theorem isp {α : Type u} (f : poly α) : is_poly ⇑f := subtype.property f

/-- Extensionality for `poly α` -/
theorem ext {α : Type u} {f : poly α} {g : poly α} (e : ∀ (x : α → ℕ), coe_fn f x = coe_fn g x) :
    f = g :=
  subtype.eq (funext e)

/-- Construct a `poly` given an extensionally equivalent `poly`. -/
def subst {α : Type u} (f : poly α) (g : (α → ℕ) → ℤ) (e : ∀ (x : α → ℕ), coe_fn f x = g x) :
    poly α :=
  { val := g, property := sorry }

@[simp] theorem subst_eval {α : Type u} (f : poly α) (g : (α → ℕ) → ℤ)
    (e : ∀ (x : α → ℕ), coe_fn f x = g x) (x : α → ℕ) : coe_fn (subst f g e) x = g x :=
  rfl

/-- The `i`th projection function, `x_i`. -/
def proj {α : Type u} (i : α) : poly α :=
  { val := fun (x : α → ℕ) => ↑(x i), property := is_poly.proj i }

@[simp] theorem proj_eval {α : Type u} (i : α) (x : α → ℕ) : coe_fn (proj i) x = ↑(x i) := rfl

/-- The constant function with value `n : ℤ`. -/
def const {α : Type u} (n : ℤ) : poly α :=
  { val := fun (x : α → ℕ) => n, property := is_poly.const n }

@[simp] theorem const_eval {α : Type u} (n : ℤ) (x : α → ℕ) : coe_fn (const n) x = n := rfl

/-- The zero polynomial -/
def zero {α : Type u} : poly α := const 0

protected instance has_zero {α : Type u} : HasZero (poly α) := { zero := zero }

@[simp] theorem zero_eval {α : Type u} (x : α → ℕ) : coe_fn 0 x = 0 := rfl

/-- The zero polynomial -/
def one {α : Type u} : poly α := const 1

protected instance has_one {α : Type u} : HasOne (poly α) := { one := one }

@[simp] theorem one_eval {α : Type u} (x : α → ℕ) : coe_fn 1 x = 1 := rfl

/-- Subtraction of polynomials -/
def sub {α : Type u} : poly α → poly α → poly α := sorry

protected instance has_sub {α : Type u} : Sub (poly α) := { sub := sub }

@[simp] theorem sub_eval {α : Type u} (f : poly α) (g : poly α) (x : α → ℕ) :
    coe_fn (f - g) x = coe_fn f x - coe_fn g x :=
  sorry

/-- Negation of a polynomial -/
def neg {α : Type u} (f : poly α) : poly α := 0 - f

protected instance has_neg {α : Type u} : Neg (poly α) := { neg := neg }

@[simp] theorem neg_eval {α : Type u} (f : poly α) (x : α → ℕ) : coe_fn (-f) x = -coe_fn f x :=
  sorry

/-- Addition of polynomials -/
def add {α : Type u} : poly α → poly α → poly α := sorry

protected instance has_add {α : Type u} : Add (poly α) := { add := add }

@[simp] theorem add_eval {α : Type u} (f : poly α) (g : poly α) (x : α → ℕ) :
    coe_fn (f + g) x = coe_fn f x + coe_fn g x :=
  sorry

/-- Multiplication of polynomials -/
def mul {α : Type u} : poly α → poly α → poly α := sorry

protected instance has_mul {α : Type u} : Mul (poly α) := { mul := mul }

@[simp] theorem mul_eval {α : Type u} (f : poly α) (g : poly α) (x : α → ℕ) :
    coe_fn (f * g) x = coe_fn f x * coe_fn g x :=
  sorry

protected instance comm_ring {α : Type u} : comm_ring (poly α) :=
  comm_ring.mk Add.add sorry 0 sorry sorry Neg.neg Sub.sub sorry sorry Mul.mul sorry 1 sorry sorry
    sorry sorry sorry

theorem induction {α : Type u} {C : poly α → Prop} (H1 : ∀ (i : α), C (proj i))
    (H2 : ∀ (n : ℤ), C (const n)) (H3 : ∀ (f g : poly α), C f → C g → C (f - g))
    (H4 : ∀ (f g : poly α), C f → C g → C (f * g)) (f : poly α) : C f :=
  sorry

/-- The sum of squares of a list of polynomials. This is relevant for
  Diophantine equations, because it means that a list of equations
  can be encoded as a single equation: `x = 0 ∧ y = 0 ∧ z = 0` is
  equivalent to `x^2 + y^2 + z^2 = 0`. -/
def sumsq {α : Type u} : List (poly α) → poly α := sorry

theorem sumsq_nonneg {α : Type u} (x : α → ℕ) (l : List (poly α)) : 0 ≤ coe_fn (sumsq l) x := sorry

theorem sumsq_eq_zero {α : Type u} (x : α → ℕ) (l : List (poly α)) :
    coe_fn (sumsq l) x = 0 ↔ list_all (fun (a : poly α) => coe_fn a x = 0) l :=
  sorry

/-- Map the index set of variables, replacing `x_i` with `x_(f i)`. -/
def remap {α : Type u_1} {β : Type u_2} (f : α → β) (g : poly α) : poly β :=
  { val := fun (v : β → ℕ) => coe_fn g (v ∘ f), property := sorry }

@[simp] theorem remap_eval {α : Type u_1} {β : Type u_2} (f : α → β) (g : poly α) (v : β → ℕ) :
    coe_fn (remap f g) v = coe_fn g (v ∘ f) :=
  rfl

end poly

namespace sum

/-- combine two functions into a function on the disjoint union -/
def join {α : Type u_1} {β : Type u_2} {γ : Sort u_3} (f : α → γ) (g : β → γ) : α ⊕ β → γ :=
  sum.rec f g

end sum

namespace option

/-- Functions from `option` can be combined similarly to `vector.cons` -/
def cons {α : Type u_1} {β : Sort u_2} (a : β) (v : α → β) : Option α → β := Option.rec a v

infixr:67 " :: " => Mathlib.option.cons

@[simp] theorem cons_head_tail {α : Type u_1} {β : Sort u_2} (v : Option α → β) :
    v none :: v ∘ some = v :=
  sorry

end option

/- dioph -/

/-- A set `S ⊆ ℕ^α` is diophantine if there exists a polynomial on
  `α ⊕ β` such that `v ∈ S` iff there exists `t : ℕ^β` with `p (v, t) = 0`. -/
def dioph {α : Type u} (S : set (α → ℕ)) :=
  Exists
    fun {β : Type u} =>
      ∃ (p : poly (α ⊕ β)), ∀ (v : α → ℕ), S v ↔ ∃ (t : β → ℕ), coe_fn p (sum.join v t) = 0

namespace dioph

theorem ext {α : Type u} {S : set (α → ℕ)} {S' : set (α → ℕ)} (d : dioph S)
    (H : ∀ (v : α → ℕ), S v ↔ S' v) : dioph S' :=
  Eq._oldrec d ((fun (this : S = S') => this) (set.ext H))

theorem of_no_dummies {α : Type u} (S : set (α → ℕ)) (p : poly α)
    (h : ∀ (v : α → ℕ), S v ↔ coe_fn p v = 0) : dioph S :=
  sorry

theorem inject_dummies_lem {α : Type u} {β : Type u} {γ : Type u} (f : β → γ) (g : γ → Option β)
    (inv : ∀ (x : β), g (f x) = some x) (p : poly (α ⊕ β)) (v : α → ℕ) :
    (∃ (t : β → ℕ), coe_fn p (sum.join v t) = 0) ↔
        ∃ (t : γ → ℕ), coe_fn (poly.remap (sum.join sum.inl (sum.inr ∘ f)) p) (sum.join v t) = 0 :=
  sorry

theorem inject_dummies {α : Type u} {β : Type u} {γ : Type u} {S : set (α → ℕ)} (f : β → γ)
    (g : γ → Option β) (inv : ∀ (x : β), g (f x) = some x) (p : poly (α ⊕ β))
    (h : ∀ (v : α → ℕ), S v ↔ ∃ (t : β → ℕ), coe_fn p (sum.join v t) = 0) :
    ∃ (q : poly (α ⊕ γ)), ∀ (v : α → ℕ), S v ↔ ∃ (t : γ → ℕ), coe_fn q (sum.join v t) = 0 :=
  Exists.intro (poly.remap (sum.join sum.inl (sum.inr ∘ f)) p)
    fun (v : α → ℕ) => iff.trans (h v) (inject_dummies_lem f g inv p v)

theorem reindex_dioph {α : Type u} {β : Type u} {S : set (α → ℕ)} (d : dioph S) (f : α → β) :
    dioph fun (v : β → ℕ) => S (v ∘ f) :=
  sorry

theorem dioph_list_all {α : Type u} (l : List (set (α → ℕ))) (d : list_all dioph l) :
    dioph fun (v : α → ℕ) => list_all (fun (S : set (α → ℕ)) => S v) l :=
  sorry

theorem and_dioph {α : Type u} {S : set (α → ℕ)} {S' : set (α → ℕ)} (d : dioph S) (d' : dioph S') :
    dioph fun (v : α → ℕ) => S v ∧ S' v :=
  dioph_list_all [S, S'] { left := d, right := d' }

theorem or_dioph {α : Type u} {S : set (α → ℕ)} {S' : set (α → ℕ)} (d : dioph S) (d' : dioph S') :
    dioph fun (v : α → ℕ) => S v ∨ S' v :=
  sorry

/-- A partial function is Diophantine if its graph is Diophantine. -/
def dioph_pfun {α : Type u} (f : (α → ℕ) →. ℕ) :=
  dioph fun (v : Option α → ℕ) => pfun.graph f (v ∘ some, v none)

/-- A function is Diophantine if its graph is Diophantine. -/
def dioph_fn {α : Type u} (f : (α → ℕ) → ℕ) := dioph fun (v : Option α → ℕ) => f (v ∘ some) = v none

theorem reindex_dioph_fn {α : Type u} {β : Type u} {f : (α → ℕ) → ℕ} (d : dioph_fn f) (g : α → β) :
    dioph_fn fun (v : β → ℕ) => f (v ∘ g) :=
  reindex_dioph d (Functor.map g)

theorem ex_dioph {α : Type u} {β : Type u} {S : set (α ⊕ β → ℕ)} :
    dioph S → dioph fun (v : α → ℕ) => ∃ (x : β → ℕ), S (sum.join v x) :=
  sorry

theorem ex1_dioph {α : Type u} {S : set (Option α → ℕ)} :
    dioph S → dioph fun (v : α → ℕ) => ∃ (x : ℕ), S (x :: v) :=
  sorry

theorem dom_dioph {α : Type u} {f : (α → ℕ) →. ℕ} (d : dioph_pfun f) : dioph (pfun.dom f) :=
  cast (congr_arg dioph (set.ext fun (v : α → ℕ) => iff.symm (pfun.dom_iff_graph f v)))
    (ex1_dioph d)

theorem dioph_fn_iff_pfun {α : Type u} (f : (α → ℕ) → ℕ) : dioph_fn f = dioph_pfun ↑f :=
  congr_arg dioph (set.ext fun (v : Option α → ℕ) => iff.symm pfun.lift_graph)

theorem abs_poly_dioph {α : Type u} (p : poly α) :
    dioph_fn fun (v : α → ℕ) => int.nat_abs (coe_fn p v) :=
  of_no_dummies
    (fun (v : Option α → ℕ) => (fun (v : α → ℕ) => int.nat_abs (coe_fn p v)) (v ∘ some) = v none)
    ((poly.remap some p - poly.proj none) * (poly.remap some p + poly.proj none))
    fun (v : Option α → ℕ) => int.eq_nat_abs_iff_mul (coe_fn p (v ∘ some)) (v none)

theorem proj_dioph {α : Type u} (i : α) : dioph_fn fun (v : α → ℕ) => v i :=
  abs_poly_dioph (poly.proj i)

theorem dioph_pfun_comp1 {α : Type u} {S : set (Option α → ℕ)} (d : dioph S) {f : (α → ℕ) →. ℕ}
    (df : dioph_pfun f) : dioph fun (v : α → ℕ) => ∃ (h : pfun.dom f v), S (pfun.fn f v h :: v) :=
  sorry

theorem dioph_fn_comp1 {α : Type u} {S : set (Option α → ℕ)} (d : dioph S) {f : (α → ℕ) → ℕ}
    (df : dioph_fn f) : dioph fun (v : α → ℕ) => S (f v :: v) :=
  sorry

theorem dioph_fn_vec_comp1 {n : ℕ} {S : set (vector3 ℕ (Nat.succ n))} (d : dioph S)
    {f : vector3 ℕ n → ℕ} (df : dioph_fn f) : dioph fun (v : vector3 ℕ n) => S (f v :: v) :=
  sorry

theorem vec_ex1_dioph (n : ℕ) {S : set (vector3 ℕ (Nat.succ n))} (d : dioph S) :
    dioph fun (v : vector3 ℕ n) => ∃ (x : ℕ), S (x :: v) :=
  sorry

theorem dioph_fn_vec {n : ℕ} (f : vector3 ℕ n → ℕ) :
    dioph_fn f ↔ dioph fun (v : vector3 ℕ (Nat.succ n)) => f (v ∘ fin2.fs) = v fin2.fz :=
  { mp := fun (h : dioph_fn f) => reindex_dioph h (fin2.fz :: fin2.fs),
    mpr :=
      fun (h : dioph fun (v : vector3 ℕ (Nat.succ n)) => f (v ∘ fin2.fs) = v fin2.fz) =>
        reindex_dioph h (none :: some) }

theorem dioph_pfun_vec {n : ℕ} (f : vector3 ℕ n →. ℕ) :
    dioph_pfun f ↔
        dioph fun (v : vector3 ℕ (Nat.succ n)) => pfun.graph f (v ∘ fin2.fs, v fin2.fz) :=
  sorry

theorem dioph_fn_compn {α : Type} {n : ℕ} {S : set (α ⊕ fin2 n → ℕ)} (d : dioph S)
    {f : vector3 ((α → ℕ) → ℕ) n} (df : vector_allp dioph_fn f) :
    dioph fun (v : α → ℕ) => S (sum.join v fun (i : fin2 n) => f i v) :=
  sorry

theorem dioph_comp {α : Type} {n : ℕ} {S : set (vector3 ℕ n)} (d : dioph S)
    (f : vector3 ((α → ℕ) → ℕ) n) (df : vector_allp dioph_fn f) :
    dioph fun (v : α → ℕ) => S fun (i : fin2 n) => f i v :=
  dioph_fn_compn (reindex_dioph d sum.inr) df

theorem dioph_fn_comp {α : Type} {n : ℕ} {f : vector3 ℕ n → ℕ} (df : dioph_fn f)
    (g : vector3 ((α → ℕ) → ℕ) n) (dg : vector_allp dioph_fn g) :
    dioph_fn fun (v : α → ℕ) => f fun (i : fin2 n) => g i v :=
  sorry

theorem proj_dioph_of_nat {n : ℕ} (m : ℕ) [fin2.is_lt m n] :
    dioph_fn fun (v : vector3 ℕ n) => v (fin2.of_nat' m) :=
  proj_dioph (fin2.of_nat' m)

theorem const_dioph {α : Type} (n : ℕ) : dioph_fn (function.const (α → ℕ) n) :=
  abs_poly_dioph (poly.const ↑n)

theorem dioph_comp2 {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) {S : ℕ → ℕ → Prop}
    (d : dioph fun (v : vector3 ℕ (bit0 1)) => S (v (fin2.of_nat' 0)) (v (fin2.of_nat' 1))) :
    dioph fun (v : α → ℕ) => S (f v) (g v) :=
  dioph_comp d (f :: g :: vector3.nil) { left := df, right := dg }

theorem dioph_fn_comp2 {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) {h : ℕ → ℕ → ℕ}
    (d : dioph_fn fun (v : vector3 ℕ (bit0 1)) => h (v (fin2.of_nat' 0)) (v (fin2.of_nat' 1))) :
    dioph_fn fun (v : α → ℕ) => h (f v) (g v) :=
  dioph_fn_comp d (f :: g :: vector3.nil) { left := df, right := dg }

theorem eq_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph fun (v : α → ℕ) => f v = g v :=
  sorry

theorem add_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v + g v :=
  dioph_fn_comp2 df dg (abs_poly_dioph (poly.proj (fin2.of_nat' 0) + poly.proj (fin2.of_nat' 1)))

theorem mul_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v * g v :=
  dioph_fn_comp2 df dg (abs_poly_dioph (poly.proj (fin2.of_nat' 0) * poly.proj (fin2.of_nat' 1)))

theorem le_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph fun (v : α → ℕ) => f v ≤ g v :=
  sorry

theorem lt_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph fun (v : α → ℕ) => f v < g v :=
  le_dioph (add_dioph df (const_dioph 1)) dg

theorem ne_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph fun (v : α → ℕ) => f v ≠ g v :=
  ext (or_dioph (lt_dioph df dg) (lt_dioph dg df)) fun (v : α → ℕ) => iff.symm ne_iff_lt_or_gt

theorem sub_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v - g v :=
  sorry

theorem dvd_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph fun (v : α → ℕ) => f v ∣ g v :=
  sorry

theorem mod_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v % g v :=
  sorry

theorem modeq_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) {h : (α → ℕ) → ℕ} (dh : dioph_fn h) :
    dioph fun (v : α → ℕ) => nat.modeq (h v) (f v) (g v) :=
  eq_dioph (mod_dioph df dh) (mod_dioph dg dh)

theorem div_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v / g v :=
  sorry

theorem pell_dioph :
    dioph
        fun (v : vector3 ℕ (bit0 (bit0 1))) =>
          ∃ (h : 1 < v (fin2.of_nat' 0)),
            pell.xn h (v (fin2.of_nat' 1)) = v (fin2.of_nat' (bit0 1)) ∧
              pell.yn h (v (fin2.of_nat' 1)) = v (fin2.of_nat' (bit1 1)) :=
  sorry

theorem xn_dioph :
    dioph_pfun
        fun (v : vector3 ℕ (bit0 1)) =>
          roption.mk (1 < v (fin2.of_nat' 0))
            fun (h : 1 < v (fin2.of_nat' 0)) => pell.xn h (v (fin2.of_nat' 1)) :=
  sorry

theorem pow_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f)
    (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v ^ g v :=
  sorry

end Mathlib


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.limits.preserves.shapes.terminal
import category_theory.limits.shapes.zero

/-!
# Preservation of zero objects and zero morphisms

We define the class `preserves_zero_morphisms` and show basic properties.

## Main results

We provide the following results:
* Left adjoints and right adjoints preserve zero morphisms;
* full functors preserve zero morphisms;
* if both categories involved have a zero object, then a functor preserves zero morphisms if and
  only if it preserves the zero object;
* functors which preserve initial or terminal objects preserve zero morphisms.

-/

universes v₁ v₂ u₁ u₂

noncomputable theory

open category_theory
open category_theory.limits

namespace category_theory.functor
variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D]

section zero_morphisms
variables [has_zero_morphisms C] [has_zero_morphisms D]

/-- A functor preserves zero morphisms if it sends zero morphisms to zero morphisms. -/
class preserves_zero_morphisms (F : C ⥤ D) : Prop :=
(map_zero' : ∀ (X Y : C), F.map (0 : X ⟶ Y) = 0 . obviously)

@[simp]
protected lemma map_zero (F : C ⥤ D) [preserves_zero_morphisms F] (X Y : C) :
  F.map (0 : X ⟶ Y) = 0 :=
preserves_zero_morphisms.map_zero' _ _

lemma zero_of_map_zero (F : C ⥤ D) [preserves_zero_morphisms F] [faithful F] {X Y : C}
  (f : X ⟶ Y) (h : F.map f = 0) : f = 0 :=
F.map_injective $ h.trans $ eq.symm $ F.map_zero _ _

lemma map_eq_zero_iff (F : C ⥤ D) [preserves_zero_morphisms F] [faithful F] {X Y : C} {f : X ⟶ Y} :
  F.map f = 0 ↔ f = 0 :=
⟨F.zero_of_map_zero _, by { rintro rfl, exact F.map_zero _ _ }⟩

@[priority 100]
instance preserves_zero_morphisms_of_is_left_adjoint (F : C ⥤ D) [is_left_adjoint F] :
  preserves_zero_morphisms F :=
{ map_zero' := λ X Y, let adj := adjunction.of_left_adjoint F in
  begin
    calc F.map (0 : X ⟶ Y) = F.map 0 ≫ F.map (adj.unit.app Y) ≫ adj.counit.app (F.obj Y) : _
    ... = F.map 0 ≫ F.map ((right_adjoint F).map (0 : F.obj X ⟶ _)) ≫ adj.counit.app (F.obj Y) : _
    ... = 0 : _,
    { rw adjunction.left_triangle_components, exact (category.comp_id _).symm },
    { simp only [← category.assoc, ← F.map_comp, zero_comp] },
    { simp only [adjunction.counit_naturality, comp_zero] }
  end }

@[priority 100]
instance preserves_zero_morphisms_of_is_right_adjoint (G : C ⥤ D) [is_right_adjoint G] :
  preserves_zero_morphisms G :=
{ map_zero' := λ X Y, let adj := adjunction.of_right_adjoint G in
  begin
    calc G.map (0 : X ⟶ Y) = adj.unit.app (G.obj X) ≫ G.map (adj.counit.app X) ≫ G.map 0 : _
    ... = adj.unit.app (G.obj X) ≫ G.map ((left_adjoint G).map (0 : _ ⟶ G.obj X)) ≫ G.map 0 : _
    ... = 0 : _,
    { rw adjunction.right_triangle_components_assoc },
    { simp only [← G.map_comp, comp_zero] },
    { simp only [adjunction.unit_naturality_assoc, zero_comp] }
  end }

@[priority 100]
instance preserves_zero_morphisms_of_full (F : C ⥤ D) [full F] : preserves_zero_morphisms F :=
{ map_zero' := λ X Y, calc
  F.map (0 : X ⟶ Y) = F.map (0 ≫ (F.preimage (0 : F.obj Y ⟶ F.obj Y))) : by rw zero_comp
                ... = 0 : by rw [F.map_comp, F.image_preimage, comp_zero] }

end zero_morphisms

section zero_object
variables [has_zero_object C] [has_zero_object D]

open_locale zero_object

variables [has_zero_morphisms C] [has_zero_morphisms D] (F : C ⥤ D)

/-- A functor that preserves zero morphisms also preserves the zero object. -/
@[simps] def map_zero_object [preserves_zero_morphisms F] : F.obj 0 ≅ 0 :=
{ hom := 0,
  inv := 0,
  hom_inv_id' := by rw [← F.map_id, id_zero, F.map_zero, zero_comp],
  inv_hom_id' := by rw [id_zero, comp_zero] }

variables {F}

lemma preserves_zero_morphisms_of_map_zero_object (i : F.obj 0 ≅ 0) : preserves_zero_morphisms F :=
{ map_zero' := λ X Y, calc
  F.map (0 : X ⟶ Y) = F.map (0 : X ⟶ 0) ≫ F.map 0 : by rw [← functor.map_comp, comp_zero]
                ... = F.map 0 ≫ (i.hom ≫ i.inv) ≫ F.map 0
                        : by rw [iso.hom_inv_id, category.id_comp]
                ... = 0 : by simp only [zero_of_to_zero i.hom, zero_comp, comp_zero] }

@[priority 100]
instance preserves_zero_morphisms_of_preserves_initial_object
  [preserves_colimit (functor.empty.{v₁} C) F] : preserves_zero_morphisms F :=
preserves_zero_morphisms_of_map_zero_object $ (F.map_iso has_zero_object.zero_iso_initial).trans $
  (preserves_initial.iso F).trans has_zero_object.zero_iso_initial.symm

@[priority 100]
instance preserves_zero_morphisms_of_preserves_terminal_object
  [preserves_limit (functor.empty.{v₁} C) F] : preserves_zero_morphisms F :=
preserves_zero_morphisms_of_map_zero_object $ (F.map_iso has_zero_object.zero_iso_terminal).trans $
    (preserves_terminal.iso F).trans has_zero_object.zero_iso_terminal.symm

end zero_object

end category_theory.functor