/-
Copyright (c) 2021 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz

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

/-!

# Sheafification

We construct the sheafification of a presheaf over a site `C` with values in `D` whenever
`D` is a concrete category for which the forgetful functor preserves the appropriate (co)limits
and reflects isomorphisms.

We generally follow the approach of https://stacks.math.columbia.edu/tag/00W1

-/

namespace CategoryTheory

open CategoryTheory.Limits Opposite

universe w v u

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

variable {D : Type w} [Category.{max v u} D]

section

variable [ConcreteCategory.{max v u} D]

attribute [local instance] concrete_category.has_coe_to_sort concrete_category.has_coe_to_fun

/-- A concrete version of the multiequalizer, to be used below. -/
@[nolint has_nonempty_instance]
def Meq {X : C} (P : Cᵒᵖ ⥤ D) (S : J.cover X) :=
  { x : ∀ I : S.arrow, P.obj (op I.y) //
    ∀ I : S.Relation, P.map I.g₁.op (x I.fst) = P.map I.g₂.op (x I.snd) }
#align category_theory.meq CategoryTheory.Meq

end

namespace Meq

variable [ConcreteCategory.{max v u} D]

attribute [local instance] concrete_category.has_coe_to_sort concrete_category.has_coe_to_fun

instance {X} (P : Cᵒᵖ ⥤ D) (S : J.cover X) :
    CoeFun (Meq P S) fun x => ∀ I : S.arrow, P.obj (op I.y) :=
  ⟨fun x => x.1⟩

@[ext]
theorem ext {X} {P : Cᵒᵖ ⥤ D} {S : J.cover X} (x y : Meq P S) (h : ∀ I : S.arrow, x I = y I) :
    x = y :=
  Subtype.ext <| funext <| h
#align category_theory.meq.ext CategoryTheory.Meq.ext

theorem condition {X} {P : Cᵒᵖ ⥤ D} {S : J.cover X} (x : Meq P S) (I : S.Relation) :
    P.map I.g₁.op (x ((S.index P).fstTo I)) = P.map I.g₂.op (x ((S.index P).sndTo I)) :=
  x.2 _
#align category_theory.meq.condition CategoryTheory.Meq.condition

/-- Refine a term of `meq P T` with respect to a refinement `S ⟶ T` of covers. -/
def refine {X : C} {P : Cᵒᵖ ⥤ D} {S T : J.cover X} (x : Meq P T) (e : S ⟶ T) : Meq P S :=
  ⟨fun I => x ⟨I.y, I.f, (leOfHom e) _ I.hf⟩, fun I =>
    x.condition
      ⟨I.y₁, I.y₂, I.z, I.g₁, I.g₂, I.f₁, I.f₂, (leOfHom e) _ I.h₁, (leOfHom e) _ I.h₂, I.w⟩⟩
#align category_theory.meq.refine CategoryTheory.Meq.refine

@[simp]
theorem refine_apply {X : C} {P : Cᵒᵖ ⥤ D} {S T : J.cover X} (x : Meq P T) (e : S ⟶ T)
    (I : S.arrow) : x.refine e I = x ⟨I.y, I.f, (leOfHom e) _ I.hf⟩ :=
  rfl
#align category_theory.meq.refine_apply CategoryTheory.Meq.refine_apply

/-- Pull back a term of `meq P S` with respect to a morphism `f : Y ⟶ X` in `C`. -/
def pullback {Y X : C} {P : Cᵒᵖ ⥤ D} {S : J.cover X} (x : Meq P S) (f : Y ⟶ X) :
    Meq P ((J.pullback f).obj S) :=
  ⟨fun I => x ⟨_, I.f ≫ f, I.hf⟩, fun I =>
    x.condition
      ⟨I.y₁, I.y₂, I.z, I.g₁, I.g₂, I.f₁ ≫ f, I.f₂ ≫ f, I.h₁, I.h₂, by simp [reassoc_of I.w]⟩⟩
#align category_theory.meq.pullback CategoryTheory.Meq.pullback

@[simp]
theorem pullback_apply {Y X : C} {P : Cᵒᵖ ⥤ D} {S : J.cover X} (x : Meq P S) (f : Y ⟶ X)
    (I : ((J.pullback f).obj S).arrow) : x.pullback f I = x ⟨_, I.f ≫ f, I.hf⟩ :=
  rfl
#align category_theory.meq.pullback_apply CategoryTheory.Meq.pullback_apply

@[simp]
theorem pullback_refine {Y X : C} {P : Cᵒᵖ ⥤ D} {S T : J.cover X} (h : S ⟶ T) (f : Y ⟶ X)
    (x : Meq P T) : (x.pullback f).refine ((J.pullback f).map h) = (refine x h).pullback _ :=
  rfl
#align category_theory.meq.pullback_refine CategoryTheory.Meq.pullback_refine

/-- Make a term of `meq P S`. -/
def mk {X : C} {P : Cᵒᵖ ⥤ D} (S : J.cover X) (x : P.obj (op X)) : Meq P S :=
  ⟨fun I => P.map I.f.op x, fun I => by
    dsimp
    simp only [← comp_apply, ← P.map_comp, ← op_comp, I.w]⟩
#align category_theory.meq.mk CategoryTheory.Meq.mk

theorem mk_apply {X : C} {P : Cᵒᵖ ⥤ D} (S : J.cover X) (x : P.obj (op X)) (I : S.arrow) :
    mk S x I = P.map I.f.op x :=
  rfl
#align category_theory.meq.mk_apply CategoryTheory.Meq.mk_apply

variable [PreservesLimits (forget D)]

/-- The equivalence between the type associated to `multiequalizer (S.index P)` and `meq P S`. -/
noncomputable def equiv {X : C} (P : Cᵒᵖ ⥤ D) (S : J.cover X) [HasMultiequalizer (S.index P)] :
    (multiequalizer (S.index P) : D) ≃ Meq P S :=
  Limits.Concrete.multiequalizerEquiv _
#align category_theory.meq.equiv CategoryTheory.Meq.equiv

@[simp]
theorem equiv_apply {X : C} {P : Cᵒᵖ ⥤ D} {S : J.cover X} [HasMultiequalizer (S.index P)]
    (x : multiequalizer (S.index P)) (I : S.arrow) :
    equiv P S x I = Multiequalizer.ι (S.index P) I x :=
  rfl
#align category_theory.meq.equiv_apply CategoryTheory.Meq.equiv_apply

@[simp]
theorem equiv_symm_eq_apply {X : C} {P : Cᵒᵖ ⥤ D} {S : J.cover X} [HasMultiequalizer (S.index P)]
    (x : Meq P S) (I : S.arrow) : Multiequalizer.ι (S.index P) I ((Meq.equiv P S).symm x) = x I :=
  by
  let z := (meq.equiv P S).symm x
  rw [← equiv_apply]
  simp
#align category_theory.meq.equiv_symm_eq_apply CategoryTheory.Meq.equiv_symm_eq_apply

end Meq

namespace GrothendieckTopology

namespace Plus

variable [ConcreteCategory.{max v u} D]

attribute [local instance] concrete_category.has_coe_to_sort concrete_category.has_coe_to_fun

variable [PreservesLimits (forget D)]

variable [∀ X : C, HasColimitsOfShape (J.cover X)ᵒᵖ D]

variable [∀ (P : Cᵒᵖ ⥤ D) (X : C) (S : J.cover X), HasMultiequalizer (S.index P)]

noncomputable section

/-- Make a term of `(J.plus_obj P).obj (op X)` from `x : meq P S`. -/
def mk {X : C} {P : Cᵒᵖ ⥤ D} {S : J.cover X} (x : Meq P S) : (J.plusObj P).obj (op X) :=
  colimit.ι (J.diagram P X) (op S) ((Meq.equiv P S).symm x)
#align category_theory.grothendieck_topology.plus.mk CategoryTheory.GrothendieckTopology.Plus.mk

theorem res_mk_eq_mk_pullback {Y X : C} {P : Cᵒᵖ ⥤ D} {S : J.cover X} (x : Meq P S) (f : Y ⟶ X) :
    (J.plusObj P).map f.op (mk x) = mk (x.pullback f) :=
  by
  dsimp [mk, plus_obj]
  simp only [← comp_apply, colimit.ι_pre, ι_colim_map_assoc]
  simp_rw [comp_apply]
  congr 1
  apply_fun meq.equiv P _
  erw [Equiv.apply_symm_apply]
  ext i
  simp only [diagram_pullback_app, meq.pullback_apply, meq.equiv_apply, ← comp_apply]
  erw [multiequalizer.lift_ι, meq.equiv_symm_eq_apply]
  cases i; rfl
#align category_theory.grothendieck_topology.plus.res_mk_eq_mk_pullback CategoryTheory.GrothendieckTopology.Plus.res_mk_eq_mk_pullback

theorem toPlus_mk {X : C} {P : Cᵒᵖ ⥤ D} (S : J.cover X) (x : P.obj (op X)) :
    (J.toPlus P).app _ x = mk (Meq.mk S x) :=
  by
  dsimp [mk, to_plus]
  let e : S ⟶ ⊤ := hom_of_le (OrderTop.le_top _)
  rw [← colimit.w _ e.op]
  delta cover.to_multiequalizer
  simp only [comp_apply]
  congr 1
  dsimp [diagram]
  apply concrete.multiequalizer_ext
  intro i
  simpa only [← comp_apply, category.assoc, multiequalizer.lift_ι, category.comp_id,
    meq.equiv_symm_eq_apply]
#align category_theory.grothendieck_topology.plus.to_plus_mk CategoryTheory.GrothendieckTopology.Plus.toPlus_mk

theorem toPlus_apply {X : C} {P : Cᵒᵖ ⥤ D} (S : J.cover X) (x : Meq P S) (I : S.arrow) :
    (J.toPlus P).app _ (x I) = (J.plusObj P).map I.f.op (mk x) :=
  by
  dsimp only [to_plus, plus_obj]
  delta cover.to_multiequalizer
  dsimp [mk]
  simp only [← comp_apply, colimit.ι_pre, ι_colim_map_assoc]
  simp only [comp_apply]
  dsimp only [functor.op]
  let e : (J.pullback I.f).obj (unop (op S)) ⟶ ⊤ := hom_of_le (OrderTop.le_top _)
  rw [← colimit.w _ e.op]
  simp only [comp_apply]
  congr 1
  apply concrete.multiequalizer_ext
  intro i
  dsimp [diagram]
  simp only [← comp_apply, category.assoc, multiequalizer.lift_ι, category.comp_id,
    meq.equiv_symm_eq_apply]
  let RR : S.relation :=
    ⟨_, _, _, i.f, 𝟙 _, I.f, i.f ≫ I.f, I.hf, sieve.downward_closed _ I.hf _, by simp⟩
  cases I
  erw [x.condition RR]
  simpa [RR]
#align category_theory.grothendieck_topology.plus.to_plus_apply CategoryTheory.GrothendieckTopology.Plus.toPlus_apply

theorem toPlus_eq_mk {X : C} {P : Cᵒᵖ ⥤ D} (x : P.obj (op X)) :
    (J.toPlus P).app _ x = mk (Meq.mk ⊤ x) :=
  by
  dsimp [mk, to_plus]
  delta cover.to_multiequalizer
  simp only [comp_apply]
  congr 1
  apply_fun meq.equiv P ⊤
  ext i
  simpa
#align category_theory.grothendieck_topology.plus.to_plus_eq_mk CategoryTheory.GrothendieckTopology.Plus.toPlus_eq_mk

variable [∀ X : C, PreservesColimitsOfShape (J.cover X)ᵒᵖ (forget D)]

theorem exists_rep {X : C} {P : Cᵒᵖ ⥤ D} (x : (J.plusObj P).obj (op X)) :
    ∃ (S : J.cover X)(y : Meq P S), x = mk y :=
  by
  obtain ⟨S, y, h⟩ := concrete.colimit_exists_rep (J.diagram P X) x
  use S.unop, meq.equiv _ _ y
  rw [← h]
  dsimp [mk]
  simp
#align category_theory.grothendieck_topology.plus.exists_rep CategoryTheory.GrothendieckTopology.Plus.exists_rep

theorem eq_mk_iff_exists {X : C} {P : Cᵒᵖ ⥤ D} {S T : J.cover X} (x : Meq P S) (y : Meq P T) :
    mk x = mk y ↔ ∃ (W : J.cover X)(h1 : W ⟶ S)(h2 : W ⟶ T), x.refine h1 = y.refine h2 :=
  by
  constructor
  · intro h
    obtain ⟨W, h1, h2, hh⟩ := concrete.colimit_exists_of_rep_eq _ _ _ h
    use W.unop, h1.unop, h2.unop
    ext I
    apply_fun multiequalizer.ι (W.unop.index P) I  at hh
    convert hh
    all_goals
      dsimp [diagram]
      simp only [← comp_apply, multiequalizer.lift_ι, category.comp_id, meq.equiv_symm_eq_apply]
      cases I; rfl
  · rintro ⟨S, h1, h2, e⟩
    apply concrete.colimit_rep_eq_of_exists
    use op S, h1.op, h2.op
    apply concrete.multiequalizer_ext
    intro i
    apply_fun fun ee => ee i  at e
    convert e
    all_goals
      dsimp [diagram]
      simp only [← comp_apply, multiequalizer.lift_ι, meq.equiv_symm_eq_apply]
      cases i; rfl
#align category_theory.grothendieck_topology.plus.eq_mk_iff_exists CategoryTheory.GrothendieckTopology.Plus.eq_mk_iff_exists

/-- `P⁺` is always separated. -/
theorem sep {X : C} (P : Cᵒᵖ ⥤ D) (S : J.cover X) (x y : (J.plusObj P).obj (op X))
    (h : ∀ I : S.arrow, (J.plusObj P).map I.f.op x = (J.plusObj P).map I.f.op y) : x = y :=
  by
  -- First, we choose representatives for x and y.
  obtain ⟨Sx, x, rfl⟩ := exists_rep x
  obtain ⟨Sy, y, rfl⟩ := exists_rep y
  simp only [res_mk_eq_mk_pullback] at h
  -- Next, using our assumption,
  -- choose covers over which the pullbacks of these representatives become equal.
  choose W h1 h2 hh using fun I : S.arrow => (eq_mk_iff_exists _ _).mp (h I)
  -- To prove equality, it suffices to prove that there exists a cover over which
  -- the representatives become equal.
  rw [eq_mk_iff_exists]
  -- Construct the cover over which the representatives become equal by combining the various
  -- covers chosen above.
  let B : J.cover X := S.bind W
  use B
  -- Prove that this cover refines the two covers over which our representatives are defined
  -- and use these proofs.
  let ex : B ⟶ Sx :=
    hom_of_le
      (by
        rintro Y f ⟨Z, e1, e2, he2, he1, hee⟩
        rw [← hee]
        apply le_of_hom (h1 ⟨_, _, he2⟩)
        exact he1)
  let ey : B ⟶ Sy :=
    hom_of_le
      (by
        rintro Y f ⟨Z, e1, e2, he2, he1, hee⟩
        rw [← hee]
        apply le_of_hom (h2 ⟨_, _, he2⟩)
        exact he1)
  use ex, ey
  -- Now prove that indeed the representatives become equal over `B`.
  -- This will follow by using the fact that our representatives become
  -- equal over the chosen covers.
  ext1 I
  let IS : S.arrow := I.from_middle
  specialize hh IS
  let IW : (W IS).arrow := I.to_middle
  apply_fun fun e => e IW  at hh
  convert hh
  · let Rx : Sx.relation :=
      ⟨I.Y, I.Y, I.Y, 𝟙 _, 𝟙 _, I.f, I.to_middle_hom ≫ I.from_middle_hom, _, _, by
        simp [I.middle_spec]⟩
    have := x.condition Rx
    simpa using this
  · let Ry : Sy.relation :=
      ⟨I.Y, I.Y, I.Y, 𝟙 _, 𝟙 _, I.f, I.to_middle_hom ≫ I.from_middle_hom, _, _, by
        simp [I.middle_spec]⟩
    have := y.condition Ry
    simpa using this
#align category_theory.grothendieck_topology.plus.sep CategoryTheory.GrothendieckTopology.Plus.sep

theorem inj_of_sep (P : Cᵒᵖ ⥤ D)
    (hsep :
      ∀ (X : C) (S : J.cover X) (x y : P.obj (op X)),
        (∀ I : S.arrow, P.map I.f.op x = P.map I.f.op y) → x = y)
    (X : C) : Function.Injective ((J.toPlus P).app (op X)) :=
  by
  intro x y h
  simp only [to_plus_eq_mk] at h
  rw [eq_mk_iff_exists] at h
  obtain ⟨W, h1, h2, hh⟩ := h
  apply hsep X W
  intro I
  apply_fun fun e => e I  at hh
  exact hh
#align category_theory.grothendieck_topology.plus.inj_of_sep CategoryTheory.GrothendieckTopology.Plus.inj_of_sep

/-- An auxiliary definition to be used in the proof of `exists_of_sep` below.
  Given a compatible family of local sections for `P⁺`, and representatives of said sections,
  construct a compatible family of local sections of `P` over the combination of the covers
  associated to the representatives.
  The separatedness condition is used to prove compatibility among these local sections of `P`. -/
def meqOfSep (P : Cᵒᵖ ⥤ D)
    (hsep :
      ∀ (X : C) (S : J.cover X) (x y : P.obj (op X)),
        (∀ I : S.arrow, P.map I.f.op x = P.map I.f.op y) → x = y)
    (X : C) (S : J.cover X) (s : Meq (J.plusObj P) S) (T : ∀ I : S.arrow, J.cover I.y)
    (t : ∀ I : S.arrow, Meq P (T I)) (ht : ∀ I : S.arrow, s I = mk (t I)) : Meq P (S.bind T)
    where
  val I := t I.fromMiddle I.toMiddle
  property := by
    intro II
    apply inj_of_sep P hsep
    rw [← comp_apply, ← comp_apply, (J.to_plus P).naturality, (J.to_plus P).naturality, comp_apply,
      comp_apply]
    erw [to_plus_apply (T II.fst.from_middle) (t II.fst.from_middle) II.fst.to_middle,
      to_plus_apply (T II.snd.from_middle) (t II.snd.from_middle) II.snd.to_middle, ← ht, ← ht, ←
      comp_apply, ← comp_apply, ← (J.plus_obj P).map_comp, ← (J.plus_obj P).map_comp]
    rw [← op_comp, ← op_comp]
    let IR : S.relation :=
      ⟨_, _, _, II.g₁ ≫ II.fst.to_middle_hom, II.g₂ ≫ II.snd.to_middle_hom, II.fst.from_middle_hom,
        II.snd.from_middle_hom, II.fst.from_middle_condition, II.snd.from_middle_condition, _⟩
    swap;
    · simp only [category.assoc, II.fst.middle_spec, II.snd.middle_spec]
      apply II.w
    exact s.condition IR
#align category_theory.grothendieck_topology.plus.meq_of_sep CategoryTheory.GrothendieckTopology.Plus.meqOfSep

theorem exists_of_sep (P : Cᵒᵖ ⥤ D)
    (hsep :
      ∀ (X : C) (S : J.cover X) (x y : P.obj (op X)),
        (∀ I : S.arrow, P.map I.f.op x = P.map I.f.op y) → x = y)
    (X : C) (S : J.cover X) (s : Meq (J.plusObj P) S) :
    ∃ t : (J.plusObj P).obj (op X), Meq.mk S t = s :=
  by
  have inj : ∀ X : C, Function.Injective ((J.to_plus P).app (op X)) := inj_of_sep _ hsep
  -- Choose representatives for the given local sections.
  choose T t ht using fun I => exists_rep (s I)
  -- Construct a large cover over which we will define a representative that will
  -- provide the gluing of the given local sections.
  let B : J.cover X := S.bind T
  choose Z e1 e2 he2 he1 hee using fun I : B.arrow => I.hf
  -- Construct a compatible system of local sections over this large cover, using the chosen
  -- representatives of our local sections.
  -- The compatilibity here follows from the separatedness assumption.
  let w : meq P B := meq_of_sep P hsep X S s T t ht
  -- The associated gluing will be the candidate section.
  use mk w
  ext I
  erw [ht, res_mk_eq_mk_pullback]
  -- Use the separatedness of `P⁺` to prove that this is indeed a gluing of our
  -- original local sections.
  apply sep P (T I)
  intro II
  simp only [res_mk_eq_mk_pullback, eq_mk_iff_exists]
  -- It suffices to prove equality for representatives over a
  -- convenient sufficiently large cover...
  use (J.pullback II.f).obj (T I)
  let e0 : (J.pullback II.f).obj (T I) ⟶ (J.pullback II.f).obj ((J.pullback I.f).obj B) :=
    hom_of_le
      (by
        intro Y f hf
        apply sieve.le_pullback_bind _ _ _ I.hf
        · cases I
          exact hf)
  use e0, 𝟙 _
  ext IV
  dsimp only [meq.refine_apply, meq.pullback_apply, w]
  let IA : B.arrow := ⟨_, (IV.f ≫ II.f) ≫ I.f, _⟩
  swap
  · refine' ⟨I.Y, _, _, I.hf, _, rfl⟩
    apply sieve.downward_closed
    convert II.hf
    cases I
    rfl
  let IB : S.arrow := IA.from_middle
  let IC : (T IB).arrow := IA.to_middle
  let ID : (T I).arrow := ⟨IV.Y, IV.f ≫ II.f, sieve.downward_closed (T I) II.hf IV.f⟩
  change t IB IC = t I ID
  apply inj IV.Y
  erw [to_plus_apply (T I) (t I) ID, to_plus_apply (T IB) (t IB) IC, ← ht, ← ht]
  -- Conclude by constructing the relation showing equality...
  let IR : S.relation := ⟨_, _, IV.Y, IC.f, ID.f, IB.f, I.f, _, I.hf, IA.middle_spec⟩
  convert s.condition IR
  cases I; rfl
#align category_theory.grothendieck_topology.plus.exists_of_sep CategoryTheory.GrothendieckTopology.Plus.exists_of_sep

variable [ReflectsIsomorphisms (forget D)]

/-- If `P` is separated, then `P⁺` is a sheaf. -/
theorem isSheaf_of_sep (P : Cᵒᵖ ⥤ D)
    (hsep :
      ∀ (X : C) (S : J.cover X) (x y : P.obj (op X)),
        (∀ I : S.arrow, P.map I.f.op x = P.map I.f.op y) → x = y) :
    Presheaf.IsSheaf J (J.plusObj P) :=
  by
  rw [presheaf.is_sheaf_iff_multiequalizer]
  intro X S
  apply is_iso_of_reflects_iso _ (forget D)
  rw [is_iso_iff_bijective]
  constructor
  · intro x y h
    apply sep P S _ _
    intro I
    apply_fun meq.equiv _ _  at h
    apply_fun fun e => e I  at h
    convert h
    · erw [meq.equiv_apply, ← comp_apply, multiequalizer.lift_ι]
    · erw [meq.equiv_apply, ← comp_apply, multiequalizer.lift_ι]
  · rintro (x : (multiequalizer (S.index _) : D))
    obtain ⟨t, ht⟩ := exists_of_sep P hsep X S (meq.equiv _ _ x)
    use t
    apply_fun meq.equiv _ _
    swap
    · infer_instance
    rw [← ht]
    ext i
    dsimp
    rw [← comp_apply, multiequalizer.lift_ι]
    rfl
#align category_theory.grothendieck_topology.plus.is_sheaf_of_sep CategoryTheory.GrothendieckTopology.Plus.isSheaf_of_sep

variable (J)

/-- `P⁺⁺` is always a sheaf. -/
theorem isSheaf_plus_plus (P : Cᵒᵖ ⥤ D) : Presheaf.IsSheaf J (J.plusObj (J.plusObj P)) :=
  by
  apply is_sheaf_of_sep
  intro X S x y
  apply sep
#align category_theory.grothendieck_topology.plus.is_sheaf_plus_plus CategoryTheory.GrothendieckTopology.Plus.isSheaf_plus_plus

end Plus

variable (J)

variable [∀ (P : Cᵒᵖ ⥤ D) (X : C) (S : J.cover X), HasMultiequalizer (S.index P)]
  [∀ X : C, HasColimitsOfShape (J.cover X)ᵒᵖ D]

/-- The sheafification of a presheaf `P`.
*NOTE:* Additional hypotheses are needed to obtain a proof that this is a sheaf! -/
def sheafify (P : Cᵒᵖ ⥤ D) : Cᵒᵖ ⥤ D :=
  J.plusObj (J.plusObj P)
#align category_theory.grothendieck_topology.sheafify CategoryTheory.GrothendieckTopology.sheafify

/-- The canonical map from `P` to its sheafification. -/
def toSheafify (P : Cᵒᵖ ⥤ D) : P ⟶ J.sheafify P :=
  J.toPlus P ≫ J.plusMap (J.toPlus P)
#align category_theory.grothendieck_topology.to_sheafify CategoryTheory.GrothendieckTopology.toSheafify

/-- The canonical map on sheafifications induced by a morphism. -/
def sheafifyMap {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) : J.sheafify P ⟶ J.sheafify Q :=
  J.plusMap <| J.plusMap η
#align category_theory.grothendieck_topology.sheafify_map CategoryTheory.GrothendieckTopology.sheafifyMap

@[simp]
theorem sheafifyMap_id (P : Cᵒᵖ ⥤ D) : J.sheafifyMap (𝟙 P) = 𝟙 (J.sheafify P) :=
  by
  dsimp [sheafify_map, sheafify]
  simp
#align category_theory.grothendieck_topology.sheafify_map_id CategoryTheory.GrothendieckTopology.sheafifyMap_id

@[simp]
theorem sheafifyMap_comp {P Q R : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (γ : Q ⟶ R) :
    J.sheafifyMap (η ≫ γ) = J.sheafifyMap η ≫ J.sheafifyMap γ :=
  by
  dsimp [sheafify_map, sheafify]
  simp
#align category_theory.grothendieck_topology.sheafify_map_comp CategoryTheory.GrothendieckTopology.sheafifyMap_comp

@[simp, reassoc.1]
theorem toSheafify_naturality {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) :
    η ≫ J.toSheafify _ = J.toSheafify _ ≫ J.sheafifyMap η :=
  by
  dsimp [sheafify_map, sheafify, to_sheafify]
  simp
#align category_theory.grothendieck_topology.to_sheafify_naturality CategoryTheory.GrothendieckTopology.toSheafify_naturality

variable (D)

/-- The sheafification of a presheaf `P`, as a functor.
*NOTE:* Additional hypotheses are needed to obtain a proof that this is a sheaf! -/
def sheafification : (Cᵒᵖ ⥤ D) ⥤ Cᵒᵖ ⥤ D :=
  J.plusFunctor D ⋙ J.plusFunctor D
#align category_theory.grothendieck_topology.sheafification CategoryTheory.GrothendieckTopology.sheafification

@[simp]
theorem sheafification_obj (P : Cᵒᵖ ⥤ D) : (J.sheafification D).obj P = J.sheafify P :=
  rfl
#align category_theory.grothendieck_topology.sheafification_obj CategoryTheory.GrothendieckTopology.sheafification_obj

@[simp]
theorem sheafification_map {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) :
    (J.sheafification D).map η = J.sheafifyMap η :=
  rfl
#align category_theory.grothendieck_topology.sheafification_map CategoryTheory.GrothendieckTopology.sheafification_map

/-- The canonical map from `P` to its sheafification, as a natural transformation.
*Note:* We only show this is a sheaf under additional hypotheses on `D`. -/
def toSheafification : 𝟭 _ ⟶ sheafification J D :=
  J.toPlusNatTrans D ≫ whiskerRight (J.toPlusNatTrans D) (J.plusFunctor D)
#align category_theory.grothendieck_topology.to_sheafification CategoryTheory.GrothendieckTopology.toSheafification

@[simp]
theorem toSheafification_app (P : Cᵒᵖ ⥤ D) : (J.toSheafification D).app P = J.toSheafify P :=
  rfl
#align category_theory.grothendieck_topology.to_sheafification_app CategoryTheory.GrothendieckTopology.toSheafification_app

variable {D}

theorem isIso_toSheafify {P : Cᵒᵖ ⥤ D} (hP : Presheaf.IsSheaf J P) : IsIso (J.toSheafify P) :=
  by
  dsimp [to_sheafify]
  haveI : is_iso (J.to_plus P) := by apply is_iso_to_plus_of_is_sheaf J P hP
  haveI : is_iso ((J.plus_functor D).map (J.to_plus P)) := by apply functor.map_is_iso
  exact @is_iso.comp_is_iso _ _ _ _ _ (J.to_plus P) ((J.plus_functor D).map (J.to_plus P)) _ _
#align category_theory.grothendieck_topology.is_iso_to_sheafify CategoryTheory.GrothendieckTopology.isIso_toSheafify

/-- If `P` is a sheaf, then `P` is isomorphic to `J.sheafify P`. -/
def isoSheafify {P : Cᵒᵖ ⥤ D} (hP : Presheaf.IsSheaf J P) : P ≅ J.sheafify P :=
  letI := is_iso_to_sheafify J hP
  as_iso (J.to_sheafify P)
#align category_theory.grothendieck_topology.iso_sheafify CategoryTheory.GrothendieckTopology.isoSheafify

@[simp]
theorem isoSheafify_hom {P : Cᵒᵖ ⥤ D} (hP : Presheaf.IsSheaf J P) :
    (J.isoSheafify hP).Hom = J.toSheafify P :=
  rfl
#align category_theory.grothendieck_topology.iso_sheafify_hom CategoryTheory.GrothendieckTopology.isoSheafify_hom

/-- Given a sheaf `Q` and a morphism `P ⟶ Q`, construct a morphism from
`J.sheafifcation P` to `Q`. -/
def sheafifyLift {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (hQ : Presheaf.IsSheaf J Q) : J.sheafify P ⟶ Q :=
  J.plusLift (J.plusLift η hQ) hQ
#align category_theory.grothendieck_topology.sheafify_lift CategoryTheory.GrothendieckTopology.sheafifyLift

@[simp, reassoc.1]
theorem toSheafify_sheafifyLift {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (hQ : Presheaf.IsSheaf J Q) :
    J.toSheafify P ≫ sheafifyLift J η hQ = η :=
  by
  dsimp only [sheafify_lift, to_sheafify]
  simp
#align category_theory.grothendieck_topology.to_sheafify_sheafify_lift CategoryTheory.GrothendieckTopology.toSheafify_sheafifyLift

theorem sheafifyLift_unique {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (hQ : Presheaf.IsSheaf J Q)
    (γ : J.sheafify P ⟶ Q) : J.toSheafify P ≫ γ = η → γ = sheafifyLift J η hQ :=
  by
  intro h
  apply plus_lift_unique
  apply plus_lift_unique
  rw [← category.assoc, ← plus_map_to_plus]
  exact h
#align category_theory.grothendieck_topology.sheafify_lift_unique CategoryTheory.GrothendieckTopology.sheafifyLift_unique

@[simp]
theorem isoSheafify_inv {P : Cᵒᵖ ⥤ D} (hP : Presheaf.IsSheaf J P) :
    (J.isoSheafify hP).inv = J.sheafifyLift (𝟙 _) hP :=
  by
  apply J.sheafify_lift_unique
  simp [iso.comp_inv_eq]
#align category_theory.grothendieck_topology.iso_sheafify_inv CategoryTheory.GrothendieckTopology.isoSheafify_inv

theorem sheafify_hom_ext {P Q : Cᵒᵖ ⥤ D} (η γ : J.sheafify P ⟶ Q) (hQ : Presheaf.IsSheaf J Q)
    (h : J.toSheafify P ≫ η = J.toSheafify P ≫ γ) : η = γ :=
  by
  apply J.plus_hom_ext _ _ hQ
  apply J.plus_hom_ext _ _ hQ
  rw [← category.assoc, ← category.assoc, ← plus_map_to_plus]
  exact h
#align category_theory.grothendieck_topology.sheafify_hom_ext CategoryTheory.GrothendieckTopology.sheafify_hom_ext

@[simp, reassoc.1]
theorem sheafifyMap_sheafifyLift {P Q R : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (γ : Q ⟶ R)
    (hR : Presheaf.IsSheaf J R) :
    J.sheafifyMap η ≫ J.sheafifyLift γ hR = J.sheafifyLift (η ≫ γ) hR :=
  by
  apply J.sheafify_lift_unique
  rw [← category.assoc, ← J.to_sheafify_naturality, category.assoc, to_sheafify_sheafify_lift]
#align category_theory.grothendieck_topology.sheafify_map_sheafify_lift CategoryTheory.GrothendieckTopology.sheafifyMap_sheafifyLift

end GrothendieckTopology

variable (J)

variable [ConcreteCategory.{max v u} D] [PreservesLimits (forget D)]
  [∀ (P : Cᵒᵖ ⥤ D) (X : C) (S : J.cover X), HasMultiequalizer (S.index P)]
  [∀ X : C, HasColimitsOfShape (J.cover X)ᵒᵖ D]
  [∀ X : C, PreservesColimitsOfShape (J.cover X)ᵒᵖ (forget D)] [ReflectsIsomorphisms (forget D)]

theorem GrothendieckTopology.sheafify_isSheaf (P : Cᵒᵖ ⥤ D) : Presheaf.IsSheaf J (J.sheafify P) :=
  GrothendieckTopology.Plus.isSheaf_plus_plus _ _
#align category_theory.grothendieck_topology.sheafify_is_sheaf CategoryTheory.GrothendieckTopology.sheafify_isSheaf

variable (D)

/-- The sheafification functor, as a functor taking values in `Sheaf`. -/
@[simps]
def presheafToSheaf : (Cᵒᵖ ⥤ D) ⥤ Sheaf J D
    where
  obj P := ⟨J.sheafify P, J.sheafify_isSheaf P⟩
  map P Q η := ⟨J.sheafifyMap η⟩
  map_id' P := Sheaf.Hom.ext _ _ <| J.sheafifyMap_id _
  map_comp' P Q R f g := Sheaf.Hom.ext _ _ <| J.sheafifyMap_comp _ _
#align category_theory.presheaf_to_Sheaf CategoryTheory.presheafToSheaf

instance presheafToSheaf_preservesZeroMorphisms [Preadditive D] :
    (presheafToSheaf J D).PreservesZeroMorphisms
    where map_zero' F G := by
    ext
    erw [colimit.ι_map, comp_zero, J.plus_map_zero, J.diagram_nat_trans_zero, zero_comp]
#align category_theory.presheaf_to_Sheaf_preserves_zero_morphisms CategoryTheory.presheafToSheaf_preservesZeroMorphisms

/-- The sheafification functor is left adjoint to the forgetful functor. -/
@[simps unit_app counit_app_val]
def sheafificationAdjunction : presheafToSheaf J D ⊣ sheafToPresheaf J D :=
  Adjunction.mkOfHomEquiv
    { homEquiv := fun P Q =>
        { toFun := fun e => J.toSheafify P ≫ e.val
          invFun := fun e => ⟨J.sheafifyLift e Q.2⟩
          left_inv := fun e => Sheaf.Hom.ext _ _ <| (J.sheafifyLift_unique _ _ _ rfl).symm
          right_inv := fun e => J.toSheafify_sheafifyLift _ _ }
      homEquiv_naturality_left_symm := by
        intro P Q R η γ; ext1; dsimp; symm
        apply J.sheafify_map_sheafify_lift
      homEquiv_naturality_right := fun P Q R η γ =>
        by
        dsimp
        rw [category.assoc] }
#align category_theory.sheafification_adjunction CategoryTheory.sheafificationAdjunction

instance sheafToPresheafIsRightAdjoint : IsRightAdjoint (sheafToPresheaf J D) :=
  ⟨_, sheafificationAdjunction J D⟩
#align category_theory.Sheaf_to_presheaf_is_right_adjoint CategoryTheory.sheafToPresheafIsRightAdjoint

instance presheaf_mono_of_mono {F G : Sheaf J D} (f : F ⟶ G) [Mono f] : Mono f.1 :=
  (sheafToPresheaf J D).map_mono _
#align category_theory.presheaf_mono_of_mono CategoryTheory.presheaf_mono_of_mono

theorem Sheaf.Hom.mono_iff_presheaf_mono {F G : Sheaf J D} (f : F ⟶ G) : Mono f ↔ Mono f.1 :=
  ⟨fun m => by
    skip
    infer_instance, fun m => by
    skip
    exact Sheaf.hom.mono_of_presheaf_mono J D f⟩
#align category_theory.Sheaf.hom.mono_iff_presheaf_mono CategoryTheory.Sheaf.Hom.mono_iff_presheaf_mono

variable {J D}

/-- A sheaf `P` is isomorphic to its own sheafification. -/
@[simps]
def sheafificationIso (P : Sheaf J D) : P ≅ (presheafToSheaf J D).obj P.val
    where
  Hom := ⟨(J.isoSheafify P.2).Hom⟩
  inv := ⟨(J.isoSheafify P.2).inv⟩
  hom_inv_id' := by
    ext1
    apply (J.iso_sheafify P.2).hom_inv_id
  inv_hom_id' := by
    ext1
    apply (J.iso_sheafify P.2).inv_hom_id
#align category_theory.sheafification_iso CategoryTheory.sheafificationIso

instance isIso_sheafificationAdjunction_counit (P : Sheaf J D) :
    IsIso ((sheafificationAdjunction J D).counit.app P) :=
  isIso_of_fully_faithful (sheafToPresheaf J D) _
#align category_theory.is_iso_sheafification_adjunction_counit CategoryTheory.isIso_sheafificationAdjunction_counit

instance sheafification_reflective : IsIso (sheafificationAdjunction J D).counit :=
  NatIso.isIso_of_isIso_app _
#align category_theory.sheafification_reflective CategoryTheory.sheafification_reflective

end CategoryTheory


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison
-/
import algebraic_geometry.prime_spectrum
import algebra.category.CommRing.colimits
import algebra.category.CommRing.limits
import topology.sheaves.local_predicate
import topology.sheaves.forget
import ring_theory.localization
import ring_theory.subring

/-!
# The structure sheaf on `prime_spectrum R`.

We define the structure sheaf on `Top.of (prime_spectrum R)`, for a commutative ring `R`.
We define this as a subsheaf of the sheaf of dependent functions into the localizations,
cut out by the condition that the function must be locally equal to a ratio of elements of `R`.

Because the condition "is equal to a fraction" passes to smaller open subsets,
the subset of functions satisfying this condition is automatically a subpresheaf.
Because the condition "is locally equal to a fraction" is local,
it is also a subsheaf.

(It may be helpful to refer back to `topology.sheaves.sheaf_of_functions`,
where we show that dependent functions into any type family form a sheaf,
and also `topology.sheaves.local_predicate`, where we characterise the predicates
which pick out sub-presheaves and sub-sheaves of these sheaves.)

We also set up the ring structure, obtaining
`structure_sheaf R : sheaf CommRing (Top.of (prime_spectrum R))`.
-/

universe u

noncomputable theory

variables (R : Type u) [comm_ring R]

open Top
open topological_space
open category_theory
open opposite

namespace algebraic_geometry

/--
$Spec R$, just as a topological space.
-/
def Spec.Top : Top := Top.of (prime_spectrum R)

namespace structure_sheaf

/--
The type family over `prime_spectrum R` consisting of the localization over each point.
-/
@[derive [comm_ring, local_ring]]
def localizations (P : Spec.Top R) : Type u := localization.at_prime P.as_ideal

instance (P : Spec.Top R) : inhabited (localizations R P) :=
⟨(localization.of _).to_map 1⟩

variables {R}

/--
The predicate saying that a dependent function on an open `U` is realised as a fixed fraction
`r / s` in each of the stalks (which are localizations at various prime ideals).
-/
def is_fraction {U : opens (Spec.Top R)} (f : Π x : U, localizations R x) : Prop :=
∃ (r s : R), ∀ x : U,
  ¬ (s ∈ x.1.as_ideal) ∧ f x * (localization.of _).to_map s = (localization.of _).to_map r

variables (R)

/--
The predicate `is_fraction` is "prelocal",
in the sense that if it holds on `U` it holds on any open subset `V` of `U`.
-/
def is_fraction_prelocal : prelocal_predicate (localizations R) :=
{ pred := λ U f, is_fraction f,
  res := by { rintro V U i f ⟨r, s, w⟩, exact ⟨r, s, λ x, w (i x)⟩ } }

/--
We will define the structure sheaf as
the subsheaf of all dependent functions in `Π x : U, localizations R x`
consisting of those functions which can locally be expressed as a ratio of
(the images in the localization of) elements of `R`.

Quoting Hartshorne:

For an open set $U ⊆ Spec A$, we define $𝒪(U)$ to be the set of functions
$s : U → ⨆_{𝔭 ∈ U} A_𝔭$, such that $s(𝔭) ∈ A_𝔭$ for each $𝔭$,
and such that $s$ is locally a quotient of elements of $A$:
to be precise, we require that for each $𝔭 ∈ U$, there is a neighborhood $V$ of $𝔭$,
contained in $U$, and elements $a, f ∈ A$, such that for each $𝔮 ∈ V, f ∉ 𝔮$,
and $s(𝔮) = a/f$ in $A_𝔮$.

Now Hartshorne had the disadvantage of not knowing about dependent functions,
so we replace his circumlocution about functions into a disjoint union with
`Π x : U, localizations x`.
-/
def is_locally_fraction : local_predicate (localizations R) :=
(is_fraction_prelocal R).sheafify

@[simp]
lemma is_locally_fraction_pred
  {U : opens (Spec.Top R)} (f : Π x : U, localizations R x) :
  (is_locally_fraction R).pred f =
  ∀ x : U, ∃ (V) (m : x.1 ∈ V) (i : V ⟶ U),
  ∃ (r s : R), ∀ y : V,
  ¬ (s ∈ y.1.as_ideal) ∧
    f (i y : U) * (localization.of _).to_map s = (localization.of _).to_map r :=
rfl

/--
The functions satisfying `is_locally_fraction` form a subring.
-/
def sections_subring (U : (opens (Spec.Top R))ᵒᵖ) :
  subring (Π x : unop U, localizations R x) :=
{ carrier := { f | (is_locally_fraction R).pred f },
  zero_mem' :=
  begin
    refine λ x, ⟨unop U, x.2, 𝟙 _, 0, 1, λ y, ⟨_, _⟩⟩,
    { rw ←ideal.ne_top_iff_one, exact y.1.is_prime.1, },
    { simp, },
  end,
  one_mem' :=
  begin
    refine λ x, ⟨unop U, x.2, 𝟙 _, 1, 1, λ y, ⟨_, _⟩⟩,
    { rw ←ideal.ne_top_iff_one, exact y.1.is_prime.1, },
    { simp, },
  end,
  add_mem' :=
  begin
    intros a b ha hb x,
    rcases ha x with ⟨Va, ma, ia, ra, sa, wa⟩,
    rcases hb x with ⟨Vb, mb, ib, rb, sb, wb⟩,
    refine ⟨Va ⊓ Vb, ⟨ma, mb⟩, opens.inf_le_left _ _ ≫ ia, ra * sb + rb * sa, sa * sb, _⟩,
    intro y,
    rcases wa (opens.inf_le_left _ _ y) with ⟨nma, wa⟩,
    rcases wb (opens.inf_le_right _ _ y) with ⟨nmb, wb⟩,
    fsplit,
    { intro H, cases y.1.is_prime.mem_or_mem H; contradiction, },
    { simp only [add_mul, ring_hom.map_add, pi.add_apply, ring_hom.map_mul],
      erw [←wa, ←wb],
      simp only [mul_assoc],
      congr' 2,
      rw [mul_comm], refl, }
  end,
  neg_mem' :=
  begin
    intros a ha x,
    rcases ha x with ⟨V, m, i, r, s, w⟩,
    refine ⟨V, m, i, -r, s, _⟩,
    intro y,
    rcases w y with ⟨nm, w⟩,
    fsplit,
    { exact nm, },
    { simp only [ring_hom.map_neg, pi.neg_apply],
      erw [←w],
      simp only [neg_mul_eq_neg_mul_symm], }
  end,
  mul_mem' :=
  begin
    intros a b ha hb x,
    rcases ha x with ⟨Va, ma, ia, ra, sa, wa⟩,
    rcases hb x with ⟨Vb, mb, ib, rb, sb, wb⟩,
    refine ⟨Va ⊓ Vb, ⟨ma, mb⟩, opens.inf_le_left _ _ ≫ ia, ra * rb, sa * sb, _⟩,
    intro y,
    rcases wa (opens.inf_le_left _ _ y) with ⟨nma, wa⟩,
    rcases wb (opens.inf_le_right _ _ y) with ⟨nmb, wb⟩,
    fsplit,
    { intro H, cases y.1.is_prime.mem_or_mem H; contradiction, },
    { simp only [pi.mul_apply, ring_hom.map_mul],
      erw [←wa, ←wb],
      simp only [mul_left_comm, mul_assoc, mul_comm],
      refl, }
  end, }

end structure_sheaf

open structure_sheaf

/--
The structure sheaf (valued in `Type`, not yet `CommRing`) is the subsheaf consisting of
functions satisfying `is_locally_fraction`.
-/
def structure_sheaf_in_Type : sheaf (Type u) (Spec.Top R):=
subsheaf_to_Types (is_locally_fraction R)

instance comm_ring_structure_sheaf_in_Type_obj (U : (opens (Spec.Top R))ᵒᵖ) :
  comm_ring ((structure_sheaf_in_Type R).presheaf.obj U) :=
(sections_subring R U).to_comm_ring

open prime_spectrum

/--
The structure presheaf, valued in `CommRing`, constructed by dressing up the `Type` valued
structure presheaf.
-/
@[simps]
def structure_presheaf_in_CommRing : presheaf CommRing (Spec.Top R) :=
{ obj := λ U, CommRing.of ((structure_sheaf_in_Type R).presheaf.obj U),
  map := λ U V i,
  { to_fun := ((structure_sheaf_in_Type R).presheaf.map i),
    map_zero' := rfl,
    map_add' := λ x y, rfl,
    map_one' := rfl,
    map_mul' := λ x y, rfl, }, }

/--
Some glue, verifying that that structure presheaf valued in `CommRing` agrees
with the `Type` valued structure presheaf.
-/
def structure_presheaf_comp_forget :
  structure_presheaf_in_CommRing R ⋙ (forget CommRing) ≅ (structure_sheaf_in_Type R).presheaf :=
nat_iso.of_components
  (λ U, iso.refl _)
  (by tidy)

open Top.presheaf

/--
The structure sheaf on $Spec R$, valued in `CommRing`.

This is provided as a bundled `SheafedSpace` as `Spec.SheafedSpace R` later.
-/
def structure_sheaf : sheaf CommRing (Spec.Top R) :=
{ presheaf := structure_presheaf_in_CommRing R,
  sheaf_condition :=
    -- We check the sheaf condition under `forget CommRing`.
    (sheaf_condition_equiv_sheaf_condition_comp _ _).symm
      (sheaf_condition_equiv_of_iso (structure_presheaf_comp_forget R).symm
        (structure_sheaf_in_Type R).sheaf_condition), }

@[simp] lemma res_apply (U V : opens (Spec.Top R)) (i : V ⟶ U)
  (s : (structure_sheaf R).presheaf.obj (op U)) (x : V) :
  ((structure_sheaf R).presheaf.map i.op s).1 x = (s.1 (i x) : _) :=
rfl

/-

Notation in this comment

X = Spec R
OX = structure sheaf

In the following we construct an isomorphism between OX_p and R_p given any point p corresponding
to a prime ideal in R.

We do this via 8 steps:

1. def const (f g : R) (V) (hv : V ≤ D_g) : OX(V) [for api]
2. def to_open (U) : R ⟶ OX(U)
3. [2] def to_stalk (p : Spec R) : R ⟶ OX_p
4. [2] def to_basic_open (f : R) : R_f ⟶ OX(D_f)
5. [3] def localization_to_stalk (p : Spec R) : R_p ⟶ OX_p
6. def open_to_localization (U) (p) (hp : p ∈ U) : OX(U) ⟶ R_p
7. [6] def stalk_to_fiber_ring_hom (p : Spec R) : OX_p ⟶ R_p
8. [5,7] def stalk_iso (p : Spec R) : OX_p ≅ R_p

In the square brackets we list the dependencies of a construction on the previous steps.

-/

/-- The section of `structure_sheaf R` on an open `U` sending each `x ∈ U` to the element
`f/g` in the localization of `R` at `x`. -/
def const (f g : R) (U : opens (Spec.Top R))
  (hu : ∀ x ∈ U, g ∈ (x : Spec.Top R).as_ideal.prime_compl) :
  (structure_sheaf R).presheaf.obj (op U) :=
⟨λ x, (localization.of _).mk' f ⟨g, hu x x.2⟩,
 λ x, ⟨U, x.2, 𝟙 _, f, g, λ y, ⟨hu y y.2, localization_map.mk'_spec _ _ _⟩⟩⟩

@[simp] lemma const_apply (f g : R) (U : opens (Spec.Top R))
  (hu : ∀ x ∈ U, g ∈ (x : Spec.Top R).as_ideal.prime_compl) (x : U) :
  (const R f g U hu).1 x = (localization.of _).mk' f ⟨g, hu x x.2⟩ :=
rfl

lemma const_apply' (f g : R) (U : opens (Spec.Top R))
  (hu : ∀ x ∈ U, g ∈ (x : Spec.Top R).as_ideal.prime_compl) (x : U)
  (hx : g ∈ (as_ideal x.1).prime_compl) :
  (const R f g U hu).1 x = (localization.of _).mk' f ⟨g, hx⟩ :=
rfl

lemma exists_const (U) (s : (structure_sheaf R).presheaf.obj (op U)) (x : Spec.Top R) (hx : x ∈ U) :
  ∃ (V : opens (Spec.Top R)) (hxV : x ∈ V) (i : V ⟶ U) (f g : R) hg,
  const R f g V hg = (structure_sheaf R).presheaf.map i.op s :=
let ⟨V, hxV, iVU, f, g, hfg⟩ := s.2 ⟨x, hx⟩ in
⟨V, hxV, iVU, f, g, λ y hyV, (hfg ⟨y, hyV⟩).1, subtype.eq $ funext $ λ y,
(localization.of _).mk'_eq_iff_eq_mul.2 $ eq.symm $ (hfg y).2⟩

@[simp] lemma res_const (f g : R) (U hu V hv i) :
  (structure_sheaf R).presheaf.map i (const R f g U hu) = const R f g V hv :=
rfl

lemma res_const' (f g : R) (V hv) :
  (structure_sheaf R).presheaf.map (hom_of_le hv).op (const R f g (basic_open g) (λ _, id)) =
    const R f g V hv :=
rfl

lemma const_zero (f : R) (U hu) : const R 0 f U hu = 0 :=
subtype.eq $ funext $ λ x, (localization.of _).mk'_eq_iff_eq_mul.2 $
by erw [ring_hom.map_zero, subtype.val_eq_coe, subring.coe_zero, pi.zero_apply, zero_mul]

lemma const_self (f : R) (U hu) : const R f f U hu = 1 :=
subtype.eq $ funext $ λ x, localization_map.mk'_self _ _

lemma const_one (U) : const R 1 1 U (λ p _, submonoid.one_mem _) = 1 :=
const_self R 1 U _

lemma const_add (f₁ f₂ g₁ g₂ : R) (U hu₁ hu₂) :
  const R f₁ g₁ U hu₁ + const R f₂ g₂ U hu₂ =
  const R (f₁ * g₂ + f₂ * g₁) (g₁ * g₂) U (λ x hx, submonoid.mul_mem _ (hu₁ x hx) (hu₂ x hx)) :=
subtype.eq $ funext $ λ x, eq.symm $
by convert (localization.of _).mk'_add f₁ f₂ ⟨g₁, hu₁ x x.2⟩ ⟨g₂, hu₂ x x.2⟩

lemma const_mul (f₁ f₂ g₁ g₂ : R) (U hu₁ hu₂) :
  const R f₁ g₁ U hu₁ * const R f₂ g₂ U hu₂ =
  const R (f₁ * f₂) (g₁ * g₂) U (λ x hx, submonoid.mul_mem _ (hu₁ x hx) (hu₂ x hx)) :=
subtype.eq $ funext $ λ x, eq.symm $
by convert (localization.of _).mk'_mul f₁ f₂ ⟨g₁, hu₁ x x.2⟩ ⟨g₂, hu₂ x x.2⟩

lemma const_ext {f₁ f₂ g₁ g₂ : R} {U hu₁ hu₂} (h : f₁ * g₂ = f₂ * g₁) :
  const R f₁ g₁ U hu₁ = const R f₂ g₂ U hu₂ :=
subtype.eq $ funext $ λ x, (localization.of _).mk'_eq_of_eq h.symm

lemma const_congr {f₁ f₂ g₁ g₂ : R} {U hu} (hf : f₁ = f₂) (hg : g₁ = g₂) :
  const R f₁ g₁ U hu = const R f₂ g₂ U (hg ▸ hu) :=
by substs hf hg

lemma const_mul_rev (f g : R) (U hu₁ hu₂) :
  const R f g U hu₁ * const R g f U hu₂ = 1 :=
by rw [const_mul, const_congr R rfl (mul_comm g f), const_self]

lemma const_mul_cancel (f g₁ g₂ : R) (U hu₁ hu₂) :
  const R f g₁ U hu₁ * const R g₁ g₂ U hu₂ = const R f g₂ U hu₂ :=
by { rw [const_mul, const_ext], rw mul_assoc }

lemma const_mul_cancel' (f g₁ g₂ : R) (U hu₁ hu₂) :
  const R g₁ g₂ U hu₂ * const R f g₁ U hu₁ = const R f g₂ U hu₂ :=
by rw [mul_comm, const_mul_cancel]

/-- The canonical ring homomorphism interpreting an element of `R` as
a section of the structure sheaf. -/
def to_open (U : opens (Spec.Top R)) : CommRing.of R ⟶ (structure_sheaf R).presheaf.obj (op U) :=
{ to_fun := λ f, ⟨λ x, (localization.of _).to_map f,
    λ x, ⟨U, x.2, 𝟙 _, f, 1, λ y, ⟨(ideal.ne_top_iff_one _).1 y.1.2.1,
      by { rw [ring_hom.map_one, mul_one], refl } ⟩⟩⟩,
  map_one' := subtype.eq $ funext $ λ x, ring_hom.map_one _,
  map_mul' := λ f g, subtype.eq $ funext $ λ x, ring_hom.map_mul _ _ _,
  map_zero' := subtype.eq $ funext $ λ x, ring_hom.map_zero _,
  map_add' := λ f g, subtype.eq $ funext $ λ x, ring_hom.map_add _ _ _ }

@[simp] lemma to_open_res (U V : opens (Spec.Top R)) (i : V ⟶ U) :
  to_open R U ≫ (structure_sheaf R).presheaf.map i.op = to_open R V :=
rfl

@[simp] lemma to_open_apply (U : opens (Spec.Top R)) (f : R) (x : U) :
  (to_open R U f).1 x = (localization.of _).to_map f :=
rfl

lemma to_open_eq_const (U : opens (Spec.Top R)) (f : R) : to_open R U f =
  const R f 1 U (λ x _, (ideal.ne_top_iff_one _).1 x.2.1) :=
subtype.eq $ funext $ λ x, eq.symm $ (localization.of _).mk'_one f

/-- The canonical ring homomorphism interpreting an element of `R` as an element of
the stalk of `structure_sheaf R` at `x`. -/
def to_stalk (x : Spec.Top R) : CommRing.of R ⟶ (structure_sheaf R).presheaf.stalk x :=
(to_open R ⊤ ≫ (structure_sheaf R).presheaf.germ ⟨x, ⟨⟩⟩ : _)

@[simp] lemma to_open_germ (U : opens (Spec.Top R)) (x : U) :
  to_open R U ≫ (structure_sheaf R).presheaf.germ x =
  to_stalk R x :=
by { rw [← to_open_res R ⊤ U (hom_of_le le_top : U ⟶ ⊤), category.assoc, presheaf.germ_res], refl }

@[simp] lemma germ_to_open (U : opens (Spec.Top R)) (x : U) (f : R) :
  (structure_sheaf R).presheaf.germ x (to_open R U f) = to_stalk R x f :=
by { rw ← to_open_germ, refl }

lemma germ_to_top (x : Spec.Top R) (f : R) :
  (structure_sheaf R).presheaf.germ (⟨x, trivial⟩ : (⊤ : opens (Spec.Top R))) (to_open R ⊤ f) =
    to_stalk R x f :=
rfl

lemma is_unit_to_basic_open_self (f : R) : is_unit (to_open R (basic_open f) f) :=
is_unit_of_mul_eq_one _ (const R 1 f (basic_open f) (λ _, id)) $
by rw [to_open_eq_const, const_mul_rev]

/-- The canonical ring homomorphism interpreting `s ∈ R_f` as a section of the structure sheaf
on the basic open defined by `f ∈ R`. -/
def to_basic_open (f : R) : CommRing.of (localization (submonoid.powers f)) ⟶
  (structure_sheaf R).presheaf.obj (op $ basic_open f) :=
localization_map.away_map.lift f (localization.away.of f) (is_unit_to_basic_open_self R f)

@[simp] lemma to_basic_open_mk' (s f : R) (g : submonoid.powers s) :
  to_basic_open R s ((localization.of _).mk' f g) =
  const R f g (basic_open s) (λ x hx, submonoid.powers_subset hx g.2) :=
((localization.of _).lift_mk'_spec _ _ _ _).2 $
by rw [to_open_eq_const, to_open_eq_const, const_mul_cancel']

@[simp] lemma localization_to_basic_open (f : R) :
  @category_theory.category_struct.comp _ _ (CommRing.of R)
      (CommRing.of (localization (submonoid.powers f))) _
    (localization.of $ submonoid.powers f).to_map
    (to_basic_open R f) =
  to_open R (basic_open f) :=
ring_hom.ext $ λ g, (localization.of _).lift_eq _ _

@[simp] lemma to_basic_open_to_map (s f : R) : to_basic_open R s ((localization.of _).to_map f) =
  const R f 1 (basic_open s) (λ _ _, submonoid.one_mem _) :=
((localization.of _).lift_eq _ _).trans $ to_open_eq_const _ _ _

lemma is_unit_to_stalk (x : Spec.Top R) (f : x.as_ideal.prime_compl) :
  is_unit (to_stalk R x (f : R)) :=
by { erw ← germ_to_open R (basic_open (f : R)) ⟨x, f.2⟩ (f : R),
    exact ring_hom.is_unit_map _ (is_unit_to_basic_open_self R f) }

/-- The canonical ring homomorphism from the localization of `R` at `p` to the stalk
of the structure sheaf at the point `p`. -/
def localization_to_stalk (x : Spec.Top R) :
  CommRing.of (localization.at_prime x.as_ideal) ⟶ (structure_sheaf R).presheaf.stalk x :=
(localization.of _).lift (is_unit_to_stalk R x)

@[simp] lemma localization_to_stalk_of (x : Spec.Top R) (f : R) :
  localization_to_stalk R x ((localization.of _).to_map f) = to_stalk R x f :=
(localization.of _).lift_eq _ f

@[simp] lemma localization_to_stalk_mk' (x : Spec.Top R) (f : R) (s : (as_ideal x).prime_compl) :
  localization_to_stalk R x ((localization.of _).mk' f s) =
  (structure_sheaf R).presheaf.germ (⟨x, s.2⟩ : basic_open (s : R))
    (const R f s (basic_open s) (λ _, id)) :=
((localization.of _).lift_mk'_spec _ _ _ _).2 $
by erw [← germ_to_open R (basic_open s) ⟨x, s.2⟩, ← germ_to_open R (basic_open s) ⟨x, s.2⟩,
    ← ring_hom.map_mul, to_open_eq_const, to_open_eq_const, const_mul_cancel']

/-- The ring homomorphism that takes a section of the structure sheaf of `R` on the open set `U`,
implemented as a subtype of dependent functions to localizations at prime ideals, and evaluates
the section on the point corresponding to a given prime ideal. -/
def open_to_localization (U : opens (Spec.Top R)) (x : Spec.Top R) (hx : x ∈ U) :
  (structure_sheaf R).presheaf.obj (op U) ⟶ CommRing.of (localization.at_prime x.as_ideal) :=
{ to_fun := λ s, (s.1 ⟨x, hx⟩ : _),
  map_one' := rfl,
  map_mul' := λ _ _, rfl,
  map_zero' := rfl,
  map_add' := λ _ _, rfl }

@[simp] lemma coe_open_to_localization (U : opens (Spec.Top R)) (x : Spec.Top R) (hx : x ∈ U) :
  (open_to_localization R U x hx :
    (structure_sheaf R).presheaf.obj (op U) → localization.at_prime x.as_ideal) =
  (λ s, (s.1 ⟨x, hx⟩ : _)) :=
rfl

lemma open_to_localization_apply (U : opens (Spec.Top R)) (x : Spec.Top R) (hx : x ∈ U)
  (s : (structure_sheaf R).presheaf.obj (op U)) :
  open_to_localization R U x hx s = (s.1 ⟨x, hx⟩ : _) :=
rfl

/-- The ring homomorphism from the stalk of the structure sheaf of `R` at a point corresponding to
a prime ideal `p` to the localization of `R` at `p`,
formed by gluing the `open_to_localization` maps. -/
def stalk_to_fiber_ring_hom (x : Spec.Top R) :
  (structure_sheaf R).presheaf.stalk x ⟶ CommRing.of (localization.at_prime x.as_ideal) :=
limits.colimit.desc (((open_nhds.inclusion x).op) ⋙ (structure_sheaf R).presheaf)
  { X := _,
    ι :=
    { app := λ U, open_to_localization R ((open_nhds.inclusion _).obj (unop U)) x (unop U).2, } }

@[simp] lemma germ_comp_stalk_to_fiber_ring_hom (U : opens (Spec.Top R)) (x : U) :
  (structure_sheaf R).presheaf.germ x ≫ stalk_to_fiber_ring_hom R x =
  open_to_localization R U x x.2 :=
limits.colimit.ι_desc _ _

@[simp] lemma stalk_to_fiber_ring_hom_germ' (U : opens (Spec.Top R)) (x : Spec.Top R) (hx : x ∈ U)
  (s : (structure_sheaf R).presheaf.obj (op U)) :
  stalk_to_fiber_ring_hom R x ((structure_sheaf R).presheaf.germ ⟨x, hx⟩ s) = (s.1 ⟨x, hx⟩ : _) :=
ring_hom.ext_iff.1 (germ_comp_stalk_to_fiber_ring_hom R U ⟨x, hx⟩ : _) s

@[simp] lemma stalk_to_fiber_ring_hom_germ (U : opens (Spec.Top R)) (x : U)
  (s : (structure_sheaf R).presheaf.obj (op U)) :
  stalk_to_fiber_ring_hom R x ((structure_sheaf R).presheaf.germ x s) = s.1 x :=
by { cases x, exact stalk_to_fiber_ring_hom_germ' R U _ _ _ }

@[simp] lemma to_stalk_comp_stalk_to_fiber_ring_hom (x : Spec.Top R) :
  to_stalk R x ≫ stalk_to_fiber_ring_hom R x = (localization.of _).to_map :=
by { erw [to_stalk, category.assoc, germ_comp_stalk_to_fiber_ring_hom], refl }

@[simp] lemma stalk_to_fiber_ring_hom_to_stalk (x : Spec.Top R) (f : R) :
  stalk_to_fiber_ring_hom R x (to_stalk R x f) = (localization.of _).to_map f :=
ring_hom.ext_iff.1 (to_stalk_comp_stalk_to_fiber_ring_hom R x) _

/-- The ring isomorphism between the stalk of the structure sheaf of `R` at a point `p`
corresponding to a prime ideal in `R` and the localization of `R` at `p`. -/
def stalk_iso (x : Spec.Top R) :
  (structure_sheaf R).presheaf.stalk x ≅ CommRing.of (localization.at_prime x.as_ideal) :=
{ hom := stalk_to_fiber_ring_hom R x,
  inv := localization_to_stalk R x,
  hom_inv_id' := (structure_sheaf R).presheaf.stalk_hom_ext $ λ U hxU,
  begin
    ext s, simp only [coe_comp], rw [coe_id, stalk_to_fiber_ring_hom_germ'],
    obtain ⟨V, hxV, iVU, f, g, hg, hs⟩ := exists_const _ _ s x hxU,
    erw [← res_apply R U V iVU s ⟨x, hxV⟩, ← hs, const_apply, localization_to_stalk_mk'],
    refine (structure_sheaf R).presheaf.germ_ext V hxV (hom_of_le hg) iVU _,
    erw [← hs, res_const']
  end,
  inv_hom_id' := (localization.of x.as_ideal.prime_compl).epic_of_localization_map $ λ f,
    by simp only [ring_hom.comp_apply, coe_comp, coe_id, localization_to_stalk_of,
        stalk_to_fiber_ring_hom_to_stalk] }

end algebraic_geometry


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem algebra_2complexrootspoly_xsqp49eqxp7itxpn7i
  (x : ℂ) :
  x^2 + 49 = (x + (7 * complex.I)) * (x + (-7 * complex.I)) :=
begin
  ring_nf,
  ring_nf,
  rw [pow_two, pow_two, complex.I_mul_I],
  ring,
end


/-
Copyright (c) 2022 Ian Wood. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ian Wood
-/
import meta.expr

/-!
# `expand_exists`

`expand_exists` is an attribute which takes a proof that something exists with some property, and
outputs a value using `classical.some`, and a proof that it has that property using
`classical.some_spec`. For example:

```lean
@[expand_exists it it_spec]
lemma it_exists (n : ℕ) : ∃ m : ℕ, n < m := sorry
```

produces

```
def it (n : ℕ) : ℕ := classical.some (it_exists n)

lemma it_spec (n : ℕ) : n < it n := classical.some_spec (it_exists n)
```
-/

namespace tactic

open expr

namespace expand_exists

/--
Data known when parsing pi expressions.

`decl`'s arguments are: is_theorem, name, type, value.
-/
meta structure parse_ctx :=
(original_decl : declaration)
(decl : bool → name → expr → pexpr → tactic unit)
(names : list name)
(pis_depth : ℕ := 0)

/--
Data known when parsing exists expressions (after parsing pi expressions).

* `with_args` applies pi arguments to a term (eg `id` -> `id #2 #1 #0`).
* `spec_chain` takes the form of `classical.some_spec^n (it_exists ...)`,
with `n` the depth of `∃` parsed.
* `exists_decls` is a list of declarations containing the value(s) of witnesses.
-/
meta structure parse_ctx_exists extends parse_ctx :=
(with_args : expr → expr)
(spec_chain : pexpr)
(exists_decls : list name := [])

/--
Data known when parsing the proposition (after parsing exists and pi expressions).

`project_proof` projects a proof of the full proposition (eg `A ∧ B ∧ C`) to a specific proof (eg
`B`).
-/
meta structure parse_ctx_props extends parse_ctx_exists :=
(project_proof : pexpr → pexpr := id)

/--
Replaces free variables with their exists declaration. For example, if:

```lean
def n_value : ℕ := ... -- generated by `expand_exists`
```

then this function converts `#0` in `#0 = #0` from `∃ n : ℕ, n = n` to `n_value = n_value`.
-/
meta def instantiate_exists_decls (ctx : parse_ctx_exists) (p : expr) : expr :=
p.instantiate_vars $ ctx.exists_decls.reverse.map (λname,
  ctx.with_args (const name ctx.original_decl.univ_levels))

/--
Parses a proposition and creates the associated specification proof. Does not break down the
proposition further.
-/
meta def parse_one_prop (ctx : parse_ctx_props) (p : expr) : tactic unit :=
do
  let p : expr := instantiate_exists_decls { ..ctx } p,
  let val : pexpr := ctx.project_proof ctx.spec_chain,
  n <- match ctx.names with
  | [n] := return n
  | [] := fail "missing name for proposition"
  | _ := fail "too many names for propositions (are you missing an and?)"
  end,
  ctx.decl true n p val

/--
Parses a proposition and decides if it should be broken down (eg `P ∧ Q` -> `P` and `Q`) depending
on how many `names` are left. Then creates the associated specification proof(s).
-/
meta def parse_props : parse_ctx_props → expr → tactic unit
| ctx (app (app (const "and" []) p) q) := do
  match ctx.names with
  | [n] := parse_one_prop ctx (app (app (const `and []) p) q)
  | (n :: tail) :=
    parse_one_prop { names := [n],
      project_proof := (λ p, (const `and.left []) p) ∘ ctx.project_proof,
      ..ctx } p
    >> parse_props { names := tail,
      project_proof := (λ p, (const `and.right []) p) ∘ ctx.project_proof,
      ..ctx } q
  | [] := fail "missing name for proposition"
  end
| ctx p := parse_one_prop ctx p

/--
Parses an `∃ a : α, p a`, and creates an associated definition with a value of `α`. When `p α` is
not an exists statement, it will call `parse_props`.
-/
meta def parse_exists : parse_ctx_exists → expr → tactic unit
| ctx (app (app (const "Exists" [lvl]) type) (lam var_name bi var_type body)) := do
  /- TODO: Is this needed, and/or does this create issues? -/
  (if type = var_type then tactic.skip else tactic.fail "exists types should be equal"),
  ⟨n, names⟩ <- match ctx.names with
  | (n :: tail) := return (n, tail)
  | [] := fail "missing name for exists"
  end,
  -- Type may be dependant on earlier arguments.
  let type := instantiate_exists_decls ctx type,
  let value : pexpr := (const `classical.some [lvl]) ctx.spec_chain,
  ctx.decl false n type value,

  let exists_decls := ctx.exists_decls.concat n,
  let some_spec : pexpr := (const `classical.some_spec [lvl]) ctx.spec_chain,
  let ctx : parse_ctx_exists := { names := names,
    spec_chain := some_spec,
    exists_decls := exists_decls,
    ..ctx },
  parse_exists ctx body
| ctx e := parse_props { ..ctx } e

/--
Parses a `∀ (a : α), p a`. If `p` is not a pi expression, it will call `parse_exists`
-/
meta def parse_pis : parse_ctx → expr → tactic unit
| ctx (pi n bi ty body) :=
  -- When making a declaration, wrap in an equivalent pi expression.
  let decl := (λ is_theorem name type val,
    ctx.decl is_theorem name (pi n bi ty type) (lam n bi (to_pexpr ty) val)) in
  parse_pis { decl := decl, pis_depth := ctx.pis_depth + 1, ..ctx } body
| ctx (app (app (const "Exists" [lvl]) type) p) :=
  let with_args := (λ (e : expr),
    (list.range ctx.pis_depth).foldr (λ n (e : expr), e (var n)) e) in
  parse_exists { with_args := with_args,
    spec_chain := to_pexpr (
      with_args $ const ctx.original_decl.to_name ctx.original_decl.univ_levels),
    ..ctx } (app (app (const "Exists" [lvl]) type) p)
| ctx e := fail ("unexpected expression " ++ to_string e)

end expand_exists

/--
From a proof that (a) value(s) exist(s) with certain properties, constructs (an) instance(s)
satisfying those properties. For instance:

```lean
@[expand_exists nat_greater nat_greater_spec]
lemma nat_greater_exists (n : ℕ) : ∃ m : ℕ, n < m := ...

#check nat_greater      -- nat_greater : ℕ → ℕ
#check nat_greater_spec -- nat_greater_spec : ∀ (n : ℕ), n < nat_greater n
```

It supports multiple witnesses:

```lean
@[expand_exists nat_greater_m nat_greater_l nat_greater_spec]
lemma nat_greater_exists (n : ℕ) : ∃ (m l : ℕ), n < m ∧ m < l := ...

#check nat_greater_m      -- nat_greater : ℕ → ℕ
#check nat_greater_l      -- nat_greater : ℕ → ℕ
#check nat_greater_spec-- nat_greater_spec : ∀ (n : ℕ),
  n < nat_greater_m n ∧ nat_greater_m n < nat_greater_l n
```

It also supports logical conjunctions:
```lean
@[expand_exists nat_greater nat_greater_lt nat_greater_nonzero]
lemma nat_greater_exists (n : ℕ) : ∃ m : ℕ, n < m ∧ m ≠ 0 := ...

#check nat_greater         -- nat_greater : ℕ → ℕ
#check nat_greater_lt      -- nat_greater_lt : ∀ (n : ℕ), n < nat_greater n
#check nat_greater_nonzero -- nat_greater_nonzero : ∀ (n : ℕ), nat_greater n ≠ 0
```
Note that without the last argument `nat_greater_nonzero`, `nat_greater_lt` would be:
```lean
#check nat_greater_lt -- nat_greater_lt : ∀ (n : ℕ), n < nat_greater n ∧ nat_greater n ≠ 0
```
-/
@[user_attribute]
meta def expand_exists_attr : user_attribute unit (list name) :=
{ name := "expand_exists",
  descr := "From a proof that (a) value(s) exist(s) with certain properties, "
  ++ "constructs (an) instance(s) satisfying those properties.",
  parser := lean.parser.many lean.parser.ident,
  after_set := some $ λ decl prio persistent, do
    d <- get_decl decl,
    names <- expand_exists_attr.get_param decl,
    expand_exists.parse_pis
    { original_decl := d,
      decl := λ is_t n ty val, (tactic.to_expr val >>= λ val,
        tactic.add_decl (if is_t then declaration.thm n d.univ_params ty (pure val)
          else declaration.defn n d.univ_params ty val default tt)),
      names := names } d.type }

add_tactic_doc
{ name := "expand_exists",
  category := doc_category.attr,
  decl_names := [`tactic.expand_exists_attr],
  tags := ["lemma derivation", "environment"] }

end tactic


import mod_forms.Eisenstein_Series.Eisenstein_series_index_lemmas
import analysis.complex.upper_half_plane.basic
import analysis.complex.upper_half_plane.metric
import analysis.complex.upper_half_plane.topology
import number_theory.modular_forms.basic
import geometry.manifold.mfderiv
import tactic

universes u v w

open complex

open_locale big_operators nnreal classical filter upper_half_plane

open modular_form
open slash_invariant_form

local notation `SL2Z`:=matrix.special_linear_group (fin 2) ℤ
noncomputable theory

local notation `ℍ'`:= (⟨upper_half_plane.upper_half_space , upper_half_plane_is_open⟩: topological_space.opens ℂ)

/-! ### Eisenstein series -/

namespace Eisenstein_series

/-- The function on `ℤ × ℤ` whose sum defines an Eisenstein series.-/

def Eise (k: ℤ) (z : ℍ) : ℤ × ℤ →  ℂ:=
λ x, 1/(x.1*z+x.2)^k

/-
def Eisen (k : ℤ) (x : ℤ × ℤ) : C(ℍ, ℂ) :=
⟨λ z, 1/(x.1*z+x.2)^k, by {simp,  sorry}⟩
-/

instance : topological_space C(ℍ, ℂ) :=infer_instance

def Eise' (k: ℤ) (z : ℂ) : ℤ × ℤ →  ℂ:=
λ x, 1/(x.1*z+x.2)^k

def real_Eise (k: ℤ) (z : ℍ) : ℤ × ℤ →  ℝ:=
λ x, complex.abs(1/(x.1*z+x.2)^k)

def Eise_deriv (k: ℤ) (z : ℂ) : ℤ × ℤ →  ℂ:=
λ x, (-k*x.1)/(x.1*z+x.2)^(k+1)

/--The Eisenstein series of weight `k : ℤ` -/
def Eisenstein_series_of_weight_ (k: ℤ) : ℍ → ℂ:=
 λ z, ∑' (x : ℤ × ℤ), (Eise k z x)

def real_Eisenstein_series_of_weight_ (k: ℤ) : ℍ → ℝ:=
 λ z, ∑' (x : ℤ × ℤ), (real_Eise k z x)

def Eisenstein_deriv_weight (k: ℤ) : ℍ → ℂ:=
 λ z, ∑' (x : ℤ × ℤ), (Eise_deriv k z x)

/-
lemma summable2 (k : ℤ) (h: 3 ≤ k) : summable (Eisen k):=
begin
  sorry,
end

def Eisenstein_series_of_weight_' (k: ℤ) : C(ℍ, ℂ):=
 ∑' (x : ℤ × ℤ), Eisen k x
-/

lemma Eise_is_nonneg (k: ℤ) (z : ℍ) (y : ℤ × ℤ): 0 ≤ abs (Eise k z y):=
begin
 apply complex.abs.nonneg,
end

lemma calc_lem (k: ℤ) (a b c d i1 i2: ℂ) (z : ℍ) (h: c*z+d ≠ 0) :
((i1* ((a*z+b)/(c*z+d))+i2)^k)⁻¹=(c*z+d)^k* (((i1 * a + i2 * c) * z + (i1 * b + i2 * d))^k)⁻¹:=
begin
  have h1 : i1*((a*z+b)/(c*z+d))+i2=(i1*(a*z+b)/(c*z+d)+i2), by {ring  }, rw h1,
  have h2 :  (i1*(a*z+b)/(c*z+d)+i2)=((i1*(a*z+b))/(c*z+d)+i2), by {ring}, rw h2,
  have h3 := div_add' (i1*(a*z+b)) i2 (c*z+d) h,
  rw h3,
  simp only [div_zpow, inv_div],
  rw [div_eq_inv_mul, mul_comm],
  have h5: (c*z+d)^k ≠ 0,
  by {apply zpow_ne_zero _ h,  },
  apply congr_arg (λ (b : ℂ), (c*z+d)^k * b⁻¹),
  ring_nf,
end

lemma coe_chain (A: SL2Z) (i j : fin (2)):
  (A.1 i j : ℂ)= ((A.1 : (matrix (fin 2) (fin 2) ℝ) ) i j : ℂ):=
begin
  simp,
  rw ← coe_coe,
  fin_cases i;
  fin_cases j,
  all_goals {simp [coe_coe],
  norm_cast},
end

/- How the Eise function changes under the Moebius action-/
lemma Eise_moeb (k: ℤ) (z : ℍ) (A : SL2Z) (i : ℤ × ℤ ) :
  Eise k ( (A : matrix.GL_pos (fin 2) ℝ) • z) i =
  ((A.1 1 0*z+A.1 1 1)^k)*(Eise k z (Ind_equiv A i ) ) :=
begin
  rw Eise,
  rw Eise,
  simp [coe_fn_coe_base'],
  dsimp,
  rw calc_lem,
  have h1:= coe_chain A,
  simp only [subtype.val_eq_coe] at h1,
  rw h1,
  rw h1,
  rw ← coe_coe,
  apply upper_half_plane.denom_ne_zero A,
end

def Eisenstein_is_slash_inv (Γ : subgroup SL2Z) (k: ℤ) :
(slash_invariant_form Γ k) :=
{to_fun := (Eisenstein_series_of_weight_ k),
  slash_action_eq' := begin
  intro A,
  ext1,
  simp_rw slash_action_eq'_iff,
  rw Eisenstein_series_of_weight_,
  simp only [set.mem_set_of_eq],
  simp,
  have h1:= Eise_moeb k x A,
  have h2:=tsum_congr h1,
  convert h2,
  simp only [subtype.val_eq_coe],
  have h3:=equiv.tsum_eq (Ind_equiv A) (Eise k x),
  rw tsum_mul_left,
  rw h3,
  end }

/-
begin
rw modular_forms.wmodular_mem',
rw Eisenstein_series_of_weight_,
simp only [set.mem_set_of_eq],
intros A z,
have h1:= Eise_moeb k z A,
have h2:=tsum_congr h1,
convert h2,
simp only [subtype.val_eq_coe],
have h3:=equiv.tsum_eq (Ind_equiv A) (Eise k z),
rw tsum_mul_left,
rw h3,
simp,
end

-/

lemma Eise_on_square_is_bounded ( k : ℕ) (z : ℍ) (n : ℕ) (x: ℤ × ℤ) (h: x ∈ Square n) (hn: 1 ≤ n):
  (complex.abs(((x.1: ℂ)*z+(x.2: ℂ))^k))⁻¹ ≤ (complex.abs ((rfunct z)^k* n^k))⁻¹ :=
begin
  by_cases C1: complex.abs (x.1: ℂ)=n,
  rw inv_le_inv,
  have h0: (x.1:ℂ) ≠ 0,
  by {norm_cast,
  intro hx,
  rw hx at C1,
  simp  [int.cast_zero] at C1,
  norm_cast at C1,
  rw ← C1 at hn,
  simp only [nat.one_ne_zero, le_zero_iff] at hn,
  exact hn,},
  have h1:(↑(x.fst) * ↑z + ↑(x.snd)) ^ k =  (↑(x.fst))^k* ((z: ℂ)+(x.2: ℂ)/(↑(x.fst)))^k,
  by { rw ← mul_pow,
  rw div_eq_mul_inv,
  have: (x.fst: ℂ) * ((z: ℂ)  + (x.snd: ℂ) * ((x.fst: ℂ))⁻¹)=(x.fst: ℂ) * (z: ℂ) + (x.snd: ℂ),
  by {have p1: (x.fst: ℂ) * ((z: ℂ)  + (x.snd: ℂ) * ((x.fst: ℂ))⁻¹)=
  ((x.fst: ℂ) * (z: ℂ)  + (x.fst : ℂ) * ((x.fst: ℂ))⁻¹ * (x.snd: ℂ)),
  ring_nf,
  rw mul_inv_cancel at p1,
  simp only [one_mul] at p1,
  rw p1,
  exact h0,},
  rw this,},
  rw h1,
  simp_rw  map_mul complex.abs,
  have h3: complex.abs (↑(x.fst) ^ k)= (complex.abs (↑(x.fst)))^k , by {apply complex.abs_pow, },
  rw h3,
  rw C1,
  have h4: complex.abs (↑n ^ k)=↑n ^ k, by {norm_cast, },
  rw h4,
  rw mul_comm,
  apply mul_le_mul_of_nonneg_left,
  have:=auxlem2 z n  x h k ,
  apply this, norm_cast,
  simp only [zero_le'],
  simp only [complex.abs.pos, ne.def],
  have hh : ((x.fst): ℂ) * (z: ℂ) + (x.snd: ℂ) ≠ 0, by {
  intro H,
  have H1 : x.1 = 0 ∨ (z: ℂ).im = 0, by simpa using congr_arg complex.im H,
  cases H1, {rw H1 at C1, simp only [int.cast_zero, abs_zero] at C1,
  norm_cast at C1,
  rw ← C1 at hn,
  simp only [nat.one_ne_zero, square_mem, le_zero_iff] at *,
  exact hn,},
  have HH:= z.property,
  simp only [subtype.val_eq_coe] at HH,
  rw H1 at HH,
  simp at HH,
  exact HH,},
  apply complex.abs.pos,
  apply pow_ne_zero,
  exact hh,
  rw map_mul complex.abs,
  apply mul_pos,
  apply complex.abs.pos,
  apply pow_ne_zero,
  have:= rfunct_pos z,
  norm_cast,
  intro np,
  rw np at this,
  simp only [lt_self_iff_false] at this,
  exact this,
  apply complex.abs.pos,
  apply pow_ne_zero,
  norm_cast,
  intro Hn,
  rw Hn at hn,
  simp only [nat.one_ne_zero, le_zero_iff] at hn,
  exact hn,
  have C2: complex.abs (x.2: ℂ)=n, by {simp only [square_mem] at h,
  have:=max_aux'' x.1.nat_abs x.2.nat_abs n h,
  norm_cast,
  cases this,
  by_contra,
  norm_cast at C1,
  rw ← this at C1,
  rw int.abs_eq_nat_abs at C1,
  simp only [eq_self_iff_true, not_true] at C1,
  exact C1,
  rw ← this,
  rw int.abs_eq_nat_abs,},
  rw inv_le_inv,
  have h0: (x.2: ℂ ) ≠ 0, by {norm_cast,
  intro hx,
  rw hx at C2,
  simp only [int.cast_zero, abs_zero] at C2,
  norm_cast at C2,
  rw ← C2 at hn,
  simp only [nat.one_ne_zero, le_zero_iff] at hn,
  exact hn,},
  have h1:(↑(x.fst) * ↑z + ↑(x.snd)) ^ k =  (↑(x.snd))^k* (((x.1:ℂ)/(x.2: ℂ))*(z: ℂ)+1)^k,
  by {rw ← mul_pow,simp only,
  rw div_eq_mul_inv,
  have: (x.snd: ℂ) * ((x.fst: ℂ) * ((x.snd: ℂ))⁻¹ * (z:ℂ) + 1)=
  ((x.snd: ℂ ) * ((x.snd : ℂ))⁻¹ * (x.fst : ℂ )* (z: ℂ) + (x.snd: ℂ)), by {ring,},
  rw this,
  rw mul_inv_cancel,
  simp only [one_mul],
  exact h0,},
  rw h1,
  rw map_mul complex.abs,
  rw map_mul complex.abs,
  have h3: complex.abs (↑(x.2) ^ k)= (complex.abs (↑(x.2)))^k ,
  by {apply complex.abs_pow,},
  rw h3,
  rw C2,
  have h4: complex.abs (↑n ^ k)=↑n ^ k, by {norm_cast, },
  rw h4,
  rw mul_comm,
  apply mul_le_mul_of_nonneg_left,
  have:=auxlem3 z n  x h k ,
  apply this,
  norm_cast,
  simp only [zero_le'],
  have hh : ((x.fst): ℂ) * (z: ℂ) + (x.snd: ℂ) ≠ 0,
  by {intro H,
  have H1 : x.1 = 0 ∨ (z: ℂ).im = 0,
  by simpa using congr_arg complex.im H,
  cases H1,
  {rw H1 at H,
  simp only [int.cast_eq_zero, int.cast_zero, zero_mul, zero_add] at H,
  rw H at C2,
  simp only [int.cast_zero, abs_zero] at C2,
  norm_cast at C2,
  rw ← C2 at hn,
  simp only [nat.one_ne_zero, square_mem, le_zero_iff] at *,
  exact hn},
  have HH:= z.property, simp only [subtype.val_eq_coe] at HH,
  rw H1 at HH, simp only [lt_self_iff_false] at HH,
  exact HH,},
  apply complex.abs.pos,
  apply pow_ne_zero,
  exact hh,
  rw map_mul complex.abs,
  apply mul_pos,
  apply complex.abs.pos,
  apply pow_ne_zero,
  have:= rfunct_pos z,
  norm_cast,
  intro np,
  rw np at this,
  simp only [lt_self_iff_false] at this,
  exact this,
  apply complex.abs.pos,
  apply pow_ne_zero,
  norm_cast,
  intro Hn,
  rw Hn at hn,
  simp only [nat.one_ne_zero, le_zero_iff] at hn,
  exact hn,
end

lemma Eise_on_square_is_bounded' ( k : ℕ) (z : ℍ) (n : ℕ) (hn: 1 ≤ n): ∀ (x: ℤ × ℤ),
x ∈ (Square n) →  (complex.abs(((x.1: ℂ)*z+(x.2: ℂ))^k))⁻¹ ≤ (complex.abs ((rfunct z)^k* n^k))⁻¹ :=
begin
intros x hx,
apply Eise_on_square_is_bounded k z n x hx hn,
end

lemma Eise_on_zero_Square (k : ℕ) (z : ℍ) (h: 1 ≤ k) : ∀ (x : ℤ × ℤ),
x ∈ (Square 0) →  (complex.abs(((x.1: ℂ)*z+(x.2: ℂ))^k))⁻¹ ≤ (complex.abs ((rfunct z)^k* 0^k))⁻¹ :=
begin
  intros x hx,
  rw Square_zero at hx,
  simp only [finset.mem_singleton] at hx,
  simp_rw hx,
  simp only [add_zero, int.cast_zero, zero_mul, map_mul complex.abs],
  have h1: (0: ℂ)^k=0, by {rw zero_pow_eq_zero, linarith,},
  rw h1,
  simp,
end

lemma Eise_on_square_is_bounded'' ( k : ℕ) (z : ℍ) (n : ℕ) (hn: 1 ≤ k): ∀ (x: ℤ × ℤ),
x ∈ (Square n) →  (complex.abs(((x.1: ℂ)*z+(x.2: ℂ))^k))⁻¹ ≤ (complex.abs ((rfunct z)^k* n^k))⁻¹ :=
begin
  by_cases h0: n=0,
  {rw h0,have:= Eise_on_zero_Square k z hn, simp at *, apply this, },
  have Hn: 1 ≤ n,
  by { have:= nat.pos_of_ne_zero h0,
  linarith },
  intros x hx,
  apply Eise_on_square_is_bounded k z n x hx Hn,
end

lemma natpowsinv (x : ℝ) (n : ℤ)  (h2: x ≠ 0): (x^(n-1))⁻¹=(x^n)⁻¹*x:=
begin
have:=zpow_sub_one₀ h2 n,
rw this,
have h3:=mul_zpow (x^n) (x⁻¹) (-1),
simp at *,
exact h3,
end

/-Sum over squares is bounded -/
lemma BigClaim (k : ℕ) (z : ℍ) (h : 3 ≤ k):
  ∀ (n: ℕ), ∑ (y: ℤ × ℤ) in (Square n),
  ((real_Eise k z) y)  ≤ (8/((rfunct z)^k))*(n^((k: ℤ)-1))⁻¹:=
begin
  intro n,
  rw real_Eise,
  simp  [one_div, complex.abs_pow, abs_inv, zpow_coe_nat],
  have k0: 1 ≤ k, by {linarith,},
  have BO :=  Eise_on_square_is_bounded'' ( k : ℕ) (z : ℍ) (n : ℕ) k0,
  by_cases n0 : n=0,
  { rw n0,
  rw Square_zero,
  simp only [add_zero, int.cast_zero, nat.cast_zero, zero_mul, finset.sum_singleton],
  have H0: (0: ℂ)^k=0, by {rw zero_pow_eq_zero, linarith,},
  simp  [abs_zero, inv_zero],
  have H00: (0: ℝ)^((k: ℤ)-1)=0,
  by { rw zero_zpow, linarith,},
  rw H00,
  simp [inv_zero, mul_zero], norm_cast at *, rw H0,},
  have := finset.sum_le_sum BO,
  simp only [finset.sum_const, map_mul complex.abs, nsmul_eq_mul] at this,
  rw Square_size n at this,
  norm_cast at this,
  have ne:( (8 * n) * (complex.abs (rfunct z ^ k) * ((n ^ k): ℝ))⁻¹ : ℝ)=
  (8/((rfunct z)^k))*(n^((k: ℤ)-1))⁻¹,
  by {rw complex.abs_pow,
  rw complex.abs_of_nonneg,
  rw ← mul_pow,
  rw div_eq_inv_mul,
  have : 8* ↑n * ((rfunct z * ↑n) ^ k)⁻¹= 8*((rfunct z)^k)⁻¹ * (↑n^((k: ℤ)-1))⁻¹,
  by {have dis: ((rfunct z * ↑n) ^ k)⁻¹ = ((rfunct z)^k)⁻¹* (↑n^k)⁻¹,
  by {rw mul_pow,
  simp_rw [← zpow_neg_one],
  simp_rw [← mul_zpow], },
  simp [dis],
  rw natpowsinv,
  ring,
  norm_cast,
  intro hN,
  rw hN at n0,
  simp only [eq_self_iff_true, not_true] at n0,
  exact n0,},
  rw this,
  ring,
  have rpos := rfunct_pos z,
  apply le_of_lt rpos,},
  norm_cast at ne,
  rw ne at this,
  norm_cast,
  simp at *,
  apply this,
  have hhh := nat.pos_of_ne_zero n0,
  linarith,
end

lemma SmallClaim (k : ℕ) (z : ℍ) (h : 3 ≤ k):
 ∀ (n : ℕ), (λ (x: ℕ), ∑ (y : ℤ × ℤ) in (Square x), (real_Eise k z) y) n ≤
  (8/(rfunct z)^k) * ((rie (k-1)) n):=
begin
have BIGCLAIM:= BigClaim k z h,
simp only at BIGCLAIM,
rw rie,
simp only [one_div],
intro n,
have tr :((↑n ^ ((k: ℤ) - 1))⁻¹: ℝ)=((↑n ^ ((k: ℝ) - 1))⁻¹: ℝ), by {simp [inv_inj],
have:= realpow n k,
rw ← this,
simp [int.cast_coe_nat, int.cast_one, int.cast_sub],},
rw ← tr,
apply BIGCLAIM n,
end

lemma real_eise_is_summable (k : ℕ) (z : ℍ) (h : 3 ≤ k): summable (real_Eise k z):=
begin
  let In:=Square,
  have HI:=Squares_cover_all,
  let g:= λ (y : ℤ × ℤ), (real_Eise k z) y,
  have gpos: ∀ (y : ℤ × ℤ), 0 ≤ g y,
  by {simp_rw g, intro y, rw real_Eise, simp,},
  have index_lem:= sum_lemma g  gpos In HI,
  rw index_lem,
  let e:=λ (x: ℕ), ∑ (y : ℤ × ℤ) in (In x), g y,
  have BIGCLAIM: ∀ (n : ℕ), ∑ (y : ℤ × ℤ) in (In n), g y ≤(8/((rfunct z)^k))*(n^((k: ℤ)-1))⁻¹,
  by {simp_rw g,
  apply BigClaim k z h,},
  have smallerclaim:  ∀ (n : ℕ), e n ≤  (8/(rfunct z)^k) * ((rie (k-1)) n),
  by {simp_rw e,
  apply SmallClaim k z h,},
  have epos: ∀ (x : ℕ), 0 ≤ e x, by {simp_rw e, simp_rw g, intro x,
  apply finset.sum_nonneg,  intros i hi, apply complex.abs.nonneg, },
  have hk: 1 < ((k-1): ℤ), by { linarith, },
  have nze: ((8/((rfunct z)^k)): ℝ)  ≠ 0,
  by {apply div_ne_zero,
  simp only [ne.def, not_false_iff, bit0_eq_zero, one_ne_zero],
  apply pow_ne_zero,
  simp only [ne.def],
  by_contra HR,
  have := rfunct_pos z,
  rw HR at this,
  simp only [lt_self_iff_false] at this,
    exact this, },
  have riesum:=int_Riemann_zeta_is_summmable (k-1) hk,
  have riesum': summable (λ (n : ℕ), (8 / (rfunct z)^k) * rie (↑k - 1) n),
  by {rw (summable_mul_left_iff nze).symm,
  simp only [int.cast_coe_nat, int.cast_one, int.cast_sub] at riesum,
  apply riesum,},
  have:=summable_of_nonneg_of_le epos smallerclaim,
  apply this,
  apply riesum',
end

lemma Real_Eisenstein_bound (k : ℕ) (z : ℍ) (h : 3 ≤ k):
    (real_Eisenstein_series_of_weight_ k z) ≤ (8/(rfunct z)^k)*Riemann_zeta (k-1):=
begin
  rw [real_Eisenstein_series_of_weight_, Riemann_zeta, ← tsum_mul_left],
  let In:=Square,
  have HI:=Squares_cover_all,
  let g:= λ (y : ℤ × ℤ), (real_Eise k z) y,
  have gpos: ∀ (y : ℤ × ℤ), 0 ≤ g y,
  by {simp_rw g, intro y, rw real_Eise, simp,},
  have hgsumm: summable g,
  by {simp_rw g, apply real_eise_is_summable k z h, },
  have index_lem:= tsum_lemma g In HI hgsumm,
  simp_rw g at index_lem,
  simp,
  rw index_lem,
  have ind_lem2:=sum_lemma g gpos In HI,
  have smallclaim:= SmallClaim k z h,
  have hk: 1 < ((k-1): ℤ), by { linarith, },
  have nze: ((8/((rfunct z)^k)): ℝ)  ≠ 0,
  by {apply div_ne_zero, simp, apply pow_ne_zero,
  simp, by_contra HR,
  have:=rfunct_pos z,
  rw HR at this,
  simp at this,
  exact this, },
  have riesum:=int_Riemann_zeta_is_summmable (k-1) hk,
  have riesum': summable (λ (n : ℕ), (8 / (rfunct z)^k) * rie (↑k - 1) n),
  by {rw (summable_mul_left_iff nze).symm,
  simp at riesum,
  apply riesum,},
  apply tsum_le_tsum,
  apply smallclaim,
  simp_rw g at ind_lem2,
  rw ← ind_lem2,
  simp_rw g at hgsumm,
  apply hgsumm,
  apply riesum',
end

lemma Eisenstein_series_is_summable (k : ℕ) (z : ℍ) (h : 3 ≤ k) : summable (Eise k z) :=
begin
let f:=(Eise k z),
have sum_Eq:  summable (λ x, abs (f x)) → summable f, by {apply summable_if_complex_abs_summable,},
apply sum_Eq,
simp_rw f,
have:=real_eise_is_summable k z h,
rw real_Eise at this,
exact this,
end

/--The sum of Eise over the `Square`'s-/
def eisen_square (k : ℤ) (n: ℕ): ℍ → ℂ:=
λ z, ∑ x in Square n, Eise k z x

lemma Eisenstein_series_is_sum_eisen_squares (k: ℕ) (z: ℍ) (h : 3 ≤ k) :
(Eisenstein_series_of_weight_ k z) = ∑' (n : ℕ), eisen_square k n z:=
begin
rw Eisenstein_series_of_weight_, simp_rw eisen_square,

have HI:=Squares_cover_all,
let g:= λ (y : ℤ × ℤ),  (Eise k z ) y,
have hgsumm: summable g, by {simp_rw g, apply Eisenstein_series_is_summable k z h, },
have index_lem:= tsum_lemma' g Square HI hgsumm, simp_rw g at index_lem, exact index_lem,

end

def Eisen_partial_sums (k: ℤ) (n : ℕ): ℍ → ℂ:=
λ z, ∑ x in (finset.range n), (eisen_square k x z)

def upper_half_space_slice (A B : ℝ) :=
  {z : ℍ' | complex.abs(z.1.1) ≤ A ∧ complex.abs(z.1.2) ≥ B  }

instance upper_half_space_slice_to_uhs (A B : ℝ) :
  has_coe (upper_half_space_slice A B) ℍ := ⟨λ z, z.1⟩

@[simp]lemma slice_mem (A B : ℝ) (z: ℍ): z ∈ (upper_half_space_slice A B) ↔
(complex.abs(z.1.1) ≤ A ∧ complex.abs(z.1.2) ≥ B) :=iff.rfl

lemma slice_in_upper_half (A B : ℝ) (x : (upper_half_space_slice A B) ) :
  x.1.1 ∈ ℍ'.1:=
begin
have hx : 0 < x.1.1.im, by {apply upper_half_plane.im_pos,},
simp at hx,
simp,
apply hx,
end

lemma ball_in_upper_half (z : ℍ') (A B ε : ℝ)(hB : 0 < B) ( hε : 0 < ε) (hBε : ε < B)
  (h : metric.closed_ball z ε ⊆ upper_half_space_slice A B) :
    metric.closed_ball z.1 ε ⊆ ℍ'.1 :=
begin
intros x hx,
simp at *,
have hg : 0 < (x.2), by {
  rw metric.closed_ball at h,
    have hz : z ∈ upper_half_space_slice A B, by {apply h, simp [hε.le]},
    simp at hz,
    have hz2:= z.2,
    have hzB: B ≤ complex.abs z.1.2, by {simp [hz.2],},
    rw dist_eq_norm at hx,
    simp at hx,
    have h3:= le_trans (abs_im_le_abs (x-z.1)) hx,
    have h4:= _root_.abs_sub_le z.1.2 x.2 0,
    rw sub_im at h3,
    rw _root_.abs_sub_comm at h3,
    have h33: -ε ≤ - |z.1.im - x.im|, by {simp, apply h3, },
    simp at h4,
    have h5 : |z.1.im| - |z.1.im - x.im| ≤ |x.im|, by {simp,linarith,},
    simp at hzB,
    have h6 : B - ε ≤ |z.1.im| - |z.1.im - x.im|, by {simp at *, linarith, },
    by_contradiction hc,
    simp at hc,
    have hcc: 0 ≤ -x.im, by {linarith, },
    have hzc :|z.1.im - x.im| = z.1.im - x.im, by {apply _root_.abs_of_nonneg, apply add_nonneg,
    have := upper_half_plane.im_pos z,
    apply this.le, apply hcc,},
    have hzp : |z.1.im| = z.1.im, by {apply _root_.abs_of_nonneg (upper_half_plane.im_pos z).le,},
    simp_rw [hzc, hzp] at h6,
    simp only [sub_sub_cancel] at h6,
    linarith,},
apply hg,
end

lemma closed_ball_in_slice (z : ℍ') : ∃ (A B ε : ℝ), 0 < ε ∧ 0 < B ∧
  metric.closed_ball z ε ⊆ upper_half_space_slice A B ∧  0 ≤ A ∧ ε < B:=
begin
  let e := 3⁻¹ * complex.abs(z.1.2),
  let a := complex.abs(z.1.2) +  complex.abs(z),
  let b := complex.abs(z.1.2) - e,
  use a,
  use b,
  use e,
  split,
  simp_rw e,
  simp,
  apply upper_half_plane.im_ne_zero z,
  split,
  simp_rw b,
  simp_rw e,
  ring_nf,
  simp only [abs_of_real, upper_half_plane.coe_im, subtype.val_eq_coe],
  apply mul_pos,
  nlinarith,
  simp,
  apply upper_half_plane.im_ne_zero z,
  split,
  intro x,
  simp only [abs_of_real, tsub_le_iff_right, ge_iff_le, metric.mem_closed_ball, slice_mem,
  upper_half_plane.coe_im, subtype.val_eq_coe, upper_half_plane.coe_re],
  intro hxz,
  have d1 : dist x z = dist (x : ℂ) (z :ℂ), by {exact subtype.dist_eq x z,},
  rw d1 at  hxz,
  rw dist_eq_norm at hxz,
  simp only [norm_eq_abs] at hxz,
  have:= complex.abs.sub_le (x : ℂ) (z : ℂ) 0,
  simp only [sub_zero, subtype.val_eq_coe] at this,
  split,
  simp_rw a,
  have hre := le_trans (abs_re_le_abs x.1) this,
  rw upper_half_plane.re,
  simp only [abs_of_real, upper_half_plane.coe_im, subtype.val_eq_coe, upper_half_plane.coe_re] at *,
  apply le_trans hre,
  simp only [add_le_add_iff_right],
  apply le_trans hxz,
  simp_rw e,
  rw upper_half_plane.im,
  simp only [abs_of_real, upper_half_plane.coe_im, subtype.val_eq_coe],
  have hxim : 0 ≤ |upper_half_plane.im z|, by {apply _root_.abs_nonneg,},
  ring_nf,
  linarith,
  have ineq1:= _root_.abs_sub_le z.1.2 x.1.2 0,
  simp only [sub_zero, upper_half_plane.coe_im, subtype.val_eq_coe] at ineq1,
  apply le_trans ineq1,
  rw add_comm,
  simp only [add_le_add_iff_left],
  have ki:= le_trans (abs_im_le_abs (x.1-z.1)) hxz,
  rw sub_im at ki,
  rw _root_.abs_sub_comm at ki,
  convert ki,
  simp_rw a,
  split,
  apply add_nonneg,
  apply complex.abs.nonneg,
  apply complex.abs.nonneg,
  simp_rw b,
  simp_rw e,
  ring_nf,
  rw ← sub_pos,
  have hr : 0 < complex.abs (z.1.im), by {simp, apply upper_half_plane.im_ne_zero z,},
  linarith,
end

/--Canonical point in the `A B` slice-/
def lbpoint (A B : ℝ) (h: 0 < B): ℍ := ⟨⟨A,B⟩, by { simp, exact h,},⟩

lemma aux55 (a b : ℝ ) (h : a ≠ 0 ) : a/(a+b)=1/(b/a+1) :=
begin
  have : b/a+1=(b+a)/a, by {ring_nf, simp [h],},
  rw this,
  simp,
  rw add_comm,
end

lemma aux4 (a b : ℝ) (h: 0 < b): (b^4+(a*b)^2)/(a^2+b^2)^2=1/((a/b)^2 +1 ):=
begin
  have h1 : (a^2+b^2)^2=(a^2+b^2)*(a^2+b^2), by {ring,},
  rw h1,
  have h2: (b^4+(a*b)^2)=b^2*(a^2+b^2) , by {ring},
  rw h2,
  rw mul_div_assoc,
  simp only [one_div, div_pow, div_self_mul_self'],
  field_simp,
  have hb : b^2 ≠ 0 , by {simp [h], intro h3, linarith,},
  have:= (aux55  (b^2) (a^2) hb),
  rw add_comm,
  exact this,
end

lemma aux5 (a b : ℝ): 0 < a^2/b^2+1:=
begin
  have h1: 0 ≤a^2/b^2, by  {apply div_nonneg, nlinarith, nlinarith, },
  linarith,
end

lemma aux6 (a b : ℝ) (h: 0 ≤  a) (h2: 0 ≤ b) : a ≤ b → a^2 ≤ b^2 :=
begin
  intro hab,
  nlinarith,
end

lemma hcoe : upper_half_plane.upper_half_space = coe '' (set.univ : set upper_half_plane) :=
begin
simp, refl,
end

lemma rfunct_lower_bound_on_slice (A B : ℝ) (h: 0 < B) (z : upper_half_space_slice A B) :
rfunct (lbpoint A B h) ≤  rfunct(z.1) :=
begin
  simp at *,
  simp_rw rfunct,
  simp_rw lbpoint,
  simp only [ min_le_iff, le_min_iff,subtype.val_eq_coe],
  cases z,
  have zpos:= upper_half_plane.im_pos z_val,
  cases z_property,
  cases z_val,
  dsimp at *,
  simp at *,
  fsplit,
  simp_rw lb,
  rw real.sqrt_le_sqrt_iff,
  have h1: B^2 ≤ complex.abs (z_val_val.im)^2, by {norm_cast, nlinarith, },
  norm_cast at h1,
  rw _root_.sq_abs at h1,
  simp [h1],
  nlinarith,
  simp_rw lb,
  rw real.sqrt_le_sqrt_iff,
  rw real.sqrt_le_sqrt_iff,
  rw aux4,
  rw aux4,
  simp,
  rw inv_le_inv,
  simp,
  simp_rw [hcoe] at z_val_property,
  simp at z_val_property,
  have i1: (((z_val_val.im)^2)⁻¹ : ℝ)≤ ((B^2)⁻¹ : ℝ) ,
    by {rw inv_le_inv,
    have h' : 0 ≤ B , by {linarith,},
    have z_prop' : 0 ≤ z_val_val.im, by {apply zpos.le, },
    apply aux6 _ _ h' z_prop',
    have : z_val_val.im = complex.abs (z_val_val.im),
    by  {norm_cast, have:= abs_of_pos zpos, exact this.symm,},
    norm_cast at this,
    rw this,
    exact z_property_right,
    apply pow_two_pos_of_ne_zero,
     have z_prop2 : 0 < z_val_val.im, by {apply zpos, },
    linarith,
    apply pow_two_pos_of_ne_zero, linarith,},
  have i2: ((z_val_val.re)^2 : ℝ )≤ (A^2 : ℝ),
    by {have : (complex.abs (z_val_val.re))^2 = z_val_val.re^2,
    by {norm_cast,
    simp,},
    norm_cast at this,
    rw ← this,
    have v2: 0 ≤ complex.abs (z_val_val.re), by {apply complex.abs.nonneg,},
    norm_cast at v2,
    have v1: 0 ≤ A, by {apply le_trans v2 z_property_left,},
    apply aux6 _ _ v2 v1,
    exact z_property_left,},
  ring_nf,
  have i3:= mul_le_mul i1 i2,
  have i4: 0 ≤ (z_val_val.re)^2, by {nlinarith,},
  have i5: 0 ≤ (B ^ 2)⁻¹ , by { simp, nlinarith,},
  have i6:= i3 i4 i5,
  simp_rw i6,
  simp,
  apply aux5,
  apply aux5,
  exact h,
  exact z_val_property,
  apply div_nonneg,
  apply right.add_nonneg,
  have he : even (4 : ℤ), by {simp,},
  have := even.zpow_nonneg he (z_val_val.im) ,
  apply this,
  simp,
  nlinarith,
  nlinarith,
  apply div_nonneg,
  apply right.add_nonneg,
  have he : even (4 : ℤ), by {simp,},
  have := even.zpow_nonneg he (z_val_val.im) ,
  apply this,
  simp only,
  nlinarith,
  nlinarith,
end

lemma rfunctbound (k : ℕ) (h : 3 ≤ k) (A B : ℝ) (hb : 0 < B) (z : upper_half_space_slice A B) :
(8/(rfunct z)^k)*Riemann_zeta (k-1)  ≤ (8/(rfunct (lbpoint A B hb) )^k)*Riemann_zeta (k-1) :=
begin
  have h1:= rfunct_lower_bound_on_slice A B hb z,
  simp only [subtype.val_eq_coe] at h1,
  have v1: 0 ≤ rfunct z, by {have:= rfunct_pos z, linarith, },
  have v2: 0 ≤ rfunct (lbpoint A B hb), by {have:= rfunct_pos (lbpoint A B hb), linarith, },
  have h2 := pow_le_pow_of_le_left v2 h1 k,
  ring_nf,
  rw ← inv_le_inv at h2,
  have h3: 0 ≤  Riemann_zeta (k-1), by {have hk: 1 < (k-1 : ℤ), by { linarith,},
  have hkk: 1 < ((k-1 : ℤ) : ℝ), by {norm_cast, exact hk,},
  simp only [int.cast_coe_nat, int.cast_one, int.cast_sub] at hkk,
  have:= Riemann_zeta_pos (k-1) hkk, linarith,},
  nlinarith,
  apply pow_pos,
  apply rfunct_pos,
  apply pow_pos,
  apply rfunct_pos,
end

lemma rfunctbound' (k : ℕ) (A B : ℝ) (hb : 0 < B) (z : upper_half_space_slice A B)
(n : ℕ) : (8/(rfunct z)^k)* (rie (k-1) n)  ≤ (8/(rfunct (lbpoint A B hb) )^k)* (rie (k-1) n) :=
begin
  have h1:= rfunct_lower_bound_on_slice A B hb z,
  simp only [subtype.val_eq_coe] at h1,
  have v1: 0 ≤ rfunct z, by {have:= rfunct_pos z, linarith, },
  have v2: 0 ≤ rfunct (lbpoint A B hb), by {have:= rfunct_pos (lbpoint A B hb), linarith, },
  have h2 := pow_le_pow_of_le_left v2 h1 k,
  ring_nf,
  rw ← inv_le_inv at h2,
  have h3: 0 ≤  rie (k-1) n,
  by {rw rie,
  simp only [one_div, inv_nonneg],
  apply real.rpow_nonneg_of_nonneg,
  simp only [nat.cast_nonneg],},
  nlinarith,
  apply pow_pos,
  apply rfunct_pos,
  apply pow_pos,
  apply rfunct_pos,
end

lemma Real_Eisenstein_bound_unifomly_on_stip (k : ℕ) (h : 3 ≤ k) (A B : ℝ) (hb : 0 < B)
  (z : upper_half_space_slice A B) :
    (real_Eisenstein_series_of_weight_ k z.1) ≤ (8/(rfunct (lbpoint A B hb) )^k)*Riemann_zeta (k-1):=
begin
have : (8/(rfunct z)^k)*Riemann_zeta (k-1)  ≤ (8/(rfunct (lbpoint A B hb) )^k)*Riemann_zeta (k-1),
by {apply rfunctbound, exact h},
apply le_trans (Real_Eisenstein_bound k z h) this,
end

def Eisen_square_slice (k : ℤ) (A B : ℝ)  (n : ℕ) :
  (upper_half_space_slice A B) → ℂ := λ x, (eisen_square k n x)

def Eisen_par_sum_slice (k : ℤ) (A B : ℝ) (n : ℕ) :
  (upper_half_space_slice A B) → ℂ :=
  λ z, ∑ x in (finset.range n), (Eisen_square_slice k A B  x z)

instance : has_coe ℍ ℍ' :=
⟨ λ z, ⟨ z.1, by {simp, cases z, assumption,}, ⟩ ⟩

instance slice_coe (A B : ℝ) (hb : 0 < B) : has_coe (upper_half_space_slice A B) ℍ' :=
⟨λ (x : (upper_half_space_slice A B)), (x : ℍ')  ⟩

def Eisenstein_series_restrict (k : ℤ) (A B : ℝ) : (upper_half_space_slice A B) → ℂ :=
λ x, Eisenstein_series_of_weight_ k x

instance  nonemp (A B : ℝ) (ha : 0 ≤  A) (hb : 0 < B) : nonempty (upper_half_space_slice A B):=
begin
  let z:= (⟨  A, B⟩ : ℂ),
  rw ← exists_true_iff_nonempty,
  simp,
  use z,
  have zim: z.im = B, by {refl,},
  use hb,
  simp_rw z,
  simp_rw [upper_half_plane.re, upper_half_plane.im],
  simp,
  split,
  have:= abs_eq_self.2 ha,
  rw this,
  apply le_abs_self,
end

lemma Eisenstein_series_is_sum_eisen_squares_slice (k: ℕ) (h : 3 ≤ k) (A B : ℝ) (hb : 0 < B)
 (z: (upper_half_space_slice A B)) :
  (Eisenstein_series_restrict k A B z) = ∑' (n : ℕ), (Eisen_square_slice k A B n z):=
begin
  rw Eisenstein_series_restrict, simp_rw Eisen_square_slice,
  have HI:=Squares_cover_all,
  let g:= λ (y : ℤ × ℤ),  (Eise k z ) y,
  have hgsumm: summable g,
  by {simp_rw g, apply Eisenstein_series_is_summable k z h, },
  have index_lem:= tsum_lemma' g Square HI hgsumm,
  simp_rw g at index_lem,
  exact index_lem,
end

lemma Eisen_partial_tends_to_uniformly (k: ℕ) (h : 3 ≤ k) (A B : ℝ) (ha : 0 ≤ A) (hb : 0 < B) :
tendsto_uniformly (Eisen_par_sum_slice k A B ) (Eisenstein_series_restrict k A B) filter.at_top:=
begin
  let M : ℕ → ℝ := λ x,   (8/(rfunct (lbpoint A B hb) )^k)* (rie  (k-1) x),
  have:= M_test_uniform _ (Eisen_square_slice k A B ) M,
  simp_rw  ← (Eisenstein_series_is_sum_eisen_squares_slice k h A B hb _) at this,
  apply this,
  simp_rw Eisen_square_slice,
  simp_rw eisen_square,
  simp_rw M,
  simp_rw Eise,
  intros n a,
  have SC:= SmallClaim k a h n,
  rw real_Eise at SC,
  simp at SC,
  simp,
  have ineq1:
  complex.abs (∑ (x : ℤ × ℤ) in Square n, ((↑(x.fst) * ↑↑a + ↑(x.snd)) ^ k)⁻¹) ≤
  ∑ (x : ℤ × ℤ) in Square n, (complex.abs ((↑(x.fst) * ↑↑a + ↑(x.snd)) ^ k))⁻¹,
  by {simp,
  have := complex_abs_sum_le  (Square n)
  (λ  (x : ℤ × ℤ),  (((x.1 : ℂ) * (a : ℂ) + (x.2 : ℂ)) ^ k)⁻¹),
  simp at this,
  exact this, },
  simp at *,
  have SC2:= le_trans ineq1 SC,
  have rb := rfunctbound' k A B hb a n,
  apply le_trans SC2 rb,
  apply_instance,
  apply_instance,
  simp_rw M,
  have hk: 1 < ((k-1): ℤ), by { linarith, },
  have nze: ((8/((rfunct (lbpoint A B hb))^k)): ℝ)  ≠ 0,
  by {apply div_ne_zero, simp, apply pow_ne_zero,
  simp, by_contra HR,
  have:=rfunct_pos (lbpoint A B hb),
  rw HR at this,
  simp at this,
  exact this, },
  have riesum:=int_Riemann_zeta_is_summmable (k-1) hk,
  rw (summable_mul_left_iff nze).symm,
  simp at riesum,
  apply riesum,
  apply Eisenstein_series.nonemp A B ha hb,
end

def powfun  (k : ℤ) : ℂ → ℂ :=
λ x, x^k

def trans (a b : ℤ) : ℂ → ℂ :=
λ x, a*x+b

def ein (a b k : ℤ): ℂ → ℂ :=
λ x, (a*x+b)^k

lemma com (a b k : ℤ): (ein a b k) = (powfun k) ∘ trans a b :=
begin
refl,
end

lemma d1 (k: ℤ) (x : ℂ): deriv (λ x, x^k) x = k*x^(k-1) :=
by {simp only [deriv_zpow'], }

lemma d2 (a b k: ℤ) (x : ℂ) (h : (a: ℂ)*x+b ≠ 0) : deriv (ein a b k) x = k*a*(a*x+b)^(k-1):=
begin
  rw com,
  rw deriv.comp,
  rw powfun,
  rw trans,
  simp,
  ring,
  rw powfun,
  rw trans, simp, simp_rw differentiable_at_zpow ,
  simp [h],
  rw trans,
  simp only [differentiable_at_const,
  differentiable_at_add_const_iff,
  differentiable_at_id',
  differentiable_at.mul],
end

lemma aux8 (a b k: ℤ ) (x : ℂ): (((a : ℂ)*x+b)^k)⁻¹ =  ((a : ℂ)*x+b)^-k:=
begin
refine (zpow_neg _ k).symm,
end

lemma dd2 (a b k: ℤ) (x : ℂ) (h : (a: ℂ)*x+b ≠ 0) :
  has_deriv_at (ein a b k) (k*(a*x+b)^(k-1)*(a) : ℂ) x:=
begin
  rw com,
  apply has_deriv_at.comp,
  rw powfun,
  rw trans,
  simp,
  apply has_deriv_at_zpow,
  simp [h],
  rw trans,
  apply has_deriv_at.add_const,
  have:= has_deriv_at.const_mul (a: ℂ) (has_deriv_at_id x) ,
  simp at *,
  exact this,
end

lemma H_member (z : ℂ) : z ∈ upper_half_plane.upper_half_space ↔ 0 < z.im:=iff.rfl

lemma Eise'_has_deriv_within_at (k : ℤ) (y: ℤ × ℤ) (hkn: k ≠ 0) :
  is_holomorphic_on (λ (z : ℍ'), Eise k z y):=
begin
  rw is_holomorphic_on,
  intro z,
  by_cases hy: (y.1 : ℂ)*z.1 + y.2 ≠ 0,
  simp_rw Eise, ring_nf,

  have:= aux8 y.1 y.2 k z.1,
  simp only [subtype.val_eq_coe] at this,
  have nz: (y.1 : ℂ)*z.1 + y.2 ≠ 0 , by {apply hy,},
  have hdd:= dd2 y.1 y.2 (-k) z nz,
  rw ein at hdd,
  have H' := has_deriv_at.has_deriv_within_at hdd,
  have H : has_deriv_within_at (λ (x : ℂ), (↑(y.fst) * x + ↑(y.snd)) ^ -k)
  (↑-k * (↑(y.fst) * ↑z + ↑(y.snd)) ^ (-k - 1) * ↑(y.fst)) upper_half_plane.upper_half_space ↑z, by {apply H'},
  simp at H,
  let fx:=(-k*((y.1:ℂ)*z.1+y.2)^(-k-1)*(y.1) : ℂ),
  refine ⟨ fx, _⟩,
  rw has_deriv_within_at_iff_tendsto at *,
  simp  [ zpow_neg, algebra.id.smul_eq_mul, eq_self_iff_true,
   ne.def, int.cast_neg, subtype.val_eq_coe, norm_eq_abs,
  sub_neg_eq_add] at *,
  rw metric.tendsto_nhds_within_nhds at *,
  intros ε hε,
  have HH:= H ε hε,
  obtain ⟨d1, hd1, hh⟩ := HH,
  refine ⟨d1 ,hd1, _⟩,
  intros x hx hd,
  dsimp at *,
  simp_rw extend_by_zero,
  simp only [dite_eq_ite, if_true, subtype.coe_prop, subtype.coe_eta, subtype.coe_mk],
  rw ← dite_eq_ite, rw dif_pos hx,
  have H3:= hh hx hd,
  simp_rw fx,
  convert H3,

  ring_nf,
  simp only [not_not, subtype.val_eq_coe] at hy,
  have hz: y.1 =0 ∧ y.2 = 0,
  by {by_contra,
  simp only [not_and] at h,
  cases z,
  cases y,
  dsimp at *,
  injections_and_clear,
  dsimp at *,
  simp only [int_cast_re, int.cast_eq_zero, add_zero, int_cast_im, zero_mul, sub_zero,
  mul_eq_zero] at *,
  cases h_2,
  rw h_2 at h_1,
  simp only [int.cast_eq_zero, int.cast_zero, zero_mul, zero_add] at *,
  have:= h h_2,
  rw h_1 at this,
  simp only [eq_self_iff_true, not_true] at this,
  exact this,
  simp only [H_member] at z_property,
  rw h_2 at z_property,
  simp only [lt_self_iff_false] at z_property,
  exact z_property,},
  simp_rw Eise, rw [hz.1, hz.2],
  simp only [one_div, add_zero, int.cast_zero, zero_mul],
  have zhol:= zero_hol ℍ' ,
  rw is_holomorphic_on at zhol,
  have zhol':= zhol z,
  simp only at zhol',
  have zk: ((0: ℂ)^k)⁻¹ =0,
  by {simp only [inv_eq_zero],
  apply zero_zpow,
  apply hkn,},
  rw zk,
  exact zhol',
end

lemma Eise'_has_diff_within_at (k : ℤ) (y: ℤ × ℤ) (hkn: k ≠ 0) :
  differentiable_on ℂ (extend_by_zero (λ (z : ℍ'), Eise k z y)) ℍ':=
begin
  have:= is_holomorphic_on_iff_differentiable_on ℍ' (λ (z : ℍ'), Eise k z y),
  simp only [subtype.coe_mk],
  rw this,
  apply Eise'_has_deriv_within_at,
  apply hkn,
end

lemma Eis_diff_on_ball {R : ℝ} {z w : ℂ} (hw : w ∈ metric.ball z R) (k : ℤ) (y: ℤ × ℤ) (hkn: k ≠ 0)
  (h : metric.closed_ball z R ⊆ ℍ' ):
  differentiable_on ℂ (extend_by_zero (λ (z : ℍ'), Eise k z y)) (metric.closed_ball z R) :=
begin
  apply differentiable_on.mono (Eise'_has_diff_within_at k y hkn),
  simp only [metric.mem_ball, ne.def, subtype.coe_mk] at *,
  apply h,
end

end Eisenstein_series