/-
import topology.category.Profinite.projective
import for_mathlib.Profinite.disjoint_union
import condensed.is_proetale_sheaf
import condensed.basic

noncomputable theory

@[simp]
lemma ultrafilter_extend_extends_apply {α X : Type*}
  [topological_space X] [t2_space X]
  (f : α → X) (a : α) :
  ultrafilter.extend f (pure a) = f a :=
begin
  change (ultrafilter.extend _ ∘ pure) _ = _,
  rw ultrafilter_extend_extends,
end

open category_theory

universes u w v

structure ExtrDisc :=
(val : Profinite.{u})
[cond : projective val]

namespace ExtrDisc

@[ext]
structure hom (X Y : ExtrDisc) := mk :: (val : X.val ⟶ Y.val)

def of (X : Profinite) [projective X] : ExtrDisc := ⟨X⟩

@[simp]
def of_val (X : Profinite) [projective X] : (of X).val = X := rfl

@[simps]
instance : category ExtrDisc :=
{ hom := hom,
  id := λ X, ⟨𝟙 _⟩,
  comp := λ X Y Z f g, ⟨f.val ≫ g.val⟩ }

@[simps]
def _root_.ExtrDisc_to_Profinite : ExtrDisc ⥤ Profinite :=
{ obj := val,
  map := λ X Y f, f.val }

instance : concrete_category ExtrDisc.{u} :=
{ forget := ExtrDisc_to_Profinite ⋙ forget _,
  forget_faithful := ⟨⟩ }

instance : has_coe_to_sort ExtrDisc Type* :=
concrete_category.has_coe_to_sort _

instance {X Y : ExtrDisc} : has_coe_to_fun (X ⟶ Y) (λ f, X → Y) :=
⟨λ f, f.val⟩

instance (X : ExtrDisc) : projective X.val := X.cond

example (X : ExtrDisc) : projective (ExtrDisc_to_Profinite.obj X) :=
by { dsimp, apply_instance }

def lift {X Y : Profinite} {P : ExtrDisc} (f : X ⟶ Y)
  (hf : function.surjective f) (e : P.val ⟶ Y) : P.val ⟶ X :=
begin
  haveI : epi f := by rwa Profinite.epi_iff_surjective f,
  choose g h using projective.factors e f,
  exact g,
end

@[simp]
lemma lift_lifts {X Y : Profinite} {P : ExtrDisc} (f : X ⟶ Y)
  (hf : function.surjective f) (e : P.val ⟶ Y) :
  lift f hf e ≫ f = e :=
begin
  haveI : epi f := by rwa Profinite.epi_iff_surjective f,
  apply (projective.factors e f).some_spec,
end

def split {X : Profinite} {Y : ExtrDisc} (f : X ⟶ Y.val) (hf : function.surjective f) :
  Y.val ⟶ X :=
begin
  haveI : epi f := by rwa Profinite.epi_iff_surjective f,
  choose g h using projective.factors (𝟙 Y.val) f,
  exact ⟨g⟩,
end

@[simp, reassoc]
lemma split_is_splitting {X : Profinite} {Y : ExtrDisc} (f : X ⟶ Y.val)
  (hf : function.surjective f) : split f hf ≫ f = 𝟙 _ :=
begin
  haveI : epi f := by rwa Profinite.epi_iff_surjective f,
  apply (projective.factors (𝟙 Y.val) f).some_spec,
end

instance (X : ExtrDisc) : topological_space X :=
show topological_space X.val, by apply_instance

instance (X : ExtrDisc) : compact_space X :=
show compact_space X.val, by apply_instance

instance (X : ExtrDisc) : t2_space X :=
show t2_space X.val, by apply_instance

instance (X : ExtrDisc) : totally_disconnected_space X :=
show totally_disconnected_space X.val, by apply_instance

def free (α : Type u) : ExtrDisc.{u} :=
{ val := Profinite.of $ ultrafilter α,
  cond := Profinite.projective_ultrafilter α }

def free.ι (α : Type u) : α → free α :=
λ t, (pure t : ultrafilter α)

@[simp]
lemma free.ι_apply {α : Type u} (a : α) : free.ι α a = (pure a : ultrafilter α) := rfl

def free.lift {X : ExtrDisc.{u}} {α : Type u} (f : α → X) : free α ⟶ X :=
⟨⟨ultrafilter.extend f, continuous_ultrafilter_extend _⟩⟩

@[simp]
lemma free.lift_apply {X : ExtrDisc.{u}} {α : Type u} (f : α → X) (F : free α) :
  free.lift f F = ultrafilter.extend f F := rfl

@[simp]
lemma free.ι_lift {X : ExtrDisc.{u}} {α : Type u} (f : α → X) :
  free.lift f ∘ free.ι _ = f :=
begin
  ext,
  dsimp,
  simp,
end

@[simp]
lemma free.ι_lift_apply {X : ExtrDisc.{u}} {α : Type u} (f : α → X) (a : α) :
  free.lift f (free.ι α a) = f a :=
show (free.lift f ∘ free.ι α) a = f a, by simp

lemma free.lift_unique {X : ExtrDisc.{u}} {α : Type u} (f : α → X)
  (g : free α ⟶ X) (h : g ∘ free.ι α = f) : g = free.lift f :=
begin
  letI hh : topological_space α := ⊥,
  have : dense_range (free.ι α) := dense_range_pure,
  rw ← free.ι_lift f at h,
  ext : 2,
  have := this.equalizer _ _ h,
  erw this,
  refl,
  exact g.val.continuous,
  exact (free.lift f).val.continuous,
end

@[ext]
lemma free.hom_ext {X : ExtrDisc.{u}} {α : Type u} (f g : free α ⟶ X)
  (h : f ∘ (free.ι α) = g ∘ (free.ι α)) : f = g :=
by rw [free.lift_unique _ f rfl, free.lift_unique _ g rfl, h]

@[simps]
def free_functor : Type u ⥤ ExtrDisc.{u} :=
{ obj := λ α, free α,
  map := λ α β f, free.lift $ (free.ι _) ∘ f,
  map_id' := by tidy,
  map_comp' := begin
    intros α β γ f g,
    ext : 2,
    dsimp,
    simp,
  end } .

@[simps]
def adjunction : free_functor ⊣ forget _ :=
adjunction.mk_of_hom_equiv $
{ hom_equiv := λ α X,
  { to_fun := λ f, f ∘ free.ι _,
    inv_fun := λ f, free.lift f,
    left_inv := λ f, by { ext, dsimp, simp },
    right_inv := λ f, by { ext, dsimp, simp } },
  hom_equiv_naturality_left_symm' := λ _ _ _ _ _, by { ext, dsimp, simp },
  hom_equiv_naturality_right' := λ _ _ _ _ _, by { ext, dsimp, simp } } .

@[simps]
def sigma {ι : Type u} [fintype ι] (X : ι → ExtrDisc) : ExtrDisc :=
{ val := Profinite.sigma $ λ i : ι, (X i).val,
  cond := begin
    let Z := Profinite.sigma (λ i : ι, (X i).val),
    let e : Z ≅ ∐ (λ i, (X i).val) :=
      (Profinite.sigma_cofan_is_colimit _).cocone_point_unique_up_to_iso
      (limits.colimit.is_colimit _),
    apply projective.of_iso e.symm,
    apply_instance,
  end }

@[simps]
def sigma.ι {ι : Type u} [fintype ι] (X : ι → ExtrDisc) (i : ι) :
  X i ⟶ sigma X := ⟨Profinite.sigma.ι _ i⟩

@[simps]
def sigma.desc {Y : ExtrDisc} {ι : Type u} [fintype ι] (X : ι → ExtrDisc)
  (f : Π i, X i ⟶ Y) : sigma X ⟶ Y := ⟨Profinite.sigma.desc _ $ λ i, (f i).val⟩

@[simp, reassoc]
lemma sigma.ι_desc {Y} {ι : Type u} (i : ι) [fintype ι] (X : ι → ExtrDisc) (f : Π a, X a ⟶ Y) :
  sigma.ι X i ≫ sigma.desc X f = f _ := by { ext1, simp }

@[ext]
lemma sigma.hom_ext {Y} {ι : Type u} [fintype ι] (X : ι → ExtrDisc) (f g : sigma X ⟶ Y)
  (w : ∀ i, sigma.ι X i ≫ f = sigma.ι X i ≫ g) : f = g :=
begin
  ext1,
  apply Profinite.sigma.hom_ext,
  intros i,
  specialize w i,
  apply_fun (λ e, e.val) at w,
  exact w,
end

def sigma.cofan {ι : Type u} [fintype ι] (X : ι → ExtrDisc) : limits.cofan X :=
limits.cofan.mk (sigma X) $ λ i, sigma.ι _ i

@[simps]
def sigma.is_colimit {ι : Type u} [fintype ι] (X : ι → ExtrDisc) :
  limits.is_colimit (sigma.cofan X) :=
{ desc := λ S, sigma.desc _ $ λ i, S.ι.app i,
  fac' := λ S i, sigma.ι_desc _ _ _,
  uniq' := begin
    intros S m h,
    apply sigma.hom_ext,
    intros i,
    simpa using h i,
  end }

.-- move this
-- @[simps]
def _root_.Profinite.sum_iso_coprod (X Y : Profinite.{u}) :
  Profinite.sum X Y ≅ X ⨿ Y :=
{ hom := Profinite.sum.desc _ _ limits.coprod.inl limits.coprod.inr,
  inv := limits.coprod.desc (Profinite.sum.inl _ _) (Profinite.sum.inr _ _),
  hom_inv_id' := by { apply Profinite.sum.hom_ext;
    simp only [← category.assoc, category.comp_id, Profinite.sum.inl_desc,
      limits.coprod.inl_desc, Profinite.sum.inr_desc, limits.coprod.inr_desc] },
  inv_hom_id' := by { apply limits.coprod.hom_ext;
    simp only [← category.assoc, category.comp_id, Profinite.sum.inl_desc,
      limits.coprod.inl_desc, Profinite.sum.inr_desc, limits.coprod.inr_desc] } }

@[simps]
def sum (X Y : ExtrDisc.{u}) : ExtrDisc.{u} :=
{ val := Profinite.sum X.val Y.val,
  cond := begin
    let Z := Profinite.sum X.val Y.val,
    apply projective.of_iso (Profinite.sum_iso_coprod X.val Y.val).symm,
    apply_instance,
  end }

@[simps]
def sum.inl (X Y : ExtrDisc) : X ⟶ sum X Y :=
⟨Profinite.sum.inl _ _⟩

@[simps]
def sum.inr (X Y : ExtrDisc) : Y ⟶ sum X Y :=
⟨Profinite.sum.inr _ _⟩

@[simps]
def sum.desc {X Y Z : ExtrDisc} (f : X ⟶ Z) (g : Y ⟶ Z) :
  sum X Y ⟶ Z :=
⟨Profinite.sum.desc _ _ f.val g.val⟩

@[simp]
lemma sum.inl_desc {X Y Z : ExtrDisc} (f : X ⟶ Z) (g : Y ⟶ Z) :
  sum.inl X Y ≫ sum.desc f g = f :=
by { ext1, dsimp, simp }

@[simp]
lemma sum.inr_desc {X Y Z : ExtrDisc} (f : X ⟶ Z) (g : Y ⟶ Z) :
  sum.inr X Y ≫ sum.desc f g = g :=
by { ext1, dsimp, simp }

@[ext]
lemma sum.hom_ext {X Y Z : ExtrDisc} (f g : sum X Y ⟶ Z)
  (hl : sum.inl X Y ≫ f = sum.inl X Y ≫ g)
  (hr : sum.inr X Y ≫ f = sum.inr X Y ≫ g) : f = g :=
begin
  ext1,
  apply Profinite.sum.hom_ext,
  { apply_fun (λ e, e.val) at hl, exact hl },
  { apply_fun (λ e, e.val) at hr, exact hr }
end

-- move this
lemma _root_.Profinite.empty_is_initial : limits.is_initial Profinite.empty.{u} :=
@limits.is_initial.of_unique.{u} _ _ _ (λ Y, ⟨⟨Profinite.empty.elim _⟩, λ f, by { ext, cases x, }⟩)

@[simps]
def empty : ExtrDisc :=
{ val := Profinite.empty,
  cond := begin
    let e : Profinite.empty ≅ ⊥_ _ :=
    Profinite.empty_is_initial.unique_up_to_iso limits.initial_is_initial,
    apply projective.of_iso e.symm,
    -- apply_instance, <-- missing instance : projective (⊥_ _)
    constructor,
    introsI A B f g _,
    refine ⟨limits.initial.to A, by simp⟩,
  end }

@[simps]
def empty.elim (X : ExtrDisc) : empty ⟶ X :=
⟨Profinite.empty.elim _⟩

@[ext]
def empty.hom_ext {X : ExtrDisc} (f g : empty ⟶ X) : f = g :=
by { ext x, cases x }

open opposite

variables {C : Type v} [category.{w} C] (F : ExtrDisc.{u}ᵒᵖ ⥤ C)

def terminal_condition [limits.has_terminal C] : Prop :=
  is_iso (limits.terminal.from (F.obj (op empty)))

def binary_product_condition [limits.has_binary_products C] : Prop := ∀ (X Y : ExtrDisc.{u}),
  is_iso (limits.prod.lift (F.map (sum.inl X Y).op) (F.map (sum.inr X Y).op))

end ExtrDisc

namespace Profinite

--instance (Y : Profinite) : t2_space Y := infer_instance

structure presentation (B : Profinite) :=
(G : ExtrDisc)
(π : G.val ⟶ B)
(hπ : function.surjective π)
(R : ExtrDisc)
(r : R.val ⟶ Profinite.pullback π π)
(hr : function.surjective r)

@[simps]
def presentation.fst {B : Profinite} (X : B.presentation) :
  X.R ⟶ X.G := ⟨X.r ≫ pullback.fst _ _⟩

@[simps]
def presentation.snd {B : Profinite} (X : B.presentation) :
  X.R ⟶ X.G := ⟨X.r ≫ pullback.snd _ _⟩

@[simps]
def presentation.map_G {B₁ B₂ : Profinite} (X₁ : B₁.presentation)
  (X₂ : B₂.presentation) (f : B₁ ⟶ B₂) : X₁.G ⟶ X₂.G :=
⟨ExtrDisc.lift X₂.π X₂.hπ (X₁.π ≫ f)⟩

@[simp, reassoc]
lemma presentation.map_G_π {B₁ B₂ : Profinite} (X₁ : B₁.presentation)
  (X₂ : B₂.presentation) (f : B₁ ⟶ B₂) :
  (X₁.map_G X₂ f).val ≫ X₂.π = X₁.π ≫ f :=
begin
  dsimp [presentation.map_G],
  simp,
end

@[simps]
def presentation.map_R {B₁ B₂ : Profinite} (X₁ : B₁.presentation)
  (X₂ : B₂.presentation) (f : B₁ ⟶ B₂) : X₁.R ⟶ X₂.R :=
⟨ExtrDisc.lift _ X₂.hr $ X₁.r ≫ pullback.lift _ _
  (pullback.fst _ _ ≫ (X₁.map_G X₂ f).val)
  (pullback.snd _ _ ≫ (X₁.map_G X₂ f).val)
  (by simp [pullback.condition_assoc])⟩

@[simp, reassoc]
lemma presentation.map_R_fst {B₁ B₂ : Profinite} (X₁ : B₁.presentation)
  (X₂ : B₂.presentation) (f : B₁ ⟶ B₂) :
  X₁.map_R X₂ f ≫ X₂.fst = X₁.fst ≫ X₁.map_G _ f := sorry

@[simp, reassoc]
lemma presentation.map_R_snd {B₁ B₂ : Profinite} (X₁ : B₁.presentation)
  (X₂ : B₂.presentation) (f : B₁ ⟶ B₂) :
  X₁.map_R X₂ f ≫ X₂.snd = X₁.snd ≫ X₁.map_G _ f := sorry

def pres (X : Profinite.{u}) : ExtrDisc.{u} :=
ExtrDisc.free X

def pres_π (X : Profinite.{u}) :
  X.pres.val ⟶ X :=
⟨ultrafilter.extend id, continuous_ultrafilter_extend _⟩

lemma pres_π_surjective (X : Profinite.{u}) :
  function.surjective X.pres_π :=
begin
  intros i,
  use (pure i : ultrafilter _),
  dsimp [Profinite.pres_π],
  simp,
end

@[simps]
def free_presentation (X : Profinite) : X.presentation :=
{ G := X.pres,
  π := X.pres_π,
  hπ := X.pres_π_surjective,
  R := (Profinite.pullback X.pres_π X.pres_π).pres,
  r := (Profinite.pullback X.pres_π X.pres_π).pres_π,
  hr := (Profinite.pullback X.pres_π X.pres_π).pres_π_surjective, }

def map_pres {X Y : Profinite.{u}} (f : X ⟶ Y) : X.pres ⟶ Y.pres :=
ExtrDisc.free_functor.map f

@[simp]
lemma map_pres_id (X : Profinite.{u}) : map_pres (𝟙 X) = 𝟙 _ :=
begin
  dsimp [map_pres],
  symmetry,
  apply ExtrDisc.free.lift_unique,
  refl,
end

@[simp]
lemma map_pres_comp {X Y Z : Profinite.{u}} (f : X ⟶ Y) (g : Y ⟶ Z) :
  map_pres (f ≫ g) = map_pres f ≫ map_pres g :=
begin
  dsimp [map_pres],
  symmetry,
  apply ExtrDisc.free.lift_unique,
  ext1,
  dsimp,
  simp,
end

-- functoriality of the presentation
@[simp, reassoc]
lemma map_pres_π {X Y : Profinite.{u}} (f : X ⟶ Y) :
  (map_pres f).val ≫ Y.pres_π = X.pres_π ≫ f :=
begin
  apply_fun (λ e, (forget Profinite).map e),
  swap, { exact (forget Profinite).map_injective },
  dsimp [pres_π, map_pres, ExtrDisc.free.lift, ExtrDisc.free.ι],
  have : dense_range (ExtrDisc.free.ι _ : X → X.pres) := dense_range_pure,
  refine this.equalizer _ _ _,
  continuity,
  exact continuous_ultrafilter_extend id,
  apply continuous_ultrafilter_extend,
  exact continuous_ultrafilter_extend id,
  ext,
  dsimp,
  simp,
end

@[simps]
def rels (X : Profinite.{u}) : ExtrDisc.{u} :=
(Profinite.pullback X.pres_π X.pres_π).pres

@[simps]
def rels_fst (X : Profinite.{u}) : X.rels ⟶ X.pres :=
⟨pres_π _ ≫ Profinite.pullback.fst _ _⟩

@[simps]
def rels_snd (X : Profinite.{u}) : X.rels ⟶ X.pres :=
⟨pres_π _ ≫ Profinite.pullback.snd _ _⟩

def map_rels {X Y : Profinite.{u}} (f : X ⟶ Y) : X.rels ⟶ Y.rels :=
map_pres $ pullback.lift _ _
  (pullback.fst _ _ ≫ (map_pres f).val)
  (pullback.snd _ _ ≫ (map_pres f).val) $
by simp [pullback.condition_assoc]

lemma rels_fst_map {X Y : Profinite.{u}} (f : X ⟶ Y) :
  X.rels_fst ≫ map_pres f = map_rels f ≫ Y.rels_fst :=
begin
  apply ExtrDisc.hom.ext,
  dsimp [map_rels],
  simp,
end

lemma rels_snd_map {X Y : Profinite.{u}} (f : X ⟶ Y) :
  X.rels_snd ≫ map_pres f = map_rels f ≫ Y.rels_snd :=
begin
  apply ExtrDisc.hom.ext,
  dsimp [map_rels],
  simp,
end

/-

Given `X : Profinite`, this is the diagram

β(βX ×_X βX) ⇉ βX

whose colimit is isomorphic to `X`, except here we consider it as a diagram in `ExtrDisc`.

Notation: `βX` = the Stone Cech compactification of `X^δ` (= the set `X` as a discrete space).

-/
def extr_diagram (X : Profinite) : limits.walking_parallel_pair.{u} ⥤ ExtrDisc.{u} :=
limits.parallel_pair X.rels_fst X.rels_snd

end Profinite

section

variables (C : Type v) [category.{w} C] [limits.has_terminal C] [limits.has_binary_products C]

structure ExtrSheaf :=
(val : ExtrDisc.{u}ᵒᵖ ⥤ C)
(terminal : ExtrDisc.terminal_condition val)
(binary_product : ExtrDisc.binary_product_condition val)

namespace ExtrSheaf

variable {C}

@[ext] structure hom (X Y : ExtrSheaf C) := mk :: (val : X.val ⟶ Y.val)

@[simps]
instance : category (ExtrSheaf C) :=
{ hom := hom,
  id := λ X, ⟨𝟙 _⟩,
  comp := λ A B C f g, ⟨f.val ≫ g.val⟩,
  id_comp' := λ X Y η, by { ext1, simp },
  comp_id' := λ X Y γ, by { ext1, simp },
  assoc' := λ X Y Z W a b c, by { ext1, simp } }

end ExtrSheaf

@[simps]
def ExtrSheaf_to_presheaf : ExtrSheaf C ⥤ ExtrDiscᵒᵖ ⥤ C :=
{ obj := λ X, X.val,
  map := λ X Y f, f.val }

instance : full (ExtrSheaf_to_presheaf C) := ⟨λ _ _ f, ⟨f⟩, λ X Y f, by { ext1, refl }⟩
instance : faithful (ExtrSheaf_to_presheaf C) := ⟨⟩

variable [limits.has_equalizers C]

@[simps]
def Condensed_to_ExtrSheaf : Condensed C ⥤ ExtrSheaf C :=
{ obj := λ F,
  { val := ExtrDisc_to_Profinite.op ⋙ F.val,
    terminal := begin
      have hF := F.cond,
      rw (functor.is_proetale_sheaf_tfae F.val).out 0 3 at hF,
      exact hF.1,
    end,
    binary_product := begin
      have hF := F.cond,
      rw (functor.is_proetale_sheaf_tfae F.val).out 0 3 at hF,
      rcases hF with ⟨h1,h2,h3⟩,
      intros X Y,
      apply h2,
    end },
  map := λ F G η, ⟨ whisker_left _ η.val ⟩ }

variable {C}

@[simps]
def ExtrDisc.via_pullback_fst {X Y Z : ExtrDisc} (f : Y ⟶ X)
  (g : Z.val ⟶ Profinite.pullback f.val f.val) :
  Z ⟶ Y := ⟨g ≫ Profinite.pullback.fst f.val f.val⟩

@[simps]
def ExtrDisc.via_pullback_snd {X Y Z : ExtrDisc} (f : Y ⟶ X)
  (g : Z.val ⟶ Profinite.pullback f.val f.val) :
  Z ⟶ Y := ⟨g ≫ Profinite.pullback.snd f.val f.val⟩

@[reassoc]
lemma ExtrDisc.via_pullback_condition {X Y Z : ExtrDisc} (f : Y ⟶ X)
  (g : Z.val ⟶ Profinite.pullback f.val f.val) :
  ExtrDisc.via_pullback_fst f g ≫ f = ExtrDisc.via_pullback_snd f g ≫ f :=
begin
  dsimp [ExtrDisc.via_pullback_fst, ExtrDisc.via_pullback_snd],
  ext1,
  dsimp,
  simp [Profinite.pullback.condition],
end

open opposite

def ExtrSheaf.map_to_equalizer (F : ExtrSheaf.{u} C) {X Y Z : ExtrDisc}
  (f : Y ⟶ X) (g : Z.val ⟶ Profinite.pullback f.val f.val) :
  F.val.obj (op X) ⟶
  limits.equalizer (F.val.map (ExtrDisc.via_pullback_fst f g).op)
  (F.val.map (ExtrDisc.via_pullback_snd f g).op) :=
limits.equalizer.lift (F.val.map f.op) $
by simp only [← F.val.map_comp, ← op_comp, ExtrDisc.via_pullback_condition]

-- This should follow from the projectivity of the objects involved.
lemma ExtrSheaf.equalizer_condition (F : ExtrSheaf.{u} C) {X Y Z : ExtrDisc}
  (f : Y ⟶ X) (hf : function.surjective f) (g : Z.val ⟶ Profinite.pullback f.val f.val)
  (hg : function.surjective g) :
  is_iso (F.map_to_equalizer f g) :=
begin
  --TODO: Add general stuff about split (co)equalizers.
  --This is a fun proof!

  -- First, let's split the surjective `Y ⟶ X`.
  let s : X ⟶ Y := ⟨ExtrDisc.split _ hf⟩,
  have hs : s ≫ f = 𝟙 _ := by { ext1, apply ExtrDisc.split_is_splitting },

  -- Now, consider the map from `Y` to the pullback of `f` with itself
  -- given by `𝟙 X` on one component and `f ≫ s` on the other.
  let e : Y.val ⟶ Profinite.pullback f.val f.val :=
    Profinite.pullback.lift _ _ (𝟙 _) (f.val ≫ s.val) _,
  swap, { apply_fun (λ e, e.val) at hs, change s.val ≫ f.val = 𝟙 _ at hs, simp [hs] },

  -- Since `g`, the map from `Z` to this pullback, is surjective (hence epic),
  -- we can use the projectivity of `Y` to lift `e` above to a morphism
  -- `t : Y ⟶ Z`.
  -- The universal property ensures that `t` composed with the first projection
  -- is the identity (i.e. `t` splits the map from `Z` to the pullback via `g`),
  -- and `t` composed with the second projection becomes `f ≫ s`.

  -- We have thus obtained the basic setting of a split equalizer,
  -- Once we apply `F` (which is a presheaf), we obtain a split coequalizer.
  -- Now we simply need to use the fact that the cofork point of a split
  -- coequalizer is the coequalizer of the diagram, and the proof below does
  -- essentially this.

  let t : Y ⟶ Z := ⟨ExtrDisc.lift _ hg e⟩,
  have ht : t.val ≫ g = e := by apply ExtrDisc.lift_lifts,

  -- Just some abbreviations for the stuff below.
  let e₁ := (F.val.map (ExtrDisc.via_pullback_fst f g).op),
  let e₂ := (F.val.map (ExtrDisc.via_pullback_snd f g).op),

  -- This will become the inverse of the canonical map from the cofork point...
  let i : limits.equalizer e₁ e₂ ⟶ F.val.obj (op X) :=
    limits.equalizer.ι e₁ e₂ ≫ F.val.map s.op,

  -- so we use it!
  use i,
  split,
  { -- The first step of the proof follows simply from the fact that `s` splits `f`.
    dsimp [ExtrSheaf.map_to_equalizer, i],
    simp only [limits.equalizer.lift_ι_assoc, ← F.val.map_comp, ← op_comp, hs,
      op_id, F.val.map_id] },
  { -- The rest of the proof uses the properties of `t` mentioned above.
    ext,
    dsimp [i, ExtrSheaf.map_to_equalizer],
    simp only [limits.equalizer.lift_ι, category.id_comp, category.assoc,
      ← F.val.map_comp, ← op_comp],
    have : f ≫ s = t ≫ ExtrDisc.via_pullback_snd f g,
    { ext1,
      dsimp [ExtrDisc.via_pullback_snd],
      rw reassoc_of ht,
      dsimp only [e],
      simp },
    dsimp only [e₁, e₂],
    rw [this, op_comp, F.val.map_comp, ← category.assoc, ← limits.equalizer.condition,
      category.assoc, ← F.val.map_comp, ← op_comp],
    have : t ≫ ExtrDisc.via_pullback_fst f g = 𝟙 _,
    { dsimp only [ExtrDisc.via_pullback_fst],
      ext1,
      change t.val ≫ g ≫ _ = 𝟙 _,
      rw reassoc_of ht,
      dsimp [e],
      simp },
    rw [this, op_id, F.val.map_id, category.comp_id] }
end

def ExtrSheaf.extend_to_obj (F : ExtrSheaf.{u} C) (X : Profinite.{u}) : C :=
limits.equalizer (F.val.map X.free_presentation.fst.op) (F.val.map X.free_presentation.snd.op)

def ExtrSheaf.extend_to_hom (F : ExtrSheaf.{u} C) {X Y : Profinite.{u}} (f : X ⟶ Y) :
  F.extend_to_obj Y ⟶ F.extend_to_obj X :=
limits.equalizer.lift (limits.equalizer.ι _ _ ≫ F.val.map (X.free_presentation.map_G _ f).op)
begin
  simp only [category.assoc, ← F.val.map_comp, ← op_comp,
    ← Profinite.presentation.map_R_snd, ← Profinite.presentation.map_R_fst],
  simp only [F.val.map_comp, op_comp, limits.equalizer.condition_assoc],
end

@[simps]
def ExtrSheaf.extend_to_presheaf (F : ExtrSheaf.{u} C) : Profiniteᵒᵖ ⥤ C :=
{ obj := λ X, F.extend_to_obj X.unop,
  map := λ X Y f, F.extend_to_hom f.unop,
  map_id' := begin
    sorry,
  end,
  map_comp' := begin
    sorry,
  end }

-- Note for AT:
-- This will be a bit hard... One should use the proetale sheaf condition involving
-- binary products, the empty profinite set, and equalizers.
-- One should presumably also use `ExtrSheaf.equalizer_condition` above.
-- Essentially, this proof is about various limits commuting with other limits.
-- I think it will be easiest to just construct the inverses needed for preserving empty,
-- products and equalizers in terms of `limit.lift` for various kinds of limits.

lemma ExtrSheaf.empty_condition_extend (F : ExtrSheaf.{u} C) :
  F.extend_to_presheaf.empty_condition' :=
begin
  dsimp [functor.empty_condition'],
  have := F.terminal,
  dsimp [ExtrDisc.terminal_condition] at this,
  resetI,
  let t : Profinite.empty.pres.{u} ⟶ ExtrDisc.empty.{u} :=
    ⟨Profinite.empty.pres_π⟩,
  haveI : is_iso t := begin
    use ExtrDisc.empty.elim _,
    split,
    { ext ⟨a⟩ : 2 },
    { ext ⟨a⟩ : 2 },
  end,
  let i : ⊤_ C ⟶ F.extend_to_obj Profinite.empty :=
    limits.equalizer.lift _ _,
  rotate,
  { exact inv (limits.terminal.from (F.val.obj (op ExtrDisc.empty))) ≫ F.val.map t.op, },
  { simp only [is_iso.eq_inv_comp, is_iso.hom_inv_id_assoc, category.assoc],
    simp only [← F.val.map_comp, ← op_comp],
    congr' 2,
    ext ⟨⟨a,b⟩,_⟩,
    apply pempty.elim,
    exact Profinite.empty.pres_π a },
  { use i,
    split,
    { dsimp [i],
      ext,
      simp,
      haveI : is_iso (F.val.map t.op) := is_iso_of_op (F.val.map (quiver.hom.op t)),
      rw [← category.assoc, ← is_iso.eq_comp_inv, is_iso.comp_inv_eq],
      apply subsingleton.elim },
    { dsimp [i],
      apply subsingleton.elim } }
end

lemma ExtrSheaf.product_condition_extend (F : ExtrSheaf.{u} C) :
  F.extend_to_presheaf.product_condition' := sorry

lemma ExtrSheaf.equalizer_condition_extend (F : ExtrSheaf.{u} C) :
  F.extend_to_presheaf.equalizer_condition' := sorry

theorem ExtrSheaf.extend_is_sheaf (F : ExtrSheaf.{u} C) : presheaf.is_sheaf proetale_topology
  F.extend_to_presheaf :=
begin
  rw F.extend_to_presheaf.is_proetale_sheaf_tfae.out 0 3,
  refine ⟨F.empty_condition_extend, F.product_condition_extend,
    F.equalizer_condition_extend⟩,
end

def ExtrSheaf.extend (F : ExtrSheaf.{u} C) : Condensed C :=
⟨F.extend_to_presheaf, F.extend_is_sheaf⟩

def ExtrSheaf.extend_restrict_hom (F : ExtrSheaf.{u} C) :
  F ⟶ (Condensed_to_ExtrSheaf C).obj F.extend := ExtrSheaf.hom.mk $
{ app := λ X, limits.equalizer.lift
    (F.val.map $ eq_to_hom (X.op_unop).symm ≫ quiver.hom.op ⟨X.unop.val.pres_π⟩) begin
      dsimp [Profinite.rels_fst, Profinite.rels_snd, Profinite.free_presentation],
      simp only [← F.val.map_comp, category.id_comp, ← op_comp],
      congr' 2,
      apply ExtrDisc.hom.ext,
      simp [Profinite.pullback.condition],
    end,
  naturality' := begin
    intros A B f,
    ext,
    dsimp [Condensed_to_ExtrSheaf],
    simp only [limits.equalizer.lift_ι, category.id_comp, category.assoc],
    dsimp [ExtrSheaf.extend, ExtrSheaf.extend_to_hom],
    simp only [limits.equalizer.lift_ι, limits.equalizer.lift_ι_assoc],
    simp only [← F.val.map_comp, ← op_comp],
    rw [← f.op_unop, ← op_comp],
    congr' 2,
    apply ExtrDisc.hom.ext,
    exact (Profinite.map_pres_π f.unop.val).symm,
  end }

-- This should follow from the equalizer condition which is proved for `ExtrSheaf` above.
instance extend_restrict_hom_app_is_iso (F : ExtrSheaf.{u} C) (X : ExtrDiscᵒᵖ) :
  is_iso (F.extend_restrict_hom.val.app X) := sorry

instance extend_restrict_hom (F : ExtrSheaf.{u} C) : is_iso F.extend_restrict_hom :=
begin
  haveI : is_iso F.extend_restrict_hom.val := nat_iso.is_iso_of_is_iso_app _,
  use ⟨inv F.extend_restrict_hom.val⟩,
  split,
  all_goals { ext1, dsimp, simp }
end

def Condensed.restrict_extend_hom (F : Condensed.{u} C) :
  F ⟶ ((Condensed_to_ExtrSheaf C).obj F).extend := Sheaf.hom.mk $
{ app := λ X, limits.equalizer.lift (F.val.map X.unop.pres_π.op) begin
    dsimp [Condensed_to_ExtrSheaf],
    simp only [← F.val.map_comp, ← op_comp, category.assoc,
      Profinite.pullback.condition],
  end,
  naturality' := begin
    intros S T f,
    ext,
    dsimp [Condensed_to_ExtrSheaf],
    simp only [limits.equalizer.lift_ι, category.assoc],
    erw [limits.equalizer.lift_ι],
    erw [limits.equalizer.lift_ι_assoc],
    dsimp,
    simp only [← F.val.map_comp, ← op_comp],
    rw Profinite.map_pres_π,
    refl,
  end }

-- This map is an equalizer inclusion, and so is a mono.
lemma Condensed.mono_map_of_surjective (F : Condensed.{u} C) {X Y : Profinite}
  (f : Y ⟶ X) (hf : function.surjective f) : mono (F.val.map f.op) :=
begin
  have := F.2,
  rw F.val.is_proetale_sheaf_tfae.out 0 3 at this,
  obtain ⟨_,_,h⟩ := this,
  let t :=
    F.val.map_to_equalizer' f (Profinite.pullback.fst f f)
      (Profinite.pullback.snd f f) _,
  have : F.val.map f.op = t ≫ limits.equalizer.ι _ _,
  { dsimp [t, functor.map_to_equalizer'],
    simp },
  rw this,
  specialize h _ _ f hf,
  change is_iso t at h,
  resetI,
  have := mono_comp t (limits.equalizer.ι _ _),
  apply this,
end

lemma Condensed.equalizer_condition (F : Condensed.{u} C) {X Y Z : Profinite}
  (f : Y ⟶ X) (hf : function.surjective f) (g : Z ⟶ Profinite.pullback f f)
  (hg : function.surjective g) :
  is_iso (F.val.map_to_equalizer' f (g ≫ Profinite.pullback.fst _ _)
    (g ≫ Profinite.pullback.snd _ _) $ by simp [Profinite.pullback.condition] ) :=
begin
  have := F.2,
  rw F.val.is_proetale_sheaf_tfae.out 0 3 at this,
  obtain ⟨_,_,h⟩ := this,
  specialize h Y X f hf,
  -- TODO: generalize these isomorphisms between various equalizers.
  let E₁ := limits.equalizer
    (F.val.map (Profinite.pullback.fst f f).op)
    (F.val.map (Profinite.pullback.snd f f).op),
  let E₂ := limits.equalizer
    (F.val.map (g ≫ Profinite.pullback.fst f f).op)
    (F.val.map (g ≫ Profinite.pullback.snd f f).op),
  let e : E₁ ⟶ E₂ :=
    limits.equalizer.lift (limits.equalizer.ι _ _) (by simp [limits.equalizer.condition_assoc]),
  haveI : is_iso e := begin
    let i : E₂ ⟶ E₁ :=
      limits.equalizer.lift (limits.equalizer.ι _ _) _,
    swap,
    { haveI : mono (F.val.map g.op) := F.mono_map_of_surjective _ hg,
      rw ← cancel_mono (F.val.map g.op),
      dsimp, simp only [category.assoc, ← F.val.map_comp, ← op_comp],
      apply limits.equalizer.condition },
    use i,
    split,
    { dsimp [i, e], ext, simp },
    { dsimp [i, e], ext, simp, dsimp, simp, },
  end,
  let t := F.val.map_to_equalizer' f
    (g ≫ Profinite.pullback.fst f f)
    (g ≫ Profinite.pullback.snd f f) _,
  swap, { simp [Profinite.pullback.condition] },
  change is_iso t,
  suffices : is_iso (t ≫ inv e),
  { resetI,
    use inv e ≫ inv (t ≫ inv e),
    split,
    { simp only [← category.assoc, is_iso.hom_inv_id] },
    { simp } },
  have : t ≫ inv e =
    F.val.map_to_equalizer' f (Profinite.pullback.fst f f) (Profinite.pullback.snd f f) _,
  { rw is_iso.comp_inv_eq,
    ext,
    dsimp [t, e, functor.map_to_equalizer'],
    simp },
  -- Closes the other goal because proof appears in assumption.
  rwa this,
end

instance restrict_extend_hom_app_is_iso (F : Condensed.{u} C) (X : Profiniteᵒᵖ) :
  is_iso (F.restrict_extend_hom.val.app X) :=
begin
  dsimp [Condensed.restrict_extend_hom],
  have := F.equalizer_condition,
  apply this,
  apply Profinite.pres_π_surjective,
  apply Profinite.pres_π_surjective,
end

instance restrict_extend_hom_is_iso (F : Condensed.{u} C) :
  is_iso F.restrict_extend_hom :=
begin
  haveI : is_iso F.restrict_extend_hom.val := nat_iso.is_iso_of_is_iso_app _,
  use ⟨inv F.restrict_extend_hom.val⟩,
  split,
  all_goals { ext1, dsimp, simp }
end

def ExtrSheaf.extend_nat_trans {F G : ExtrSheaf.{u} C} (η : F ⟶ G) :
  F.extend_to_presheaf ⟶ G.extend_to_presheaf :=
{ app := λ X, limits.equalizer.lift
    (limits.equalizer.ι _ _ ≫ η.val.app _) begin
      simp only [category.assoc, ← η.val.naturality,
        limits.equalizer.condition_assoc],
    end,
  naturality' := begin
    intros S T f,
    dsimp [ExtrSheaf.extend_to_hom],
    ext,
    simp,
  end }

@[simp]
lemma ExtrSheaf.extend_nat_trans_id (F : ExtrSheaf.{u} C) :
  ExtrSheaf.extend_nat_trans (𝟙 F) = 𝟙 _ :=
begin
  ext S,
  dsimp [ExtrSheaf.extend_nat_trans],
  simp,
end

@[simp]
lemma ExtrSheaf.extend_nat_trans_comp {F G H : ExtrSheaf.{u} C} (η : F ⟶ G) (γ : G ⟶ H) :
  ExtrSheaf.extend_nat_trans (η ≫ γ) =
  ExtrSheaf.extend_nat_trans η ≫ ExtrSheaf.extend_nat_trans γ :=
begin
  ext,
  dsimp [ExtrSheaf.extend_nat_trans],
  simp,
end

variable (C)
@[simps]
def ExtrSheaf_to_Condensed : ExtrSheaf.{u} C ⥤ Condensed.{u} C :=
{ obj := λ F, F.extend,
  map := λ F G η, ⟨ExtrSheaf.extend_nat_trans η⟩,
  map_id' := λ X, by { ext1, apply ExtrSheaf.extend_nat_trans_id },
  map_comp' := λ X Y Z f g, by { ext1, apply ExtrSheaf.extend_nat_trans_comp } }

def ExtrSheaf_Condensed_equivalence : ExtrSheaf.{u} C ≌ Condensed.{u} C :=
equivalence.mk (ExtrSheaf_to_Condensed C) (Condensed_to_ExtrSheaf C)
(nat_iso.of_components (λ X,
  { hom := X.extend_restrict_hom,
    inv := let e := inv X.extend_restrict_hom in e,
    hom_inv_id' := is_iso.hom_inv_id _,
    inv_hom_id' := is_iso.inv_hom_id _ }) begin
      intros X Y f,
      ext,
      dsimp [ExtrSheaf.extend_restrict_hom, ExtrSheaf.extend_nat_trans],
      simp,
    end)
(nat_iso.of_components (λ X,
  { hom := let e := inv X.restrict_extend_hom in e,
    inv := X.restrict_extend_hom,
    hom_inv_id' := is_iso.inv_hom_id _,
    inv_hom_id' := is_iso.hom_inv_id _ }) begin
      intros X Y f,
      dsimp,
      rw [is_iso.comp_inv_eq, category.assoc, is_iso.eq_inv_comp],
      ext,
      dsimp [Condensed.restrict_extend_hom, ExtrSheaf.extend_nat_trans],
      simp,
    end)

end
-/


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Chris Hughes, Mario Carneiro, Yury Kudryashov

! This file was ported from Lean 3 source module algebra.ring.prod
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Int.Cast.Prod
import Mathlib.Algebra.Group.Prod
import Mathlib.Algebra.Ring.Equiv
import Mathlib.Algebra.Order.Group.Prod

/-!
# Semiring, ring etc structures on `R × S`

In this file we define two-binop (`Semiring`, `Ring` etc) structures on `R × S`. We also prove
trivial `simp` lemmas, and define the following operations on `RingHom`s and similarly for
`NonUnitalRingHom`s:

* `fst R S : R × S →+* R`, `snd R S : R × S →+* S`: projections `Prod.fst` and `Prod.snd`
  as `RingHom`s;
* `f.prod g : R →+* S × T`: sends `x` to `(f x, g x)`;
* `f.prod_map g : R × S → R' × S'`: `Prod.map f g` as a `RingHom`,
  sends `(x, y)` to `(f x, g y)`.
-/

variable {α β R R' S S' T T' : Type _}

namespace Prod

/-- Product of two distributive types is distributive. -/
instance [Distrib R] [Distrib S] : Distrib (R × S) :=
  { left_distrib := fun _ _ _ => mk.inj_iff.mpr ⟨left_distrib _ _ _, left_distrib _ _ _⟩
    right_distrib := fun _ _ _ => mk.inj_iff.mpr ⟨right_distrib _ _ _, right_distrib _ _ _⟩ }

/-- Product of two `NonUnitalNonAssocSemiring`s is a `NonUnitalNonAssocSemiring`. -/
instance [NonUnitalNonAssocSemiring R] [NonUnitalNonAssocSemiring S] :
    NonUnitalNonAssocSemiring (R × S) :=
  { inferInstanceAs (AddCommMonoid (R × S)),
    inferInstanceAs (Distrib (R × S)),
    inferInstanceAs (MulZeroClass (R × S)) with }

/-- Product of two `NonUnitalSemiring`s is a `NonUnitalSemiring`. -/
instance [NonUnitalSemiring R] [NonUnitalSemiring S] : NonUnitalSemiring (R × S) :=
  { inferInstanceAs (NonUnitalNonAssocSemiring (R × S)),
    inferInstanceAs (SemigroupWithZero (R × S)) with }

/-- Product of two `NonAssocSemiring`s is a `NonAssocSemiring`. -/
instance [NonAssocSemiring R] [NonAssocSemiring S] : NonAssocSemiring (R × S) :=
  { inferInstanceAs (NonUnitalNonAssocSemiring (R × S)),
    inferInstanceAs (MulZeroOneClass (R × S)),
    inferInstanceAs (AddMonoidWithOne (R × S)) with }

/-- Product of two semirings is a semiring. -/
instance [Semiring R] [Semiring S] : Semiring (R × S) :=
  { inferInstanceAs (NonUnitalSemiring (R × S)),
    inferInstanceAs (NonAssocSemiring (R × S)),
    inferInstanceAs (MonoidWithZero (R × S)) with }

/-- Product of two `NonUnitalCommSemiring`s is a `NonUnitalCommSemiring`. -/
instance [NonUnitalCommSemiring R] [NonUnitalCommSemiring S] : NonUnitalCommSemiring (R × S) :=
  { inferInstanceAs (NonUnitalSemiring (R × S)), inferInstanceAs (CommSemigroup (R × S)) with }

/-- Product of two commutative semirings is a commutative semiring. -/
instance [CommSemiring R] [CommSemiring S] : CommSemiring (R × S) :=
  { inferInstanceAs (Semiring (R × S)), inferInstanceAs (CommMonoid (R × S)) with }

instance [NonUnitalNonAssocRing R] [NonUnitalNonAssocRing S] : NonUnitalNonAssocRing (R × S) :=
  { inferInstanceAs (AddCommGroup (R × S)),
    inferInstanceAs (NonUnitalNonAssocSemiring (R × S)) with }

instance [NonUnitalRing R] [NonUnitalRing S] : NonUnitalRing (R × S) :=
  { inferInstanceAs (NonUnitalNonAssocRing (R × S)),
    inferInstanceAs (NonUnitalSemiring (R × S)) with }

instance [NonAssocRing R] [NonAssocRing S] : NonAssocRing (R × S) :=
  { inferInstanceAs (NonUnitalNonAssocRing (R × S)),
    inferInstanceAs (NonAssocSemiring (R × S)),
    inferInstanceAs (AddGroupWithOne (R × S)) with }

/-- Product of two rings is a ring. -/
instance [Ring R] [Ring S] : Ring (R × S) :=
  { inferInstanceAs (Semiring (R × S)),
    inferInstanceAs (AddCommGroup (R × S)),
    inferInstanceAs (AddGroupWithOne (R × S)) with }

/-- Product of two `NonUnitalCommRing`s is a `NonUnitalCommRing`. -/
instance [NonUnitalCommRing R] [NonUnitalCommRing S] : NonUnitalCommRing (R × S) :=
  { inferInstanceAs (NonUnitalRing (R × S)), inferInstanceAs (CommSemigroup (R × S)) with }

/-- Product of two commutative rings is a commutative ring. -/
instance [CommRing R] [CommRing S] : CommRing (R × S) :=
  { inferInstanceAs (Ring (R × S)), inferInstanceAs (CommMonoid (R × S)) with }

end Prod

namespace NonUnitalRingHom

variable (R S) [NonUnitalNonAssocSemiring R] [NonUnitalNonAssocSemiring S]

/-- Given non-unital semirings `R`, `S`, the natural projection homomorphism from `R × S` to `R`.-/
def fst : R × S →ₙ+* R :=
  { MulHom.fst R S, AddMonoidHom.fst R S with toFun := Prod.fst }
#align non_unital_ring_hom.fst NonUnitalRingHom.fst

/-- Given non-unital semirings `R`, `S`, the natural projection homomorphism from `R × S` to `S`.-/
def snd : R × S →ₙ+* S :=
  { MulHom.snd R S, AddMonoidHom.snd R S with toFun := Prod.snd }
#align non_unital_ring_hom.snd NonUnitalRingHom.snd

variable {R S}

@[simp]
theorem coe_fst : ⇑(fst R S) = Prod.fst :=
  rfl
#align non_unital_ring_hom.coe_fst NonUnitalRingHom.coe_fst

@[simp]
theorem coe_snd : ⇑(snd R S) = Prod.snd :=
  rfl
#align non_unital_ring_hom.coe_snd NonUnitalRingHom.coe_snd

section Prod

variable [NonUnitalNonAssocSemiring T] (f : R →ₙ+* S) (g : R →ₙ+* T)

/-- Combine two non-unital ring homomorphisms `f : R →ₙ+* S`, `g : R →ₙ+* T` into
`f.prod g : R →ₙ+* S × T` given by `(f.prod g) x = (f x, g x)` -/
protected def prod (f : R →ₙ+* S) (g : R →ₙ+* T) : R →ₙ+* S × T :=
  { MulHom.prod (f : MulHom R S) (g : MulHom R T), AddMonoidHom.prod (f : R →+ S) (g : R →+ T) with
    toFun := fun x => (f x, g x) }
#align non_unital_ring_hom.prod NonUnitalRingHom.prod

@[simp]
theorem prod_apply (x) : f.prod g x = (f x, g x) :=
  rfl
#align non_unital_ring_hom.prod_apply NonUnitalRingHom.prod_apply

@[simp]
theorem fst_comp_prod : (fst S T).comp (f.prod g) = f :=
  ext fun _ => rfl
#align non_unital_ring_hom.fst_comp_prod NonUnitalRingHom.fst_comp_prod

@[simp]
theorem snd_comp_prod : (snd S T).comp (f.prod g) = g :=
  ext fun _ => rfl
#align non_unital_ring_hom.snd_comp_prod NonUnitalRingHom.snd_comp_prod

theorem prod_unique (f : R →ₙ+* S × T) : ((fst S T).comp f).prod ((snd S T).comp f) = f :=
  ext fun x => by simp only [prod_apply, coe_fst, coe_snd, comp_apply, Prod.mk.eta]
#align non_unital_ring_hom.prod_unique NonUnitalRingHom.prod_unique

end Prod

section Prod_map

variable [NonUnitalNonAssocSemiring R'] [NonUnitalNonAssocSemiring S'] [NonUnitalNonAssocSemiring T]

variable (f : R →ₙ+* R') (g : S →ₙ+* S')

/-- `prod.map` as a `NonUnitalRingHom`. -/
def prodMap : R × S →ₙ+* R' × S' :=
  (f.comp (fst R S)).prod (g.comp (snd R S))
#align non_unital_ring_hom.prod_map NonUnitalRingHom.prodMap

@[simp]
theorem coe_prodMap : ⇑(prodMap f g) = Prod.map f g :=
  rfl
#align non_unital_ring_hom.coe_prod_map NonUnitalRingHom.coe_prodMap

theorem prod_comp_prodMap (f : T →ₙ+* R) (g : T →ₙ+* S) (f' : R →ₙ+* R') (g' : S →ₙ+* S') :
    (f'.prodMap g').comp (f.prod g) = (f'.comp f).prod (g'.comp g) :=
  rfl
#align non_unital_ring_hom.prod_comp_prod_map NonUnitalRingHom.prod_comp_prodMap

end Prod_map

end NonUnitalRingHom

namespace RingHom

variable (R S) [NonAssocSemiring R] [NonAssocSemiring S]

/-- Given semirings `R`, `S`, the natural projection homomorphism from `R × S` to `R`.-/
def fst : R × S →+* R :=
  { MonoidHom.fst R S, AddMonoidHom.fst R S with toFun := Prod.fst }
#align ring_hom.fst RingHom.fst

/-- Given semirings `R`, `S`, the natural projection homomorphism from `R × S` to `S`.-/
def snd : R × S →+* S :=
  { MonoidHom.snd R S, AddMonoidHom.snd R S with toFun := Prod.snd }
#align ring_hom.snd RingHom.snd

variable {R S}

@[simp]
theorem coe_fst : ⇑(fst R S) = Prod.fst :=
  rfl
#align ring_hom.coe_fst RingHom.coe_fst

@[simp]
theorem coe_snd : ⇑(snd R S) = Prod.snd :=
  rfl
#align ring_hom.coe_snd RingHom.coe_snd

section Prod

variable [NonAssocSemiring T] (f : R →+* S) (g : R →+* T)

/-- Combine two ring homomorphisms `f : R →+* S`, `g : R →+* T` into `f.prod g : R →+* S × T`
given by `(f.prod g) x = (f x, g x)` -/
protected def prod (f : R →+* S) (g : R →+* T) : R →+* S × T :=
  { MonoidHom.prod (f : R →* S) (g : R →* T), AddMonoidHom.prod (f : R →+ S) (g : R →+ T) with
    toFun := fun x => (f x, g x) }
#align ring_hom.prod RingHom.prod

@[simp]
theorem prod_apply (x) : f.prod g x = (f x, g x) :=
  rfl
#align ring_hom.prod_apply RingHom.prod_apply

@[simp]
theorem fst_comp_prod : (fst S T).comp (f.prod g) = f :=
  ext fun _ => rfl
#align ring_hom.fst_comp_prod RingHom.fst_comp_prod

@[simp]
theorem snd_comp_prod : (snd S T).comp (f.prod g) = g :=
  ext fun _ => rfl
#align ring_hom.snd_comp_prod RingHom.snd_comp_prod

theorem prod_unique (f : R →+* S × T) : ((fst S T).comp f).prod ((snd S T).comp f) = f :=
  ext fun x => by simp only [prod_apply, coe_fst, coe_snd, comp_apply, Prod.mk.eta]
#align ring_hom.prod_unique RingHom.prod_unique

end Prod

section Prod_map

variable [NonAssocSemiring R'] [NonAssocSemiring S'] [NonAssocSemiring T]

variable (f : R →+* R') (g : S →+* S')

/-- `Prod.map` as a `RingHom`. -/
def prodMap : R × S →+* R' × S' :=
  (f.comp (fst R S)).prod (g.comp (snd R S))
#align ring_hom.prod_map RingHom.prodMap

theorem prodMap_def : prodMap f g = (f.comp (fst R S)).prod (g.comp (snd R S)) :=
  rfl
#align ring_hom.prod_map_def RingHom.prodMap_def

@[simp]
theorem coe_prodMap : ⇑(prodMap f g) = Prod.map f g :=
  rfl
#align ring_hom.coe_prod_map RingHom.coe_prodMap

theorem prod_comp_prodMap (f : T →+* R) (g : T →+* S) (f' : R →+* R') (g' : S →+* S') :
    (f'.prodMap g').comp (f.prod g) = (f'.comp f).prod (g'.comp g) :=
  rfl
#align ring_hom.prod_comp_prod_map RingHom.prod_comp_prodMap

end Prod_map

end RingHom

namespace RingEquiv

variable [NonAssocSemiring R] [NonAssocSemiring S]

/-- Swapping components as an equivalence of (semi)rings. -/
def prodComm : R × S ≃+* S × R :=
  { AddEquiv.prodComm, MulEquiv.prodComm with }
#align ring_equiv.prod_comm RingEquiv.prodComm

@[simp]
theorem coe_prod_comm : ⇑(prodComm : R × S ≃+* S × R) = Prod.swap :=
  rfl
#align ring_equiv.coe_prod_comm RingEquiv.coe_prod_comm

@[simp]
theorem coe_prod_comm_symm : ⇑(prodComm : R × S ≃+* S × R).symm = Prod.swap :=
  rfl
#align ring_equiv.coe_prod_comm_symm RingEquiv.coe_prod_comm_symm

@[simp]
theorem fst_comp_coe_prod_comm :
    (RingHom.fst S R).comp ↑(prodComm : R × S ≃+* S × R) = RingHom.snd R S :=
  RingHom.ext fun _ => rfl
#align ring_equiv.fst_comp_coe_prod_comm RingEquiv.fst_comp_coe_prod_comm

@[simp]
theorem snd_comp_coe_prod_comm :
    (RingHom.snd S R).comp ↑(prodComm : R × S ≃+* S × R) = RingHom.fst R S :=
  RingHom.ext fun _ => rfl
#align ring_equiv.snd_comp_coe_prod_comm RingEquiv.snd_comp_coe_prod_comm

variable (R S) [Subsingleton S]

/-- A ring `R` is isomorphic to `R × S` when `S` is the zero ring -/
@[simps]
def prodZeroRing : R ≃+* R × S where
  toFun x := (x, 0)
  invFun := Prod.fst
  map_add' := by simp
  map_mul' := by simp
  left_inv x := rfl
  right_inv x := by cases x; simp
#align ring_equiv.prod_zero_ring RingEquiv.prodZeroRing
#align ring_equiv.prod_zero_ring_symm_apply RingEquiv.prodZeroRing_symm_apply
#align ring_equiv.prod_zero_ring_apply RingEquiv.prodZeroRing_apply

/-- A ring `R` is isomorphic to `S × R` when `S` is the zero ring -/
@[simps]
def zeroRingProd : R ≃+* S × R where
  toFun x := (0, x)
  invFun := Prod.snd
  map_add' := by simp
  map_mul' := by simp
  left_inv x := rfl
  right_inv x := by cases x; simp
#align ring_equiv.zero_ring_prod RingEquiv.zeroRingProd
#align ring_equiv.zero_ring_prod_symm_apply RingEquiv.zeroRingProd_symm_apply
#align ring_equiv.zero_ring_prod_apply RingEquiv.zeroRingProd_apply

end RingEquiv

/-- The product of two nontrivial rings is not a domain -/
theorem false_of_nontrivial_of_product_domain (R S : Type _) [Ring R] [Ring S] [IsDomain (R × S)]
    [Nontrivial R] [Nontrivial S] : False := by
  have :=
    NoZeroDivisors.eq_zero_or_eq_zero_of_mul_eq_zero (show ((0 : R), (1 : S)) * (1, 0) = 0 by simp)
  rw [Prod.mk_eq_zero, Prod.mk_eq_zero] at this
  rcases this with (⟨_, h⟩ | ⟨h, _⟩)
  · exact zero_ne_one h.symm
  · exact zero_ne_one h.symm
#align false_of_nontrivial_of_product_domain false_of_nontrivial_of_product_domain

/-! ### Order -/

instance [OrderedSemiring α] [OrderedSemiring β] : OrderedSemiring (α × β) :=
  { inferInstanceAs (Semiring (α × β)), inferInstanceAs (OrderedAddCommMonoid (α × β)) with
    zero_le_one := ⟨zero_le_one, zero_le_one⟩
    mul_le_mul_of_nonneg_left := fun _ _ _ hab hc =>
      ⟨mul_le_mul_of_nonneg_left hab.1 hc.1, mul_le_mul_of_nonneg_left hab.2 hc.2⟩
    mul_le_mul_of_nonneg_right := fun _ _ _ hab hc =>
      ⟨mul_le_mul_of_nonneg_right hab.1 hc.1, mul_le_mul_of_nonneg_right hab.2 hc.2⟩ }

instance [OrderedCommSemiring α] [OrderedCommSemiring β] : OrderedCommSemiring (α × β) :=
  { inferInstanceAs (OrderedSemiring (α × β)), inferInstanceAs (CommSemiring (α × β)) with }

-- porting note: compile fails with `inferInstanceAs (OrderedSemiring (α × β))`
instance [OrderedRing α] [OrderedRing β] : OrderedRing (α × β) :=
  { inferInstanceAs (Ring (α × β)), inferInstanceAs (OrderedAddCommGroup (α × β)) with
    zero_le_one := ⟨zero_le_one, zero_le_one⟩
    mul_nonneg := fun _ _ ha hb => ⟨mul_nonneg ha.1 hb.1, mul_nonneg ha.2 hb.2⟩ }

instance [OrderedCommRing α] [OrderedCommRing β] : OrderedCommRing (α × β) :=
  { inferInstanceAs (OrderedRing (α × β)), inferInstanceAs (CommRing (α × β)) with }


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

! This file was ported from Lean 3 source module analysis.normed.group.SemiNormedGroup
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Normed.Group.Hom
import Mathbin.CategoryTheory.Limits.Shapes.ZeroMorphisms
import Mathbin.CategoryTheory.ConcreteCategory.BundledHom
import Mathbin.CategoryTheory.Elementwise

/-!
# The category of seminormed groups

We define `SemiNormedGroup`, the category of seminormed groups and normed group homs between them,
as well as `SemiNormedGroup₁`, the subcategory of norm non-increasing morphisms.
-/

noncomputable section

universe u

open CategoryTheory

/-- The category of seminormed abelian groups and bounded group homomorphisms. -/
def SemiNormedGroup : Type (u + 1) :=
  Bundled SeminormedAddCommGroup
#align SemiNormedGroup SemiNormedGroup

namespace SemiNormedGroup

instance bundledHom : BundledHom @NormedAddGroupHom :=
  ⟨@NormedAddGroupHom.toFun, @NormedAddGroupHom.id, @NormedAddGroupHom.comp,
    @NormedAddGroupHom.coe_inj⟩
#align SemiNormedGroup.bundled_hom SemiNormedGroup.bundledHom

deriving instance LargeCategory, ConcreteCategory for SemiNormedGroup

instance : CoeSort SemiNormedGroup (Type u) :=
  Bundled.hasCoeToSort

/-- Construct a bundled `SemiNormedGroup` from the underlying type and typeclass. -/
def of (M : Type u) [SeminormedAddCommGroup M] : SemiNormedGroup :=
  Bundled.of M
#align SemiNormedGroup.of SemiNormedGroup.of

instance (M : SemiNormedGroup) : SeminormedAddCommGroup M :=
  M.str

@[simp]
theorem coe_of (V : Type u) [SeminormedAddCommGroup V] : (SemiNormedGroup.of V : Type u) = V :=
  rfl
#align SemiNormedGroup.coe_of SemiNormedGroup.coe_of

@[simp]
theorem coe_id (V : SemiNormedGroup) : ⇑(𝟙 V) = id :=
  rfl
#align SemiNormedGroup.coe_id SemiNormedGroup.coe_id

@[simp]
theorem coe_comp {M N K : SemiNormedGroup} (f : M ⟶ N) (g : N ⟶ K) : (f ≫ g : M → K) = g ∘ f :=
  rfl
#align SemiNormedGroup.coe_comp SemiNormedGroup.coe_comp

instance : Inhabited SemiNormedGroup :=
  ⟨of PUnit⟩

instance ofUnique (V : Type u) [SeminormedAddCommGroup V] [i : Unique V] :
    Unique (SemiNormedGroup.of V) :=
  i
#align SemiNormedGroup.of_unique SemiNormedGroup.ofUnique

instance : Limits.HasZeroMorphisms.{u, u + 1} SemiNormedGroup where

@[simp]
theorem zero_apply {V W : SemiNormedGroup} (x : V) : (0 : V ⟶ W) x = 0 :=
  rfl
#align SemiNormedGroup.zero_apply SemiNormedGroup.zero_apply

theorem isZero_of_subsingleton (V : SemiNormedGroup) [Subsingleton V] : Limits.IsZero V :=
  by
  refine' ⟨fun X => ⟨⟨⟨0⟩, fun f => _⟩⟩, fun X => ⟨⟨⟨0⟩, fun f => _⟩⟩⟩
  · ext
    have : x = 0 := Subsingleton.elim _ _
    simp only [this, map_zero]
  · ext
    apply Subsingleton.elim
#align SemiNormedGroup.is_zero_of_subsingleton SemiNormedGroup.isZero_of_subsingleton

instance hasZeroObject : Limits.HasZeroObject SemiNormedGroup.{u} :=
  ⟨⟨of PUnit, isZero_of_subsingleton _⟩⟩
#align SemiNormedGroup.has_zero_object SemiNormedGroup.hasZeroObject

theorem iso_isometry_of_normNoninc {V W : SemiNormedGroup} (i : V ≅ W) (h1 : i.hom.NormNoninc)
    (h2 : i.inv.NormNoninc) : Isometry i.hom :=
  by
  apply AddMonoidHomClass.isometry_of_norm
  intro v
  apply le_antisymm (h1 v)
  calc
    ‖v‖ = ‖i.inv (i.hom v)‖ := by rw [iso.hom_inv_id_apply]
    _ ≤ ‖i.hom v‖ := h2 _

#align SemiNormedGroup.iso_isometry_of_norm_noninc SemiNormedGroup.iso_isometry_of_normNoninc

end SemiNormedGroup

/-- `SemiNormedGroup₁` is a type synonym for `SemiNormedGroup`,
which we shall equip with the category structure consisting only of the norm non-increasing maps.
-/
def SemiNormedGroup₁ : Type (u + 1) :=
  Bundled SeminormedAddCommGroup
#align SemiNormedGroup₁ SemiNormedGroup₁

namespace SemiNormedGroup₁

instance : CoeSort SemiNormedGroup₁ (Type u) :=
  Bundled.hasCoeToSort

instance : LargeCategory.{u} SemiNormedGroup₁
    where
  hom X Y := { f : NormedAddGroupHom X Y // f.NormNoninc }
  id X := ⟨NormedAddGroupHom.id X, NormedAddGroupHom.NormNoninc.id⟩
  comp X Y Z f g := ⟨(g : NormedAddGroupHom Y Z).comp (f : NormedAddGroupHom X Y), g.2.comp f.2⟩

@[ext]
theorem hom_ext {M N : SemiNormedGroup₁} (f g : M ⟶ N) (w : (f : M → N) = (g : M → N)) : f = g :=
  Subtype.eq (NormedAddGroupHom.ext (congr_fun w))
#align SemiNormedGroup₁.hom_ext SemiNormedGroup₁.hom_ext

instance : ConcreteCategory.{u} SemiNormedGroup₁
    where
  forget :=
    { obj := fun X => X
      map := fun X Y f => f }
  forget_faithful := { }

/-- Construct a bundled `SemiNormedGroup₁` from the underlying type and typeclass. -/
def of (M : Type u) [SeminormedAddCommGroup M] : SemiNormedGroup₁ :=
  Bundled.of M
#align SemiNormedGroup₁.of SemiNormedGroup₁.of

instance (M : SemiNormedGroup₁) : SeminormedAddCommGroup M :=
  M.str

/-- Promote a morphism in `SemiNormedGroup` to a morphism in `SemiNormedGroup₁`. -/
def mkHom {M N : SemiNormedGroup} (f : M ⟶ N) (i : f.NormNoninc) :
    SemiNormedGroup₁.of M ⟶ SemiNormedGroup₁.of N :=
  ⟨f, i⟩
#align SemiNormedGroup₁.mk_hom SemiNormedGroup₁.mkHom

@[simp]
theorem mkHom_apply {M N : SemiNormedGroup} (f : M ⟶ N) (i : f.NormNoninc) (x) :
    mkHom f i x = f x :=
  rfl
#align SemiNormedGroup₁.mk_hom_apply SemiNormedGroup₁.mkHom_apply

/-- Promote an isomorphism in `SemiNormedGroup` to an isomorphism in `SemiNormedGroup₁`. -/
@[simps]
def mkIso {M N : SemiNormedGroup} (f : M ≅ N) (i : f.hom.NormNoninc) (i' : f.inv.NormNoninc) :
    SemiNormedGroup₁.of M ≅ SemiNormedGroup₁.of N
    where
  hom := mkHom f.hom i
  inv := mkHom f.inv i'
  hom_inv_id' := by
    apply Subtype.eq
    exact f.hom_inv_id
  inv_hom_id' := by
    apply Subtype.eq
    exact f.inv_hom_id
#align SemiNormedGroup₁.mk_iso SemiNormedGroup₁.mkIso

instance : HasForget₂ SemiNormedGroup₁ SemiNormedGroup
    where forget₂ :=
    { obj := fun X => X
      map := fun X Y f => f.1 }

@[simp]
theorem coe_of (V : Type u) [SeminormedAddCommGroup V] : (SemiNormedGroup₁.of V : Type u) = V :=
  rfl
#align SemiNormedGroup₁.coe_of SemiNormedGroup₁.coe_of

@[simp]
theorem coe_id (V : SemiNormedGroup₁) : ⇑(𝟙 V) = id :=
  rfl
#align SemiNormedGroup₁.coe_id SemiNormedGroup₁.coe_id

@[simp]
theorem coe_comp {M N K : SemiNormedGroup₁} (f : M ⟶ N) (g : N ⟶ K) : (f ≫ g : M → K) = g ∘ f :=
  rfl
#align SemiNormedGroup₁.coe_comp SemiNormedGroup₁.coe_comp

-- If `coe_fn_coe_base` fires before `coe_comp`, `coe_comp'` puts us back in normal form.
@[simp]
theorem coe_comp' {M N K : SemiNormedGroup₁} (f : M ⟶ N) (g : N ⟶ K) :
    (f ≫ g : NormedAddGroupHom M K) = (↑g : NormedAddGroupHom N K).comp ↑f :=
  rfl
#align SemiNormedGroup₁.coe_comp' SemiNormedGroup₁.coe_comp'

instance : Inhabited SemiNormedGroup₁ :=
  ⟨of PUnit⟩

instance ofUnique (V : Type u) [SeminormedAddCommGroup V] [i : Unique V] :
    Unique (SemiNormedGroup₁.of V) :=
  i
#align SemiNormedGroup₁.of_unique SemiNormedGroup₁.ofUnique

instance : Limits.HasZeroMorphisms.{u, u + 1} SemiNormedGroup₁
    where
  Zero X Y := { zero := ⟨0, NormedAddGroupHom.NormNoninc.zero⟩ }
  comp_zero X Y f Z := by
    ext
    rfl
  zero_comp X Y Z f := by
    ext
    simp [coeFn_coe_base']

@[simp]
theorem zero_apply {V W : SemiNormedGroup₁} (x : V) : (0 : V ⟶ W) x = 0 :=
  rfl
#align SemiNormedGroup₁.zero_apply SemiNormedGroup₁.zero_apply

theorem isZero_of_subsingleton (V : SemiNormedGroup₁) [Subsingleton V] : Limits.IsZero V :=
  by
  refine' ⟨fun X => ⟨⟨⟨0⟩, fun f => _⟩⟩, fun X => ⟨⟨⟨0⟩, fun f => _⟩⟩⟩
  · ext
    have : x = 0 := Subsingleton.elim _ _
    simp only [this, map_zero]
    exact map_zero f.1
  · ext
    apply Subsingleton.elim
#align SemiNormedGroup₁.is_zero_of_subsingleton SemiNormedGroup₁.isZero_of_subsingleton

instance hasZeroObject : Limits.HasZeroObject SemiNormedGroup₁.{u} :=
  ⟨⟨of PUnit, isZero_of_subsingleton _⟩⟩
#align SemiNormedGroup₁.has_zero_object SemiNormedGroup₁.hasZeroObject

theorem iso_isometry {V W : SemiNormedGroup₁} (i : V ≅ W) : Isometry i.hom :=
  by
  change Isometry (i.hom : V →+ W)
  refine' AddMonoidHomClass.isometry_of_norm i.hom _
  intro v
  apply le_antisymm (i.hom.2 v)
  calc
    ‖v‖ = ‖i.inv (i.hom v)‖ := by rw [iso.hom_inv_id_apply]
    _ ≤ ‖i.hom v‖ := i.inv.2 _

#align SemiNormedGroup₁.iso_isometry SemiNormedGroup₁.iso_isometry

end SemiNormedGroup₁


import tactic
import data.set.finite
import data.real.basic
import data.real.ereal
import linear_algebra.affine_space.independent
import analysis.convex.basic
import topology.sequences

noncomputable theory
open set affine topological_space
open_locale affine filter big_operators

variables  {V : Type*} [add_comm_group V] [module ℝ V]
variables [affine_space V V]

variables {k n : ℕ}

variables (Δ : simplex ℝ V n)

def pts (C : simplex ℝ V k) : set V := convex_hull (C.points '' univ)

structure triangulation :=
(simps : set (@simplex ℝ V V _ _ _ _ n) )
(cov : (⋃ s ∈ simps, (pts s)) = pts Δ)
--(inter : ∀ s t ∈ simps, (pts s) ∩ (pts t) ≠ ∅ → ∃ (m : ℕ) (st m),
--  (pts s) ∩ (pts t) = pts st)
-- exercici: escriure la condició d'intersecció fent servir "face".

lemma fixed_point_of_epsilon_fixed (X : Type) [metric_space X]
  [hsq : seq_compact_space X]
  (f : X → X) (hf : continuous f)
  (h : ∀ (ε : ℝ), 0 < ε → ∃ x, dist x (f x) < ε) :
  ∃ x : X, f x = x :=
begin
  have hpos : ∀ (n : ℕ), 0 < 1 / ((n+1) : ℝ), by apply nat.one_div_pos_of_nat,
  let a : ℕ → X := λ n, classical.some (h (1 / ((n+1) : ℝ)) (hpos n)),
  have ha : ∀ n, dist (a n) (f (a n)) < 1 / ((n+1) : ℝ) :=
    λ n, classical.some_spec (h (1 / ((n+1) : ℝ)) (hpos n)),
  have exists_lim : ∃ (z ∈ univ) (Φ : ℕ → ℕ),
    strict_mono Φ ∧ filter.tendsto (a ∘ Φ) filter.at_top (nhds z),
  {
    apply hsq.seq_compact_univ,
    exact λ n, by tauto,
  },
  obtain ⟨z, ⟨_, ⟨Φ, ⟨hΦ1, hΦ2⟩⟩⟩ ⟩ := exists_lim,
  use z,
  suffices : ∀ ε > 0, dist z (f z) ≤ ε,
  {
    rw [←dist_le_zero, dist_comm],
    exact le_of_forall_le_of_dense this,
  },
  intros ε hε,
  have H1 : ∀ δ, 0 < δ →  ∃ (n : ℕ), ∀ m ≥ n, dist z ((a ∘ Φ) m) < δ,
  {
    intros δ hδ,
    rw seq_tendsto_iff at hΦ2,
    specialize hΦ2 (metric.ball z (δ)) (by rwa [metric.mem_ball, dist_self]) (metric.is_open_ball),
    simp [metric.mem_ball, dist_comm] at hΦ2,
    simp only [function.comp_app],
    exact hΦ2,
  },
  have H2 : ∃ (n : ℕ), ∀ m ≥ n, dist ((a∘Φ) m) (f ((a∘Φ) m)) ≤ ε/3,
  {
    have hkey : ∃ (n : ℕ), 1 / ((n+1):ℝ) < ε/3,
    {
      have hnlarge : ∃ (n : ℕ), (n :ℝ) > 3 / ε := exists_nat_gt (3 / ε),
      obtain ⟨n, hn⟩:= hnlarge,
      use n,
      have hn' : (n+1 : ℝ) > 3 / ε, by linarith,
      refine (inv_lt_inv _ (hpos n)).mp _, by linarith,
      field_simp,
      linarith,
    },
    obtain ⟨n, hn⟩ := hkey,
    use n,
    intros m hm,
    specialize ha (Φ m),
    have hmn : 1 / ((m + 1) : ℝ) ≤ 1 / ((n + 1) : ℝ), by apply nat.one_div_le_one_div hm,
    have hinc : 1 / ((Φ m) + 1:ℝ) ≤ 1 / ((m + 1):ℝ), by exact nat.one_div_le_one_div (strict_mono.id_le hΦ1 m),
    linarith,
  },
  have H3 : ∃ (n : ℕ), ∀ m ≥ n, dist (f ((a∘Φ) m)) (f z) < ε/3 :=
      let ⟨δ, ⟨hδpos, h'⟩⟩ := (metric.continuous_iff.1 hf) z (ε/3) (by linarith), ⟨n1, hn1⟩ := H1 δ hδpos in
        ⟨n1, λ m hm, let h := hn1 m hm in h' (a (Φ m)) (by rwa dist_comm)⟩,
  obtain ⟨⟨n1, hn1⟩, ⟨n2, hn2⟩, ⟨n3, hn3⟩⟩ := ⟨H1 (ε / 3) (by linarith), H2, H3⟩,
  let n := max (max n1 n2) n3,
  specialize hn1 n (le_of_max_le_left (le_max_left (max n1 n2) n3)),
  specialize hn2 n (le_trans (le_max_right n1 n2) (le_max_left (max n1 n2) n3)),
  specialize hn3 n (le_max_right (max n1 n2) n3),
  calc
  dist z (f z) ≤ dist z ((a ∘ Φ) n)
                + dist ((a ∘ Φ) n) (f ((a ∘ Φ) n))
                + dist (f ((a ∘ Φ) n)) (f z) : dist_triangle4 z ((a ∘ Φ) n) (f ((a ∘ Φ) n)) (f z)
  ... ≤ ε/3 + ε/3 + ε/3 : by { linarith [hn1, hn2, hn3] }
  ... = ε : by {ring},
end

lemma le_min_right_or_left {α : Type*} [linear_order α] (a b : α) : a ≤ min a b ∨ b ≤ min a b :=
by cases (le_total a b) with h; simp [true_or, le_min rfl.ge h]; exact or.inr h

lemma max_le_right_or_left {α : Type*} [linear_order α] (a b : α) : max a b ≤ a ∨ max a b ≤ b :=
by cases (le_total a b) with h; simp [true_or, max_le rfl.ge h]; exact or.inr h

lemma edist_lt_of_diam_lt {X : Type*} [pseudo_emetric_space X] (s : set X)  {d : ennreal} :
  emetric.diam s < d → ∀ (x ∈ s) (y ∈ s), edist x y < d :=
λ h x hx y hy, gt_of_gt_of_ge h (emetric.edist_le_diam_of_mem hx hy)

lemma enndiameter_growth' {X : Type} [pseudo_emetric_space X] {S : set X}
  {f : X → X} (hf : uniform_continuous_on f S) : ∀ ε > 0,  ∃ δ > 0,
  ∀ T ⊆ S, emetric.diam T < δ → emetric.diam (f '' T) ≤ ε :=
λ ε hε, let ⟨δ, hδ, H⟩ := emetric.uniform_continuous_on_iff.1 hf ε hε in
  ⟨δ, hδ, λ R hR hdR, emetric.diam_image_le_iff.2
  (λ x hx y hy, le_of_lt (H (hR hx) (hR hy) (edist_lt_of_diam_lt R hdR x hx y hy)))⟩

lemma enndiameter_growth {X : Type} [pseudo_emetric_space X] {S : set X}
  {f : X → X} (hf : uniform_continuous_on f S) : ∀ ε > 0,  ∃ δ > 0,
  ∀ T ⊆ S, emetric.diam T < δ → emetric.diam (f '' T) < ε :=
begin
  intros ε hε,
  set γ := min 1 (ε/2) with hhγ,
  have hγ : γ > 0,
  { cases (le_min_right_or_left 1 (ε/2)),
    { exact lt_of_lt_of_le (ennreal.zero_lt_one) h },
    { exact lt_of_lt_of_le (ennreal.div_pos_iff.2 ⟨ne_of_gt hε, ennreal.two_ne_top⟩) h } },
  obtain ⟨δ, hδ, H⟩ := enndiameter_growth' hf γ hγ,
  have hγε: γ < ε,
  { cases (lt_or_ge 1 ε),
    { exact lt_of_le_of_lt (min_le_left 1 (ε/2)) h },
    { have hεtop := ne_of_lt (lt_of_le_of_lt h (lt_of_le_of_ne le_top ennreal.one_ne_top)),
      exact lt_of_le_of_lt (min_le_right 1 (ε/2)) (ennreal.half_lt_self (ne_of_gt hε) hεtop) } },
  exact ⟨δ, hδ, (λ R hR hdR, lt_of_le_of_lt (H R hR hdR) hγε)⟩,
end

lemma diameter_growth (X : Type) [metric_space X] (S : set X)
  (f : X → X) (hf : uniform_continuous_on f S) (ε : ℝ) (hε : 0 < ε) :
  ∃ δ > 0, ∀ T ⊆ S, metric.bounded T → metric.diam T ≤ δ →
  metric.bounded (f '' T) ∧ metric.diam (f '' T) ≤ ε :=
begin
  sorry
end

variables {d : ℕ}
local notation `E` := fin d → ℝ

def H := { x: E | (∑ (i : fin d), x i) = 1}

variables (f: E → E)

example (a b : real) (r : ennreal) (h1 : (a : ereal) ≤ (b : ereal) + r) (h2 : (a : ereal) ≥ (b : ereal) - r) :
  ennreal.of_real (abs (a - b)) ≤ r :=
begin
  sorry
end

lemma points_coordinates_bounded_distance (x y : E) (i : fin d) :
  ennreal.of_real (abs (x i - y i)) ≤ edist x y :=
begin
  sorry
end

lemma points_coordinates_bounded_diam (S : set E) (x y : E) (hx : x ∈ S) (hy : y ∈ S)
(i : fin d) : ennreal.of_real (abs (x i - y i)) ≤ emetric.diam S :=
begin
  sorry
end

-- per tota coordenada i, existeix un vertex v tal que la coordenada i-èssima
-- és la primera que complex que f(v)_i < f(v)
def is_sperner_set (f: E → E) (S : set E)  :=
  ∀ i: fin d, ∃ v : E, v ∈ S ∧
  (∀ j < i, (f v) j ≥  (v j)) ∧ (((f v) i) < v i)

lemma epsilon_fixed_condition
{f : E → E} {S : set E} (hs : S ⊆ H) (hd : 0 < d)
(hf : uniform_continuous_on f S)
{ε : real} (hε : 0 < ε)
: ∃ δ, 0 < δ ∧
∀ T ⊆ S,
  metric.bounded T → metric.diam T < δ →
  is_sperner_set f T →
  ∀ x ∈ T, dist (f x) x < ε :=
begin
  let ε₁ := ε / (2 * d),
  have h₁ := div_pos hε (mul_pos zero_lt_two (nat.cast_pos.mpr hd)),
  obtain ⟨δ₀, hδ₀pos, hδ₀⟩ := metric.uniform_continuous_on_iff.mp hf ε₁ h₁,
  let δ := min δ₀ (ε₁/2),
  use δ,
  split,
  { cases le_min_right_or_left δ₀ (ε₁/2),
    { exact gt_of_ge_of_gt h hδ₀pos },
    { exact lt_min hδ₀pos (half_pos h₁) } },
  intros T hTS hbT hdT hfT x hx,
  have hmost : ∀ (i : fin d) (hi : (i : ℕ) ≠ d-1),
    abs (((f x) i)-(x i))
     ≤ δ + (metric.diam (f '' T)),
  {
    intros i hi,
    rw abs_sub_le_iff,
    split,
    {
      sorry
    },
    {
      sorry
    }
  },
  have hlast : abs(((f x) ⟨d-1, buffer.lt_aux_2 hd⟩)) - x ⟨d-1, buffer.lt_aux_2 hd⟩ ≤ (d-1) * (δ + (metric.diam (f '' T))),
  {
    sorry
  },
  sorry
end


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import tactic.rcases
/-!
# lift tactic

This file defines the `lift` tactic, allowing the user to lift elements from one type to another
under a specified condition.

## Tags

lift, tactic
-/

/-- A class specifying that you can lift elements from `α` to `β` assuming `cond` is true.
  Used by the tactic `lift`. -/
class can_lift (α β : Sort*) :=
(coe : β → α)
(cond : α → Prop)
(prf : ∀(x : α), cond x → ∃(y : β), coe y = x)

open tactic

/--
A user attribute used internally by the `lift` tactic.
This should not be applied by hand.
-/
@[user_attribute]
meta def can_lift_attr : user_attribute (list name) :=
{ name := "_can_lift",
  descr := "internal attribute used by the lift tactic",
  parser := failed,
  cache_cfg :=
  { mk_cache := λ _,
      do { ls ← attribute.get_instances `instance,
          ls.mfilter $ λ l,
          do { (_,t) ← mk_const l >>= infer_type >>= open_pis,
          return $ t.is_app_of `can_lift } },
    dependencies := [`instance] } }

instance : can_lift ℤ ℕ :=
⟨coe, λ n, 0 ≤ n, λ n hn, ⟨n.nat_abs, int.nat_abs_of_nonneg hn⟩⟩

/-- Enable automatic handling of pi types in `can_lift`. -/
instance pi.can_lift (ι : Sort*) (α : Π i : ι, Sort*) (β : Π i : ι, Sort*)
  [Π i : ι, can_lift (α i) (β i)] :
  can_lift (Π i : ι, α i) (Π i : ι, β i) :=
{ coe := λ f i, can_lift.coe (f i),
  cond := λ f, ∀ i, can_lift.cond (β i) (f i),
  prf := λ f hf, ⟨λ i, classical.some (can_lift.prf (f i) (hf i)), funext $ λ i,
    classical.some_spec (can_lift.prf (f i) (hf i))⟩ }

instance pi_subtype.can_lift (ι : Sort*) (α : Π i : ι, Sort*) [ne : Π i, nonempty (α i)]
  (p : ι → Prop) :
  can_lift (Π i : subtype p, α i) (Π i, α i) :=
{ coe := λ f i, f i,
  cond := λ _, true,
  prf :=
    begin
      classical,
      refine λ f _, ⟨λ i, if hi : p i then f ⟨i, hi⟩ else classical.choice (ne i), funext _⟩,
      rintro ⟨i, hi⟩,
      exact dif_pos hi
    end }

instance pi_subtype.can_lift' (ι : Sort*) (α : Sort*) [ne : nonempty α] (p : ι → Prop) :
  can_lift (subtype p → α) (ι → α) :=
pi_subtype.can_lift ι (λ _, α) p

instance subtype.can_lift {α : Sort*} (p : α → Prop) : can_lift α {x // p x} :=
{ coe := coe,
  cond := p,
  prf := λ a ha, ⟨⟨a, ha⟩, rfl⟩ }

namespace tactic

/--
Construct the proof of `cond x` in the lift tactic.
*  `e` is the expression being lifted and `h` is the specified proof of `can_lift.cond e`.
*  `old_tp` and `new_tp` are the arguments to `can_lift` and `inst` is the `can_lift`-instance.
*  `s` and `to_unfold` contain the information of the simp set used to simplify.

If the proof was specified, we check whether it has the correct type.
If it doesn't have the correct type, we display an error message
(but first call dsimp on the expression in the message).

If the proof was not specified, we create assert it as a local constant.
(The name of this local constant doesn't matter, since `lift` will remove it from the context.)
-/
meta def get_lift_prf (h : option pexpr) (old_tp new_tp inst e : expr)
  (s : simp_lemmas) (to_unfold : list name) : tactic expr := do
  expected_prf_ty ← mk_app `can_lift.cond [old_tp, new_tp, inst, e],
  expected_prf_ty ← s.dsimplify to_unfold expected_prf_ty,
  if h_some : h.is_some then
    decorate_error "lift tactic failed." $ i_to_expr ``((%%(option.get h_some) : %%expected_prf_ty))
  else do
    prf_nm ← get_unused_name,
    prf ← assert prf_nm expected_prf_ty,
    swap,
    return prf

/-- Lift the expression `p` to the type `t`, with proof obligation given by `h`.
  The list `n` is used for the two newly generated names, and to specify whether `h` should
  remain in the local context. See the doc string of `tactic.interactive.lift` for more information.
  -/
meta def lift (p : pexpr) (t : pexpr) (h : option pexpr) (n : list name) : tactic unit :=
do
  propositional_goal <|>
    fail "lift tactic failed. Tactic is only applicable when the target is a proposition.",
  e ← i_to_expr p,
  old_tp ← infer_type e,
  new_tp ← i_to_expr ``(%%t : Sort*),
  inst_type ← mk_app ``can_lift [old_tp, new_tp],
  inst ← mk_instance inst_type <|>
    pformat!"Failed to find a lift from {old_tp} to {new_tp}. Provide an instance of\n  {inst_type}"
    >>= fail,
  /- make the simp set to get rid of `can_lift` projections -/
  can_lift_instances ← can_lift_attr.get_cache >>= λ l, l.mmap resolve_name,
  (s, to_unfold) ← mk_simp_set tt [] $ can_lift_instances.map simp_arg_type.expr,
  prf_cond ← get_lift_prf h old_tp new_tp inst e s to_unfold,
  let prf_nm := if prf_cond.is_local_constant then some prf_cond.local_pp_name else none,
  /- We use mk_mapp to apply `can_lift.prf` to all but one argument, and then just use expr.app
  for the last argument. For some reason we get an error when applying mk_mapp it to all
  arguments. -/
  prf_ex0 ← mk_mapp `can_lift.prf [old_tp, new_tp, inst, e],
  let prf_ex := prf_ex0 prf_cond,
  /- Find the name of the new variable -/
  new_nm ← if n ≠ [] then return n.head
    else if e.is_local_constant then return e.local_pp_name
    else get_unused_name,
  /- Find the name of the proof of the equation -/
  eq_nm ← if hn : 1 < n.length then return (n.nth_le 1 hn)
    else if e.is_local_constant then return `rfl
    else get_unused_name `h,
  /- We add the proof of the existential statement to the context and then apply
  `dsimp` to it, unfolding all `can_lift` instances. -/
  temp_nm ← get_unused_name,
  temp_e ← note temp_nm none prf_ex,
  dsimp_hyp temp_e s to_unfold {},
  /- We case on the existential. We use `rcases` because `eq_nm` could be `rfl`. -/
  rcases none (pexpr.of_expr temp_e) $ rcases_patt.tuple ([new_nm, eq_nm].map rcases_patt.one),
  /- If the lifted variable is not a local constant,
    try to rewrite it away using the new equality. -/
  when (¬ e.is_local_constant) (get_local eq_nm >>=
    λ e, interactive.rw ⟨[⟨⟨0, 0⟩, tt, (pexpr.of_expr e)⟩], none⟩ interactive.loc.wildcard),
  /- If the proof `prf_cond` is a local constant, remove it from the context,
    unless `n` specifies to keep it. -/
  if h_prf_nm : prf_nm.is_some ∧ n.nth 2 ≠ prf_nm then
    get_local (option.get h_prf_nm.1) >>= clear else skip

setup_tactic_parser

/-- Parses an optional token "using" followed by a trailing `pexpr`. -/
meta def using_texpr := (tk "using" *> texpr)?

/-- Parses a token "to" followed by a trailing `pexpr`. -/
meta def to_texpr := (tk "to" *> texpr)

namespace interactive

/--
Lift an expression to another type.
* Usage: `'lift' expr 'to' expr ('using' expr)? ('with' id (id id?)?)?`.
* If `n : ℤ` and `hn : n ≥ 0` then the tactic `lift n to ℕ using hn` creates a new
  constant of type `ℕ`, also named `n` and replaces all occurrences of the old variable `(n : ℤ)`
  with `↑n` (where `n` in the new variable). It will remove `n` and `hn` from the context.
  + So for example the tactic `lift n to ℕ using hn` transforms the goal
    `n : ℤ, hn : n ≥ 0, h : P n ⊢ n = 3` to `n : ℕ, h : P ↑n ⊢ ↑n = 3`
    (here `P` is some term of type `ℤ → Prop`).
* The argument `using hn` is optional, the tactic `lift n to ℕ` does the same, but also creates a
  new subgoal that `n ≥ 0` (where `n` is the old variable).
  + So for example the tactic `lift n to ℕ` transforms the goal
    `n : ℤ, h : P n ⊢ n = 3` to two goals
    `n : ℕ, h : P ↑n ⊢ ↑n = 3` and `n : ℤ, h : P n ⊢ n ≥ 0`.
* You can also use `lift n to ℕ using e` where `e` is any expression of type `n ≥ 0`.
* Use `lift n to ℕ with k` to specify the name of the new variable.
* Use `lift n to ℕ with k hk` to also specify the name of the equality `↑k = n`. In this case, `n`
  will remain in the context. You can use `rfl` for the name of `hk` to substitute `n` away
  (i.e. the default behavior).
* You can also use `lift e to ℕ with k hk` where `e` is any expression of type `ℤ`.
  In this case, the `hk` will always stay in the context, but it will be used to rewrite `e` in
  all hypotheses and the target.
  + So for example the tactic `lift n + 3 to ℕ using hn with k hk` transforms the goal
    `n : ℤ, hn : n + 3 ≥ 0, h : P (n + 3) ⊢ n + 3 = 2 * n` to the goal
    `n : ℤ, k : ℕ, hk : ↑k = n + 3, h : P ↑k ⊢ ↑k = 2 * n`.
* The tactic `lift n to ℕ using h` will remove `h` from the context. If you want to keep it,
  specify it again as the third argument to `with`, like this: `lift n to ℕ using h with n rfl h`.
* More generally, this can lift an expression from `α` to `β` assuming that there is an instance
  of `can_lift α β`. In this case the proof obligation is specified by `can_lift.cond`.
* Given an instance `can_lift β γ`, it can also lift `α → β` to `α → γ`; more generally, given
  `β : Π a : α, Type*`, `γ : Π a : α, Type*`, and `[Π a : α, can_lift (β a) (γ a)]`, it
  automatically generates an instance `can_lift (Π a, β a) (Π a, γ a)`.

`lift` is in some sense dual to the `zify` tactic. `lift (z : ℤ) to ℕ` will change the type of an
integer `z` (in the supertype) to `ℕ` (the subtype), given a proof that `z ≥ 0`;
propositions concerning `z` will still be over `ℤ`. `zify` changes propositions about `ℕ` (the
subtype) to propositions about `ℤ` (the supertype), without changing the type of any variable.
-/
meta def lift (p : parse texpr) (t : parse to_texpr) (h : parse using_texpr)
  (n : parse with_ident_list) : tactic unit :=
tactic.lift p t h n

add_tactic_doc
{ name       := "lift",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.lift],
  tags       := ["coercions"] }

end interactive
end tactic


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Scott Morrison
import .braided_monoidal_category
import categories.universal.instances
import categories.types
import categories.universal.types

open categories
open categories.functor
open categories.products
open categories.natural_transformation
open categories.monoidal_category
open categories.universal

namespace categories.monoidal_category

universes u v
variables {C : Type u} [category.{u v} C] [has_BinaryProducts.{u v} C] {W X Y Z : C}

@[reducible,applicable] definition left_associated_triple_Product_projection_1 : (binary_product (binary_product.{u v} X Y).product Z).product ⟶ X :=
  (BinaryProduct.left_projection _) ≫ (BinaryProduct.left_projection _)
@[reducible,applicable] definition left_associated_triple_Product_projection_2 : (binary_product (binary_product.{u v} X Y).product Z).product ⟶ Y :=
  (BinaryProduct.left_projection _) ≫ (BinaryProduct.right_projection _)
@[reducible,applicable] definition right_associated_triple_Product_projection_2 : (binary_product X (binary_product.{u v} Y Z).product).product ⟶ Y :=
  (BinaryProduct.right_projection _) ≫ (BinaryProduct.left_projection _)
@[reducible,applicable] definition right_associated_triple_Product_projection_3 : (binary_product X (binary_product.{u v} Y Z).product).product ⟶ Z :=
  (BinaryProduct.right_projection _) ≫ (BinaryProduct.right_projection _)

@[simp] lemma left_factorisation_associated_1 (h : W ⟶ Z) (f : Z ⟶ X ) (g : Z ⟶ Y) : (h ≫ ((binary_product.{u v} X Y).map f g)) ≫ (binary_product X Y).left_projection = h ≫ f := by obviously
@[simp] lemma left_factorisation_associated_2 (h : X ⟶ W) (f : Z ⟶ X ) (g : Z ⟶ Y) : ((binary_product.{u v} X Y).map f g) ≫ ((binary_product X Y).left_projection ≫ h) = f ≫ h := by obviously
@[simp] lemma right_factorisation_associated_1 (h : W ⟶ Z) (f : Z ⟶ X ) (g : Z ⟶ Y) : (h ≫ ((binary_product.{u v} X Y).map f g)) ≫ (binary_product X Y).right_projection = h ≫ g := by obviously
@[simp] lemma right_factorisation_associated_2 (h : Y ⟶ W) (f : Z ⟶ X ) (g : Z ⟶ Y) : ((binary_product.{u v} X Y).map f g) ≫ ((binary_product X Y).right_projection ≫ h) = g ≫ h := by obviously

definition TensorProduct_from_Products (C : Type u) [category.{u v} C] [has_BinaryProducts.{u v} C] : TensorProduct C :=
{ onObjects     := λ p, (binary_product.{u v} p.1 p.2).product,
  onMorphisms   := λ X Y f, ((binary_product Y.1 Y.2).map
                                ((binary_product X.1 X.2).left_projection ≫ (f.1))
                                ((binary_product X.1 X.2).right_projection ≫ (f.2))) }

local attribute [simp] category.associativity

definition Associator_for_Products : Associator (TensorProduct_from_Products C) := by tidy

definition LeftUnitor_for_Products [has_TerminalObject C] : LeftUnitor terminal_object (TensorProduct_from_Products C) := by tidy

definition RightUnitor_for_Products [has_TerminalObject C] : RightUnitor terminal_object (TensorProduct_from_Products C) := by tidy

instance MonoidalStructure_from_Products (C : Type u) [category.{u v} C] [has_TerminalObject C] [has_BinaryProducts.{u v} C] : monoidal_category.{u v} C :=
{ tensor := TensorProduct_from_Products C,
  tensor_unit := terminal_object,
  associator_transformation   := Associator_for_Products C,
  left_unitor_transformation  := LeftUnitor_for_Products C,
  right_unitor_transformation := RightUnitor_for_Products C,
  pentagon := by obviously,
  triangle := by obviously }

open categories.braided_monoidal_category

definition Symmetry_on_MonoidalStructure_from_Products (C : Type u) [category.{u v} C] [has_TerminalObject C] [has_BinaryProducts.{u v} C] : Symmetry (MonoidalStructure_from_Products C) := by tidy
open categories.types

private definition symmetry_on_types := (Symmetry_on_MonoidalStructure_from_Products CategoryOfTypes).braiding.morphism.components

private example : symmetry_on_types (ℕ, bool) (3, ff) == (ff, 3) := by obviously

end categories.monoidal_category


import algebra.homology.homological_complex

noncomputable theory

open category_theory category_theory.category category_theory.limits

variables (C : Type*) [category C] [preadditive C]

namespace homological_complex

section

variables {C} {ι : Type*} {c : complex_shape ι}

def X_iso_of_eq (K : homological_complex C c) {n n' : ι} (h : n = n') :
  K.X n ≅ K.X n' :=
eq_to_iso (by congr')

@[simp]
lemma X_iso_of_eq_refl (K : homological_complex C c) (n : ι) :
  K.X_iso_of_eq (rfl : n = n) = iso.refl _ :=
begin
  dsimp only [X_iso_of_eq],
  simp,
end

@[simp, reassoc]
lemma X_iso_of_eq_hom_comp_d (K : homological_complex C c) {n n' : ι} (h : n = n') (n'' : ι) :
  (K.X_iso_of_eq h).hom ≫ K.d n' n'' = K.d n n'' :=
by { subst h, simp, }

@[simp, reassoc]
lemma X_iso_of_eq_inv_comp_d (K : homological_complex C c) {n n' : ι} (h : n = n') (n'' : ι) :
  (K.X_iso_of_eq h).inv ≫ K.d n n'' = K.d n' n'' :=
by { subst h, simp, }

@[simp, reassoc]
lemma d_comp_X_iso_of_eq_hom (K : homological_complex C c) (n : ι) {n' n'' : ι} (h : n' = n'') :
  K.d n n' ≫ (K.X_iso_of_eq h).hom = K.d n n'' :=
by { subst h, simp, }

@[simp, reassoc]
lemma d_comp_X_iso_of_eq_inv (K : homological_complex C c) (n : ι) {n' n'' : ι} (h : n' = n'') :
  K.d n n'' ≫ (K.X_iso_of_eq h).inv = K.d n n' :=
by { subst h, simp, }

@[reassoc]
lemma X_iso_of_eq_hom_naturality {K L : homological_complex C c} (φ : K ⟶ L) {n n' : ι}
  (h : n = n') :
  φ.f n ≫ (L.X_iso_of_eq h).hom = (K.X_iso_of_eq h).hom ≫ φ.f n' :=
by { subst h, simp, }

@[reassoc]
lemma X_iso_of_eq_inv_naturality {K L : homological_complex C c} (φ : K ⟶ L) {n n' : ι}
  (h : n = n') :
  φ.f n' ≫ (L.X_iso_of_eq h).inv = (K.X_iso_of_eq h).inv ≫ φ.f n :=
by { subst h, simp, }

@[simp, reassoc]
lemma X_iso_of_eq_hom_hom (K : homological_complex C c) {n n' n'' : ι} (h : n = n') (h' : n' = n'') :
  (K.X_iso_of_eq h).hom ≫ (K.X_iso_of_eq h').hom = (K.X_iso_of_eq (h.trans h')).hom :=
by { substs h h', simp, }

@[simp, reassoc]
lemma X_iso_of_eq_hom_inv (K : homological_complex C c) {n n' n'' : ι} (h : n = n') (h' : n'' = n') :
  (K.X_iso_of_eq h).hom ≫ (K.X_iso_of_eq h').inv = (K.X_iso_of_eq (h.trans h'.symm)).hom :=
by { substs h h', simp, }

@[simp, reassoc]
lemma X_iso_of_eq_inv_hom (K : homological_complex C c) {n n' n'' : ι} (h : n' = n) (h' : n' = n'') :
  (K.X_iso_of_eq h).inv ≫ (K.X_iso_of_eq h').hom = (K.X_iso_of_eq (h.symm.trans h')).hom :=
by { substs h h', simp, }

@[simp, reassoc]
lemma X_iso_of_eq_inv_inv (K : homological_complex C c) {n n' n'' : ι} (h : n' = n) (h' : n'' = n') :
  (K.X_iso_of_eq h).inv ≫ (K.X_iso_of_eq h').inv = (K.X_iso_of_eq (h'.trans h)).inv :=
by { substs h h', simp, }

end

end homological_complex


import morphisms.valuative_criterion
import morphisms.quasi_finite
import for_mathlib.pullback_mono

/-!

# Summary of this repository

-/

namespace algebraic_geometry

open _root_.category_theory.morphism_property morphism_property (topologically)

open _root_.category_theory (is_iso)

open function (injective surjective bijective)

open Top.presheaf (is_locally_surjective)

/- QoL definitions -/

universe u

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

local infix (name := impl) `⇒`      := @has_le.le (category_theory.morphism_property Scheme) _
local infix (name := and) `+`        := @has_inf.inf (category_theory.morphism_property Scheme) _

local notation `@is_iso`             := @category_theory.is_iso Scheme _
local notation `@mono`               := @category_theory.mono Scheme _
local notation `is_local_at_target`  := property_is_local_at_target
local notation `is_local_at_source`  := property_is_local_at_source
local notation `ring_hom.surjective` := λ R S _ _ f, function.surjective f
local notation `ring_hom.integral`   := λ R S _ _ f, by exactI ring_hom.is_integral f
local notation `qcqs`                := @quasi_compact + @quasi_separated

def Scheme.has_coe_to_sort : has_coe_to_sort Scheme Type* := ⟨λ X, X.carrier⟩
def Scheme.has_coe_to_fun : has_coe_to_fun (X ⟶ Y) (λ _, X.carrier → Y.carrier) := ⟨λ f, f.1.base⟩
local attribute [reducible, instance] Scheme.has_coe_to_sort Scheme.has_coe_to_fun

noncomputable
abbreviation Scheme.hom.stalk_map {X Y : Scheme} (f : X ⟶ Y) := PresheafedSpace.stalk_map f.1

meta def show_impl := `[intros X Y f hf, exactI infer_instance]

/- end QoL definitions -/

/-! # Isomorphisms -/

example : is_iso f ↔ is_iso f.1.base ∧ ∀ x, category_theory.is_iso (f.stalk_map x)                  := is_iso_iff_stalk

example : is_local_at_target       @is_iso := is_iso_is_local_at_target
example : stable_under_composition @is_iso := λ _ _ _ f g _ _, by exactI infer_instance
example : stable_under_base_change @is_iso := λ _ _ _ _ _ _ _ _ H _, by exactI H.is_iso_right

/-! # Monomorphisms -/

example : @mono = diagonal @is_iso := mono_eq_diagonal

example : is_local_at_target       @mono := mono_is_local_at_target
example : stable_under_composition @mono := λ _ _ _ f g _ _, by exactI category_theory.mono_comp f g
example : stable_under_base_change @mono := λ _ _ _ _ _ _ _ _ H _, by exactI H.mono_right

example : @is_iso                 ⇒ @mono := by show_impl
example : @is_open_immersion      ⇒ @mono := by show_impl
example : @is_preimmersion        ⇒ @mono := by show_impl
example : @is_immersion           ⇒ @mono := by show_impl
example : @is_closed_immersion    ⇒ @mono := by show_impl

/-! # Surjective morphisms -/

example : is_local_at_target       @surjective := surjective_is_local_at_target
example : stable_under_composition @surjective := surjective_stable_under_composition
example : stable_under_base_change @surjective := surjective_stable_under_base_change

example : @is_iso                 ⇒ @surjective := by show_impl

/-! # Radicial morphisms -/

/-!
```lean
class radicial (f : X ⟶ Y) : Prop :=
(base_injective [] : function.injective f.1.base)
(residue_radicial [] : ∀ x, ring_hom.is_radicial (f.map_residue_field x))
```

Disclaimer: radicial extensions are defined to be epimorphisms in the category of fields,
since we do not have results on purely inseparable extensions yet.
-/
example : @radicial = diagonal @surjective                                                          := radicial_eq_diagonal_surjective
example : @radicial = universally morphism_property.injective                                       := radicial_eq_univerally_injective

example : is_local_at_target       @radicial := radicial_is_local_at_target
example : stable_under_composition @radicial := radicial_stable_under_composition
example : stable_under_base_change @radicial := radicial_stable_under_base_change

example : @is_iso                 ⇒ @radicial := by show_impl
example : @mono                   ⇒ @radicial := by show_impl
example : @is_open_immersion      ⇒ @radicial := by show_impl
example : @is_preimmersion        ⇒ @radicial := by show_impl
example : @is_immersion           ⇒ @radicial := by show_impl
example : @is_closed_immersion    ⇒ @radicial := by show_impl

/-! # Quasi-compact morphisms -/

/-!
```lean
class quasi_compact (f : X ⟶ Y) : Prop :=
(is_compact_preimage : ∀ U : set Y.carrier, is_open U → is_compact U → is_compact (f.1.base ⁻¹' U))
```
-/
example : @quasi_compact = target_affine_locally (λ X Y f _, compact_space X)                       := quasi_compact_eq_affine_property

example : is_local_at_target       @quasi_compact := quasi_compact.is_local_at_target
example : stable_under_composition @quasi_compact := quasi_compact_stable_under_composition
example : stable_under_base_change @quasi_compact := quasi_compact_stable_under_base_change

example : @is_iso                 ⇒ @quasi_compact := by show_impl
example : @affine                 ⇒ @quasi_compact := by show_impl
example : @is_closed_immersion    ⇒ @quasi_compact := by show_impl
example : @integral               ⇒ @quasi_compact := by show_impl
example : @finite                 ⇒ @quasi_compact := by show_impl
example : @universally_closed     ⇒ @quasi_compact := by show_impl
example : @proper                 ⇒ @quasi_compact := by show_impl

example [quasi_compact (f ≫ g)] [quasi_separated g] : quasi_compact f := quasi_compact_of_comp f g
example [quasi_compact (f ≫ g)] [surjective f] : quasi_compact g := quasi_compact_of_comp_surjective f g

/-! # Quasi-separated morphisms -/

/-!
```lean
class quasi_separated (f : X ⟶ Y) : Prop :=
(diagonal_quasi_compact : quasi_compact (pullback.diagonal f))
```
-/
example : @quasi_separated = diagonal @quasi_compact                                                := quasi_separated_eq_diagonal_is_quasi_compact
example : @quasi_separated = target_affine_locally (λ X Y f _, quasi_separated_space X)             := quasi_separated_eq_affine_property

example : is_local_at_target       @quasi_separated := quasi_separated.is_local_at_target
example : stable_under_composition @quasi_separated := quasi_separated_stable_under_composition
example : stable_under_base_change @quasi_separated := quasi_separated_stable_under_base_change

example : @is_iso                 ⇒ @quasi_separated := by show_impl
example : @mono                   ⇒ @quasi_separated := by show_impl
example : @radicial               ⇒ @quasi_separated := by show_impl
example : @affine                 ⇒ @quasi_separated := by show_impl
example : @is_open_immersion      ⇒ @quasi_separated := by show_impl
example : @is_preimmersion        ⇒ @quasi_separated := by show_impl
example : @is_immersion           ⇒ @quasi_separated := by show_impl
example : @is_closed_immersion    ⇒ @quasi_separated := by show_impl
example : @separated              ⇒ @quasi_separated := by show_impl
example : @integral               ⇒ @quasi_separated := by show_impl
example : @finite                 ⇒ @quasi_separated := by show_impl
example : @proper                 ⇒ @quasi_separated := by show_impl

example [quasi_separated (f ≫ g)] : quasi_separated f := quasi_separated_of_comp f g

/-! # Affine morphisms -/

/-!
```lean
class affine (f : X ⟶ Y) : Prop :=
(is_affine_preimage : ∀ U : opens Y.carrier,
  is_affine_open U → is_affine_open ((opens.map f.1.base).obj U))
```
-/
example : @affine = target_affine_locally (λ X Y f _, is_affine X)                                  := affine_eq_affine_property

example : is_local_at_target       @affine := affine_is_local_at_target
example : stable_under_composition @affine := affine_stable_under_composition
example : stable_under_base_change @affine := affine_stable_under_base_change

example : @is_iso                 ⇒ @affine := by show_impl
example : @is_closed_immersion    ⇒ @affine := by show_impl
example : @integral               ⇒ @affine := by show_impl
example : @finite                 ⇒ @affine := by show_impl

/-! # Open immersions -/

/-!
```lean
class is_open_immersion (f : X ⟶ Y) : Prop :=
(base_open : open_embedding f)
(c_iso : ∀ U : opens X, is_iso (f.c.app (op (base_open.is_open_map.functor.obj U))))
```

Disclaimer: It is actually defined on all morphsms between presheaved spaces instead, but it is
definitionally equal to the above for Schemes.
-/
example : is_open_immersion f ↔ open_embedding f ∧ ∀ x, is_iso (f.stalk_map x)                     := is_open_immersion_iff_stalk

example : is_local_at_target       @is_open_immersion := is_open_immersion_is_local_at_target
example : stable_under_composition @is_open_immersion := is_open_immersion_stable_under_composition
example : stable_under_base_change @is_open_immersion := is_open_immersion_stable_under_base_change

example : @is_iso                 ⇒ @is_open_immersion := by show_impl

/-! # Preimmersions -/

/-!
```lean
class is_preimmersion (f : X ⟶ Y) : Prop :=
(base_embedding [] : embedding f.1.base)
(stalk_map_surjective [] : ∀ x, function.surjective (f.stalk_map x))
```
-/
example : is_local_at_target       @is_preimmersion := is_preimmersion_is_local_at_target
example : stable_under_composition @is_preimmersion := is_preimmersion_stable_under_composition
example : stable_under_base_change @is_preimmersion := is_preimmersion_stable_under_base_change

example : @is_iso                 ⇒ @is_preimmersion := by show_impl
example : @is_open_immersion      ⇒ @is_preimmersion := by show_impl
example : @is_closed_immersion    ⇒ @is_preimmersion := by show_impl
example : @is_immersion           ⇒ @is_preimmersion := by show_impl

/-! # Immersions -/

/-!
```lean
class is_immersion (f : X ⟶ Y) extends is_preimmersion f : Prop :=
(range_is_locally_closed [] : is_locally_closed (set.range f.1.base))
```

This is different but equivalent to the usual definition. See the example below
-/
example : is_immersion f ↔
  ∃ Z (g : X ⟶ Z) [is_closed_immersion g] (h : Z ⟶ Y) [is_open_immersion h], g ≫ h = f :=
is_immersion_iff_exists_factor f

example : is_local_at_target       @is_immersion := is_immersion_is_local_at_target
example : stable_under_composition @is_immersion := is_immersion_stable_under_composition
example : stable_under_base_change @is_immersion := is_immersion_stable_under_base_change

example : @is_iso                 ⇒ @is_immersion := by show_impl
example : @is_open_immersion      ⇒ @is_immersion := by show_impl
example : @is_closed_immersion    ⇒ @is_immersion := by show_impl

/-! # Closed immersions -/

/-!
```lean
class is_closed_immersion (f : X ⟶ Y) extends is_preimmersion f : Prop :=
(range_is_closed [] : is_closed (set.range f.1.base))
```
-/

example : is_closed_immersion f ↔ closed_embedding f.1.base ∧ is_locally_surjective f.1.c           := is_closed_immersion_iff_closed_embedding_and_locally_surjective
example : @is_closed_immersion = target_affine_locally (affine_and ring_hom.surjective)             := is_closed_immersion_eq_affine_property
example : @is_closed_immersion = @finite + @mono                                                    := is_closed_immersion_eq_finite_inf_mono

example : is_local_at_target       @is_closed_immersion := is_closed_immersion_is_local_at_target
example : stable_under_composition @is_closed_immersion := is_closed_immersion_stable_under_composition
example : stable_under_base_change @is_closed_immersion := is_closed_immersion_stable_under_base_change

example : @is_iso                 ⇒ @is_closed_immersion := by show_impl

/-! # Separated morphisms -/

/-!
```lean
class separated (f : X ⟶ Y) : Prop :=
(diagonal_is_closed_immersion : is_closed_immersion (pullback.diagonal f))
```
-/
example : @separated = target_affine_locally (λ X Y f _, is_separated X)                            := separated_eq_affine_property
example : @separated = @quasi_separated + valuative_criterion.uniqueness                            := separated_eq_valuative_criterion

example : is_local_at_target       @separated := separated.is_local_at_target
example : stable_under_composition @separated := separated_stable_under_composition
example : stable_under_base_change @separated := separated_stable_under_base_change

example : @is_iso                 ⇒ @separated := by show_impl
example : @mono                   ⇒ @separated := by show_impl
example : @radicial               ⇒ @separated := by show_impl
example : @affine                 ⇒ @separated := by show_impl
example : @is_open_immersion      ⇒ @separated := by show_impl
example : @is_preimmersion        ⇒ @separated := by show_impl
example : @is_immersion           ⇒ @separated := by show_impl
example : @is_closed_immersion    ⇒ @separated := by show_impl
example : @integral               ⇒ @separated := by show_impl
example : @finite                 ⇒ @separated := by show_impl
example : @proper                 ⇒ @separated := by show_impl

/-! # Locally of finite type morphisms -/

/-!
```lean
class locally_of_finite_type (f : X ⟶ Y) : Prop :=
(finite_type_of_affine_subset :
  ∀ (U : Y.affine_opens) (V : X.affine_opens) (e : V.1 ≤ (opens.map f.1.base).obj U.1),
  (f.app_le e).finite_type)
```
-/
example : @locally_of_finite_type = affine_locally @ring_hom.finite_type                            := locally_of_finite_type_eq

example : is_local_at_source       @locally_of_finite_type := locally_of_finite_type_is_local_at_source
example : is_local_at_target       @locally_of_finite_type := locally_of_finite_type_is_local_at_target
example : stable_under_composition @locally_of_finite_type := locally_of_finite_type_stable_under_composition
example : stable_under_base_change @locally_of_finite_type := locally_of_finite_type_stable_under_base_change

example : @is_iso                 ⇒ @locally_of_finite_type := by show_impl
example : @is_open_immersion      ⇒ @locally_of_finite_type := by show_impl
example : @is_closed_immersion    ⇒ @locally_of_finite_type := by show_impl
example : @is_immersion           ⇒ @locally_of_finite_type := by show_impl
example : @finite                 ⇒ @locally_of_finite_type := by show_impl
example : @locally_quasi_finite   ⇒ @locally_of_finite_type := by show_impl
example : @proper                 ⇒ @locally_of_finite_type := by show_impl

example [locally_of_finite_type (f ≫ g)] : locally_of_finite_type f := locally_of_finite_type_of_comp f g

/-! # Integral morphisms -/

/-!
```lean
class integral (f : X ⟶ Y) extends affine f : Prop :=
(is_integral_of_affine [] :
  ∀ U : opens Y.carrier, is_affine_open U → (f.1.c.app (op U)).is_integral)
```
-/
example : @integral = target_affine_locally (affine_and ring_hom.integral)                          := integral_eq_affine_property
example : @integral = @affine + @universally_closed                                                 := integral_eq_affine_inf_universally_closed

example : is_local_at_target       @integral := integral_is_local_at_target
example : stable_under_composition @integral := integral_stable_under_composition
example : stable_under_base_change @integral := integral_stable_under_base_change

example : @is_iso                 ⇒ @integral := by show_impl
example : @is_closed_immersion    ⇒ @integral := by show_impl
example : @finite                 ⇒ @integral := by show_impl

/-! # Finite morphisms -/

/-!
```lean
class finite (f : X ⟶ Y) extends affine f : Prop :=
(is_finite_of_affine : ∀ U : opens Y.carrier, is_affine_open U → (f.1.c.app (op U)).finite)
```
-/
example : @finite = target_affine_locally (affine_and @ring_hom.finite)                             := finite_eq_affine_property
example : @finite = @proper + @affine                                                               := finite_eq_proper_inf_affine
example : @finite = @integral + @locally_of_finite_type                                             := finite_eq_integral_inf_locally_of_finite_type

example : is_local_at_target       @finite := finite_is_local_at_target
example : stable_under_composition @finite := finite_stable_under_composition
example : stable_under_base_change @finite := finite_stable_under_base_change

example : @is_iso                 ⇒ @finite := by show_impl
example : @is_closed_immersion    ⇒ @finite := by show_impl

/-! # Locally quasi-finite morphisms -/

/-!
```lean
def Scheme.hom.quasi_finite_at (x : X.carrier) : Prop :=
𝓝[f.1.base ⁻¹' {f.1.base x} \ {x}] x = ⊥

class locally_quasi_finite extends locally_of_finite_type f : Prop :=
(quasi_finite_at : ∀ x, f.quasi_finite_at x)
```
-/

example : is_local_at_source       @locally_quasi_finite := locally_quasi_finite_is_local_at_source
example : is_local_at_target       @locally_quasi_finite := locally_quasi_finite_is_local_at_target
example : stable_under_composition @locally_quasi_finite := locally_quasi_finite_stable_under_composition
example : stable_under_base_change @locally_quasi_finite := locally_quasi_finite_stable_under_base_change

example : @is_iso                 ⇒ @locally_quasi_finite := by show_impl
example : @is_open_immersion      ⇒ @locally_quasi_finite := by show_impl
example : @is_immersion           ⇒ @locally_quasi_finite := by show_impl
example : @is_closed_immersion    ⇒ @locally_quasi_finite := by show_impl
example : @finite                 ⇒ @locally_quasi_finite := by show_impl

example [locally_quasi_finite (f ≫ g)] : locally_quasi_finite f := locally_quasi_finite_of_comp f g ‹_›

/-! # Universally specializing morphisms -/

/-!
This is only for the valuative criterion.
-/
example : valuative_criterion.existence = universally (topologically @specializing_map)             := valuative_criterion.existence_eq

/-! # Universally closed morphisms -/

/-!
```lean
class universally_closed (f : X ⟶ Y) : Prop :=
(out : universally (topologically @is_closed_map) f)
```
-/
example : @universally_closed = universally (topologically @is_closed_map)                          := universally_closed_eq
example : @universally_closed = @quasi_compact + universally (topologically @specializing_map)      := universally_closed_eq_quasi_compact_and_universally_specializing
example : @universally_closed = @quasi_compact + valuative_criterion.existence                      := universally_closed_eq_valuative_criterion

example : is_local_at_target       @universally_closed := universally_closed_is_local_at_target
example : stable_under_composition @universally_closed := universally_closed_stable_under_composition
example : stable_under_base_change @universally_closed := universally_closed_stable_under_base_change

example : @is_iso                 ⇒ @universally_closed := by show_impl
example : @is_closed_immersion    ⇒ @universally_closed := by show_impl
example : @integral               ⇒ @universally_closed := by show_impl
example : @finite                 ⇒ @universally_closed := by show_impl
example : @proper                 ⇒ @universally_closed := by show_impl

/-! # Proper morphisms -/

/-!
```lean
class proper extends separated f, universally_closed f, locally_of_finite_type f : Prop.
```
-/
example : @proper = @separated + @universally_closed + @locally_of_finite_type                      := proper_eq
example : @proper = qcqs + @locally_of_finite_type + valuative_criterion                            := proper_eq_valuative_criterion

example : is_local_at_target       @proper := proper_is_local_at_target
example : stable_under_composition @proper := proper_stable_under_composition
example : stable_under_base_change @proper := proper_stable_under_base_change

example : @is_iso                 ⇒ @proper := by show_impl
example : @is_closed_immersion    ⇒ @proper := by show_impl
example : @finite                 ⇒ @proper := by show_impl

end algebraic_geometry