/-
Copyright (c) 2018 Michael Jendrusch. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Jendrusch, Scott Morrison, Bhavik Mehta
-/
import category_theory.monoidal.category
import category_theory.adjunction.basic
import category_theory.products.basic

/-!
# (Lax) monoidal functors

A lax monoidal functor `F` between monoidal categories `C` and `D`
is a functor between the underlying categories equipped with morphisms
* `ε : 𝟙_ D ⟶ F.obj (𝟙_ C)` (called the unit morphism)
* `μ X Y : (F.obj X) ⊗ (F.obj Y) ⟶ F.obj (X ⊗ Y)` (called the tensorator, or strength).
satisfying various axioms.

A monoidal functor is a lax monoidal functor for which `ε` and `μ` are isomorphisms.

We show that the composition of (lax) monoidal functors gives a (lax) monoidal functor.

See also `category_theory.monoidal.functorial` for a typeclass decorating an object-level
function with the additional data of a monoidal functor.
This is useful when stating that a pre-existing functor is monoidal.

See `category_theory.monoidal.natural_transformation` for monoidal natural transformations.

We show in `category_theory.monoidal.Mon_` that lax monoidal functors take monoid objects
to monoid objects.

## Future work
* Oplax monoidal functors.

## References

See https://stacks.math.columbia.edu/tag/0FFL.
-/

open category_theory

universes v₁ v₂ v₃ u₁ u₂ u₃

open category_theory.category
open category_theory.functor

namespace category_theory

section

open monoidal_category

variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C]
          (D : Type u₂) [category.{v₂} D] [monoidal_category.{v₂} D]

/-- A lax monoidal functor is a functor `F : C ⥤ D` between monoidal categories,
equipped with morphisms `ε : 𝟙 _D ⟶ F.obj (𝟙_ C)` and `μ X Y : F.obj X ⊗ F.obj Y ⟶ F.obj (X ⊗ Y)`,
satisfying the appropriate coherences. -/
-- The direction of `left_unitality` and `right_unitality` as simp lemmas may look strange:
-- remember the rule of thumb that component indices of natural transformations
-- "weigh more" than structural maps.
-- (However by this argument `associativity` is currently stated backwards!)
structure lax_monoidal_functor extends C ⥤ D :=
-- unit morphism
(ε               : 𝟙_ D ⟶ obj (𝟙_ C))
-- tensorator
(μ                : Π X Y : C, (obj X) ⊗ (obj Y) ⟶ obj (X ⊗ Y))
(μ_natural'       : ∀ {X Y X' Y' : C}
  (f : X ⟶ Y) (g : X' ⟶ Y'),
  ((map f) ⊗ (map g)) ≫ μ Y Y' = μ X X' ≫ map (f ⊗ g)
  . obviously)
-- associativity of the tensorator
(associativity'   : ∀ (X Y Z : C),
    (μ X Y ⊗ 𝟙 (obj Z)) ≫ μ (X ⊗ Y) Z ≫ map (α_ X Y Z).hom
  = (α_ (obj X) (obj Y) (obj Z)).hom ≫ (𝟙 (obj X) ⊗ μ Y Z) ≫ μ X (Y ⊗ Z)
  . obviously)
-- unitality
(left_unitality'  : ∀ X : C,
    (λ_ (obj X)).hom
  = (ε ⊗ 𝟙 (obj X)) ≫ μ (𝟙_ C) X ≫ map (λ_ X).hom
  . obviously)
(right_unitality' : ∀ X : C,
    (ρ_ (obj X)).hom
  = (𝟙 (obj X) ⊗ ε) ≫ μ X (𝟙_ C) ≫ map (ρ_ X).hom
  . obviously)

restate_axiom lax_monoidal_functor.μ_natural'
attribute [simp, reassoc] lax_monoidal_functor.μ_natural
restate_axiom lax_monoidal_functor.left_unitality'
attribute [simp] lax_monoidal_functor.left_unitality
restate_axiom lax_monoidal_functor.right_unitality'
attribute [simp] lax_monoidal_functor.right_unitality
restate_axiom lax_monoidal_functor.associativity'
attribute [simp, reassoc] lax_monoidal_functor.associativity

-- When `rewrite_search` lands, add @[search] attributes to
-- lax_monoidal_functor.μ_natural lax_monoidal_functor.left_unitality
-- lax_monoidal_functor.right_unitality lax_monoidal_functor.associativity

section
variables {C D}

@[simp, reassoc]
lemma lax_monoidal_functor.left_unitality_inv (F : lax_monoidal_functor C D) (X : C) :
  (λ_ (F.obj X)).inv ≫ (F.ε ⊗ 𝟙 (F.obj X)) ≫ F.μ (𝟙_ C) X = F.map (λ_ X).inv :=
begin
  rw [iso.inv_comp_eq, F.left_unitality, category.assoc, category.assoc,
    ←F.to_functor.map_comp, iso.hom_inv_id, F.to_functor.map_id, comp_id],
end

@[simp, reassoc]
lemma lax_monoidal_functor.right_unitality_inv (F : lax_monoidal_functor C D) (X : C) :
  (ρ_ (F.obj X)).inv ≫ (𝟙 (F.obj X) ⊗ F.ε) ≫ F.μ X (𝟙_ C) = F.map (ρ_ X).inv :=
begin
  rw [iso.inv_comp_eq, F.right_unitality, category.assoc, category.assoc,
    ←F.to_functor.map_comp, iso.hom_inv_id, F.to_functor.map_id, comp_id],
end

@[simp, reassoc]
lemma lax_monoidal_functor.associativity_inv (F : lax_monoidal_functor C D) (X Y Z : C) :
  (𝟙 (F.obj X) ⊗ F.μ Y Z) ≫ F.μ X (Y ⊗ Z) ≫ F.map (α_ X Y Z).inv =
    (α_ (F.obj X) (F.obj Y) (F.obj Z)).inv ≫ (F.μ X Y ⊗ 𝟙 (F.obj Z)) ≫ F.μ (X ⊗ Y) Z :=
begin
  rw [iso.eq_inv_comp, ←F.associativity_assoc,
    ←F.to_functor.map_comp, iso.hom_inv_id, F.to_functor.map_id, comp_id],
end

end

/--
A monoidal functor is a lax monoidal functor for which the tensorator and unitor as isomorphisms.

See https://stacks.math.columbia.edu/tag/0FFL.
-/
structure monoidal_functor
extends lax_monoidal_functor.{v₁ v₂} C D :=
(ε_is_iso            : is_iso ε . tactic.apply_instance)
(μ_is_iso            : Π X Y : C, is_iso (μ X Y) . tactic.apply_instance)

attribute [instance] monoidal_functor.ε_is_iso monoidal_functor.μ_is_iso

variables {C D}

/--
The unit morphism of a (strong) monoidal functor as an isomorphism.
-/
noncomputable
def monoidal_functor.ε_iso (F : monoidal_functor.{v₁ v₂} C D) :
  tensor_unit D ≅ F.obj (tensor_unit C) :=
as_iso F.ε

/--
The tensorator of a (strong) monoidal functor as an isomorphism.
-/
noncomputable
def monoidal_functor.μ_iso (F : monoidal_functor.{v₁ v₂} C D) (X Y : C) :
  (F.obj X) ⊗ (F.obj Y) ≅ F.obj (X ⊗ Y) :=
as_iso (F.μ X Y)

end

open monoidal_category

namespace lax_monoidal_functor

variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C]

/-- The identity lax monoidal functor. -/
@[simps] def id : lax_monoidal_functor.{v₁ v₁} C C :=
{ ε := 𝟙 _,
  μ := λ X Y, 𝟙 _,
  .. 𝟭 C }

instance : inhabited (lax_monoidal_functor C C) := ⟨id C⟩

end lax_monoidal_functor

namespace monoidal_functor

section
variables {C : Type u₁} [category.{v₁} C] [monoidal_category.{v₁} C]
variables {D : Type u₂} [category.{v₂} D] [monoidal_category.{v₂} D]
variable (F : monoidal_functor.{v₁ v₂} C D)

lemma map_tensor {X Y X' Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y') :
  F.map (f ⊗ g) = inv (F.μ X X') ≫ ((F.map f) ⊗ (F.map g)) ≫ F.μ Y Y' :=
by simp

lemma map_left_unitor (X : C) :
  F.map (λ_ X).hom = inv (F.μ (𝟙_ C) X) ≫ (inv F.ε ⊗ 𝟙 (F.obj X)) ≫ (λ_ (F.obj X)).hom :=
begin
  simp only [lax_monoidal_functor.left_unitality],
  slice_rhs 2 3 { rw ←comp_tensor_id, simp, },
  simp,
end

lemma map_right_unitor (X : C) :
  F.map (ρ_ X).hom = inv (F.μ X (𝟙_ C)) ≫ (𝟙 (F.obj X) ⊗ inv F.ε) ≫ (ρ_ (F.obj X)).hom :=
begin
  simp only [lax_monoidal_functor.right_unitality],
  slice_rhs 2 3 { rw ←id_tensor_comp, simp, },
  simp,
end

/-- The tensorator as a natural isomorphism. -/
noncomputable
def μ_nat_iso :
  (functor.prod F.to_functor F.to_functor) ⋙ (tensor D) ≅ (tensor C) ⋙ F.to_functor :=
nat_iso.of_components
  (by { intros, apply F.μ_iso })
  (by { intros, apply F.to_lax_monoidal_functor.μ_natural })

@[simp] lemma μ_iso_hom (X Y : C) : (F.μ_iso X Y).hom = F.μ X Y := rfl
@[simp, reassoc] lemma μ_inv_hom_id (X Y : C) : (F.μ_iso X Y).inv ≫ F.μ X Y = 𝟙 _ :=
(F.μ_iso X Y).inv_hom_id
@[simp] lemma μ_hom_inv_id (X Y : C) : F.μ X Y ≫ (F.μ_iso X Y).inv = 𝟙 _ :=
(F.μ_iso X Y).hom_inv_id

@[simp] lemma ε_iso_hom : F.ε_iso.hom = F.ε := rfl
@[simp, reassoc] lemma ε_inv_hom_id : F.ε_iso.inv ≫ F.ε = 𝟙 _ := F.ε_iso.inv_hom_id
@[simp] lemma ε_hom_inv_id : F.ε ≫ F.ε_iso.inv = 𝟙 _ := F.ε_iso.hom_inv_id

end

section
variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C]

/-- The identity monoidal functor. -/
@[simps] def id : monoidal_functor.{v₁ v₁} C C :=
{ ε := 𝟙 _,
  μ := λ X Y, 𝟙 _,
  .. 𝟭 C }

instance : inhabited (monoidal_functor C C) := ⟨id C⟩

end

end monoidal_functor

variables {C : Type u₁} [category.{v₁} C] [monoidal_category.{v₁} C]
variables {D : Type u₂} [category.{v₂} D] [monoidal_category.{v₂} D]
variables {E : Type u₃} [category.{v₃} E] [monoidal_category.{v₃} E]

namespace lax_monoidal_functor
variables (F : lax_monoidal_functor.{v₁ v₂} C D) (G : lax_monoidal_functor.{v₂ v₃} D E)

-- The proofs here are horrendous; rewrite_search helps a lot.
/-- The composition of two lax monoidal functors is again lax monoidal. -/
@[simps] def comp : lax_monoidal_functor.{v₁ v₃} C E :=
{ ε                := G.ε ≫ (G.map F.ε),
  μ                := λ X Y, G.μ (F.obj X) (F.obj Y) ≫ G.map (F.μ X Y),
  μ_natural'       := λ _ _ _ _ f g,
  begin
    simp only [functor.comp_map, assoc],
    rw [←category.assoc, lax_monoidal_functor.μ_natural, category.assoc, ←map_comp, ←map_comp,
        ←lax_monoidal_functor.μ_natural]
  end,
  associativity'   := λ X Y Z,
  begin
    dsimp,
    rw id_tensor_comp,
    slice_rhs 3 4 { rw [← G.to_functor.map_id, G.μ_natural], },
    slice_rhs 1 3 { rw ←G.associativity, },
    rw comp_tensor_id,
    slice_lhs 2 3 { rw [← G.to_functor.map_id, G.μ_natural], },
    rw [category.assoc, category.assoc, category.assoc, category.assoc, category.assoc,
        ←G.to_functor.map_comp, ←G.to_functor.map_comp, ←G.to_functor.map_comp,
        ←G.to_functor.map_comp, F.associativity],
  end,
  left_unitality'  := λ X,
  begin
    dsimp,
    rw [G.left_unitality, comp_tensor_id, category.assoc, category.assoc],
    apply congr_arg,
    rw [F.left_unitality, map_comp, ←nat_trans.id_app, ←category.assoc,
        ←lax_monoidal_functor.μ_natural, nat_trans.id_app, map_id, ←category.assoc, map_comp],
  end,
  right_unitality' := λ X,
  begin
    dsimp,
    rw [G.right_unitality, id_tensor_comp, category.assoc, category.assoc],
    apply congr_arg,
    rw [F.right_unitality, map_comp, ←nat_trans.id_app, ←category.assoc,
        ←lax_monoidal_functor.μ_natural, nat_trans.id_app, map_id, ←category.assoc, map_comp],
  end,
  .. (F.to_functor) ⋙ (G.to_functor) }.

infixr ` ⊗⋙ `:80 := comp

end lax_monoidal_functor

namespace lax_monoidal_functor
universes v₀ u₀
variables {B : Type u₀} [category.{v₀} B] [monoidal_category.{v₀} B]
variables (F : lax_monoidal_functor.{v₀ v₁} B C) (G : lax_monoidal_functor.{v₂ v₃} D E)

local attribute [simp] μ_natural associativity left_unitality right_unitality

/-- The cartesian product of two lax monoidal functors is lax monoidal. -/
@[simps]
def prod : lax_monoidal_functor (B × D) (C × E) :=
{ ε := (ε F, ε G),
  μ := λ X Y, (μ F X.1 Y.1, μ G X.2 Y.2),
  .. (F.to_functor).prod (G.to_functor) }

end lax_monoidal_functor

namespace monoidal_functor
variable (C)

/-- The diagonal functor as a monoidal functor. -/
@[simps]
def diag : monoidal_functor C (C × C) :=
{ ε := 𝟙 _,
  μ := λ X Y, 𝟙 _,
  .. functor.diag C }

end monoidal_functor

namespace lax_monoidal_functor
variables (F : lax_monoidal_functor.{v₁ v₂} C D) (G : lax_monoidal_functor.{v₁ v₃} C E)

/-- The cartesian product of two lax monoidal functors starting from the same monoidal category `C`
    is lax monoidal. -/
def prod' : lax_monoidal_functor C (D × E) :=
(monoidal_functor.diag C).to_lax_monoidal_functor ⊗⋙ (F.prod G)

@[simp] lemma prod'_to_functor :
  (F.prod' G).to_functor = (F.to_functor).prod' (G.to_functor) := rfl

@[simp] lemma prod'_ε : (F.prod' G).ε = (F.ε, G.ε) :=
by { dsimp [prod'], simp }

@[simp] lemma prod'_μ (X Y : C) : (F.prod' G).μ X Y = (F.μ X Y, G.μ X Y) :=
by { dsimp [prod'], simp }

end lax_monoidal_functor

namespace monoidal_functor

variables (F : monoidal_functor.{v₁ v₂} C D) (G : monoidal_functor.{v₂ v₃} D E)

/-- The composition of two monoidal functors is again monoidal. -/
@[simps]
def comp : monoidal_functor.{v₁ v₃} C E :=
{ ε_is_iso := by { dsimp, apply_instance },
  μ_is_iso := by { dsimp, apply_instance },
  .. (F.to_lax_monoidal_functor).comp (G.to_lax_monoidal_functor) }.

infixr ` ⊗⋙ `:80 := comp -- We overload notation; potentially dangerous, but it seems to work.

end monoidal_functor

namespace monoidal_functor
universes v₀ u₀
variables {B : Type u₀} [category.{v₀} B] [monoidal_category.{v₀} B]
variables (F : monoidal_functor.{v₀ v₁} B C) (G : monoidal_functor.{v₂ v₃} D E)

/-- The cartesian product of two monoidal functors is monoidal. -/
@[simps]
def prod : monoidal_functor (B × D) (C × E) :=
{ ε_is_iso := (is_iso_prod_iff C E).mpr ⟨ε_is_iso F, ε_is_iso G⟩,
  μ_is_iso := λ X Y, (is_iso_prod_iff C E).mpr ⟨μ_is_iso F X.1 Y.1, μ_is_iso G X.2 Y.2⟩,
  .. (F.to_lax_monoidal_functor).prod (G.to_lax_monoidal_functor) }

end monoidal_functor

namespace monoidal_functor
variables (F : monoidal_functor.{v₁ v₂} C D) (G : monoidal_functor.{v₁ v₃} C E)

/-- The cartesian product of two monoidal functors starting from the same monoidal category `C`
    is monoidal. -/
def prod' : monoidal_functor C (D × E) := diag C ⊗⋙ (F.prod G)

@[simp] lemma prod'_to_lax_monoidal_functor :
    (F.prod' G).to_lax_monoidal_functor
  = (F.to_lax_monoidal_functor).prod' (G.to_lax_monoidal_functor) := rfl

end monoidal_functor

/--
If we have a right adjoint functor `G` to a monoidal functor `F`, then `G` has a lax monoidal
structure as well.
-/
@[simps]
noncomputable
def monoidal_adjoint (F : monoidal_functor C D) {G : D ⥤ C} (h : F.to_functor ⊣ G) :
  lax_monoidal_functor D C :=
{ to_functor := G,
  ε := h.hom_equiv _ _ (inv F.ε),
  μ := λ X Y,
    h.hom_equiv _ (X ⊗ Y) (inv (F.μ (G.obj X) (G.obj Y)) ≫ (h.counit.app X ⊗ h.counit.app Y)),
  μ_natural' := λ X Y X' Y' f g,
  begin
    rw [←h.hom_equiv_naturality_left, ←h.hom_equiv_naturality_right, equiv.apply_eq_iff_eq, assoc,
      is_iso.eq_inv_comp, ←F.to_lax_monoidal_functor.μ_natural_assoc, is_iso.hom_inv_id_assoc,
      ←tensor_comp, adjunction.counit_naturality, adjunction.counit_naturality, tensor_comp],
  end,
  associativity' := λ X Y Z,
  begin
    rw [←h.hom_equiv_naturality_right, ←h.hom_equiv_naturality_left, ←h.hom_equiv_naturality_left,
      ←h.hom_equiv_naturality_left, equiv.apply_eq_iff_eq,
      ← cancel_epi (F.to_lax_monoidal_functor.μ (G.obj X ⊗ G.obj Y) (G.obj Z)),
      ← cancel_epi (F.to_lax_monoidal_functor.μ (G.obj X) (G.obj Y) ⊗ 𝟙 (F.obj (G.obj Z))),
      F.to_lax_monoidal_functor.associativity_assoc (G.obj X) (G.obj Y) (G.obj Z),
      ←F.to_lax_monoidal_functor.μ_natural_assoc, assoc, is_iso.hom_inv_id_assoc,
      ←F.to_lax_monoidal_functor.μ_natural_assoc, is_iso.hom_inv_id_assoc, ←tensor_comp,
      ←tensor_comp, id_comp, functor.map_id, functor.map_id, id_comp, ←tensor_comp_assoc,
      ←tensor_comp_assoc, id_comp, id_comp, h.hom_equiv_unit, h.hom_equiv_unit, functor.map_comp,
      assoc, assoc, h.counit_naturality, h.left_triangle_components_assoc, is_iso.hom_inv_id_assoc,
      functor.map_comp, assoc, h.counit_naturality, h.left_triangle_components_assoc,
      is_iso.hom_inv_id_assoc],
    exact associator_naturality (h.counit.app X) (h.counit.app Y) (h.counit.app Z),
  end,
  left_unitality' := λ X,
  begin
    rw [←h.hom_equiv_naturality_right, ←h.hom_equiv_naturality_left, ←equiv.symm_apply_eq,
      h.hom_equiv_counit, F.map_left_unitor, h.hom_equiv_unit, assoc, assoc, assoc, F.map_tensor,
      assoc, assoc, is_iso.hom_inv_id_assoc, ←tensor_comp_assoc, functor.map_id, id_comp,
      functor.map_comp, assoc, h.counit_naturality, h.left_triangle_components_assoc,
      ←left_unitor_naturality, ←tensor_comp_assoc, id_comp, comp_id],
  end,
  right_unitality' := λ X,
  begin
    rw [←h.hom_equiv_naturality_right, ←h.hom_equiv_naturality_left, ←equiv.symm_apply_eq,
      h.hom_equiv_counit, F.map_right_unitor, assoc, assoc, ←right_unitor_naturality,
      ←tensor_comp_assoc, comp_id, id_comp, h.hom_equiv_unit, F.map_tensor, assoc, assoc, assoc,
      is_iso.hom_inv_id_assoc, functor.map_comp, functor.map_id, ←tensor_comp_assoc, assoc,
      h.counit_naturality, h.left_triangle_components_assoc, id_comp],
  end }.

/-- If a monoidal functor `F` is an equivalence of categories then its inverse is also monoidal. -/
@[simps]
noncomputable
def monoidal_inverse (F : monoidal_functor C D) [is_equivalence F.to_functor] :
  monoidal_functor D C :=
{ to_lax_monoidal_functor := monoidal_adjoint F (as_equivalence _).to_adjunction,
  ε_is_iso := by { dsimp [equivalence.to_adjunction], apply_instance },
  μ_is_iso := λ X Y, by { dsimp [equivalence.to_adjunction], apply_instance } }

end category_theory


import cicm2022.examples.Proj.degree_zero_part
import cicm2022.examples.Proj.structure_sheaf
import cicm2022.examples.Proj.lemmas
import cicm2022.examples.Proj.Proj_iso_Spec.Top_component.from_Spec

import algebraic_geometry.structure_sheaf
import algebraic_geometry.Spec

noncomputable theory

namespace algebraic_geometry

open_locale direct_sum big_operators pointwise big_operators
open direct_sum set_like.graded_monoid localization finset (hiding mk_zero)

variables {R A : Type*}
variables [comm_ring R] [comm_ring A] [algebra R A]

variables (𝒜 : ℕ → submodule R A)
variables [graded_algebra 𝒜]

open Top topological_space
open category_theory opposite
open projective_spectrum.structure_sheaf

local notation `Proj` := Proj.to_LocallyRingedSpace 𝒜
-- `Proj` as a locally ringed space
local notation `Proj.T` := Proj .1.1.1
-- the underlying topological space of `Proj`
local notation `Proj| ` U := Proj .restrict (opens.open_embedding (U : opens Proj.T))
-- `Proj` restrict to some open set
local notation `Proj.T| ` U :=
  (Proj .restrict (opens.open_embedding (U : opens Proj.T))).to_SheafedSpace.to_PresheafedSpace.1
-- the underlying topological space of `Proj` restricted to some open set
local notation `pbo` x := projective_spectrum.basic_open 𝒜 x
-- basic open sets in `Proj`
local notation `sbo` f := prime_spectrum.basic_open f
-- basic open sets in `Spec`
local notation `Spec` ring := Spec.LocallyRingedSpace_obj (CommRing.of ring)
-- `Spec` as a locally ringed space
local notation `Spec.T` ring :=
  (Spec.LocallyRingedSpace_obj (CommRing.of ring)).to_SheafedSpace.to_PresheafedSpace.1
-- the underlying topological space of `Spec`
local notation `A⁰_` f_deg := degree_zero_part f_deg

namespace Proj_iso_Spec_Sheaf_component

namespace to_Spec

variables {𝒜} {f : A} {m : ℕ} (hm : 0 < m) (f_deg : f ∈ 𝒜 m)
variable (U : (opens (Spec.T (A⁰_ f_deg)))ᵒᵖ)

local notation `pf_sheaf` x := (Proj_iso_Spec_Top_component hm f_deg).hom _* x.presheaf -- pushforward a sheaf

variable (hh : (pf_sheaf (Proj| (pbo f))).obj U)

lemma pf_sheaf.one_val :
  (1 : (pf_sheaf (Proj| (pbo f))).obj U).1 = 1 := rfl

lemma pf_sheaf.zero_val :
  (0 : (pf_sheaf (Proj| (pbo f))).obj U).1 = 0 := rfl

lemma pf_sheaf.add_val (x y : (pf_sheaf (Proj| (pbo f))).obj U) :
  (x + y).1 = x.1 + y.1 := rfl

lemma pf_sheaf.mul_val (x y : (pf_sheaf (Proj| (pbo f))).obj U) :
  (x * y).1 = x.1 * y.1 := rfl

variables {f_deg hm U}
lemma inv_mem (y : unop U) :
  ((Proj_iso_Spec_Top_component hm f_deg).inv y.1).1 ∈
    ((@opens.open_embedding Proj.T (pbo f)).is_open_map.functor.op.obj
      ((opens.map (Proj_iso_Spec_Top_component hm f_deg).hom).op.obj U)).unop :=
begin
  refine ⟨⟨((Proj_iso_Spec_Top_component hm f_deg).inv y.1).1, ((Proj_iso_Spec_Top_component hm f_deg).inv y.1).2⟩, _, rfl⟩,
  change _ ∈ _ ⁻¹' _,
  erw set.mem_preimage,
  change (Proj_iso_Spec_Top_component.to_Spec.to_fun 𝒜 f_deg (Proj_iso_Spec_Top_component.from_Spec.to_fun f_deg hm y.1)) ∈ _,
  erw Proj_iso_Spec_Top_component.to_Spec_from_Spec 𝒜 hm f_deg y.1,
  exact y.2,
end

variable (hm)
def hl (y : unop U) : homogeneous_localization 𝒜 _ :=
hh.1 ⟨((Proj_iso_Spec_Top_component hm f_deg).inv y.1).1, inv_mem y⟩

lemma hl.one (y : unop U) :
  hl hm 1 y = 1 :=
by rw [hl, pf_sheaf.one_val, pi.one_apply]

lemma hl.zero (y : unop U) :
  hl hm 0 y = 0 :=
by rw [hl, pf_sheaf.zero_val, pi.zero_apply]

lemma hl.add (x y : (pf_sheaf (Proj| (pbo f))).obj U) (z : unop U) :
  hl hm (x + y) z = hl hm x z + hl hm y z :=
by rw [hl, pf_sheaf.add_val, pi.add_apply, hl, hl]

lemma hl.mul (x y : (pf_sheaf (Proj| (pbo f))).obj U) (z : unop U) :
  hl hm (x * y) z = hl hm x z * hl hm y z :=
by rw [hl, hl, hl, pf_sheaf.mul_val, pi.mul_apply]

def num (y : unop U) : A⁰_ f_deg :=
⟨mk ((hl hm hh y).num * (hl hm hh y).denom ^ m.pred) ⟨f^(hl hm hh y).deg, ⟨_, rfl⟩⟩,
  ⟨(hl hm hh y).deg, ⟨(hl hm hh y).num * (hl hm hh y).denom ^ m.pred, begin
    convert mul_mem (hl hm hh y).num_mem (set_like.graded_monoid.pow_mem m.pred (hl hm hh y).denom_mem),
    exact calc m * (hl hm hh y).deg
            = (m.pred + 1) * (hl hm hh y).deg
            : begin
              congr,
              conv_lhs { rw ←nat.succ_pred_eq_of_pos hm },
            end
        ... = m.pred * (hl hm hh y).deg +
              1 * (hl hm hh y).deg
            : by rw add_mul
        ... = _ : begin
          rw [add_comm, one_mul],
          congr,
        end,
  end⟩, rfl⟩⟩

def denom (y : unop U) : A⁰_ f_deg :=
⟨mk ((hl hm hh y).denom ^ m) ⟨f^(hl hm hh y).deg, ⟨_, rfl⟩⟩,
  ⟨(hl hm hh y).deg, ⟨_, set_like.graded_monoid.pow_mem m (hl hm hh y).denom_mem⟩, rfl⟩⟩

lemma denom.not_mem (y : unop U) : denom hm hh y ∉ y.1.as_ideal := λ r,
begin
  have prop1 := (hl hm hh y).denom_not_mem,
  change _ ∉ (Proj_iso_Spec_Top_component.from_Spec.to_fun f_deg hm y.1).1.as_homogeneous_ideal at prop1,
  contrapose! prop1,
  change ∀ _, _,

  contrapose! prop1,
  obtain ⟨n, hn⟩ := prop1,

  have eq1 : (hl hm hh y).deg = n,
  { -- n ≠ i, contradiction,
    by_contra ineq,
    simp only [graded_algebra.proj_apply, direct_sum.decompose_of_mem_ne 𝒜 ((hl hm hh y).denom_mem) ineq, zero_pow hm, mk_zero] at hn,
    apply hn,
    exact submodule.zero_mem _, },
  apply hn,
  convert r,

  rw [graded_algebra.proj_apply, ←eq1, direct_sum.decompose_of_mem_same],
  exact (hl hm hh y).denom_mem,
  exact eq1.symm,
end

def fmk (y : unop U) : localization.at_prime y.1.as_ideal :=
mk (num hm hh y) ⟨denom hm hh y, denom.not_mem hm hh y⟩

lemma fmk.one (y : unop U) : fmk hm 1 y = 1 :=
begin
  unfold fmk,
  dsimp only,
  rw [show (1 : structure_sheaf.localizations (A⁰_ f_deg) y.val) =
    localization.mk 1 1, begin
      erw localization.mk_self 1,
    end, localization.mk_eq_mk', is_localization.eq],

  have eq1 := (hl hm 1 y).eq_num_div_denom,
  rw [hl.one, homogeneous_localization.one_val] at eq1,
  erw [show (1 : localization.at_prime ((Proj_iso_Spec_Top_component hm f_deg).inv y.1).1.as_homogeneous_ideal.to_ideal) =
    mk 1 1,
      begin
        symmetry,
        convert localization.mk_self _,
        refl,
      end, localization.mk_eq_mk', is_localization.eq] at eq1,
  obtain ⟨⟨c, hc1⟩, eq1⟩ := eq1,

  change ¬(∀ i : ℕ, _ ∈ _) at hc1,
  rw not_forall at hc1,
  obtain ⟨j, hc1⟩ := hc1,
  rw [one_mul, submonoid.coe_one, mul_one] at eq1,
  simp only [←subtype.val_eq_coe] at eq1,
  rw [← hl.one] at eq1,
  have eq2 : graded_algebra.proj 𝒜 ((hl hm 1 y).deg + j) ((hl hm 1 y).denom * c)
    = graded_algebra.proj 𝒜 ((hl hm 1 y).deg + j) ((hl hm 1 y).num * c),
  { exact congr_arg _ eq1, },

  have eq3 : graded_algebra.proj 𝒜 ((hl hm 1 y).deg + j) ((hl hm 1 y).denom * c)
    = (hl hm 1 y).denom * (graded_algebra.proj 𝒜 j c),
  { apply graded_algebra.proj_hom_mul,
    exact (hl hm 1 y).denom_mem,
    intro rid,
    apply hc1,
    simp only [rid, zero_pow hm, localization.mk_zero],
    exact submodule.zero_mem _, },

  have eq4 : graded_algebra.proj 𝒜 ((hl hm 1 y).deg + j)
    ((hl hm 1 y).num * c)
    = (hl hm 1 y).num * (graded_algebra.proj 𝒜 j c),
  { apply graded_algebra.proj_hom_mul,
    exact (hl hm 1 y).num_mem,
    intro rid,
    apply hc1,
    simp only [rid, zero_pow hm, localization.mk_zero],
    exact submodule.zero_mem _, },

  erw [eq3, eq4] at eq2,

  use mk ((graded_algebra.proj 𝒜 j c)^m) ⟨f^j, ⟨_, rfl⟩⟩,
  rw [submonoid.coe_one, one_mul, mul_one, ← subtype.val_eq_coe, ← subtype.val_eq_coe],
  dsimp only,

  unfold num denom,
  rw [subtype.ext_iff, subring.coe_mul],
  dsimp only [subtype.coe_mk],
  rw [mk_mul, subring.coe_mul],
  dsimp only [subtype.coe_mk],
  rw [mk_mul],
  congr' 1,
  exact calc (hl hm 1 y).num * (hl hm 1 y).denom ^ m.pred * (graded_algebra.proj 𝒜 j) c ^ m
          = (hl hm 1 y).num * (hl hm 1 y).denom ^ m.pred * (graded_algebra.proj 𝒜 j) c ^ (m.pred + 1)
          : begin
            congr',
            symmetry,
            apply nat.succ_pred_eq_of_pos,
            exact hm
          end
      ... = (hl hm 1 y).num * (hl hm 1 y).denom ^ m.pred * ((graded_algebra.proj 𝒜 j) c ^ m.pred * graded_algebra.proj 𝒜 j c)
          : by ring_exp
      ... = ((hl hm 1 y).num * graded_algebra.proj 𝒜 j c) * ((hl hm 1 y).denom ^ m.pred * (graded_algebra.proj 𝒜 j) c ^ m.pred)
          : by ring
      ... = ((hl hm 1 y).denom * graded_algebra.proj 𝒜 j c) * ((hl hm 1 y).denom ^ m.pred * (graded_algebra.proj 𝒜 j) c ^ m.pred)
          : by rw eq2
      ... = ((hl hm 1 y).denom * graded_algebra.proj 𝒜 j c) ^ (1 + m.pred)
          : by ring_exp
      ... = ((hl hm 1 y).denom * graded_algebra.proj 𝒜 j c) ^ m
          : begin
            congr' 1,
            rw [add_comm],
            convert nat.succ_pred_eq_of_pos hm,
          end
      ... = _ : by rw mul_pow,
end

lemma fmk.zero (y : unop U) : fmk hm 0 y = 0 :=
begin
  unfold fmk,
  rw [show (0 : structure_sheaf.localizations (A⁰_ f_deg) y.val) =
    localization.mk 0 1, begin
      rw localization.mk_zero,
    end, localization.mk_eq_mk', is_localization.eq],
  dsimp only,

  have eq1 := (hl hm 0 y).eq_num_div_denom,
  rw [hl.zero, homogeneous_localization.zero_val] at eq1,
  erw [show (0 : localization.at_prime ((Proj_iso_Spec_Top_component hm f_deg).inv y.1).1.as_homogeneous_ideal.to_ideal) =
    localization.mk 0 1,
      begin
        rw localization.mk_zero,
      end, localization.mk_eq_mk', is_localization.eq] at eq1,
  obtain ⟨⟨c, hc1⟩, eq1⟩ := eq1,
  rw [zero_mul, zero_mul, submonoid.coe_one, mul_one] at eq1,
  simp only [←subtype.val_eq_coe] at eq1,
  dsimp only at eq1,

  change c ∉ Proj_iso_Spec_Top_component.from_Spec.carrier _ at hc1,
  change ¬(∀ i : ℕ, _ ∈ _) at hc1,
  rw not_forall at hc1,
  obtain ⟨j, hc1⟩ := hc1,
  replace eq1 := eq1.symm,
  have eq2 : graded_algebra.proj 𝒜 ((hl hm 0 y).deg + j) ((hl hm 0 y).num * c) = 0,
  { erw [eq1, linear_map.map_zero], },
  have eq3 : graded_algebra.proj 𝒜 ((hl hm 0 y).deg + j) ((hl hm 0 y).num * c)
    = (hl hm 0 y).num * graded_algebra.proj 𝒜 j c,
  { apply graded_algebra.proj_hom_mul,
    exact (hl hm 0 y).num_mem,
    intro rid,
    apply hc1,
    simp only [rid, zero_pow hm, mk_zero],
    exact submodule.zero_mem _, },
    erw eq3 at eq2,

  use mk ((graded_algebra.proj 𝒜 j c)^m) ⟨f^j, ⟨_, rfl⟩⟩,
  unfold num,
  dsimp only [subtype.coe_mk],
  rw [subtype.ext_iff, subring.coe_mul, subring.coe_mul, subring.coe_mul, subring.coe_mul,
    add_submonoid_class.coe_zero, zero_mul, submonoid.coe_one, subring.coe_one, mul_one, zero_mul],
  dsimp only [subtype.coe_mk],
  rw [mk_mul],
  convert mk_zero _,
  exact calc (hl hm 0 y).num * (hl hm 0 y).denom ^ m.pred * (graded_algebra.proj 𝒜 j) c ^ m
          = (hl hm 0 y).num * (hl hm 0 y).denom ^ m.pred * (graded_algebra.proj 𝒜 j) c ^ (m.pred + 1)
          : begin
            congr',
            symmetry,
            apply nat.succ_pred_eq_of_pos,
            exact hm
          end
      ... = (hl hm 0 y).num * (hl hm 0 y).denom ^ m.pred * ((graded_algebra.proj 𝒜 j) c ^ m.pred * graded_algebra.proj 𝒜 j c)
          : by rw [pow_add, pow_one]
      ... = ((hl hm 0 y).num * graded_algebra.proj 𝒜 j c)
            * ((hl hm 0 y).denom ^ m.pred * (graded_algebra.proj 𝒜 j) c ^ m.pred) : by ring
      ... = 0 * ((hl hm 0 y).denom ^ m.pred * (graded_algebra.proj 𝒜 j) c ^ m.pred) : by rw eq2
      ... = 0 : by rw zero_mul,
end

lemma fmk.add (x y : (pf_sheaf (Proj| (pbo f))).obj U) (z : unop U) :
  fmk hm (x + y) z = fmk hm x z + fmk hm y z :=
begin
  unfold fmk,
  rw [localization.add_mk],

  have eq_xz := (hl hm x z).eq_num_div_denom,
  have eq_yz := (hl hm y z).eq_num_div_denom,
  have eq_addz := (hl hm (x + y) z).eq_num_div_denom,
  rw [hl.add, homogeneous_localization.add_val, eq_xz, eq_yz, localization.add_mk, localization.mk_eq_mk', is_localization.eq] at eq_addz,
  obtain ⟨⟨c, hc⟩, eq_addz⟩ := eq_addz,
  rw [submonoid.coe_mul] at eq_addz,
  simp only [←subtype.val_eq_coe] at eq_addz,

  set d_x := (hl hm x z).denom with dx_eq,
  set n_x := (hl hm x z).num with nx_eq,
  set d_y := (hl hm y z).denom with dy_eq,
  set n_y := (hl hm y z).num with ny_eq,
  set d_xy := (hl hm (x + y) z).denom with dxy_eq,
  set n_xy := (hl hm (x + y) z).num with nxy_eq,
  set i_x := (hl hm x z).deg with ix_eq,
  set i_y := (hl hm y z).deg with iy_eq,
  set i_xy := (hl hm (x + y) z).deg with ixy_eq,

  unfold num denom,
  simp only [←dx_eq, ←nx_eq, ←dy_eq, ←ny_eq, ←dxy_eq, ←nxy_eq, ←i_x, ←i_y, ←i_xy] at eq_addz ⊢,
  rw [localization.mk_eq_mk', is_localization.eq],

  change ¬(∀ i : ℕ, _ ∈ _) at hc,
  rw not_forall at hc,
  obtain ⟨j, hc⟩ := hc,

  use localization.mk ((graded_algebra.proj 𝒜 j c)^m) ⟨f^j, ⟨_, rfl⟩⟩,
  rw [submonoid.coe_mul],
  simp only [subtype.ext_iff, subring.coe_mul, add_mem_class.coe_add, mk_mul, add_mk,
    subtype.coe_mk],
  rw [localization.mk_eq_mk', is_localization.eq],
  use 1,
  simp only [submonoid.coe_one, submonoid.mk_mul_mk, set_like.coe_mk, mul_one, ← pow_add],

  rw calc (f ^ (i_x + i_y) * (d_y ^ m * (n_x * d_x ^ m.pred))
          + f ^ (i_y + i_x) * (d_x ^ m * (n_y * d_y ^ m.pred)))
          * d_xy ^ m
          * (graded_algebra.proj 𝒜 j) c ^ m
          * f ^ (i_xy + (i_x + i_y) + j)
        = (f ^ (i_x + i_y) * (d_y ^ m * (n_x * d_x ^ m.pred))
            + f ^ (i_x + i_y) * (d_x ^ m * (n_y * d_y ^ m.pred)))
          * d_xy ^ m
          * (graded_algebra.proj 𝒜 j) c ^ m
          * f ^ (i_xy + (i_x + i_y) + j)
        : begin
          congr' 4,
          rw add_comm,
        end
    ... = (f ^ (i_x + i_y) * (d_y ^ m * (n_x * d_x ^ m.pred) + d_x ^ m * (n_y * d_y ^ m.pred)))
          * d_xy ^ m
          * (graded_algebra.proj 𝒜 j) c ^ m
          * f ^ (i_xy + (i_x + i_y) + j)
        : begin
          congr' 3,
          rw mul_add,
        end
    ... = (d_y ^ m * (n_x * d_x ^ m.pred) + d_x ^ m * (n_y * d_y ^ m.pred))
          * d_xy ^ m
          * (graded_algebra.proj 𝒜 j) c ^ m
          * (f ^ (i_x + i_y) * f ^ (i_xy + (i_x + i_y) + j)) : by ring
    ... = (d_y ^ m * (n_x * d_x ^ m.pred) + d_x ^ m * (n_y * d_y ^ m.pred))
          * d_xy ^ m
          * (graded_algebra.proj 𝒜 j) c ^ m
          * (f ^ (i_x + i_y + (i_xy + (i_x + i_y) + j)))
        : begin
          congr' 1,
          rw [←pow_add],
        end
    ... = (d_y ^ m * (n_x * d_x ^ m.pred) + d_x ^ m * (n_y * d_y ^ m.pred))
          * d_xy ^ m
          * (graded_algebra.proj 𝒜 j) c ^ m
          * (f ^ (i_x + i_y + (i_y + i_x) + i_xy + j))
        : begin
          congr' 2,
          ring,
        end,
  congr' 1,
  suffices EQ : (d_x * n_y + d_y * n_x) * d_xy * graded_algebra.proj 𝒜 j c = n_xy * (d_x * d_y) * graded_algebra.proj 𝒜 j c,
  { rw calc n_xy * d_xy ^ m.pred * (d_x ^ m * d_y ^ m) * (graded_algebra.proj 𝒜 j) c ^ m
          = n_xy * d_xy ^ m.pred * (d_x ^ m * d_y ^ m) * (graded_algebra.proj 𝒜 j) c ^ (m.pred + 1)
          : begin
            congr',
            symmetry,
            apply nat.succ_pred_eq_of_pos hm,
          end
      ... = n_xy * d_xy ^ m.pred * (d_x ^ (m.pred + 1) * d_y ^ m) * (graded_algebra.proj 𝒜 j) c ^ (m.pred + 1)
          : begin
            congr',
            symmetry,
            apply nat.succ_pred_eq_of_pos hm,
          end
      ... = n_xy * d_xy ^ m.pred * (d_x ^ (m.pred + 1) * d_y ^ (m.pred + 1)) * (graded_algebra.proj 𝒜 j) c ^ (m.pred + 1)
          : begin
            congr',
            symmetry,
            apply nat.succ_pred_eq_of_pos hm,
          end
      ... = n_xy * d_xy ^ m.pred * (d_x ^ m.pred * d_x * (d_y ^ m.pred * d_y))
            * ((graded_algebra.proj 𝒜 j) c ^ m.pred * (graded_algebra.proj 𝒜 j) c)
          : begin
            simp only [pow_add, pow_one],
          end
      ... = (n_xy * (d_x * d_y) * graded_algebra.proj 𝒜 j c)
            * (d_xy ^ m.pred * d_x ^ m.pred * d_y ^ m.pred * (graded_algebra.proj 𝒜 j c) ^ m.pred)
          : by ring
      ... = ((d_x * n_y + d_y * n_x) * d_xy * (graded_algebra.proj 𝒜 j) c)
            * (d_xy ^ m.pred * d_x ^ m.pred * d_y ^ m.pred * (graded_algebra.proj 𝒜 j c) ^ m.pred)
          : by rw EQ
      ... = (d_x * n_y + d_y * n_x)
            * ((d_xy ^ m.pred * d_xy) * d_x ^ m.pred * d_y ^ m.pred
              * ((graded_algebra.proj 𝒜 j c) ^ m.pred * (graded_algebra.proj 𝒜 j c)))
          : by ring
      ... = (d_x * n_y + d_y * n_x)
            * (d_xy ^ m * d_x ^ m.pred * d_y ^ m.pred
              * (graded_algebra.proj 𝒜 j c) ^ m)
          : begin
            congr';
            conv_rhs { rw [show m = m.pred + 1, from (nat.succ_pred_eq_of_pos hm).symm] };
            rw [pow_add, pow_one],
          end
      ... = (d_x * n_y + d_y * n_x)
            * d_x ^ m.pred * d_y ^ m.pred * d_xy ^ m
            * (graded_algebra.proj 𝒜 j c) ^ m : by ring,
    congr',

    exact calc (d_x * n_y + d_y * n_x) * d_x ^ m.pred * d_y ^ m.pred
          = (d_y ^ m.pred * d_y) * (n_x * d_x ^ m.pred) + (d_x ^ m.pred * d_x) * (n_y * d_y ^ m.pred)
          : by ring
      ... = (d_y ^ m.pred * d_y^1) * (n_x * d_x ^ m.pred) + (d_x ^ m.pred * d_x ^ 1) * (n_y * d_y ^ m.pred)
          : by simp only [pow_one]
      ... = (d_y ^ (m.pred + 1)) * (n_x * d_x ^ m.pred) + (d_x ^ (m.pred + 1)) * (n_y * d_y ^ m.pred)
          : by simp only [pow_add]
      ... = d_y ^ m * (n_x * d_x ^ m.pred) + d_x ^ m * (n_y * d_y ^ m.pred)
          : begin
            congr';
            apply nat.succ_pred_eq_of_pos hm,
          end, },

  replace eq_addz := congr_arg (graded_algebra.proj 𝒜 ((i_x + i_y) + i_xy + j)) eq_addz,
  have eq1 : (graded_algebra.proj 𝒜 (i_x + i_y + i_xy + j)) ((d_x * n_y + d_y * n_x) * d_xy * c)
    = (d_x * n_y + d_y * n_x) * d_xy * graded_algebra.proj 𝒜 j c,
  { apply graded_algebra.proj_hom_mul,
    { apply set_like.graded_monoid.mul_mem,
      apply submodule.add_mem _ _ _,
      apply set_like.graded_monoid.mul_mem,
      exact (hl hm x z).denom_mem,
      exact (hl hm y z).num_mem,
      rw add_comm,
      apply set_like.graded_monoid.mul_mem,
      exact (hl hm y z).denom_mem,
      exact (hl hm x z).num_mem,
      exact (hl hm (x + y) z).denom_mem, },
    intro rid,
    apply hc,
    simp only [rid, zero_pow hm, localization.mk_zero],
    exact submodule.zero_mem _, },
  erw eq1 at eq_addz,
  clear eq1,

  have eq2 : (graded_algebra.proj 𝒜 (i_x + i_y + i_xy + j)) (n_xy * (d_x * d_y) * c)
    = n_xy * (d_x * d_y) * graded_algebra.proj 𝒜 j c,
  { apply graded_algebra.proj_hom_mul,
    { rw show i_x + i_y + i_xy = i_xy + (i_x + i_y), by ring,
      apply set_like.graded_monoid.mul_mem,
      exact (hl hm (x + y) z).num_mem,
      apply set_like.graded_monoid.mul_mem,
      exact (hl hm _ z).denom_mem,
      exact (hl hm _ z).denom_mem, },
    intro rid,
    apply hc,
    simp only [rid, zero_pow hm, localization.mk_zero],
    exact submodule.zero_mem _, },
  erw eq2 at eq_addz,
  exact eq_addz,
end

lemma fmk.mul (x y : (pf_sheaf (Proj| (pbo f))).obj U) (z : unop U) :
  fmk hm (x * y) z = fmk hm x z * fmk hm y z :=
begin
  unfold fmk,
  rw [mk_mul],

  have eq_xz := (hl hm x z).eq_num_div_denom,
  have eq_yz := (hl hm y z).eq_num_div_denom,
  have eq_mulz := (hl hm (x * y) z).eq_num_div_denom,
  rw [hl.mul, homogeneous_localization.mul_val, eq_xz, eq_yz, mk_mul, mk_eq_mk', is_localization.eq] at eq_mulz,
  obtain ⟨⟨c, hc⟩, eq_mulz⟩ := eq_mulz,
  simp only [submonoid.coe_mul] at eq_mulz,
  simp only [← subtype.val_eq_coe] at eq_mulz,

  set d_x := (hl hm x z).denom with dx_eq,
  set n_x := (hl hm x z).num with nx_eq,
  set d_y := (hl hm y z).denom with dy_eq,
  set n_y := (hl hm y z).num with ny_eq,
  set d_xy := (hl hm (x * y) z).denom with dxy_eq,
  set n_xy := (hl hm (x * y) z).num with nxy_eq,
  set i_x := (hl hm x z).deg with ix_eq,
  set i_y := (hl hm y z).deg with iy_eq,
  set i_xy := (hl hm (x * y) z).deg with ixy_eq,

  unfold num denom,
  simp only [←dx_eq, ←nx_eq, ←dy_eq, ←ny_eq, ←dxy_eq, ←nxy_eq, ←i_x, ←i_y, ←i_xy] at eq_mulz ⊢,
  rw [localization.mk_eq_mk', is_localization.eq],

  change ¬(∀ i : ℕ, _ ∈ _) at hc,
  erw not_forall at hc,
  obtain ⟨j, hc⟩ := hc,

  use mk ((graded_algebra.proj 𝒜 j c)^m) ⟨f^j, ⟨_, rfl⟩⟩,
  simp only [submonoid.coe_mul],
  simp only [← subtype.val_eq_coe, subtype.ext_iff, subring.coe_mul, mk_mul],
  simp only [mk_eq_mk', is_localization.eq],

  use 1,
  simp only [submonoid.coe_one, submonoid.coe_mul, mul_one],
  simp only [← subtype.val_eq_coe, ← pow_add],

  suffices EQ : n_x * n_y * d_xy * graded_algebra.proj 𝒜 j c = n_xy * (d_x * d_y) * graded_algebra.proj 𝒜 j c,

  rw calc n_xy * d_xy ^ m.pred * (d_x ^ m * d_y ^ m)
          * (graded_algebra.proj 𝒜 j) c ^ m
          * f ^ (i_x + i_y + i_xy + j)
        = n_xy * d_xy ^ m.pred * (d_x ^ m * d_y ^ m)
          * (graded_algebra.proj 𝒜 j) c ^ (m.pred + 1)
          * f ^ (i_x + i_y + i_xy + j)
        : begin
          congr',
          symmetry,
          apply nat.succ_pred_eq_of_pos hm,
        end
    ... = n_xy * d_xy ^ m.pred * (d_x ^ m * d_y ^ m)
          * ((graded_algebra.proj 𝒜 j) c ^ m.pred * (graded_algebra.proj 𝒜 j) c)
          * f ^ (i_x + i_y + i_xy + j)
        : by ring_exp
    ... = n_xy * d_xy ^ m.pred * (d_x ^ (m.pred + 1) * d_y ^ (m.pred + 1))
          * ((graded_algebra.proj 𝒜 j) c ^ m.pred * (graded_algebra.proj 𝒜 j) c)
          * f ^ (i_x + i_y + i_xy + j)
        : begin
          congr',
          all_goals { symmetry, apply nat.succ_pred_eq_of_pos hm, },
        end
    ... = (n_xy * (d_x * d_y) * graded_algebra.proj 𝒜 j c) * (d_xy^m.pred * d_x^m.pred * d_y^m.pred * (graded_algebra.proj 𝒜 j c)^m.pred)
          * f ^ (i_x + i_y + i_xy + j)
        : by ring_exp
    ... = (n_x * n_y * d_xy * graded_algebra.proj 𝒜 j c) * (d_xy^m.pred * d_x^m.pred * d_y^m.pred * (graded_algebra.proj 𝒜 j c)^m.pred)
          * f ^ (i_x + i_y + i_xy + j)
        : by rw EQ
    ... = (n_x * n_y * d_xy) * (d_xy^m.pred * d_x^m.pred * d_y^m.pred * ((graded_algebra.proj 𝒜 j c)^m.pred * graded_algebra.proj 𝒜 j c))
          * f ^ (i_x + i_y + i_xy + j) : by ring
    ... = (n_x * n_y * d_xy) * (d_xy^m.pred * d_x^m.pred * d_y^m.pred * ((graded_algebra.proj 𝒜 j c)^m.pred * (graded_algebra.proj 𝒜 j c)^1))
          * f ^ (i_x + i_y + i_xy + j) : by rw pow_one
    ... = (n_x * n_y * d_xy) * (d_xy^m.pred * d_x^m.pred * d_y^m.pred * ((graded_algebra.proj 𝒜 j c)^(m.pred + 1)))
          * f ^ (i_x + i_y + i_xy + j)
        : by ring_exp
    ... = (n_x * n_y * d_xy) * (d_xy^m.pred * d_x^m.pred * d_y^m.pred * ((graded_algebra.proj 𝒜 j c)^m))
          * f ^ (i_x + i_y + i_xy + j)
        : begin
          congr',
          exact nat.succ_pred_eq_of_pos hm,
        end
    ... = (n_x * n_y) * ((d_xy^m.pred * d_xy) * d_x^m.pred * d_y^m.pred * ((graded_algebra.proj 𝒜 j c)^m))
          * f ^ (i_x + i_y + i_xy + j) : by ring
    ... = (n_x * n_y) * ((d_xy^m.pred * d_xy^1) * d_x^m.pred * d_y^m.pred * ((graded_algebra.proj 𝒜 j c)^m))
          * f ^ (i_x + i_y + i_xy + j) : by rw pow_one
    ... = (n_x * n_y) * ((d_xy^(m.pred + 1)) * d_x^m.pred * d_y^m.pred * ((graded_algebra.proj 𝒜 j c)^m))
          * f ^ (i_x + i_y + i_xy + j)
        : by ring_exp
    ... = (n_x * n_y) * (d_xy^m * d_x^m.pred * d_y^m.pred * ((graded_algebra.proj 𝒜 j c)^m))
          * f ^ (i_x + i_y + i_xy + j)
        : begin
          congr',
          exact nat.succ_pred_eq_of_pos hm,
        end,
  ring_nf,

  have INEQ : graded_algebra.proj 𝒜 j c ≠ 0,
  { intro rid,
    apply hc,
    simp only [rid, zero_pow hm, localization.mk_zero],
    exact submodule.zero_mem _, },
  replace eq_mulz := congr_arg (graded_algebra.proj 𝒜 (i_x + i_y + i_xy + j)) eq_mulz,
  rw [graded_algebra.proj_hom_mul, graded_algebra.proj_hom_mul] at eq_mulz,
  exact eq_mulz,

  have : (hl hm x z * hl hm y z).num * (d_x * d_y) ∈ 𝒜 (i_xy + (i_x + i_y)),
  { apply set_like.graded_monoid.mul_mem,
    rw [← hl.mul],
    exact (hl hm (x * y) z).num_mem,
    apply set_like.graded_monoid.mul_mem,
    exact (hl hm x z).denom_mem,
    exact (hl hm y z).denom_mem, },
  convert this using 2,
  ring,

  exact INEQ,

  apply set_like.graded_monoid.mul_mem,
  apply set_like.graded_monoid.mul_mem,
  exact (hl hm x z).num_mem,
  exact (hl hm y z).num_mem,
  rw [← hl.mul],
  exact (hl hm (x * y) z).denom_mem,

  exact INEQ,
end

namespace is_locally_quotient

variables {α : Type*} (p : α → Prop)

variable (f_deg)
def open_set (V : opens Proj.T) : opens (Spec.T (A⁰_ f_deg)) :=
⟨homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg) ''
  {z | @coe (subtype _) ↥((Proj.to_LocallyRingedSpace (λ {m : ℕ}, 𝒜 m)).to_Top) _ z ∈ V.1}, begin
  have := Proj.T,
  rw [homeomorph.is_open_image, is_open_induced_iff],
  refine ⟨V.1, V.2, _⟩,
  ext z, split; intro hz,
  { rw set.mem_preimage at hz,
    exact hz, },
  { rw set.mem_preimage,
    exact hz, }
end⟩

lemma open_set_is_subset
  (V : opens Proj.T) (y : unop U)
  (subset1 : V ⟶ ((@opens.open_embedding Proj.T (pbo f)).is_open_map.functor.op.obj
            ((opens.map (Proj_iso_Spec_Top_component hm f_deg).hom).op.obj U)).unop) :
  (open_set 𝒜 hm f_deg V) ⟶ unop U := hom_of_le
begin
  have subset2 := le_of_hom subset1,
  rintros z z_mem,
  obtain ⟨z, z_mem, rfl⟩ := z_mem,
  dsimp only [set.mem_set_of] at z_mem,
  specialize subset2 z_mem,
  obtain ⟨a, a_mem, eq2⟩ := subset2,
  erw set.mem_preimage at a_mem,
  rw homeo_of_iso_apply,
  change _ ∈ (unop U).val,
  convert a_mem,
  rw subtype.ext_iff,
  rw ←eq2,
  refl,
end

lemma mem_open_subset_of_inv_mem (V : opens Proj.T) (y : unop U)
  (mem1 : (((Proj_iso_Spec_Top_component hm f_deg).inv) y.val).val ∈ V) :
  y.1 ∈ open_set 𝒜 hm f_deg V  :=
begin
  refine ⟨(Proj_iso_Spec_Top_component hm f_deg).inv y.1, mem1, _⟩,
  rw [homeo_of_iso_apply],
  convert Proj_iso_Spec_Top_component.to_Spec_from_Spec _ _ _ _,
end

/--
For b ∈ 𝒜 i
z ∈ V and b ∉ z, then b^m / f^i ∉ forward f
-/
lemma not_mem
  (V : opens Proj.T)
  -- (subset1 : V ⟶ ((@opens.open_embedding Proj.T (pbo f)).is_open_map.functor.op.obj
  --           ((opens.map (Top_component hm f_deg).hom).op.obj U)).unop)
  (b : A) (degree : ℕ) (b_mem : b ∈ 𝒜 degree)
  (z : Proj.T| (pbo f))
  (z_mem : z.1 ∈ V.1)
  (b_not_mem : b ∉ z.1.as_homogeneous_ideal) :
  (⟨localization.mk (b^m) ⟨f^degree, ⟨_, rfl⟩⟩,
    ⟨degree, ⟨_, set_like.graded_monoid.pow_mem _ b_mem⟩, rfl⟩⟩ : A⁰_ f_deg)
  ∉ ((homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg)) z).as_ideal := λ rid,
begin
  classical,

  rw homeo_of_iso_apply at rid,
  erw Proj_iso_Spec_Top_component.to_Spec.mem_carrier_iff at rid,
  dsimp only at rid,

  erw [←ideal.submodule_span_eq, finsupp.span_eq_range_total, set.mem_range] at rid,
  obtain ⟨c, eq1⟩ := rid,
  erw [finsupp.total_apply, finsupp.sum] at eq1,
  dsimp only [subtype.coe_mk] at eq1,
  obtain ⟨N, hN⟩ := clear_denominator (finset.image (λ i, c i * i.1) c.support),
  -- N is the common denom
  choose after_clear_denominator hacd using hN,
  have prop1 : ∀ i, i ∈ c.support → c i * i.1 ∈ (finset.image (λ i, c i * i.1) c.support),
  { intros i hi, rw finset.mem_image, refine ⟨_, hi, rfl⟩, },
  have eq3 := calc (localization.mk (b^m) 1 : localization.away f) * localization.mk (f^N) 1
          = localization.mk (b^m) ⟨f^degree, ⟨_, rfl⟩⟩ * localization.mk (f^degree) 1 * localization.mk (f^N) 1
          : begin
            congr,
            rw [localization.mk_mul, localization.mk_eq_mk', is_localization.eq],
            use 1,
            erw [mul_one, mul_one, mul_one, mul_one, ←subtype.val_eq_coe],
          end
      ... = localization.mk (f^degree) 1 * localization.mk (b^m) ⟨f^degree, ⟨_, rfl⟩⟩ * localization.mk (f^N) 1
          : by ring
      ... = localization.mk (f^degree) 1 * localization.mk (f^N) 1 * ∑ i in c.support, c i * i.1
          : begin
            erw eq1, ring,
          end
      ... = localization.mk (f^degree) 1 * (localization.mk (f^N) 1 * ∑ i in c.support, c i * i.1) : by ring
      ... = localization.mk (f^degree) 1 * ∑ i in c.support, (localization.mk (f^N) 1) * (c i * i.1)
          : begin
            congr' 1,
            rw finset.mul_sum,
          end
      ... = localization.mk (f^degree) 1 * ∑ i in c.support.attach, (localization.mk (f^N) 1) * (c i.1 * i.1.1)
          : begin
            congr' 1,
            symmetry,
            convert finset.sum_attach,
            refl,
          end
      ... = localization.mk (f^degree) 1 * ∑ i in c.support.attach, (localization.mk (after_clear_denominator (c i.1 * i.1.1) (prop1 i.1 i.2)) 1)
          : begin
            congr' 1,
            rw finset.sum_congr rfl (λ j hj, _),
            have eq2 := (hacd (c j.1 * j.1.1) (prop1 j.1 j.2)).2,
            dsimp only at eq2,
            erw eq2,
            rw mul_comm,
          end
      ... = ∑ i in c.support.attach, (localization.mk (f^degree) 1) * (localization.mk (after_clear_denominator (c i.1 * i.1.1) (prop1 i.1 i.2)) 1)
          : begin
            rw finset.mul_sum,
          end
      ... = ∑ i in c.support.attach, localization.mk (f^degree * (after_clear_denominator (c i.1 * i.1.1) (prop1 i.1 i.2))) 1
          : begin
            rw finset.sum_congr rfl (λ j hj, _),
            erw [localization.mk_mul, one_mul],
          end
      ... = localization.mk (∑ i in c.support.attach, (f^degree * (after_clear_denominator (c i.1 * i.1.1) (prop1 i.1 i.2)))) 1
          : begin
            induction c.support.attach using finset.induction_on with y s hy ih,
            rw [finset.sum_empty, finset.sum_empty, localization.mk_zero],
            rw [finset.sum_insert hy, finset.sum_insert hy, ih, localization.add_mk, mul_one, ←subtype.val_eq_coe,
              show (1 : submonoid.powers f).1 = 1, from rfl, one_mul, one_mul, add_comm],
          end,
  erw [localization.mk_mul, one_mul] at eq3,
  simp only [localization.mk_eq_mk', is_localization.eq] at eq3,
  obtain ⟨⟨_, ⟨l, rfl⟩⟩, eq3⟩ := eq3,
  erw [mul_one, ←subtype.val_eq_coe, mul_one] at eq3,
  dsimp only at eq3,
  suffices : (∑ i in c.support.attach, (f^degree * (after_clear_denominator (c i.1 * i.1.1) (prop1 i.1 i.2)))) * f^l ∈ z.1.as_homogeneous_ideal,
  erw ←eq3 at this,
  rcases z.1.is_prime.mem_or_mem this with H1 | H3,
  rcases z.1.is_prime.mem_or_mem H1 with H1 | H2,
  { apply b_not_mem,
    rw z.1.is_prime.pow_mem_iff_mem at H1,
    exact H1,
    exact hm, },
  { have mem3 := z.2,
    have mem4 := z.1.is_prime.mem_of_pow_mem _ H2,
    erw projective_spectrum.mem_basic_open at mem3,
    apply mem3,
    exact mem4, },
  { have mem3 := z.2,
    have mem4 := z.1.is_prime.mem_of_pow_mem _ H3,
    erw projective_spectrum.mem_basic_open at mem3,
    apply mem3,
    exact mem4, },
  apply ideal.mul_mem_right,
  apply ideal.sum_mem,
  intros j hj,
  apply ideal.mul_mem_left,
  set g := classical.some j.1.2 with g_eq,
  have mem3 : g ∈ z.1.as_homogeneous_ideal := (classical.some_spec j.1.2).1,
  have eq3 : j.1.1 = localization.mk g 1 := (classical.some_spec j.1.2).2.symm,
  have eq4 := (hacd (c j.1 * j.1.1) (prop1 j.1 j.2)).2,
  dsimp only at eq4,
  have eq5 : ∃ (a : A) (zz : ℕ), c j.1 = localization.mk a ⟨f^zz, ⟨zz, rfl⟩⟩,
  { induction (c j.1) using localization.induction_on with data,
    rcases data with ⟨a, ⟨_, ⟨zz, rfl⟩⟩⟩,
    refine ⟨a, zz, rfl⟩, },
  obtain ⟨α, zz, hzz⟩ := eq5,
  have eq6 := calc localization.mk (after_clear_denominator (c j.1 * j.1.1) (prop1 j.1 j.2)) 1
          = c j.1 * j.1.1 * localization.mk (f^N) 1 : eq4
      ... = (localization.mk α ⟨f^zz, ⟨zz, rfl⟩⟩ : localization.away f) * j.1.1 * localization.mk (f^N) 1
          : by erw hzz
      ... = (localization.mk α ⟨f^zz, ⟨zz, rfl⟩⟩ : localization.away f) * localization.mk g 1 * localization.mk (f^N) 1
          : by erw eq3
      ... = localization.mk (α * g * f^N) ⟨f^zz, ⟨zz, rfl⟩⟩
          : begin
            erw [localization.mk_mul, localization.mk_mul, mul_one, mul_one],
          end,
  simp only [localization.mk_eq_mk', is_localization.eq] at eq6,
  obtain ⟨⟨_, ⟨v, rfl⟩⟩, eq6⟩ := eq6,
  erw [←subtype.val_eq_coe, ←subtype.val_eq_coe, mul_one] at eq6,
  dsimp only at eq6,
  have mem4 : α * g * f ^ N * f ^ v ∈ z.1.as_homogeneous_ideal,
  { apply ideal.mul_mem_right,
    apply ideal.mul_mem_right,
    apply ideal.mul_mem_left,
    exact mem3, },
  erw ←eq6 at mem4,
  rcases z.1.is_prime.mem_or_mem mem4 with H1 | H3,
  rcases z.1.is_prime.mem_or_mem H1 with H1 | H2,
  { exact H1 },
  { exfalso,
    have mem3 := z.2,
    have mem4 := z.1.is_prime.mem_of_pow_mem _ H2,
    erw projective_spectrum.mem_basic_open at mem3,
    apply mem3,
    exact mem4, },
  { exfalso,
    have mem3 := z.2,
    have mem4 := z.1.is_prime.mem_of_pow_mem _ H3,
    erw projective_spectrum.mem_basic_open at mem3,
    apply mem3,
    exact mem4, },
end

include hm
lemma mk_proj_pow_not_mem
  (V : opens (projective_spectrum.Top 𝒜))
  (z : Proj .restrict (@opens.open_embedding (projective_spectrum.Top 𝒜)
    (projective_spectrum.basic_open 𝒜 f)))
  (C : A) (j : ℕ) (hj : graded_algebra.proj 𝒜 j C ∉ z.1.as_homogeneous_ideal) :
  (localization.mk ((graded_algebra.proj 𝒜 j) C ^ m) ⟨f ^ j, ⟨j, rfl⟩⟩ : localization.away f) ∉
    ideal.span ((algebra_map A (away f)) '' ↑(projective_spectrum.as_homogeneous_ideal z.val)) :=
begin
  haveI : decidable_eq (away f) := classical.dec_eq _,

  intro rid,
  erw [←ideal.submodule_span_eq, finsupp.span_eq_range_total, set.mem_range] at rid,
  obtain ⟨c, eq1⟩ := rid,
  erw [finsupp.total_apply, finsupp.sum] at eq1,
  obtain ⟨N, hN⟩ := clear_denominator (finset.image (λ i, c i * i.1) c.support),
  -- N is the common denom
  choose after_clear_denominator hacd using hN,
  have prop1 : ∀ i, i ∈ c.support → c i * i.1 ∈ (finset.image (λ i, c i * i.1) c.support),
  { intros i hi, rw finset.mem_image, refine ⟨_, hi, rfl⟩, },
  have eq3 := calc (localization.mk ((graded_algebra.proj 𝒜 j) C ^ m) 1 : localization.away f) * localization.mk (f^N) 1
          = localization.mk ((graded_algebra.proj 𝒜 j) C ^ m) ⟨f^j, ⟨_, rfl⟩⟩ * localization.mk (f^j) 1 * localization.mk (f^N) 1
          : begin
            congr,
            rw [localization.mk_mul, localization.mk_eq_mk', is_localization.eq],
            use 1,
            erw [mul_one, mul_one, mul_one, mul_one, ←subtype.val_eq_coe],
          end
      ... = localization.mk (f^j) 1 * localization.mk ((graded_algebra.proj 𝒜 j) C ^ m) ⟨f^j, ⟨_, rfl⟩⟩ * localization.mk (f^N) 1
          : by ring
      ... = localization.mk (f^j) 1 * localization.mk (f^N) 1 * ∑ i in c.support, c i * i.1
          : begin
            erw eq1, ring,
          end
      ... = localization.mk (f^j) 1 * (localization.mk (f^N) 1 * ∑ i in c.support, c i * i.1) : by ring
      ... = localization.mk (f^j) 1 * ∑ i in c.support, (localization.mk (f^N) 1) * (c i * i.1)
          : begin
            congr' 1,
            rw finset.mul_sum,
          end
      ... = localization.mk (f^j) 1 * ∑ i in c.support.attach, (localization.mk (f^N) 1) * (c i.1 * i.1.1)
          : begin
            congr' 1,
            symmetry,
            convert finset.sum_attach,
            refl,
          end
      ... = localization.mk (f^j) 1 * ∑ i in c.support.attach, (localization.mk (after_clear_denominator (c i.1 * i.1.1) (prop1 i.1 i.2)) 1)
          : begin
            congr' 1,
            rw finset.sum_congr rfl (λ j hj, _),
            have eq2' := (hacd (c j.1 * j.1.1) (prop1 j.1 j.2)).2,
            dsimp only at eq2',
            erw eq2',
            rw mul_comm,
          end
      ... = ∑ i in c.support.attach, (localization.mk (f^j) 1) * (localization.mk (after_clear_denominator (c i.1 * i.1.1) (prop1 i.1 i.2)) 1)
          : begin
            rw finset.mul_sum,
          end
      ... = ∑ i in c.support.attach, localization.mk (f^j * (after_clear_denominator (c i.1 * i.1.1) (prop1 i.1 i.2))) 1
          : begin
            rw finset.sum_congr rfl (λ j hj, _),
            erw [localization.mk_mul, one_mul],
          end
      ... = localization.mk (∑ i in c.support.attach, (f^j * (after_clear_denominator (c i.1 * i.1.1) (prop1 i.1 i.2)))) 1
          : begin
            induction c.support.attach using finset.induction_on with y s hy ih,
            rw [finset.sum_empty, finset.sum_empty, localization.mk_zero],
            erw [finset.sum_insert hy, finset.sum_insert hy, ih, localization.add_mk, mul_one, one_mul, one_mul, add_comm],
          end,
  erw [localization.mk_mul, one_mul] at eq3,
  simp only [localization.mk_eq_mk', is_localization.eq] at eq3,
  obtain ⟨⟨_, ⟨l, rfl⟩⟩, eq3⟩ := eq3,
  erw [mul_one, ←subtype.val_eq_coe, mul_one] at eq3,
  dsimp only at eq3,
  suffices : (∑ i in c.support.attach, (f^j * (after_clear_denominator (c i.1 * i.1.1) (prop1 i.1 i.2)))) * f^l ∈ z.1.as_homogeneous_ideal,
  erw ←eq3 at this,
  rcases z.1.is_prime.mem_or_mem this with H1 | H3,
  rcases z.1.is_prime.mem_or_mem H1 with H1 | H2,
  { apply hj,
    rw z.1.is_prime.pow_mem_iff_mem at H1,
    exact H1,
    exact hm, },
  { have mem3 := z.2,
    have mem4 := z.1.is_prime.mem_of_pow_mem _ H2,
    erw projective_spectrum.mem_basic_open at mem3,
    apply mem3,
    exact mem4, },
  { have mem3 := z.2,
    have mem4 := z.1.is_prime.mem_of_pow_mem _ H3,
    erw projective_spectrum.mem_basic_open at mem3,
    apply mem3,
    exact mem4, },
  apply ideal.mul_mem_right,
  apply ideal.sum_mem,
  intros j hj,
  apply ideal.mul_mem_left,
  set g := classical.some j.1.2 with g_eq,
  have mem3 : g ∈ z.1.as_homogeneous_ideal := (classical.some_spec j.1.2).1,
  have eq3 : j.1.1 = localization.mk g 1 := (classical.some_spec j.1.2).2.symm,
  have eq4 := (hacd (c j.1 * j.1.1) (prop1 j.1 j.2)).2,
  dsimp only at eq4,

  have eq5 : ∃ (a : A) (zz : ℕ), c j.1 = localization.mk a ⟨f^zz, ⟨zz, rfl⟩⟩,
  { induction (c j.1) using localization.induction_on with data,
    rcases data with ⟨a, ⟨_, ⟨zz, rfl⟩⟩⟩,
    refine ⟨a, zz, rfl⟩, },
  obtain ⟨α, zz, hzz⟩ := eq5,

  have eq6 := calc localization.mk (after_clear_denominator (c j.1 * j.1.1) (prop1 j.1 j.2)) 1
          = c j.1 * j.1.1 * localization.mk (f^N) 1 : eq4
      ... = (localization.mk α ⟨f^zz, ⟨zz, rfl⟩⟩ : localization.away f) * j.1.1 * localization.mk (f^N) 1
          : by erw hzz
      ... = (localization.mk α ⟨f^zz, ⟨zz, rfl⟩⟩ : localization.away f) * localization.mk g 1 * localization.mk (f^N) 1
          : by erw eq3
      ... = localization.mk (α * g * f^N) ⟨f^zz, ⟨zz, rfl⟩⟩
          : begin
            erw [localization.mk_mul, localization.mk_mul, mul_one, mul_one],
          end,
  simp only [localization.mk_eq_mk', is_localization.eq] at eq6,
  obtain ⟨⟨_, ⟨v, rfl⟩⟩, eq6⟩ := eq6,
  erw [←subtype.val_eq_coe, ←subtype.val_eq_coe, mul_one] at eq6,
  dsimp only at eq6,

  have mem4 : α * g * f ^ N * f ^ v ∈ z.1.as_homogeneous_ideal,
  { apply ideal.mul_mem_right,
    apply ideal.mul_mem_right,
    apply ideal.mul_mem_left,
    exact mem3, },
  erw ←eq6 at mem4,

  rcases z.1.is_prime.mem_or_mem mem4 with H1 | H3,
  rcases z.1.is_prime.mem_or_mem H1 with H1 | H2,
  { exact H1 },
  { exfalso,
    have mem3 := z.2,
    have mem4 := z.1.is_prime.mem_of_pow_mem _ H2,
    erw projective_spectrum.mem_basic_open at mem3,
    apply mem3,
    exact mem4, },
  { exfalso,
    have mem3 := z.2,
    have mem4 := z.1.is_prime.mem_of_pow_mem _ H3,
    erw projective_spectrum.mem_basic_open at mem3,
    apply mem3,
    exact mem4, }
end

omit hm
lemma final_eq
  (d_hh n_hh a b C : A) (degree i_hh j : ℕ) (INEQ : graded_algebra.proj 𝒜 j C ≠ 0)
  (d_hh_mem : d_hh ∈ 𝒜 i_hh) (n_hh_mem : n_hh ∈ 𝒜 i_hh)
  (a_hom : a ∈ 𝒜 degree) (b_hom : b ∈ 𝒜 degree)
  (eq1 : n_hh * b * C = a * d_hh * C) : n_hh * b * graded_algebra.proj 𝒜 j C = a * d_hh * graded_algebra.proj 𝒜 j C :=
begin
  have eq2 := congr_arg (graded_algebra.proj 𝒜 (i_hh + degree + j)) eq1,
  rw [graded_algebra.proj_hom_mul, graded_algebra.proj_hom_mul] at eq2,
  exact eq2,

  rw add_comm,
  apply set_like.graded_monoid.mul_mem,
  exact a_hom,
  exact d_hh_mem,
  exact INEQ,

  apply set_like.graded_monoid.mul_mem,
  exact n_hh_mem,
  exact b_hom,
  exact INEQ,
end

lemma inv_hom_mem_bo (V : opens Proj.T) (z : Proj.T| (pbo f))
  (subset2 : open_set 𝒜 hm f_deg V ⟶ unop U) (z_mem : z.1 ∈ V) :
  (((Proj_iso_Spec_Top_component hm f_deg).inv)
    (subset2 ⟨(homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg)) z, begin
    erw [set.mem_preimage],
    refine ⟨z, z_mem, rfl⟩,
  end⟩).val).val ∈ projective_spectrum.basic_open 𝒜 f :=
begin
  erw projective_spectrum.mem_basic_open,
  intro rid,
  change ∀ _, _ at rid,
  specialize rid m,
  simp only [graded_algebra.proj_apply, direct_sum.decompose_of_mem_same 𝒜 f_deg] at rid,
  change _ ∈ ((homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg)) z).1 at rid,
  have rid2 : (1 : A⁰_ f_deg) ∈ ((homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg)) z).1,
  { convert rid,
    rw subtype.ext_iff,
    dsimp only [subtype.coe_mk],
    erw localization.mk_self (⟨f^m, ⟨_, rfl⟩⟩ : submonoid.powers f),
    refl, },
  rw homeo_of_iso_apply at rid2,
  apply (((Proj_iso_Spec_Top_component hm f_deg).hom) z).is_prime.1,
  rw ideal.eq_top_iff_one,
  exact rid2,
end

lemma inv_hom_mem2
  (V : opens Proj.T)
  (z : Proj.T| (pbo f))
  (subset2 : open_set 𝒜 hm f_deg V ⟶ unop U)
  (z_mem : z.1 ∈ V) :
  (((Proj_iso_Spec_Top_component hm f_deg).inv)
    (subset2 ⟨(homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg)) z, begin
    erw [set.mem_preimage],
    refine ⟨z, z_mem, rfl⟩,
  end⟩).val).val ∈
  ((@opens.open_embedding (projective_spectrum.Top 𝒜) (projective_spectrum.basic_open 𝒜 f)).is_open_map.functor.op.obj
    ((opens.map (Proj_iso_Spec_Top_component hm f_deg).hom).op.obj U)).unop :=
begin
  simp only [unop_op, functor.op_obj],
  set z' := (((Proj_iso_Spec_Top_component hm f_deg).inv)
    (subset2 ⟨(homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg)) z, begin
    erw [set.mem_preimage],
    refine ⟨z, z_mem, rfl⟩,
  end⟩).val).val with z'_eq,
  refine ⟨⟨z', _⟩, _, rfl⟩,
  have mem_z' : z' ∈ projective_spectrum.basic_open 𝒜 f,
  erw projective_spectrum.mem_basic_open,
  intro rid,
  erw z'_eq at rid,
  change ∀ _, _ at rid,
  specialize rid m,
  simp only [graded_algebra.proj_apply, direct_sum.decompose_of_mem_same 𝒜 f_deg] at rid,
  change _ ∈ ((homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg)) z).1 at rid,
  have rid2 : (1 : A⁰_ f_deg) ∈ ((homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg)) z).1,
  { convert rid,
    rw subtype.ext_iff,
    dsimp only [subtype.coe_mk],
    erw localization.mk_self (⟨f^m, ⟨_, rfl⟩⟩ : submonoid.powers f),
    refl, },
  rw homeo_of_iso_apply at rid2,
  apply (((Proj_iso_Spec_Top_component hm f_deg).hom) z).is_prime.1,
  rw ideal.eq_top_iff_one,
  exact rid2,
  exact mem_z',
  erw [set.mem_preimage],
  have subset3 := le_of_hom subset2,
  suffices : ((Proj_iso_Spec_Top_component hm f_deg).hom) ⟨z', _⟩ ∈ open_set 𝒜 hm f_deg V,
  apply subset3,
  exact this,

  refine ⟨z, z_mem, _⟩,
  simp only [homeo_of_iso_apply],
  congr',
  rw subtype.ext_iff,
  dsimp only [subtype.coe_mk],
  rw z'_eq,
  change z.1 = (Proj_iso_Spec_Top_component.from_Spec hm f_deg (Proj_iso_Spec_Top_component.to_Spec _ _ _)).1,
  congr',
  symmetry,
  apply Proj_iso_Spec_Top_component.from_Spec_to_Spec 𝒜 hm f_deg z,
end

end is_locally_quotient

variables (hm f_deg)
lemma fmk_is_locally_quotient (y : unop U) :
  ∃ (V : opens (Spec.T (A⁰_ f_deg))) (mem : y.val ∈ V) (i : V ⟶ unop U) (r s : (A⁰_ f_deg)),
    ∀ (z : V),
      ∃ (s_not_mem : s ∉ prime_spectrum.as_ideal z.val),
        fmk hm hh ⟨(i z).1, (i z).2⟩ = mk r ⟨s, s_not_mem⟩ :=
begin
  classical,

  obtain ⟨V, mem1, subset1, degree, ⟨a, a_mem⟩, ⟨b, b_mem⟩, eq1⟩ := hh.2 ⟨((Proj_iso_Spec_Top_component hm f_deg).inv y.1).1, inv_mem y⟩,
  set VVo : opens (Spec.T (A⁰_ f_deg)) := is_locally_quotient.open_set 𝒜 hm f_deg V with VVo_eq,
  have subset2 : VVo ⟶ unop U := is_locally_quotient.open_set_is_subset 𝒜 hm f_deg V y subset1,
  have y_mem1 : y.1 ∈ VVo,
  { convert is_locally_quotient.mem_open_subset_of_inv_mem 𝒜 hm f_deg V y mem1 },
  refine ⟨VVo, y_mem1, subset2,
    ⟨localization.mk (a * b^m.pred) ⟨f^degree, ⟨_, rfl⟩⟩, ⟨degree, ⟨_, begin
      have mem1 : b^m.pred ∈ 𝒜 (m.pred * degree) := set_like.graded_monoid.pow_mem _ b_mem,
      have mem2 := set_like.graded_monoid.mul_mem a_mem mem1,
      convert mem2,
      exact calc m * degree
              = (m.pred + 1) * degree
              : begin
                congr' 1,
                symmetry,
                apply nat.succ_pred_eq_of_pos hm,
              end
          ... = m.pred * degree + 1 * degree : by rw add_mul
          ... = m.pred * degree + degree : by rw one_mul
          ... = degree + m.pred * degree : by rw add_comm,
    end⟩, rfl⟩⟩,
    ⟨localization.mk (b^m) ⟨f^degree, ⟨_, rfl⟩⟩, ⟨degree, ⟨_, set_like.graded_monoid.pow_mem _ b_mem⟩, rfl⟩⟩, _⟩,

  rintros ⟨z, z_mem⟩,
  obtain ⟨z, z_mem, rfl⟩ := z_mem,
  specialize eq1 ⟨z.1, z_mem⟩,
  obtain ⟨b_not_mem, eq1⟩ := eq1,

  refine ⟨is_locally_quotient.not_mem 𝒜 hm f_deg V b degree b_mem z z_mem b_not_mem, _⟩,

  have eq2 := (hh.val (subset1 ⟨z.val, z_mem⟩)).eq_num_div_denom,
  dsimp only at eq1,
  rw [homogeneous_localization.ext_iff_val] at eq1,
  rw [eq2, homogeneous_localization.val_mk'] at eq1,
  simp only [← subtype.val_eq_coe] at eq1,
  rw [localization.mk_eq_mk', is_localization.eq] at eq1,
  obtain ⟨⟨C, hC⟩, eq1⟩ := eq1,
  unfold fmk,
  rw [localization.mk_eq_mk', is_localization.eq],
  simp only [←subtype.val_eq_coe] at eq1,
  set degree_hh := (hh.val (subset1 ⟨z.val, z_mem⟩)).deg with degree_hh_eq,
  have mem_C : ∃ (j : ℕ), graded_algebra.proj 𝒜 j C ∉ z.1.as_homogeneous_ideal,
  { by_contra rid,
    rw not_exists at rid,
    apply hC,
    rw ←direct_sum.sum_support_decompose 𝒜 C,
    apply ideal.sum_mem,
    intros j hj,
    specialize rid j,
    rw not_not at rid,
    apply rid, },
  obtain ⟨j, hj⟩ := mem_C,
  refine ⟨⟨⟨localization.mk ((graded_algebra.proj 𝒜 j C)^m) ⟨f^j, ⟨_, rfl⟩⟩,
    ⟨j, ⟨(graded_algebra.proj 𝒜 j C)^m, set_like.graded_monoid.pow_mem _ (submodule.coe_mem _)⟩, rfl⟩⟩, _⟩, _⟩,
  { change _ ∉ _,
    simp only [← subtype.val_eq_coe],
    erw Proj_iso_Spec_Top_component.to_Spec.mem_carrier_iff,
    apply is_locally_quotient.mk_proj_pow_not_mem hm V z C j hj, },

  set z' := (((Proj_iso_Spec_Top_component hm f_deg).inv)
    (subset2 ⟨(homeo_of_iso (Proj_iso_Spec_Top_component hm f_deg)) z, begin
    erw [set.mem_preimage],
    refine ⟨z, z_mem, rfl⟩,
  end⟩).val).val with z'_eq,

  have z'_mem : z' ∈ (((@opens.open_embedding Proj.T) (pbo f)).is_open_map.functor.op.obj
        ((opens.map (Proj_iso_Spec_Top_component hm f_deg).hom).op.obj U)).unop,
  { convert is_locally_quotient.inv_hom_mem2 𝒜 hm f_deg V z subset2 z_mem },

  have eq_pt : (subset1 ⟨z.1, z_mem⟩) = ⟨z', z'_mem⟩,
  { rw subtype.ext_iff,
    change z.1 = (Proj_iso_Spec_Top_component.from_Spec hm f_deg (Proj_iso_Spec_Top_component.to_Spec m f_deg _)).1,
    congr',
    symmetry,
    apply Proj_iso_Spec_Top_component.from_Spec_to_Spec 𝒜 hm f_deg z, },
  erw [eq_pt] at eq1,

  unfold num denom,
  simp only [←subtype.val_eq_coe, subtype.ext_iff, subring.coe_mul, localization.mk_mul],
  rw [localization.mk_eq_mk', is_localization.eq],
  use 1,
  simp only [submonoid.coe_mul, submonoid.coe_one],
  simp only [←subtype.val_eq_coe, one_mul, mul_one, ←pow_add],

  set d_hh := (hh.val ⟨z', z'_mem⟩).denom with d_hh_eq,
  set n_hh := (hh.val ⟨z', z'_mem⟩).num with n_hh_eq,
  set i_hh := (hh.val ⟨z', z'_mem⟩).deg with i_hh_eq,
  simp only [←d_hh_eq, ←n_hh_eq, ←i_hh_eq] at eq1,

  suffices : n_hh * d_hh ^ m.pred * b ^ m * (graded_algebra.proj 𝒜 j) C ^ m * f ^ (degree + i_hh + j)
    = a * b ^ m.pred * d_hh ^ m * (graded_algebra.proj 𝒜 j) C ^ m * f ^ (i_hh + degree + j),
  convert this,

  suffices EQ : n_hh * b * graded_algebra.proj 𝒜 j C = a * d_hh * graded_algebra.proj 𝒜 j C,
  erw calc n_hh * d_hh ^ m.pred * b ^ m * (graded_algebra.proj 𝒜 j) C ^ m * f ^ (degree + i_hh + j)
        = n_hh * d_hh ^ m.pred * b ^ (m.pred + 1) * (graded_algebra.proj 𝒜 j) C^(m.pred + 1) * f^(degree + i_hh + j)
        : begin
          congr';
          symmetry;
          apply nat.succ_pred_eq_of_pos hm,
        end
    ... = n_hh * d_hh ^ m.pred * (b ^ m.pred * b) * ((graded_algebra.proj 𝒜 j C) ^ m.pred * (graded_algebra.proj 𝒜 j C)) * f^(degree + i_hh + j)
        : begin
          congr',
          all_goals { rw [pow_add, pow_one], },
        end
    ... = (n_hh * b * graded_algebra.proj 𝒜 j C) * (d_hh ^ m.pred * b ^ m.pred * (graded_algebra.proj 𝒜 j C)^m.pred) * f^(degree + i_hh + j)  : by ring
    ... = (a * d_hh * graded_algebra.proj 𝒜 j C) * (d_hh ^ m.pred * b ^ m.pred * (graded_algebra.proj 𝒜 j C)^m.pred) * f^(degree + i_hh + j)  : by rw EQ
    ... = a * b ^ m.pred * (d_hh ^ m.pred * d_hh) * ((graded_algebra.proj 𝒜 j C)^m.pred * graded_algebra.proj 𝒜 j C) * f^(degree + i_hh + j)  : by ring
    ... = a * b ^ m.pred * (d_hh ^ m.pred * d_hh^1) * ((graded_algebra.proj 𝒜 j C)^m.pred * graded_algebra.proj 𝒜 j C ^ 1) * f^(degree + i_hh + j)
        : by rw [pow_one, pow_one]
    ... =  a * b ^ m.pred * (d_hh ^ (m.pred + 1)) * ((graded_algebra.proj 𝒜 j C)^(m.pred + 1)) * f^(degree + i_hh + j)
        : by simp only [pow_add]
    ... = a * b ^ m.pred * d_hh ^ m * (graded_algebra.proj 𝒜 j C)^m * f^(degree + i_hh + j)
        : begin
          congr',
          all_goals { apply nat.succ_pred_eq_of_pos hm, },
        end
    ... = a * b ^ m.pred * d_hh ^ m * (graded_algebra.proj 𝒜 j C)^m * f^(i_hh + degree + j)
        : begin
          congr' 1,
          rw add_comm i_hh degree,
        end,
  have INEQ : graded_algebra.proj 𝒜 j C ≠ 0,
  { intro rid,
    apply hj,
    rw rid,
    exact submodule.zero_mem _, },

  have eq2 := congr_arg (graded_algebra.proj 𝒜 (i_hh + degree + j)) eq1,
  rw [graded_algebra.proj_hom_mul, graded_algebra.proj_hom_mul] at eq2,
  exact eq2,

  rw add_comm,
  apply set_like.graded_monoid.mul_mem,
  exact a_mem,
  exact (hh.val ⟨z', z'_mem⟩).denom_mem,
  exact INEQ,

  apply set_like.graded_monoid.mul_mem,
  exact (hh.val ⟨z', z'_mem⟩).num_mem,
  exact b_mem,
  exact INEQ,
end

variable (U)
def to_fun : (pf_sheaf (Proj| (pbo f))).obj U ⟶ (Spec (A⁰_ f_deg)).presheaf.obj U :=
{ to_fun := λ hh, ⟨λ y, fmk hm hh y, begin
    rw algebraic_geometry.structure_sheaf.is_locally_fraction_pred',
    exact fmk_is_locally_quotient hm f_deg hh,
  end⟩,
  map_one' := begin
    rw subtype.ext_iff,
    dsimp only [subtype.coe_mk],
    ext y,
    rw [fmk.one hm],
    convert pi.one_apply _,
  end,
  map_mul' := λ x y, begin
    rw subtype.ext_iff,
    dsimp only [subtype.coe_mk],
    ext z,
    rw [fmk.mul hm],
    change _ * _ = _ * _,
    dsimp only,
    refl,
  end,
  map_zero' := begin
    rw subtype.ext_iff,
    dsimp only [subtype.coe_mk],
    ext y,
    rw [fmk.zero hm],
    convert pi.zero_apply _,
  end,
  map_add' := λ x y, begin
    rw subtype.ext_iff,
    dsimp only [subtype.coe_mk],
    ext z,
    rw [fmk.add hm],
    change _ + _ = fmk hm x z + fmk hm y z,
    dsimp only,
    refl
  end }

end to_Spec

section

def to_Spec {f : A} {m : ℕ} (hm : 0 < m) (f_deg : f ∈ 𝒜 m):
  ((Proj_iso_Spec_Top_component hm f_deg).hom _* (Proj| (pbo f)).presheaf) ⟶ (Spec (A⁰_ f_deg)).presheaf :=
{ app := λ U, to_Spec.to_fun hm f_deg U,
  naturality' := λ U V subset1, begin
    ext1 z,
    simp only [comp_apply, ring_hom.coe_mk, functor.op_map, presheaf.pushforward_obj_map],
    refl,
  end }

end

end Proj_iso_Spec_Sheaf_component

end algebraic_geometry


import for_mathlib.homotopy_category_pretriangulated
import for_mathlib.abelian_category
import for_mathlib.derived.homological
import for_mathlib.derived.defs
import category_theory.abelian.projective
import for_mathlib.snake_lemma3
import for_mathlib.les_homology
import for_mathlib.exact_seq3
import for_mathlib.triangle_shift
import for_mathlib.homology_iso
import for_mathlib.projective_replacement
import for_mathlib.homology_exact
import for_mathlib.is_iso_neg
-- import for_mathlib.arrow_preadditive

noncomputable theory

open category_theory category_theory.limits category_theory.triangulated
open homological_complex

universes v u
variables {A : Type u} [category.{v} A] [abelian A]

namespace homotopy_category

local notation `𝒦` := homotopy_category A (complex_shape.up ℤ)
local notation `HH` i := homotopy_category.homology_functor A (complex_shape.up ℤ) i

-- Move this
instance homology_functor_additive (i : ℤ) : functor.additive (HH i) := functor.additive.mk $
begin
  rintros X Y ⟨f⟩ ⟨g⟩,
  dsimp [homotopy_category.homology_functor],
  erw ← (_root_.homology_functor _ _ _).map_add,
  refl,
  apply_instance,
end

lemma _root_.category_theory.cochain_complex.exact_cone_in_cone_out
  (i : ℤ) (X Y : cochain_complex A ℤ) (f : X ⟶ Y) :
  exact ((_root_.homology_functor _ _ i).map (cone.in f))
    ((_root_.homology_functor _ _ i).map (cone.out f)) :=
begin
  refine (homological_complex.six_term_exact_seq (cone.in f) (cone.out f) _ i (i+1) rfl).pair,
  intro n,
  refine (cone.termwise_split _ _).short_exact,
end

/-
lemma _root_.category_theory.cochain_complex.exact_to_cone_in
  (X Y : cochain_complex A ℤ) (f : X ⟶ Y) :
  exact ((_root_.homology_functor _ _ 0).map f)
    ((_root_.homology_functor _ _ 0).map (cone.in f)) :=
begin
  admit
end
-/

lemma _root_.category_theory.abelian.exact_neg_left (X Y Z : A) (f : X ⟶ Y) (g : Y ⟶ Z)
  (h : exact f g) : exact (-f) g :=
begin
  refine preadditive.exact_of_iso_of_exact' f g (-f) g _ (iso.refl _) (iso.refl _) _ _ h,
  { have : (-𝟙 X) ≫ (-𝟙 X) = 𝟙 X,
    { simp only [preadditive.comp_neg, category.comp_id, neg_neg], },
    exact ⟨-𝟙 X, -𝟙 X, this, this⟩, },
  { simp only [preadditive.comp_neg, category.comp_id, iso.refl_hom, category.id_comp, preadditive.neg_comp, neg_neg], },
  { simp only [iso.refl_hom, category.id_comp, category.comp_id], },
end

lemma _root_.category_theory.abelian.exact_neg_left_iff (X Y Z : A) (f : X ⟶ Y) (g : Y ⟶ Z) :
  exact (-f) g ↔ exact f g :=
begin
  refine ⟨_, category_theory.abelian.exact_neg_left _ _ _ _ _⟩,
  intro h,
  simpa only [neg_neg] using category_theory.abelian.exact_neg_left _ _ _ _ _ h,
end

lemma _root_.category_theory.abelian.exact_neg_right (X Y Z : A) (f : X ⟶ Y) (g : Y ⟶ Z)
  (h : exact f g) : exact f (-g) :=
begin
  refine preadditive.exact_of_iso_of_exact' f g f (-g) (iso.refl _) (iso.refl _) _ _ _ h,
  { have : (-𝟙 Z) ≫ (-𝟙 Z) = 𝟙 Z,
    { simp only [preadditive.comp_neg, category.comp_id, neg_neg], },
    exact ⟨-𝟙 Z, -𝟙 Z, this, this⟩, },
  { simp only [iso.refl_hom, category.id_comp, category.comp_id], },
  { simp only [preadditive.comp_neg, category.comp_id, iso.refl_hom, category.id_comp], }
end

lemma _root_.category_theory.abelian.exact_neg_right_iff (X Y Z : A) (f : X ⟶ Y) (g : Y ⟶ Z) :
  exact f (-g) ↔ exact f g :=
begin
  refine ⟨_, category_theory.abelian.exact_neg_right _ _ _ _ _⟩,
  intro h,
  simpa only [neg_neg] using category_theory.abelian.exact_neg_right _ _ _ _ _ h,
end

instance homology_functor_homological (i : ℤ) : homological_functor (HH i) :=
begin
  apply homological_of_rotate,
  intros T hT,
  erw mem_distinguished_iff_exists_iso_cone at hT,
  obtain ⟨X,Y,f,⟨E⟩⟩ := hT,
  let E' : T.rotate ≅
    ((neg₃_functor (homotopy_category A (complex_shape.up ℤ))).obj (cone.triangleₕ f)).rotate :=
    ⟨E.hom.rotate, E.inv.rotate, _, _⟩,
  rotate,
  { ext; dsimp,
    { change (E.hom ≫ E.inv).hom₂ = _, rw iso.hom_inv_id, refl },
    { change (E.hom ≫ E.inv).hom₃ = _, rw iso.hom_inv_id, refl },
    { simp only [← functor.map_comp],
      change (category_theory.shift_functor 𝒦 (1 : ℤ)).map ((E.hom ≫ E.inv).hom₁) = _,
      rw iso.hom_inv_id, refl } },
  { ext; dsimp,
    { change (E.inv ≫ E.hom).hom₂ = _, rw iso.inv_hom_id, refl },
    { change (E.inv ≫ E.hom).hom₃ = _, rw iso.inv_hom_id, refl },
    { simp only [← functor.map_comp],
      change (category_theory.shift_functor 𝒦 (1 : ℤ)).map ((E.inv ≫ E.hom).hom₁) = _,
      rw iso.inv_hom_id, refl } },
  refine homological_of_exists_aux _ _ _ E'.inv _,
  dsimp,
  simp only [functor.map_neg],
  apply category_theory.abelian.exact_neg_right,
  apply category_theory.cochain_complex.exact_cone_in_cone_out,
end .

variable (A)

def homology_shift_iso (i j : ℤ) :
  category_theory.shift_functor (homotopy_category A (complex_shape.up ℤ)) i ⋙
    homology_functor A (complex_shape.up ℤ) j ≅ homology_functor A (complex_shape.up ℤ) (j+i) :=
nat_iso.of_components (λ (X : 𝒦), homology_shift_obj_iso X.as i j : _)
begin
  intros X Y f,
  rw ← quotient_map_out f,
  dsimp,
  erw homotopy_category.shift_functor_map_quotient,
  rw ← homology_functor_map_factors,
  erw (homology_shift_iso A i j).hom.naturality,
  erw ← homology_functor_map_factors,
  refl
end

def homology_zero_shift_iso (i : ℤ) :
  category_theory.shift_functor (homotopy_category A (complex_shape.up ℤ)) i ⋙
    homology_functor A (complex_shape.up ℤ) 0 ≅ homology_functor A (complex_shape.up ℤ) i :=
homology_shift_iso _ _ _ ≪≫ (eq_to_iso (by rw zero_add))

variable {A}

lemma is_acyclic_iff (X : 𝒦) :
  (∀ (i : ℤ), is_zero ((homotopy_category.homology_functor _ _ 0).obj (X⟦i⟧))) ↔
  is_acyclic X :=
begin
  split,
  { intros h,
    constructor,
    intros i,
    apply is_zero_of_iso_of_zero (h i),
    apply (homology_zero_shift_iso A i).app _ },
  { introsI h i,
    apply (is_acyclic.cond _ i).of_iso ((homology_zero_shift_iso A _).app _),
    assumption },
end

lemma is_quasi_iso_iff {X Y : 𝒦} (f : X ⟶ Y) :
  (∀ (i : ℤ), is_iso ((homotopy_category.homology_functor _ _ 0).map (f⟦i⟧'))) ↔
  is_quasi_iso f :=
begin
  split,
  { intros h,
    constructor,
    intros i,
    specialize h i,
    have := (homology_zero_shift_iso A i).hom.naturality f,
    rw ← is_iso.inv_comp_eq at this,
    rw ← this,
    apply_with is_iso.comp_is_iso { instances := ff },
    apply_instance,
    apply_with is_iso.comp_is_iso { instances := ff },
    exact h,
    apply_instance },
  { introsI h i,
    have := (homology_zero_shift_iso A i).hom.naturality f,
    rw ← is_iso.eq_comp_inv at this,
    erw this,
    apply_with is_iso.comp_is_iso { instances := ff },
    apply_with is_iso.comp_is_iso { instances := ff },
    apply_instance,
    apply is_quasi_iso.cond,
    apply_instance }
end

instance is_iso_of_is_quasi_iso' {X Y : 𝒦} (f : X ⟶ Y) [h : is_quasi_iso f] (i : ℤ) :
  is_iso ((homotopy_category.homology_functor _ _ 0).map (f⟦i⟧')) :=
begin
  rw ← is_quasi_iso_iff at h,
  apply h,
end

instance is_iso_of_is_quasi_iso {X Y : 𝒦} (f : X ⟶ Y)
  [is_quasi_iso f] (i : ℤ) :
  is_iso ((homotopy_category.homology_functor _ _ i).map f) :=
begin
  apply is_quasi_iso.cond,
end

instance is_quasi_iso_comp {X Y Z : 𝒦} (f : X ⟶ Y) (g : Y ⟶ Z)
  [is_quasi_iso f] [is_quasi_iso g] : is_quasi_iso (f ≫ g) :=
begin
  constructor, intros i,
  simp only [functor.map_comp],
  apply_instance,
end

instance is_quasi_iso_of_is_iso {X Y : 𝒦} (f : X ⟶ Y) [is_iso f] : is_quasi_iso f :=
begin
  constructor,
  intros i, apply_instance
end

example {X Y Z : 𝒦} (f : X ⟶ Y) (g : Y ⟶ Z)
  [hf : is_quasi_iso f] [hg : is_iso g] :
  is_quasi_iso (f ≫ g) := infer_instance
/-
instance is_quasi_iso_comp_iso {X Y Z : 𝒦} (f : X ⟶ Y) (g : Y ⟶ Z)
  [hf : is_quasi_iso f] [hg : is_iso g] :
  is_quasi_iso (f ≫ g) := infer_instance
{ cond := λ i, by { rw (homology_functor A (complex_shape.up ℤ) i).map_comp, apply_instance, } }
-/

-- TODO(!): Why is this needed!?!?
instance : has_shift (triangle 𝒦) ℤ :=
triangle.has_shift (homotopy_category A (complex_shape.up ℤ))

open category_theory.preadditive

/-- If `A → B → C → A[1]` is a distinguished triangle,
then `A → B` is a quasi-isomorphism if and only if `C` is acyclic. -/
lemma is_quasi_iso_iff_is_acyclic (T : triangle 𝒦) (hT : T ∈ dist_triang 𝒦) :
  is_quasi_iso T.mor₁ ↔ is_acyclic T.obj₃ :=
begin
  let H := homology_functor A (complex_shape.up ℤ) 0,
  rw [← is_acyclic_iff],
  let S : ℤ → triangle 𝒦 := λ i, T⟦i⟧,
  have hS : ∀ i : ℤ, S i ∈ dist_triang 𝒦,
  { apply pretriangulated.shift_of_dist_triangle, assumption },
  have hSmor₁ : ∀ i, (S i).mor₁ = i.neg_one_pow • T.mor₁⟦i⟧', { intro i, refl },
  have aux : ∀ i, is_iso (H.map (S i).mor₁) ↔ is_iso (H.map (T.mor₁⟦i⟧')),
  { intro i, rw [hSmor₁, H.map_zsmul, is_iso_neg_one_pow_iff], },
  show _ ↔ (∀ i : ℤ, is_zero (H.obj (S i).obj₃)),
  split; introsI hh,
  { intro i,
    haveI : is_iso (H.map ((S i).rotate.mor₃)),
    { dsimp [triangle.rotate_mor₃],
      rw [functor.map_neg, is_iso_neg_iff],
    let EE : (category_theory.shift_functor 𝒦 i ⋙ category_theory.shift_functor 𝒦 (1 : ℤ)) ⋙ H ≅
      homology_functor _ _ (i + 1),
    { refine iso_whisker_right _ _ ≪≫ homology_zero_shift_iso _ (i + 1),
      refine (shift_functor_add _ _ _).symm },
    suffices : is_iso ((homology_functor _ _ (i+1)).map T.mor₁),
    { have hhh := EE.hom.naturality T.mor₁,
      rw ← is_iso.eq_comp_inv at hhh,
      dsimp only [functor.comp_map] at hhh,
      simp only [functor.map_zsmul],
      rw is_iso_neg_one_pow_iff,
      rw hhh,
      apply_with is_iso.comp_is_iso { instances := ff },
      apply_with is_iso.comp_is_iso { instances := ff },
      all_goals { apply_instance <|> assumption } },
    apply is_quasi_iso.cond },
    haveI : is_iso (H.map (S i).mor₁),
    { simp only [← is_quasi_iso_iff, ← aux] at hh, exact hh i },
    have E' := λ i : ℤ, five_term_exact_seq' H (S i) (hS i),
    apply is_zero_of_exact_seq_of_is_iso_of_is_iso _ _ _ _ (E' i) },
  { simp only [← is_quasi_iso_iff, ← aux],
    intro i,
    have E := five_term_exact_seq H (S i) (hS i),
    apply E.is_iso_of_zero_of_zero,
    { apply is_zero.eq_of_src,
      let EE : (category_theory.shift_functor 𝒦 i ⋙ category_theory.shift_functor 𝒦 (-1 : ℤ)) ⋙ H ≅
        (category_theory.shift_functor 𝒦 (i + -1)) ⋙ H,
      { refine iso_whisker_right _ _, refine (shift_functor_add _ _ _).symm },
      let e := EE.app T.obj₃,
      -- let e := (homology_zero_shift_iso _ (-1 : ℤ)).app (S i).obj₃,
      refine is_zero_of_iso_of_zero _ e.symm, clear e,
      exact hh _, },
    { apply (hh i).eq_of_tgt, }, }
end

/-- If `A → B → C → A[1]` is a distinguished triangle, and `A → B` is a quasi-isomorphism,
then `C` is acyclic. -/
lemma is_acyclic_of_dist_triang_of_is_quasi_iso (T : triangle 𝒦) (hT : T ∈ dist_triang 𝒦)
  [h : is_quasi_iso T.mor₁] : is_acyclic T.obj₃ :=
by rwa ← is_quasi_iso_iff_is_acyclic T hT

instance is_acyclic_shift (T : 𝒦) [h : is_acyclic T] (i : ℤ) : is_acyclic (T⟦i⟧) :=
begin
  rw ← is_acyclic_iff,
  intros j,
  let H := homology_functor A (complex_shape.up ℤ) 0,
  let e : H.obj (T⟦i⟧⟦j⟧) ≅ (homology_functor A (complex_shape.up ℤ) (i+j)).obj T :=
    _ ≪≫ (homology_zero_shift_iso _ (i+j)).app T,
  swap,
  { let e := (iso_whisker_right (shift_functor_add _ i j).symm H).app T,
    refine _ ≪≫ e,
    refine iso.refl _ },
  apply is_zero_of_iso_of_zero _ e.symm,
  apply is_acyclic.cond,
end

instance is_quasi_iso_shift (X Y : 𝒦) (f : X ⟶ Y) [is_quasi_iso f] (i : ℤ) :
  is_quasi_iso (f⟦i⟧') :=
begin
  rw ← is_quasi_iso_iff,
  intros j,
  have := (category_theory.shift_functor_add 𝒦 i j).hom.naturality f,
  apply_fun (λ e, (homology_functor _ _ 0).map e) at this,
  simp only [functor.map_comp, functor.comp_map] at this,
  rw ← is_iso.inv_comp_eq at this,
  rw ← this,
  apply is_iso.comp_is_iso,
end

lemma hom_K_projective_bijective {X Y : 𝒦} (P : 𝒦) [is_K_projective P]
  (f : X ⟶ Y) [hf : is_quasi_iso f] : function.bijective (λ e : P ⟶ X, e ≫ f) :=
begin
  /-
  Steps:
  1. Complete `f` to a dist triang `X → Y → Z → X[1]`.
  2. Use LES assoc. to `Hom(P,-)`, proved in `for_mathlib/derived/homological.lean`.
  3. Use lemma above + def of K-projective to see that `Hom(P,Z) = 0`.
  -/
  obtain ⟨Z,g,h,hT⟩ := pretriangulated.distinguished_cocone_triangle _ _ f,
  let T := triangle.mk _ f g h,
  change T ∈ _ at hT,
  let H : 𝒦 ⥤ Ab := preadditive_yoneda.flip.obj (opposite.op P),
  have EE : exact_seq Ab [arrow.mk (H.map T.inv_rotate.mor₁), arrow.mk (H.map f), H.map g],
  { apply exact_seq.cons,
    apply homological_functor.cond H T.inv_rotate,
    apply inv_rotate_mem_distinguished_triangles,
    assumption,
    rw ← exact_iff_exact_seq,
    apply homological_functor.cond H T hT },
  split,
  { intros e₁ e₂ hh,
    let ee := (EE.extract 0 2).pair,
    rw AddCommGroup.exact_iff at ee,
    dsimp at hh,
    rw [← sub_eq_zero, ← preadditive.sub_comp] at hh,
    change _ ∈ (H.map f).ker at hh,
    rw ← ee at hh,
    obtain ⟨g,hg⟩ := hh,
    let g' : P ⟶ _ := g,
    haveI : is_acyclic T.inv_rotate.obj₁,
    { change is_acyclic ((T.obj₃)⟦(-1 : ℤ)⟧),
      apply_with homotopy_category.is_acyclic_shift { instances := ff },
      haveI : is_quasi_iso T.mor₁ := hf,
      apply is_acyclic_of_dist_triang_of_is_quasi_iso,
      exact hT },
    have : g' = 0,
    { apply is_K_projective.cond },
    change g' ≫ _ = _ at hg,
    rw [this, zero_comp] at hg,
    rw ← sub_eq_zero,
    exact hg.symm },
  { intros q,
    have : q ≫ g = 0,
    { haveI : is_acyclic Z,
      { change is_acyclic T.obj₃,
        apply_with is_acyclic_of_dist_triang_of_is_quasi_iso { instances := ff },
        assumption,
        exact hf },
      apply is_K_projective.cond },
    let ee := (EE.extract 1 3).pair,
    rw AddCommGroup.exact_iff at ee,
    change _ ∈ (H.map g).ker at this,
    rwa ← ee at this }
end

instance (X : 𝒦) [is_bounded_above X] (i : ℤ) : is_bounded_above (X⟦i⟧) :=
begin
  obtain ⟨a,ha⟩ := is_bounded_above.cond X,
  use a - i,
  intros j hj,
  apply ha,
  linarith
end

lemma is_K_projective_of_iso (P Q : 𝒦) [is_K_projective P] (e : P ≅ Q) : is_K_projective Q :=
begin
  constructor,
  introsI Y _ f,
  apply_fun (λ q, e.hom ≫ q),
  dsimp,
  rw comp_zero,
  apply is_K_projective.cond,
  intros a b h,
  apply_fun (λ q, e.inv ≫ q) at h,
  simpa using h,
end

instance is_K_projective_shift (P : 𝒦) [is_K_projective P] (i : ℤ) : is_K_projective (P⟦i⟧) :=
begin
  constructor,
  introsI Y _ f,
  let e := (shift_functor_comp_shift_functor_neg _ i).app P,
  dsimp at e,
  haveI : is_K_projective (P⟦i⟧⟦-i⟧) := is_K_projective_of_iso _ _ e.symm,
  apply (category_theory.shift_functor 𝒦 (-i)).map_injective,
  simp,
  apply is_K_projective.cond,
end

lemma is_quasi_iso_of_triangle
  (T₁ T₂ : triangle 𝒦)
  (h₁ : T₁ ∈ dist_triang 𝒦)
  (h₂ : T₂ ∈ dist_triang 𝒦)
  (f : T₁ ⟶ T₂)
  [is_quasi_iso f.hom₁]
  [is_quasi_iso f.hom₂] :
  is_quasi_iso f.hom₃ :=
begin
  -- Another application of the five lemma...
  let H : 𝒦 ⥤ _ := homotopy_category.homology_functor _ _ 0,
  rw ← is_quasi_iso_iff,
  intros i,
  let S₁ := T₁⟦i⟧,
  let S₂ := T₂⟦i⟧,
  let g : S₁ ⟶ S₂ := f⟦i⟧',
  have aux1 : exact (H.map S₁.mor₁) (H.map S₁.mor₂),
  { apply homological_functor.cond,
    apply pretriangulated.shift_of_dist_triangle,
    assumption },
  have aux2 : exact (H.map S₁.mor₂) (H.map S₁.mor₃),
  { apply homological_functor.cond H S₁.rotate,
    apply pretriangulated.rot_of_dist_triangle,
    apply pretriangulated.shift_of_dist_triangle,
    assumption },
  have aux3 : exact (H.map S₁.mor₃) (H.map S₁.rotate.mor₃),
  { apply homological_functor.cond H S₁.rotate.rotate,
    apply pretriangulated.rot_of_dist_triangle,
    apply pretriangulated.rot_of_dist_triangle,
    apply pretriangulated.shift_of_dist_triangle,
    assumption },
  have aux4 : exact (H.map S₂.mor₁) (H.map S₂.mor₂),
  { apply homological_functor.cond,
    apply pretriangulated.shift_of_dist_triangle,
    assumption },
  have aux5 : exact (H.map S₂.mor₂) (H.map S₂.mor₃),
  { apply homological_functor.cond H S₂.rotate,
    apply pretriangulated.rot_of_dist_triangle,
    apply pretriangulated.shift_of_dist_triangle,
    assumption },
  have aux6 : exact (H.map S₂.mor₃) (H.map S₂.rotate.mor₃),
  { apply homological_functor.cond H S₂.rotate.rotate,
    apply pretriangulated.rot_of_dist_triangle,
    apply pretriangulated.rot_of_dist_triangle,
    apply pretriangulated.shift_of_dist_triangle,
    assumption },
  haveI : is_iso (H.map g.hom₁),
  { change is_iso (H.map (f.hom₁⟦i⟧')),
    apply_instance },
  haveI : is_iso (H.map g.hom₂),
  { change is_iso (H.map (f.hom₂⟦i⟧')),
    apply_instance },
  haveI : is_iso (H.map (g.hom₁⟦(1 : ℤ)⟧')),
  { change is_iso (H.map (f.hom₁⟦i⟧'⟦(1 :ℤ)⟧')),
    have := (category_theory.shift_functor_add 𝒦 i 1).hom.naturality f.hom₁,
    apply_fun (λ e, H.map e) at this,
    simp only [H.map_comp, functor.comp_map] at this,
    rw ← is_iso.inv_comp_eq at this,
    rw ← this,
    apply is_iso.comp_is_iso },
  haveI : is_iso (H.map (g.hom₂⟦(1 : ℤ)⟧')),
  { change is_iso (H.map (f.hom₂⟦i⟧'⟦(1 :ℤ)⟧')),
    have := (category_theory.shift_functor_add 𝒦 i 1).hom.naturality f.hom₂,
    apply_fun (λ e, H.map e) at this,
    simp only [H.map_comp, functor.comp_map] at this,
    rw ← is_iso.inv_comp_eq at this,
    rw ← this,
    apply is_iso.comp_is_iso },
  refine @abelian.is_iso_of_is_iso_of_is_iso_of_is_iso_of_is_iso A _ _
    (H.obj S₁.obj₁) (H.obj S₁.obj₂) (H.obj S₁.obj₃) (H.obj (S₁.obj₁⟦(1 : ℤ)⟧))
    (H.obj S₂.obj₁) (H.obj S₂.obj₂) (H.obj S₂.obj₃) (H.obj (S₂.obj₁⟦(1 : ℤ)⟧))
    (H.map S₁.mor₁) (H.map S₁.mor₂) (H.map S₁.mor₃)
    (H.map S₂.mor₁) (H.map S₂.mor₂) (H.map S₂.mor₃)
    (H.map g.hom₁) (H.map g.hom₂) (H.map g.hom₃) (H.map (g.hom₁⟦(1 : ℤ)⟧'))
    _ _ _
    (H.obj (S₁.obj₂⟦(1 : ℤ)⟧))
    (H.obj (S₂.obj₂⟦(1 : ℤ)⟧))
    (H.map (S₁.rotate.mor₃))
    (H.map (S₂.rotate.mor₃))
    (H.map (g.hom₂⟦(1 : ℤ)⟧')) _ aux1 aux2 aux3 aux4 aux5 aux6 _ _ _ _,
  { simp only [← H.map_comp, g.comm₁] },
  { simp only [← H.map_comp, g.comm₂] },
  { simp only [← H.map_comp, g.comm₃] },
  { simp only [← functor.map_comp],
    congr' 1,
    dsimp,
    simp only [preadditive.comp_neg, preadditive.neg_comp, neg_inj, ← functor.map_comp, f.comm₁,
      preadditive.zsmul_comp, preadditive.comp_zsmul] },
end

lemma is_K_projective_of_triangle (T : triangle 𝒦) (hT : T ∈ dist_triang 𝒦)
  [is_K_projective T.obj₁] [is_K_projective T.obj₂] : is_K_projective T.obj₃ :=
begin
  constructor,
  introsI Y _ f,
  let H : 𝒦 ⥤ Abᵒᵖ := (preadditive_yoneda.obj Y).right_op,
  haveI : homological_functor H := infer_instance, -- sanity check
  have e := homological_functor.cond H T.rotate
    (rotate_mem_distinguished_triangles _ hT),
  dsimp [H] at e,
  let a := _, let b := _, change exact a b at e, have e' : exact b.unop a.unop := e.unop,
  dsimp at e',
  rw AddCommGroup.exact_iff at e',
  let a' := _, let b' := _, change add_monoid_hom.range a' = add_monoid_hom.ker b' at e',
  have : f ∈ b'.ker,
  { change _  ≫ _ = 0,
    apply_with is_K_projective.cond { instances := ff },
    dsimp,
    apply_instance,
    apply_instance },
  rw ← e' at this,
  obtain ⟨g,hg⟩ := this,
  dsimp at hg,
  rw ← hg,
  have : g = 0,
  { apply is_K_projective.cond },
  simp [this],
end

variable [enough_projectives A]

lemma exists_bounded_K_projective_replacement_of_bounded (a : ℤ) (X : 𝒦) (H : X.bounded_by a) :
  ∃ (P : 𝒦) [is_K_projective P] (hP : P.bounded_by a)
    (f : P ⟶ X), is_quasi_iso f ∧ (∀ k, projective (P.as.X k)) :=
begin
  use projective.replacement X.as a H,
  refine ⟨⟨_⟩, _, (quotient _ _).map (projective.replacement.hom X.as a H), ⟨_⟩, _⟩,
  { intros Y hY f,
    convert eq_of_homotopy _ _ (projective.null_homotopic_of_projective_to_acyclic f.out a
      (projective.replacement_is_projective X.as a H)
      (projective.replacement_is_bounded X.as a H)
      hY.1),
    simp },
  { apply projective.replacement_is_bounded },
  { intro i,
    erw ← homology_functor_map_factors,
    apply_instance },
  { intro k, dsimp, apply projective.replacement_is_projective }
end

lemma exists_K_projective_replacement_of_uniformly_bounded_above {α : Type*}
  (X : α → 𝒦) [is_uniformly_bounded_above X] :
  ∃ (P : α → 𝒦) [∀ a, is_K_projective (P a)] [is_uniformly_bounded_above P]
    (f : Π a, P a ⟶ X a), (∀ a, is_quasi_iso (f a)) ∧ (∀ a k, projective ((P a).as.X k)) :=
begin
  obtain ⟨a,H⟩ := is_uniformly_bounded_above.cond X,
  have := λ t, exists_bounded_K_projective_replacement_of_bounded a _ (H t),
  choose P H1 H2 f H3 H4 using this,
  refine ⟨P, H1, ⟨⟨a, H2⟩⟩, f, H3, H4⟩,
end

lemma exists_K_projective_replacement_of_bounded (X : 𝒦)
  [is_bounded_above X] :
  ∃ (P : 𝒦) [is_K_projective P] [is_bounded_above P]
    (f : P ⟶ X), is_quasi_iso f ∧ (∀ k, projective (P.as.X k)) :=
begin
  obtain ⟨a, H⟩ := is_bounded_above.cond X,
  have := exists_bounded_K_projective_replacement_of_bounded a _ H,
  choose P H1 H2 f H3 H4 using this,
  refine ⟨P, H1, ⟨⟨a, H2⟩⟩, f, H3, H4⟩,
end

instance is_K_projective_of_bounded_termwise_projective
  (P : bounded_homotopy_category A)
  [hP : ∀ k, projective (P.val.as.X k)] :
  P.val.is_K_projective :=
⟨λ Y hY f, begin
  suffices H : homotopy f.out 0,
  { have h := homotopy_category.eq_of_homotopy f.out 0 H,
    simpa only [homotopy_category.quotient_map_out] using h, },
  exact projective.null_homotopic_of_projective_to_acyclic _ P.bdd.1.some hP P.bdd.1.some_spec
    hY.1,
end⟩

end homotopy_category


import challenge_notations
import challenge_prerequisites
import for_mathlib.universal_delta_functor.Ext

/-!

This file discusses the various Ext groups appearing in our project.
We also discuss the computation `Ext^1(ℤ/nℤ, ℤ/nℤ) = ℤ/nℤ`.

-/

noncomputable theory

open_locale liquid_tensor_experiment nnreal

open category_theory category_theory.limits opposite
open bounded_homotopy_category bounded_derived_category

section Ext

namespace liquid_tensor_experiment

/-!
The `Ext i (ℳ_{p'} S) V` which appears in the main statement of the challenge
is just an alias for `Ext' i (op (ℳ_{p'} S)) (Condensed.of_top_ab V)`.
The notation `Ext'` will be explained below, while `ℳ_{p'} S` is discussed in the file
`examples/radon_measures.lean` and `(Condensed.of_top_ab V)` is discussed in the file
`examples/pBanach.lean`.
-/
example
  (p' p : ℝ≥0) [fact (0 < p')] [fact (p' < p)] [fact (p ≤ 1)]
  (S : Profinite.{0}) (V : pBanach.{0} p) :
  ∀ i > 0,
    Ext i (ℳ_{p'} S) V =
    Ext' i (op (ℳ_{p'} S)) (Condensed.of_top_ab V) :=
by { intros, refl }

end liquid_tensor_experiment

universes v u
/-!
We fix an abelian category with enough projectives.
-/
variables {𝓐 : Type u} [category.{v} 𝓐] [abelian 𝓐] [enough_projectives 𝓐]

/-!
The functor from `𝓐` to the bounded above homotopy category, sending `X` to `X[0]`,
is denoted by `single 𝓐 0`.
-/
example : 𝓐 ⥤ bounded_homotopy_category 𝓐 :=
single 𝓐 0

/-!
We introduced a coercion to simplify the notation.
-/
example (X : 𝓐) : bounded_homotopy_category 𝓐 := X
example (X : 𝓐) : (X : bounded_homotopy_category 𝓐) = (single _ 0) X := rfl

/-!
Our Ext functor `Ext n`, for `n : ℤ`, is defined for arbitrary objects in the bounded above
homotopy category.
It is a bifunctor which is contravariant in the first component and covariant in the second.
-/
example (n : ℤ) : (bounded_homotopy_category 𝓐)ᵒᵖ ⥤ bounded_homotopy_category 𝓐 ⥤ Ab :=
Ext n

/-!
`Ext' n (X, B)` is defined to be `Ext n (X, B)`, modulo the coercion mentioned above.
We have to manually tell Lean that a coercion is involved in this case using `↑`.
-/
example (n : ℕ) (X Y : 𝓐) :
  Ext' n (op X) Y =
  Ext n (op ↑X) ↑Y :=
rfl

/-!
The `Ext' n` can be assembled into a δ-functor, which is denoted `Ext_δ_functor 𝓐 Y`.
To be precise, this is considering `Ext' n (X, Y)` as functors in `X`, with `Y` fixed.
-/
example (Y : 𝓐) : 𝓐ᵒᵖ ⥤δ Ab.{v} := Ext_δ_functor 𝓐 Y

/-!
The `n-th` component of this delta functor is denoted `Ext_δ_functor 𝓐 Y n`,
and it is defined on objects as `Ext' n (op X) Y`. -/
example (n : ℕ) (Y : 𝓐) : 𝓐ᵒᵖ ⥤ Ab.{v} := Ext_δ_functor 𝓐 Y n

example (n : ℕ) (X Y : 𝓐) :
  (Ext_δ_functor 𝓐 Y n) (op X) = Ext' n (op X) Y :=
rfl

/-!
`Ext' 0 (X, Y) ≅ Hom(X,Y)`.
-/
example (X Y : 𝓐) : Ext' 0 (op X) Y ≅ AddCommGroup.of (X ⟶ Y) :=
(Ext'_zero_flip_iso 𝓐 Y).app (op X)

/-!
The isomorphism above is functorial in the first variable, and the isomorphism of functors
is denoted `Ext'_zero_flip_iso 𝓐 Y`. This isomorphism will be used in the example below.
-/
example (Y : 𝓐) : (Ext' 0).flip.obj Y ≅ preadditive_yoneda.obj Y :=
Ext'_zero_flip_iso 𝓐 Y

/-!
Any natural transformation `Hom(-,B) ⟶ F 0` to the zeroth-component of some
delta functor `F` extends in a unique way to a morphism of delta functors
`Ext_δ_functor A B ⟶ F`.

Note that `Ext' 0 (X,B)` is not definitionally equal to `Hom(X,B)`,
so we must compose with the isomorphism `Ext'_zero_flip_iso` from the previous example.
-/
theorem Ext_δ_functor_is_universal_for_Hom
  (Y : 𝓐)
  -- Let `F` be a contravariant delta functor on `𝓐`,
  (F : 𝓐ᵒᵖ ⥤δ Ab.{v})
  -- and `e0` a morphism from `Hom(-,Y)` to `F 0`.
  (e0 : preadditive_yoneda Y ⟶ F 0) :
  -- Then there exists a unique morphism of δ-functors `e : Ext_δ_functor 𝓐 Y ⟶ F`
  ∃! (e : Ext_δ_functor 𝓐 Y ⟶ F),
  -- such that `e0` is the composition of the zero-th component of `e` with the isomorphism
  -- `Hom(-,Y) ≅ Ext' 0 (-,Y)`.
  e0 = (Ext'_zero_flip_iso 𝓐 Y).inv ≫ (e : Ext_δ_functor 𝓐 Y ⟶ F) 0 :=
begin
  let e0' : Ext_δ_functor 𝓐 Y 0 ⟶ F 0 := (Ext'_zero_flip_iso _ _).hom ≫ e0,
  obtain ⟨e,he1,he2⟩ := delta_functor.universal.cond F e0',
  refine ⟨e,_,_⟩,
  { dsimp, simp only [e0', he1, iso.inv_hom_id_assoc], },
  { intros η hη, specialize he2 η,
    apply he2, rw iso.eq_inv_comp at hη,
    exact hη.symm },
end

open AddCommGroup

/-!
An explicit computation: `Ext^1(ℤ/n,ℤ/n) = ℤ/n`.
The notation `AddCommGroup.of A` considers an abelian group `A` as an object of
`AddCommGroup`, the category of abelian groups.
-/
example (n : ℕ) (hn : n ≠ 0) :
  Ext' 1 (op (AddCommGroup.of (zmod n))) (AddCommGroup.of (zmod n)) ≅
  AddCommGroup.of (zmod n) :=
begin
  refine Ext'_iso (op $ of $ zmod n) (of $ zmod n) 1 (zmod_resolution n) (zmod_resolution_pi n)
    (zmod_resolution_is_resolution n hn) ≪≫
      (category_theory.homology_iso _ 0 (-1) (-2) rfl rfl) ≪≫ _,
  refine (AddCommGroup.homology_iso _ _ _) ≪≫ _,
  refine add_equiv_iso_AddCommGroup_iso.hom _,
  refine add_equiv.surjective_congr _ (quotient_add_group.mk' _) (add_monoid_hom.id _)
    (quot.mk_surjective _) function.surjective_id _,
  refine (add_equiv.add_subgroup_congr _).trans _,
  { exact ⊤ },
  { convert add_monoid_hom.ker_zero using 2,
    refine is_zero.eq_of_tgt _ _ _,
    refine AddCommGroup.is_zero_of_eq _ _,
    intros f g,
    apply category_theory.limits.has_zero_object.from_zero_ext, },
  { refine (add_subgroup.equiv_top _).symm.trans (zmultiples_add_hom _).symm, },
  { simp only [add_monoid_hom.ker_zero, quotient_add_group.ker_mk,
     functor.map_homological_complex_obj_d, homological_complex.op_d],
    ext ⟨f, hf⟩,
    simp only [add_subgroup.mem_comap, add_equiv.coe_to_add_monoid_hom, add_equiv.coe_trans,
      function.comp_app, zmultiples_add_hom_symm_apply, add_subgroup.coe_subtype,
      add_subgroup.coe_mk, add_monoid_hom.mem_range],
    simp only [add_subgroup.equiv_top_symm_apply, add_monoid_hom.mem_ker],
    dsimp [add_equiv.add_subgroup_congr, zmod_resolution],
    split,
    { intro hf1, refine ⟨0, comp_zero.trans _⟩, ext1, exact hf1.symm },
    { intro H, cases H with g hg, rw [← hg, coe_comp],
      convert g.map_nsmul _ _ using 1,
      simp only [eq_to_hom_refl, id_apply, zmod.nsmul_eq_zero] } }
end

end Ext


import tactic.interactive
import category.traversable

universes u

--open lean
--open lean.parser

--example (list : ℕ) := list.map

@[irreducible]
def freeze {α : Sort u} (x : α) : α := x

def dup {α : Sort u} (x : α) : Σ' (y : α), x = y := ⟨x, rfl⟩

def ex (x : ℕ) : 0 = x ∨ ∃ y, y + 1 = x :=
let ⟨y, h⟩ := dup x,
hy : 0 = y ∨ ∃ x, x + 1 = y := match x, h with
| 0, h := or.inl h
| (x + 1), h := or.inr ⟨x, h⟩
end
in begin
 rw ← h at hy,
 exact hy
end

#print ex
#print ex._match_2

namespace tactic
namespace interactive

setup_tactic_parser

def metavar {α} {x : α} : α := x

-- def f := begin
--   have y : ℕ := 4,
--   have x : ℕ := metavar,
--   by_cases h : y = x + 1,
--   repeat { sorry }
-- end

@[derive has_reflect]
meta structure equation := (witness : option name) (pattern : pexpr) (body : pexpr)

meta def equation.parser : lean.parser equation := do
  tk "|",
  witness <- optional $ tk "{" *> ident <* tk "}",
  pattern <- parser.pexpr,
  tk ":=",
  body <- texpr,
  return { witness := witness, pattern := pattern, body := body }

namespace dmatch_
meta def mk_case : equation → tactic (name × pexpr × pexpr)
| ⟨none, pattern, body⟩ := (λ h, (h, pattern, body)) <$> get_unused_name `h
| ⟨some h, pattern, body⟩ := return (h, pattern, body)

meta def lam (x : name) (t : pexpr) (e : pexpr) : pexpr := expr.lam x binder_info.default t e

meta def cons (x : pexpr) : name × pexpr × pexpr → pexpr → pexpr
| ⟨h, pattern, body⟩ rest
:= let case := ``(%%x = %%pattern) in ``(dite %%case %%(lam h case body) %%(lam h ``(¬%%case) rest))

@[irreducible]
def opaque {α} (x : α) : α := x

def opaque.refl {α} (x : α) : x = opaque x := by { delta opaque, refl }

def hm (x : ℕ) := let y := opaque x in match x, opaque.refl x with a + 1, b := by {  } | _, _ := 1 end

meta def impossible : list (name × pexpr × pexpr) → tactic pexpr
| [⟨h₀, p₀, _⟩] := return ``(match )
| _ := fail "too many patterns not implemented"

meta def mk (x : pexpr) (patterns : list equation) : tactic pexpr := do
  cases <- sequence $ patterns.map mk_case,
  imp <- impossible cases,
  return $ cases.foldr (cons x) imp
end dmatch_

meta def dmatch (x : parse (parser.pexpr <* tk "with")) (patterns : parse (many equation.parser)) : tactic unit :=
  dmatch_.mk x patterns >>= «exact»

def hmmm (x : ℕ) (h : x = 1): x = 1 := by { cases x, cases h, assumption }

#print hmmm

end interactive
end tactic

def foo (y : ℕ) : Π x : ℕ, x = y → ℕ
| 0 _ := 1
| 3 _ := 4
| (x + 2) _ := x
| 1 _ := 5

#print foo._main

def fib (n : ℕ) (f : fin n → ℕ) : ℕ :=
by dmatch n with
| 0 := 1
| 1 := 1
| {h} (m + 2) := f ⟨m, _⟩ + f ⟨m + 1, _⟩