import Preloaded set_theory.cardinal

noncomputable theorem mathlib_example : ℕ ≃ ℤ :=
  by apply classical.choice; rw [← cardinal.eq,
  cardinal.mk_nat, cardinal.mk_int]


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.algebra.subalgebra.basic
import algebra.free_algebra
import algebra.category.Ring.basic
import algebra.category.Module.basic

/-!
# Category instance for algebras over a commutative ring

We introduce the bundled category `Algebra` of algebras over a fixed commutative ring `R ` along
with the forgetful functors to `Ring` and `Module`. We furthermore show that the functor associating
to a type the free `R`-algebra on that type is left adjoint to the forgetful functor.
-/

open category_theory
open category_theory.limits

universes v u

variables (R : Type u) [comm_ring R]

/-- The category of R-algebras and their morphisms. -/
structure Algebra :=
(carrier : Type v)
[is_ring : ring carrier]
[is_algebra : algebra R carrier]

attribute [instance] Algebra.is_ring Algebra.is_algebra

namespace Algebra

instance : has_coe_to_sort (Algebra R) (Type v) := ⟨Algebra.carrier⟩

instance : category (Algebra.{v} R) :=
{ hom   := λ A B, A →ₐ[R] B,
  id    := λ A, alg_hom.id R A,
  comp  := λ A B C f g, g.comp f }

instance : concrete_category.{v} (Algebra.{v} R) :=
{ forget := { obj := λ R, R, map := λ R S f, (f : R → S) },
  forget_faithful := { } }

instance has_forget_to_Ring : has_forget₂ (Algebra.{v} R) Ring.{v} :=
{ forget₂ :=
  { obj := λ A, Ring.of A,
    map := λ A₁ A₂ f, alg_hom.to_ring_hom f, } }

instance has_forget_to_Module : has_forget₂ (Algebra.{v} R) (Module.{v} R) :=
{ forget₂ :=
  { obj := λ M, Module.of R M,
    map := λ M₁ M₂ f, alg_hom.to_linear_map f, } }

/-- The object in the category of R-algebras associated to a type equipped with the appropriate
typeclasses. -/
def of (X : Type v) [ring X] [algebra R X] : Algebra.{v} R := ⟨X⟩

/-- Typecheck a `alg_hom` as a morphism in `Algebra R`. -/
def of_hom {R : Type u} [comm_ring R] {X Y : Type v} [ring X] [algebra R X] [ring Y] [algebra R Y]
  (f : X →ₐ[R] Y) : of R X ⟶ of R Y := f

@[simp] lemma of_hom_apply {R : Type u} [comm_ring R]
  {X Y : Type v} [ring X] [algebra R X] [ring Y] [algebra R Y] (f : X →ₐ[R] Y) (x : X) :
  of_hom f x = f x := rfl

instance : inhabited (Algebra R) := ⟨of R R⟩

@[simp]
lemma coe_of (X : Type u) [ring X] [algebra R X] : (of R X : Type u) = X := rfl

variables {R}

/-- Forgetting to the underlying type and then building the bundled object returns the original
algebra. -/
@[simps]
def of_self_iso (M : Algebra.{v} R) : Algebra.of R M ≅ M :=
{ hom := 𝟙 M, inv := 𝟙 M }

variables {R} {M N U : Module.{v} R}

@[simp]

@[simp] lemma coe_comp (f : M ⟶ N) (g : N ⟶ U) :
  ((f ≫ g) : M → U) = g ∘ f := rfl

variables (R)
/-- The "free algebra" functor, sending a type `S` to the free algebra on `S`. -/
@[simps]
def free : Type u ⥤ Algebra.{u} R :=
{ obj := λ S,
  { carrier := free_algebra R S,
    is_ring := algebra.semiring_to_ring R },
  map := λ S T f, free_algebra.lift _ $ (free_algebra.ι _) ∘ f,
  -- obviously can fill the next two goals, but it is slow
  map_id' := by { intros X, ext1, simp only [free_algebra.ι_comp_lift], refl },
  map_comp' := by { intros, ext1, simp only [free_algebra.ι_comp_lift], ext1,
    simp only [free_algebra.lift_ι_apply, category_theory.coe_comp, function.comp_app,
      types_comp_apply] } }

/-- The free/forget adjunction for `R`-algebras. -/
def adj : free.{u} R ⊣ forget (Algebra.{u} R) :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X A, (free_algebra.lift _).symm,
  -- Relying on `obviously` to fill out these proofs is very slow :(
  hom_equiv_naturality_left_symm' := by { intros, ext,
    simp only [free_map, equiv.symm_symm, free_algebra.lift_ι_apply, category_theory.coe_comp,
      function.comp_app, types_comp_apply] },
  hom_equiv_naturality_right' := by { intros, ext,
    simp only [forget_map_eq_coe, category_theory.coe_comp, function.comp_app,
      free_algebra.lift_symm_apply, types_comp_apply] } }

instance : is_right_adjoint (forget (Algebra.{u} R)) := ⟨_, adj R⟩

end Algebra

variables {R}
variables {X₁ X₂ : Type u}

/-- Build an isomorphism in the category `Algebra R` from a `alg_equiv` between `algebra`s. -/
@[simps]
def alg_equiv.to_Algebra_iso
  {g₁ : ring X₁} {g₂ : ring X₂} {m₁ : algebra R X₁} {m₂ : algebra R X₂} (e : X₁ ≃ₐ[R] X₂) :
  Algebra.of R X₁ ≅ Algebra.of R X₂ :=
{ hom := (e : X₁ →ₐ[R] X₂),
  inv := (e.symm : X₂ →ₐ[R] X₁),
  hom_inv_id' := begin ext, exact e.left_inv x, end,
  inv_hom_id' := begin ext, exact e.right_inv x, end, }

namespace category_theory.iso

/-- Build a `alg_equiv` from an isomorphism in the category `Algebra R`. -/
@[simps]
def to_alg_equiv {X Y : Algebra R} (i : X ≅ Y) : X ≃ₐ[R] Y :=
{ to_fun    := i.hom,
  inv_fun   := i.inv,
  left_inv  := by tidy,
  right_inv := by tidy,
  map_add'  := by tidy,
  map_mul'  := by tidy,
  commutes' := by tidy, }.

end category_theory.iso

/-- Algebra equivalences between `algebras`s are the same as (isomorphic to) isomorphisms in
`Algebra`. -/
@[simps]
def alg_equiv_iso_Algebra_iso {X Y : Type u}
  [ring X] [ring Y] [algebra R X] [algebra R Y] :
  (X ≃ₐ[R] Y) ≅ (Algebra.of R X ≅ Algebra.of R Y) :=
{ hom := λ e, e.to_Algebra_iso,
  inv := λ i, i.to_alg_equiv, }

instance (X : Type u) [ring X] [algebra R X] : has_coe (subalgebra R X) (Algebra R) :=
⟨ λ N, Algebra.of R N ⟩

instance Algebra.forget_reflects_isos : reflects_isomorphisms (forget (Algebra.{u} R)) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget (Algebra.{u} R)).map f),
    let e : X ≃ₐ[R] Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_Algebra_iso).1⟩,
  end }


/-!

==========
Hello
==========

Inspecting Lean
=================

-/
#eval Lean.versionString

#eval Lean.versionStringCore

#eval Lean.toolchain

#eval Lean.origin

#eval Lean.githash

/-!

Proofs
=======

-/
theorem test (p q : Prop) (hp : p) (hq : q): p ∧ q ↔ q ∧ p := by
  apply Iff.intro
  . intro h
    apply And.intro
    . exact hq
    . exact hp
  . intro h
    apply And.intro
    . exact hp
    . exact hq


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.functor.hom
import category_theory.functor.currying
import category_theory.products.basic

/-!
# The Yoneda embedding

The Yoneda embedding as a functor `yoneda : C ⥤ (Cᵒᵖ ⥤ Type v₁)`,
along with an instance that it is `fully_faithful`.

Also the Yoneda lemma, `yoneda_lemma : (yoneda_pairing C) ≅ (yoneda_evaluation C)`.

## References
* [Stacks: Opposite Categories and the Yoneda Lemma](https://stacks.math.columbia.edu/tag/001L)
-/

namespace category_theory
open opposite

universes v₁ u₁ u₂-- morphism levels before object levels. See note [category_theory universes].

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

/--
The Yoneda embedding, as a functor from `C` into presheaves on `C`.

See https://stacks.math.columbia.edu/tag/001O.
-/
@[simps]
def yoneda : C ⥤ (Cᵒᵖ ⥤ Type v₁) :=
{ obj := λ X,
  { obj := λ Y, unop Y ⟶ X,
    map := λ Y Y' f g, f.unop ≫ g,
    map_comp' := λ _ _ _ f g, begin ext, dsimp, erw [category.assoc] end,
    map_id' := λ Y, begin ext, dsimp, erw [category.id_comp] end },
  map := λ X X' f, { app := λ Y g, g ≫ f } }

/--
The co-Yoneda embedding, as a functor from `Cᵒᵖ` into co-presheaves on `C`.
-/
@[simps] def coyoneda : Cᵒᵖ ⥤ (C ⥤ Type v₁) :=
{ obj := λ X,
  { obj := λ Y, unop X ⟶ Y,
    map := λ Y Y' f g, g ≫ f },
  map := λ X X' f, { app := λ Y g, f.unop ≫ g } }

namespace yoneda

lemma obj_map_id {X Y : C} (f : op X ⟶ op Y) :
  (yoneda.obj X).map f (𝟙 X) = (yoneda.map f.unop).app (op Y) (𝟙 Y) :=
by { dsimp, simp }

@[simp] lemma naturality {X Y : C} (α : yoneda.obj X ⟶ yoneda.obj Y)
  {Z Z' : C} (f : Z ⟶ Z') (h : Z' ⟶ X) : f ≫ α.app (op Z') h = α.app (op Z) (f ≫ h) :=
(functor_to_types.naturality _ _ α f.op h).symm

/--
The Yoneda embedding is full.

See https://stacks.math.columbia.edu/tag/001P.
-/
instance yoneda_full : full (yoneda : C ⥤ Cᵒᵖ ⥤ Type v₁) :=
{ preimage := λ X Y f, f.app (op X) (𝟙 X) }

/--
The Yoneda embedding is faithful.

See https://stacks.math.columbia.edu/tag/001P.
-/
instance yoneda_faithful : faithful (yoneda : C ⥤ Cᵒᵖ ⥤ Type v₁) :=
{ map_injective' := λ X Y f g p, by convert (congr_fun (congr_app p (op X)) (𝟙 X)); dsimp; simp }

/-- Extensionality via Yoneda. The typical usage would be
```
-- Goal is `X ≅ Y`
apply yoneda.ext,
-- Goals are now functions `(Z ⟶ X) → (Z ⟶ Y)`, `(Z ⟶ Y) → (Z ⟶ X)`, and the fact that these
functions are inverses and natural in `Z`.
```
-/
def ext (X Y : C)
  (p : Π {Z : C}, (Z ⟶ X) → (Z ⟶ Y)) (q : Π {Z : C}, (Z ⟶ Y) → (Z ⟶ X))
  (h₁ : Π {Z : C} (f : Z ⟶ X), q (p f) = f) (h₂ : Π {Z : C} (f : Z ⟶ Y), p (q f) = f)
  (n : Π {Z Z' : C} (f : Z' ⟶ Z) (g : Z ⟶ X), p (f ≫ g) = f ≫ p g) : X ≅ Y :=
@preimage_iso _ _ _ _ yoneda _ _ _ _
  (nat_iso.of_components (λ Z, { hom := p, inv := q, }) (by tidy))

/--
If `yoneda.map f` is an isomorphism, so was `f`.
-/
lemma is_iso {X Y : C} (f : X ⟶ Y) [is_iso (yoneda.map f)] : is_iso f :=
is_iso_of_fully_faithful yoneda f

end yoneda

namespace coyoneda

@[simp] lemma naturality {X Y : Cᵒᵖ} (α : coyoneda.obj X ⟶ coyoneda.obj Y)
  {Z Z' : C} (f : Z' ⟶ Z) (h : unop X ⟶ Z') : (α.app Z' h) ≫ f = α.app Z (h ≫ f) :=
(functor_to_types.naturality _ _ α f h).symm

instance coyoneda_full : full (coyoneda : Cᵒᵖ ⥤ C ⥤ Type v₁) :=
{ preimage := λ X Y f, (f.app _ (𝟙 X.unop)).op }

instance coyoneda_faithful : faithful (coyoneda : Cᵒᵖ ⥤ C ⥤ Type v₁) :=
{ map_injective' := λ X Y f g p,
  begin
    have t := congr_fun (congr_app p X.unop) (𝟙 _),
    simpa using congr_arg quiver.hom.op t,
  end }

/--
If `coyoneda.map f` is an isomorphism, so was `f`.
-/
lemma is_iso {X Y : Cᵒᵖ} (f : X ⟶ Y) [is_iso (coyoneda.map f)] : is_iso f :=
is_iso_of_fully_faithful coyoneda f

/-- The identity functor on `Type` is isomorphic to the coyoneda functor coming from `punit`. -/
def punit_iso : coyoneda.obj (opposite.op punit) ≅ 𝟭 (Type v₁) :=
nat_iso.of_components
  (λ X, { hom := λ f, f ⟨⟩, inv := λ x _, x })
  (by tidy)

end coyoneda

namespace functor

/--
A functor `F : Cᵒᵖ ⥤ Type v₁` is representable if there is object `X` so `F ≅ yoneda.obj X`.

See https://stacks.math.columbia.edu/tag/001Q.
-/
class representable (F : Cᵒᵖ ⥤ Type v₁) : Prop :=
(has_representation : ∃ X (f : yoneda.obj X ⟶ F), is_iso f)

instance {X : C} : representable (yoneda.obj X) :=
{ has_representation := ⟨X, 𝟙 _, infer_instance⟩ }

/--
A functor `F : C ⥤ Type v₁` is corepresentable if there is object `X` so `F ≅ coyoneda.obj X`.

See https://stacks.math.columbia.edu/tag/001Q.
-/
class corepresentable (F : C ⥤ Type v₁) : Prop :=
(has_corepresentation : ∃ X (f : coyoneda.obj X ⟶ F), is_iso f)

instance {X : Cᵒᵖ} : corepresentable (coyoneda.obj X) :=
{ has_corepresentation := ⟨X, 𝟙 _, infer_instance⟩ }

-- instance : corepresentable (𝟭 (Type v₁)) :=
-- corepresentable_of_nat_iso (op punit) coyoneda.punit_iso

section representable
variables (F : Cᵒᵖ ⥤ Type v₁)
variable [F.representable]

/-- The representing object for the representable functor `F`. -/
noncomputable def repr_X : C :=
(representable.has_representation : ∃ X (f : _ ⟶ F), _).some

/-- The (forward direction of the) isomorphism witnessing `F` is representable. -/
noncomputable def repr_f : yoneda.obj F.repr_X ⟶ F :=
representable.has_representation.some_spec.some

/--
The representing element for the representable functor `F`, sometimes called the universal
element of the functor.
-/
noncomputable def repr_x : F.obj (op F.repr_X) :=
F.repr_f.app (op F.repr_X) (𝟙 F.repr_X)

instance : is_iso F.repr_f :=
representable.has_representation.some_spec.some_spec

/--
An isomorphism between `F` and a functor of the form `C(-, F.repr_X)`.  Note the components
`F.repr_w.app X` definitionally have type `(X.unop ⟶ F.repr_X) ≅ F.obj X`.
-/
noncomputable def repr_w : yoneda.obj F.repr_X ≅ F := as_iso F.repr_f

@[simp] lemma repr_w_hom : F.repr_w.hom = F.repr_f := rfl

lemma repr_w_app_hom (X : Cᵒᵖ) (f : unop X ⟶ F.repr_X) :
  (F.repr_w.app X).hom f = F.map f.op F.repr_x :=
begin
  change F.repr_f.app X f = (F.repr_f.app (op F.repr_X) ≫ F.map f.op) (𝟙 F.repr_X),
  rw ←F.repr_f.naturality,
  dsimp,
  simp
end

end representable

section corepresentable

variables (F : C ⥤ Type v₁)
variable [F.corepresentable]

/-- The representing object for the corepresentable functor `F`. -/
noncomputable def corepr_X : C :=
(corepresentable.has_corepresentation : ∃ X (f : _ ⟶ F), _).some.unop

/-- The (forward direction of the) isomorphism witnessing `F` is corepresentable. -/
noncomputable def corepr_f : coyoneda.obj (op F.corepr_X) ⟶ F :=
corepresentable.has_corepresentation.some_spec.some

/--
The representing element for the corepresentable functor `F`, sometimes called the universal
element of the functor.
-/
noncomputable def corepr_x : F.obj F.corepr_X :=
F.corepr_f.app F.corepr_X (𝟙 F.corepr_X)

instance : is_iso F.corepr_f :=
corepresentable.has_corepresentation.some_spec.some_spec

/--
An isomorphism between `F` and a functor of the form `C(F.corepr X, -)`. Note the components
`F.corepr_w.app X` definitionally have type `F.corepr_X ⟶ X ≅ F.obj X`.
-/
noncomputable def corepr_w : coyoneda.obj (op F.corepr_X) ≅ F := as_iso F.corepr_f

lemma corepr_w_app_hom (X : C) (f : F.corepr_X ⟶ X) :
  (F.corepr_w.app X).hom f = F.map f F.corepr_x :=
begin
  change F.corepr_f.app X f = (F.corepr_f.app F.corepr_X ≫ F.map f) (𝟙 F.corepr_X),
  rw ←F.corepr_f.naturality,
  dsimp,
  simp
end

end corepresentable

end functor

lemma representable_of_nat_iso (F : Cᵒᵖ ⥤ Type v₁) {G} (i : F ≅ G) [F.representable] :
  G.representable :=
{ has_representation := ⟨F.repr_X, F.repr_f ≫ i.hom, infer_instance⟩ }

lemma corepresentable_of_nat_iso (F : C ⥤ Type v₁) {G} (i : F ≅ G) [F.corepresentable] :
  G.corepresentable :=
{ has_corepresentation := ⟨op F.corepr_X, F.corepr_f ≫ i.hom, infer_instance⟩ }

instance : functor.corepresentable (𝟭 (Type v₁)) :=
corepresentable_of_nat_iso (coyoneda.obj (op punit)) coyoneda.punit_iso

open opposite

variables (C)

-- We need to help typeclass inference with some awkward universe levels here.
instance prod_category_instance_1 : category ((Cᵒᵖ ⥤ Type v₁) × Cᵒᵖ) :=
category_theory.prod.{(max u₁ v₁) v₁} (Cᵒᵖ ⥤ Type v₁) Cᵒᵖ

instance prod_category_instance_2 : category (Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) :=
category_theory.prod.{v₁ (max u₁ v₁)} Cᵒᵖ (Cᵒᵖ ⥤ Type v₁)

open yoneda

/--
The "Yoneda evaluation" functor, which sends `X : Cᵒᵖ` and `F : Cᵒᵖ ⥤ Type`
to `F.obj X`, functorially in both `X` and `F`.
-/
def yoneda_evaluation : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁) ⥤ Type (max u₁ v₁) :=
evaluation_uncurried Cᵒᵖ (Type v₁) ⋙ ulift_functor.{u₁}

@[simp] lemma yoneda_evaluation_map_down
  (P Q : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (x : (yoneda_evaluation C).obj P) :
  ((yoneda_evaluation C).map α x).down = α.2.app Q.1 (P.2.map α.1 x.down) := rfl

/--
The "Yoneda pairing" functor, which sends `X : Cᵒᵖ` and `F : Cᵒᵖ ⥤ Type`
to `yoneda.op.obj X ⟶ F`, functorially in both `X` and `F`.
-/
def yoneda_pairing : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁) ⥤ Type (max u₁ v₁) :=
functor.prod yoneda.op (𝟭 (Cᵒᵖ ⥤ Type v₁)) ⋙ functor.hom (Cᵒᵖ ⥤ Type v₁)

@[simp] lemma yoneda_pairing_map
  (P Q : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (β : (yoneda_pairing C).obj P) :
  (yoneda_pairing C).map α β = yoneda.map α.1.unop ≫ β ≫ α.2 := rfl

/--
The Yoneda lemma asserts that that the Yoneda pairing
`(X : Cᵒᵖ, F : Cᵒᵖ ⥤ Type) ↦ (yoneda.obj (unop X) ⟶ F)`
is naturally isomorphic to the evaluation `(X, F) ↦ F.obj X`.

See https://stacks.math.columbia.edu/tag/001P.
-/
def yoneda_lemma : yoneda_pairing C ≅ yoneda_evaluation C :=
{ hom :=
  { app := λ F x, ulift.up ((x.app F.1) (𝟙 (unop F.1))),
    naturality' :=
    begin
      intros X Y f, ext, dsimp,
      erw [category.id_comp, ←functor_to_types.naturality],
      simp only [category.comp_id, yoneda_obj_map],
    end },
  inv :=
  { app := λ F x,
    { app := λ X a, (F.2.map a.op) x.down,
      naturality' :=
      begin
        intros X Y f, ext, dsimp,
        rw [functor_to_types.map_comp_apply]
      end },
    naturality' :=
    begin
      intros X Y f, ext, dsimp,
      rw [←functor_to_types.naturality, functor_to_types.map_comp_apply]
    end },
  hom_inv_id' :=
  begin
    ext, dsimp,
    erw [←functor_to_types.naturality,
         obj_map_id],
    simp only [yoneda_map_app, quiver.hom.unop_op],
    erw [category.id_comp],
  end,
  inv_hom_id' :=
  begin
    ext, dsimp,
    rw [functor_to_types.map_id_apply]
  end }.

variables {C}

/--
The isomorphism between `yoneda.obj X ⟶ F` and `F.obj (op X)`
(we need to insert a `ulift` to get the universes right!)
given by the Yoneda lemma.
-/
@[simps] def yoneda_sections (X : C) (F : Cᵒᵖ ⥤ Type v₁) :
  (yoneda.obj X ⟶ F) ≅ ulift.{u₁} (F.obj (op X)) :=
(yoneda_lemma C).app (op X, F)

/--
We have a type-level equivalence between natural transformations from the yoneda embedding
and elements of `F.obj X`, without any universe switching.
-/
def yoneda_equiv {X : C} {F : Cᵒᵖ ⥤ Type v₁} : (yoneda.obj X ⟶ F) ≃ F.obj (op X) :=
(yoneda_sections X F).to_equiv.trans equiv.ulift

@[simp]
lemma yoneda_equiv_apply {X : C} {F : Cᵒᵖ ⥤ Type v₁} (f : yoneda.obj X ⟶ F) :
  yoneda_equiv f = f.app (op X) (𝟙 X) :=
rfl

@[simp]
lemma yoneda_equiv_symm_app_apply {X : C} {F : Cᵒᵖ ⥤ Type v₁} (x : F.obj (op X))
  (Y : Cᵒᵖ) (f : Y.unop ⟶ X) :
  (yoneda_equiv.symm x).app Y f = F.map f.op x :=
rfl

lemma yoneda_equiv_naturality {X Y : C} {F : Cᵒᵖ ⥤ Type v₁} (f : yoneda.obj X ⟶ F) (g : Y ⟶ X) :
  F.map g.op (yoneda_equiv f) = yoneda_equiv (yoneda.map g ≫ f) :=
begin
  change (f.app (op X) ≫ F.map g.op) (𝟙 X) = f.app (op Y) (𝟙 Y ≫ g),
  rw ←f.naturality,
  dsimp,
  simp,
end

/--
When `C` is a small category, we can restate the isomorphism from `yoneda_sections`
without having to change universes.
-/
def yoneda_sections_small {C : Type u₁} [small_category C] (X : C)
  (F : Cᵒᵖ ⥤ Type u₁) :
  (yoneda.obj X ⟶ F) ≅ F.obj (op X) :=
yoneda_sections X F ≪≫ ulift_trivial _

@[simp]
lemma yoneda_sections_small_hom {C : Type u₁} [small_category C] (X : C)
  (F : Cᵒᵖ ⥤ Type u₁) (f : yoneda.obj X ⟶ F) :
  (yoneda_sections_small X F).hom f = f.app _ (𝟙 _) :=
rfl

@[simp]
lemma yoneda_sections_small_inv_app_apply {C : Type u₁} [small_category C] (X : C)
  (F : Cᵒᵖ ⥤ Type u₁) (t : F.obj (op X)) (Y : Cᵒᵖ) (f : Y.unop ⟶ X) :
  ((yoneda_sections_small X F).inv t).app Y f = F.map f.op t :=
rfl

local attribute[ext] functor.ext

/-- The curried version of yoneda lemma when `C` is small. -/
def curried_yoneda_lemma {C : Type u₁} [small_category C] :
  (yoneda.op ⋙ coyoneda : Cᵒᵖ ⥤ (Cᵒᵖ ⥤ Type u₁) ⥤ Type u₁) ≅ evaluation Cᵒᵖ (Type u₁) :=
eq_to_iso (by tidy) ≪≫ curry.map_iso (yoneda_lemma C ≪≫
  iso_whisker_left (evaluation_uncurried Cᵒᵖ (Type u₁)) ulift_functor_trivial) ≪≫
    eq_to_iso (by tidy)

/-- The curried version of yoneda lemma when `C` is small. -/
def curried_yoneda_lemma' {C : Type u₁} [small_category C] :
  yoneda ⋙ (whiskering_left Cᵒᵖ (Cᵒᵖ ⥤ Type u₁)ᵒᵖ (Type u₁)).obj yoneda.op ≅ 𝟭 (Cᵒᵖ ⥤ Type u₁) :=
eq_to_iso (by tidy) ≪≫ curry.map_iso (iso_whisker_left (prod.swap _ _)
  (yoneda_lemma C ≪≫ iso_whisker_left
    (evaluation_uncurried Cᵒᵖ (Type u₁)) ulift_functor_trivial : _)) ≪≫ eq_to_iso (by tidy)

end category_theory


variable x : int
example : x=x :=
begin
trivial
end

#check 2
#check x
#check (2:int)
#check int
#check Type
#check Type 1

#check 2
#check ℕ
#check Type
#check Type 1
#check Type 2
#check Type 3


import category_theory.preadditive.additive_functor

import for_mathlib.free_abelian_group

noncomputable theory

universes v u

namespace category_theory

structure FreeAb (C : Type u) [category.{v} C] := of :: (as : C)

namespace FreeAb

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

instance : quiver (FreeAb C) :=
{ hom := λ X Y, free_abelian_group (X.as ⟶ Y.as) }

variables {C}

protected def id (X : FreeAb C) : X ⟶ X := free_abelian_group.of (𝟙 X.as)

protected def comp {X Y Z : FreeAb C} : (X ⟶ Y) →+ (Y ⟶ Z) →+ (X ⟶ Z) :=
free_abelian_group.lift $ λ f : X.as ⟶ Y.as,
  free_abelian_group.lift $ λ g : Y.as ⟶ Z.as, free_abelian_group.of (f ≫ g)

variables (C)

instance : category_struct (FreeAb C) :=
{ id := FreeAb.id,
  comp := λ X Y Z f g, FreeAb.comp f g }

@[simp]
protected lemma comp_apply {X Y Z : FreeAb C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  FreeAb.comp f g = f ≫ g := rfl

instance : category (FreeAb C) :=
{ id_comp' := λ X Y f, begin
    show FreeAb.comp X.id f = add_monoid_hom.id _ f, congr' 1, clear f, ext1 f,
    simp only [add_monoid_hom.id_apply, FreeAb.comp, free_abelian_group.lift.of, FreeAb.id,
      category.id_comp],
  end,
  comp_id' := λ X Y f, begin
    show FreeAb.comp f Y.id = add_monoid_hom.id _ f,
    rw [← add_monoid_hom.flip_apply], congr' 1, clear f, ext1 f,
    simp only [add_monoid_hom.id_apply, FreeAb.comp, free_abelian_group.lift.of, FreeAb.id,
      category.comp_id, add_monoid_hom.flip_apply],
  end,
  assoc' := λ W X Y Z f g h, begin
    show FreeAb.comp.comp (FreeAb.comp f) g h = (FreeAb.comp f).comp (FreeAb.comp g) h,
    congr' 1,
    rw [← add_monoid_hom.comp_hom_apply_apply, ← add_monoid_hom.comp_hom_apply_apply,
        ← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_apply],
    congr' 1,
    conv_rhs { rw [← add_monoid_hom.comp_hom_apply_apply, ← add_monoid_hom.flip_apply,
      ← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_apply] },
    congr' 1,
    clear f g h, ext f g h,
    simp only [add_monoid_hom.comp_apply, add_monoid_hom.comp_hom_apply_apply,
      add_monoid_hom.flip_apply, FreeAb.comp, free_abelian_group.lift.of, category.assoc],
  end }
.

instance : preadditive (FreeAb C) :=
{ hom_group := by { intros, apply_instance },
  add_comp' := by { intros, show FreeAb.comp (_ + _) _ = _, simp only [map_add], refl },
  comp_add' := by { intros, show FreeAb.comp _ (_ + _) = _, simp only [map_add], refl } }

def eval [preadditive C] : FreeAb C ⥤ C :=
{ obj := FreeAb.as,
  map := λ X Y, free_abelian_group.lift id,
  map_id' := λ X, show free_abelian_group.lift id X.id = 𝟙 X.as,
    by { simp only [FreeAb.id, free_abelian_group.lift.of], refl },
  map_comp' := λ X Y Z f g, begin
    show free_abelian_group.lift id (FreeAb.comp f g) = preadditive.comp_hom _ _,
    rw [← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_apply], congr' 1,
    rw [← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_hom_apply_apply,
        ← add_monoid_hom.comp_apply],
    conv_rhs { rw [← add_monoid_hom.comp_hom_apply_apply, ← add_monoid_hom.flip_apply,
      ← add_monoid_hom.comp_apply] }, congr' 1, clear f g, ext f g,
    simp only [add_monoid_hom.comp_apply, add_monoid_hom.comp_hom_apply_apply,
      add_monoid_hom.flip_apply, FreeAb.comp, free_abelian_group.lift.of],
    refl,
  end }

instance eval_additive [preadditive C] : (eval C).additive :=
{ map_add' := λ X Y f g, add_monoid_hom.map_add _ _ _ }

end FreeAb

namespace functor

variables {C D : Type*} [category C] [category D]

def map_FreeAb (F : C ⥤ D) : FreeAb C ⥤ FreeAb D :=
{ obj := λ X, FreeAb.of (F.obj X.as),
  map := λ X Y, free_abelian_group.map (λ f, F.map f),
  map_id' := λ X, by { erw [free_abelian_group.map_of_apply, F.map_id], refl },
  map_comp' := λ X Y Z f g, begin
    rw [← FreeAb.comp_apply, ← FreeAb.comp_apply,
        ← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_apply], congr' 1,
    rw [← add_monoid_hom.comp_hom_apply_apply, ← add_monoid_hom.comp_apply],
    conv_rhs { rw [← add_monoid_hom.comp_hom_apply_apply, ← add_monoid_hom.flip_apply,
      ← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_apply] }, congr' 1, clear f g, ext f g,
    simp only [add_monoid_hom.comp_apply, add_monoid_hom.comp_hom_apply_apply,
      add_monoid_hom.flip_apply, FreeAb.comp, free_abelian_group.lift.of,
      free_abelian_group.map, ← F.map_comp],
  end }

instance map_FreeAb_additive (F : C ⥤ D) : F.map_FreeAb.additive :=
{ map_add' := λ X Y f g, add_monoid_hom.map_add _ _ _ }

end functor

end category_theory


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import tactic
import measure_theory.measurable_space
import measure_theory.integration
import measure_theory.borel_space
import measure_theory.bochner_integration
import topology.metric_space.basic
import topology.instances.real
import topology.instances.ennreal
import order.liminf_limsup

noncomputable theory
open set
open classical
open measure_theory
open measurable_space
open filter
open_locale topological_space

namespace portmanteau

abbreviation bdd_Rval {β : Type*} (f : β → ℝ) : Prop :=
  ∃ (M : ℝ) , ∀ (b : β) , abs(f(b)) ≤ M

abbreviation bdd_ennval {α : Type*} (f : α → ennreal) : Prop :=
  ∃ (M : nnreal) , ∀ (a : α) , f(a) ≤ M

section test_functions_for_weak_convergence

/-- Continuous bounded functions on a topological space `α` with values
in `ennreal` are used as "test functions" in the definition of the topology of
the weak convergence of probability measures. They are defined as a subtype
of `α → ennreal`, so that the type of (positive) functionals is just
`(cont_bdd_ennval α) → ennreal`. -/
def cont_bdd_ennval (α : Type*) [topological_space α] : Type*
  := { f : α → ennreal // continuous f ∧ bdd_ennval f }

def functional_cont_bdd_ennval (α : Type*) [topological_space α] : Type*
  := (cont_bdd_ennval α) → ennreal

instance {α : Type*} [topological_space α] :
  has_coe (cont_bdd_ennval α) (α → ennreal) := ⟨subtype.val⟩

@[simp] lemma val_eq_coe_testfun {α : Type*} [topological_space α] (f : cont_bdd_ennval α) :
  f.val = f := rfl

/-- As a first step towards the definition of the topology of the weak convergence
of probability measures, the space of functionals `(cont_bdd_ennval α) → ennreal`
is equipped with the product topology (the topology of "testfunctionwise" convergence,
i.e., of pointwise convergence of the functionals defined on the space of continuous
bounded test functions). -/
instance {α : Type*} [topological_space α] :
  topological_space (functional_cont_bdd_ennval α) := Pi.topological_space

/-- In an alternative an more familiar formulation, continuous bounded `ℝ`-valued
functions on a topological space `α` are used as "test functions" in the definition
of the topology of the weak convergence of probability measures. They are defined as
a subtype of `α → ℝ`. -/
def cont_bdd_Rval (α : Type*) [topological_space α] : Type*
  := { f : α → ℝ // continuous f ∧ bdd_Rval f }

def cont_bdd_Rval_mk {α : Type*} [topological_space α]
  (g : α → ℝ) (g_cont : continuous g) (g_bdd : bdd_Rval g) : cont_bdd_Rval α :=
{ val := g ,
  property := ⟨ g_cont , g_bdd ⟩ , }

-- TODO: It would be good to equip `cont_bdd_Rval` with the sup-norm, show that it is
-- a Banach space, define the (continuous) dual of it, equip it with the dual norm,
-- show that each Borel probability measure defines an element of the (continuous)
-- dual, etc... At least currently the result `weak_conv_seq_iff` essentially shows
-- that the mapping the Borel probability measures into the dual will be an
-- embedding (the topologies are compatible).

--TODO: I can't use the same name for the following coercion.
--instance {α : Type*} [topological_space α] :
--  has_coe (cont_bdd_Rval α) (α → ℝ) := ⟨subtype.val⟩

end test_functions_for_weak_convergence

section topology_of_weak_convergence

/-- Borel probability measures on a topological space `α` are defined as a subtype
of measures. This subtype `borel_proba α` is equipped with the topology of weak
convergence. -/
def borel_proba (α : Type*) [topological_space α] : Type
  := { μ : @measure_theory.measure α (borel(α)) // @probability_measure α (borel(α)) μ }

instance (α : Type*) [topological_space α] :
  has_coe (borel_proba α) (@measure_theory.measure α (borel(α))) := ⟨subtype.val⟩

@[simp] lemma val_eq_coe_borel_proba {α : Type*} [topological_space α] (ν : borel_proba α) :
  ν.val = ν := rfl

abbreviation integrate_cont_bdd_ennval {α : Type*} [topological_space α]
  (μ : borel_proba α) (f : cont_bdd_ennval α) : ennreal := @lintegral α (borel(α)) μ f

/-- The topology of weak convergence on `borel_proba α` is defined as the induced
topology of the mapping `(borel_proba α) → ((cont_bdd_ennval α) → ennreal)` to
functionals defined by integration of a test functio against to the measure. In
other contexts this could be called the weak-* topology. -/
instance {α : Type} [topological_space α] : topological_space (borel_proba α)
  := topological_space.induced (λ (μ : borel_proba α) , integrate_cont_bdd_ennval μ) infer_instance

/-- Integration of test functions against borel probability measures depends
continuously on the measure. -/
lemma integrate_cont_bdd_ennval_cont {α : Type} [topological_space α] :
  continuous (@integrate_cont_bdd_ennval α _) := continuous_induced_dom

-- Remark: It felt convenient to isolate the following fact (does it exist already?).
lemma conv_seq_induced {α γ : Type*} [top_γ : topological_space γ]
  (f : α → γ) (x : ℕ → α) (x₀ : α) :
    tendsto (f ∘ x) at_top (𝓝 (f(x₀)))
      → tendsto x at_top (@nhds α (topological_space.induced f top_γ) x₀) :=
begin
  intro h_f_lim ,
  apply tendsto_nhds.mpr ,
  intros U open_U U_ni_x₀ ,
  rcases ((@is_open_induced_iff α γ top_γ U f).mp open_U) with ⟨ V , open_V , preim_V_eq_U ⟩ ,
  induction preim_V_eq_U ,
  apply tendsto_nhds.mp h_f_lim V open_V U_ni_x₀ ,
end

/-- The usual definition of weak convergence of probability measures is given in
terms of sequences of probability measures: it is the requirement that the integrals
of all continuous bounded functions against members of the sequence converge.
This characterization is shown in `weak_conv_seq_iff'` in the case when the
functions are `ennreal`-valued and the integral is `lintegral`. The most common
formulation with `ℝ`-valued functions and Bochner integrals is `weak_conv_seq_iff`. -/
theorem weak_conv_seq_iff' {α : Type*} [topological_space α]
  {μseq : ℕ → borel_proba α} {μ : borel_proba α} :
    tendsto μseq at_top (𝓝 μ)
      ↔ ∀ (f : cont_bdd_ennval α) ,
        tendsto (λ n, integrate_cont_bdd_ennval (μseq(n)) f) at_top (𝓝 (integrate_cont_bdd_ennval μ f)) :=
begin
  split ,
  { intros weak_conv ,
    have key := tendsto.comp (continuous.tendsto (@integrate_cont_bdd_ennval_cont α _) μ) weak_conv ,
    exact tendsto_pi.mp key , } ,
  { intro h_lim_forall ,
    have h_lim : tendsto (λ n, integrate_cont_bdd_ennval (μseq(n))) at_top (𝓝 (integrate_cont_bdd_ennval μ)) ,
    { exact tendsto_pi.mpr h_lim_forall , } ,
    exact conv_seq_induced _ μseq μ h_lim , } ,
end

end topology_of_weak_convergence

section equivalent_conditions
-- See <pormanteau_conclusions.lean> for the main theorems about the equivalence.

abbreviation portmanteau_continuous_ennval {α : Type} [topological_space α]
  (μseq : ℕ → @measure_theory.measure α (borel α)) (μ : @measure_theory.measure α (borel α)) : Prop :=
    ∀ (f : α → ennreal) , (continuous f) → (bdd_ennval f) →
      tendsto (λ n , (@lintegral α (borel(α)) (μseq(n)) f) ) at_top (𝓝 (@lintegral α (borel(α)) μ f))

abbreviation portmanteau_continuous_Rval {α : Type} [topological_space α]
  (μseq : ℕ → @measure_theory.measure α (borel α)) (μ : @measure_theory.measure α (borel α)) : Prop :=
    ∀ (f : α → ℝ) , (continuous f) → (bdd_Rval f) →
      tendsto (λ n , (@integral α ℝ (borel(α)) _ _ _ _ _ _ (μseq(n)) f)) at_top (𝓝 (@integral α ℝ (borel(α)) _ _ _ _ _ _ μ f))

abbreviation portmanteau_open {α : Type} [topological_space α]
  (μseq : ℕ → @measure_theory.measure α (borel α)) (μ : @measure_theory.measure α (borel α)) : Prop :=
    ∀ (G : set α) , (is_open G) → μ(G) ≤ liminf at_top (λ n , (μseq(n))(G))

abbreviation portmanteau_closed {α : Type} [topological_space α]
  (μseq : ℕ → @measure_theory.measure α (borel α)) (μ : @measure_theory.measure α (borel α)) : Prop :=
    ∀ (F : set α) , (is_closed F) → limsup at_top (λ n , (μseq(n))(F)) ≤ μ(F)

abbreviation portmanteau_borel {α : Type} [topological_space α]
  (μseq : ℕ → @measure_theory.measure α (borel α)) (μ : @measure_theory.measure α (borel α)) : Prop :=
    ∀ (E : set α) , ((borel α).measurable_set' E) → (μ(frontier E) = 0)
      → (tendsto (λ n , (μseq(n))(E)) at_top (𝓝 (μ(E))))

end equivalent_conditions

end portmanteau


-- Copyright (c) 2018 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Scott Morrison, Johan Commelin

import category_theory.types
import category_theory.isomorphism
import category_theory.whiskering
import category_theory.opposites
import category_theory.punit
import category_theory.equivalence

namespace category_theory

universes v₁ v₂ v₃ u₁ u₂ u₃ -- declare the `v`'s first; see `category_theory.category` for an explanation
variables {A : Type u₁} [𝒜 : category.{v₁} A]
variables {B : Type u₂} [ℬ : category.{v₂} B]
variables {T : Type u₃} [𝒯 : category.{v₃} T]
include 𝒜 ℬ 𝒯

structure comma (L : A ⥤ T) (R : B ⥤ T) :=
(left : A . obviously)
(right : B . obviously)
(hom : L.obj left ⟶ R.obj right)

variables {L : A ⥤ T} {R : B ⥤ T}

structure comma_morphism (X Y : comma L R) :=
(left : X.left ⟶ Y.left . obviously)
(right : X.right ⟶ Y.right . obviously)
(w' : L.map left ≫ Y.hom = X.hom ≫ R.map right . obviously)

restate_axiom comma_morphism.w'
attribute [simp] comma_morphism.w

namespace comma_morphism
@[extensionality] lemma ext
  {X Y : comma L R} {f g : comma_morphism X Y}
  (l : f.left = g.left) (r : f.right = g.right) : f = g :=
begin
  cases f, cases g,
  congr; assumption
end
end comma_morphism

instance comma_category : category (comma L R) :=
{ hom := comma_morphism,
  id := λ X,
  { left := 𝟙 X.left,
    right := 𝟙 X.right },
  comp := λ X Y Z f g,
  { left := f.left ≫ g.left,
    right := f.right ≫ g.right,
    w' :=
    begin
      rw [functor.map_comp,
          category.assoc,
          g.w,
          ←category.assoc,
          f.w,
          functor.map_comp,
          category.assoc],
    end }}

namespace comma

section
variables {X Y Z : comma L R} {f : X ⟶ Y} {g : Y ⟶ Z}

@[simp] lemma comp_left  : (f ≫ g).left  = f.left ≫ g.left   := rfl
@[simp] lemma comp_right : (f ≫ g).right = f.right ≫ g.right := rfl

end

variables (L) (R)

def fst : comma L R ⥤ A :=
{ obj := λ X, X.left,
  map := λ _ _ f, f.left }

def snd : comma L R ⥤ B :=
{ obj := λ X, X.right,
  map := λ _ _ f, f.right }

@[simp] lemma fst_obj {X : comma L R} : (fst L R).obj X = X.left := rfl
@[simp] lemma snd_obj {X : comma L R} : (snd L R).obj X = X.right := rfl
@[simp] lemma fst_map {X Y : comma L R} {f : X ⟶ Y} : (fst L R).map f = f.left := rfl
@[simp] lemma snd_map {X Y : comma L R} {f : X ⟶ Y} : (snd L R).map f = f.right := rfl

def nat_trans : fst L R ⋙ L ⟹ snd L R ⋙ R :=
{ app := λ X, X.hom }

section
variables {L₁ L₂ L₃ : A ⥤ T} {R₁ R₂ R₃ : B ⥤ T}

def map_left (l : L₁ ⟹ L₂) : comma L₂ R ⥤ comma L₁ R :=
{ obj := λ X,
  { left  := X.left,
    right := X.right,
    hom   := l.app X.left ≫ X.hom },
  map := λ X Y f,
  { left  := f.left,
    right := f.right,
    w' := by tidy; rw [←category.assoc, l.naturality f.left, category.assoc]; tidy } }

section
variables {X Y : comma L₂ R} {f : X ⟶ Y} {l : L₁ ⟹ L₂}
@[simp] lemma map_left_obj_left  : ((map_left R l).obj X).left  = X.left                := rfl
@[simp] lemma map_left_obj_right : ((map_left R l).obj X).right = X.right               := rfl
@[simp] lemma map_left_obj_hom   : ((map_left R l).obj X).hom   = l.app X.left ≫ X.hom := rfl
@[simp] lemma map_left_map_left  : ((map_left R l).map f).left  = f.left                := rfl
@[simp] lemma map_left_map_right : ((map_left R l).map f).right = f.right               := rfl
end

def map_left_id : map_left R (𝟙 L) ≅ functor.id _ :=
{ hom :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } },
  inv :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } } }

section
variables {X : comma L R}
@[simp] lemma map_left_id_hom_app_left  : (((map_left_id L R).hom).app X).left  = 𝟙 (X.left)  := rfl
@[simp] lemma map_left_id_hom_app_right : (((map_left_id L R).hom).app X).right = 𝟙 (X.right) := rfl
@[simp] lemma map_left_id_inv_app_left  : (((map_left_id L R).inv).app X).left  = 𝟙 (X.left)  := rfl
@[simp] lemma map_left_id_inv_app_right : (((map_left_id L R).inv).app X).right = 𝟙 (X.right) := rfl
end

def map_left_comp (l : L₁ ⟹ L₂) (l' : L₂ ⟹ L₃) :
(map_left R (l ⊟ l')) ≅ (map_left R l') ⋙ (map_left R l) :=
{ hom :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } },
  inv :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } } }

section
variables {X : comma L₃ R} {l : L₁ ⟹ L₂} {l' : L₂ ⟹ L₃}
@[simp] lemma map_left_comp_hom_app_left  : (((map_left_comp R l l').hom).app X).left  = 𝟙 (X.left)  := rfl
@[simp] lemma map_left_comp_hom_app_right : (((map_left_comp R l l').hom).app X).right = 𝟙 (X.right) := rfl
@[simp] lemma map_left_comp_inv_app_left  : (((map_left_comp R l l').inv).app X).left  = 𝟙 (X.left)  := rfl
@[simp] lemma map_left_comp_inv_app_right : (((map_left_comp R l l').inv).app X).right = 𝟙 (X.right) := rfl
end

def map_right (r : R₁ ⟹ R₂) : comma L R₁ ⥤ comma L R₂ :=
{ obj := λ X,
  { left  := X.left,
    right := X.right,
    hom   := X.hom ≫ r.app X.right },
  map := λ X Y f,
  { left  := f.left,
    right := f.right,
    w' := by tidy; rw [←r.naturality f.right, ←category.assoc]; tidy } }

section
variables {X Y : comma L R₁} {f : X ⟶ Y} {r : R₁ ⟹ R₂}
@[simp] lemma map_right_obj_left  : ((map_right L r).obj X).left  = X.left                 := rfl
@[simp] lemma map_right_obj_right : ((map_right L r).obj X).right = X.right                := rfl
@[simp] lemma map_right_obj_hom   : ((map_right L r).obj X).hom   = X.hom ≫ r.app X.right  := rfl
@[simp] lemma map_right_map_left  : ((map_right L r).map f).left  = f.left                 := rfl
@[simp] lemma map_right_map_right : ((map_right L r).map f).right = f.right                := rfl
end

def map_right_id : map_right L (𝟙 R) ≅ functor.id _ :=
{ hom :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } },
  inv :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } } }

section
variables {X : comma L R}
@[simp] lemma map_right_id_hom_app_left  : (((map_right_id L R).hom).app X).left  = 𝟙 (X.left)  := rfl
@[simp] lemma map_right_id_hom_app_right : (((map_right_id L R).hom).app X).right = 𝟙 (X.right) := rfl
@[simp] lemma map_right_id_inv_app_left  : (((map_right_id L R).inv).app X).left  = 𝟙 (X.left)  := rfl
@[simp] lemma map_right_id_inv_app_right : (((map_right_id L R).inv).app X).right = 𝟙 (X.right) := rfl
end

def map_right_comp (r : R₁ ⟹ R₂) (r' : R₂ ⟹ R₃) : (map_right L (r ⊟ r')) ≅ (map_right L r) ⋙ (map_right L r') :=
{ hom :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } },
  inv :=
  { app := λ X, { left := 𝟙 _, right := 𝟙 _ } } }

section
variables {X : comma L R₁} {r : R₁ ⟹ R₂} {r' : R₂ ⟹ R₃}
@[simp] lemma map_right_comp_hom_app_left  : (((map_right_comp L r r').hom).app X).left  = 𝟙 (X.left)  := rfl
@[simp] lemma map_right_comp_hom_app_right : (((map_right_comp L r r').hom).app X).right = 𝟙 (X.right) := rfl
@[simp] lemma map_right_comp_inv_app_left  : (((map_right_comp L r r').inv).app X).left  = 𝟙 (X.left)  := rfl
@[simp] lemma map_right_comp_inv_app_right : (((map_right_comp L r r').inv).app X).right = 𝟙 (X.right) := rfl
end

end

end comma

omit 𝒜 ℬ

def over (X : T) := comma.{v₃ 0 v₃} (functor.id T) (functor.of.obj X)

namespace over

variables {X : T}

instance category : category (over X) := by delta over; apply_instance

@[extensionality] lemma over_morphism.ext {X : T} {U V : over X} {f g : U ⟶ V}
  (h : f.left = g.left) : f = g :=
by tidy

@[simp] lemma over_right (U : over X) : U.right = punit.star := by tidy
@[simp] lemma over_morphism_right {U V : over X} (f : U ⟶ V) : f.right = 𝟙 punit.star := by tidy

@[simp] lemma id_left (U : over X) : comma_morphism.left (𝟙 U) = 𝟙 U.left := rfl
@[simp] lemma comp_left (a b c : over X) (f : a ⟶ b) (g : b ⟶ c) :
  (f ≫ g).left = f.left ≫ g.left := rfl

@[simp] lemma w {A B : over X} (f : A ⟶ B) : f.left ≫ B.hom = A.hom :=
by have := f.w; tidy

def mk {X Y : T} (f : Y ⟶ X) : over X :=
{ left := Y, hom := f }

@[simp] lemma mk_left {X Y : T} (f : Y ⟶ X) : (mk f).left = Y := rfl
@[simp] lemma mk_hom {X Y : T} (f : Y ⟶ X) : (mk f).hom = f := rfl

def hom_mk {U V : over X} (f : U.left ⟶ V.left) (w : f ≫ V.hom = U.hom . obviously) :
  U ⟶ V :=
{ left := f }

@[simp] lemma hom_mk_left {U V : over X} (f : U.left ⟶ V.left) (w : f ≫ V.hom = U.hom) :
  (hom_mk f).left = f :=
rfl

def forget : (over X) ⥤ T := comma.fst _ _

@[simp] lemma forget_obj {U : over X} : forget.obj U = U.left := rfl
@[simp] lemma forget_map {U V : over X} {f : U ⟶ V} : forget.map f = f.left := rfl

def map {Y : T} (f : X ⟶ Y) : over X ⥤ over Y := comma.map_right _ $ functor.of.map f

section
variables {Y : T} {f : X ⟶ Y} {U V : over X} {g : U ⟶ V}
@[simp] lemma map_obj_left : ((map f).obj U).left = U.left := rfl
@[simp] lemma map_obj_hom  : ((map f).obj U).hom  = U.hom ≫ f := rfl
@[simp] lemma map_map_left : ((map f).map g).left = g.left := rfl
end

section
variables {D : Type u₃} [Dcat : category.{v₃} D]
include Dcat

def post (F : T ⥤ D) : over X ⥤ over (F.obj X) :=
{ obj := λ Y, mk $ F.map Y.hom,
  map := λ Y₁ Y₂ f,
  { left := F.map f.left,
    w' := by tidy; erw [← F.map_comp, w] } }

end

end over

def under (X : T) := comma.{0 v₃ v₃} (functor.of.obj X) (functor.id T)

namespace under

variables {X : T}

instance : category (under X) := by delta under; apply_instance

@[extensionality] lemma under_morphism.ext {X : T} {U V : under X} {f g : U ⟶ V}
  (h : f.right = g.right) : f = g :=
by tidy

@[simp] lemma under_left (U : under X) : U.left = punit.star := by tidy
@[simp] lemma under_morphism_left {U V : under X} (f : U ⟶ V) : f.left = 𝟙 punit.star := by tidy

@[simp] lemma id_right (U : under X) : comma_morphism.right (𝟙 U) = 𝟙 U.right := rfl
@[simp] lemma comp_right (a b c : under X) (f : a ⟶ b) (g : b ⟶ c) :
  (f ≫ g).right = f.right ≫ g.right := rfl

@[simp] lemma w {A B : under X} (f : A ⟶ B) : A.hom ≫ f.right = B.hom :=
by have := f.w; tidy

def mk {X Y : T} (f : X ⟶ Y) : under X :=
{ right := Y, hom := f }

@[simp] lemma mk_right {X Y : T} (f : X ⟶ Y) : (mk f).right = Y := rfl
@[simp] lemma mk_hom {X Y : T} (f : X ⟶ Y) : (mk f).hom = f := rfl

def hom_mk {U V : under X} (f : U.right ⟶ V.right) (w : U.hom ≫ f = V.hom . obviously) :
  U ⟶ V :=
{ right := f }

@[simp] lemma hom_mk_right {U V : under X} (f : U.right ⟶ V.right) (w : U.hom ≫ f = V.hom) :
  (hom_mk f).right = f :=
rfl

def forget : (under X) ⥤ T := comma.snd _ _

@[simp] lemma forget_obj {U : under X} : forget.obj U = U.right := rfl
@[simp] lemma forget_map {U V : under X} {f : U ⟶ V} : forget.map f = f.right := rfl

def map {Y : T} (f : X ⟶ Y) : under Y ⥤ under X := comma.map_left _ $ functor.of.map f

section
variables {Y : T} {f : X ⟶ Y} {U V : under Y} {g : U ⟶ V}
@[simp] lemma map_obj_right : ((map f).obj U).right = U.right := rfl
@[simp] lemma map_obj_hom   : ((map f).obj U).hom   = f ≫ U.hom := rfl
@[simp] lemma map_map_right : ((map f).map g).right = g.right := rfl
end

section
variables {D : Type u₃} [Dcat : category.{v₃} D]
include Dcat

def post {X : T} (F : T ⥤ D) : under X ⥤ under (F.obj X) :=
{ obj := λ Y, mk $ F.map Y.hom,
  map := λ Y₁ Y₂ f,
  { right := F.map f.right,
    w' := by tidy; erw [← F.map_comp, w] } }

end

end under

end category_theory


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

/-!
# (Co)Limits of Schemes

We construct various limits and colimits in the category of schemes.

* The existence of fibred products was shown in `algebraic_geometry/pullbacks.lean`.
* `Spec ℤ` is the terminal object.
* The preceding two results imply that `Scheme` has all finite limits.
* The empty scheme is the (strict) initial object.

## Todo

* Coproducts exists (and the forgetful functors preserve them).

-/

universe u

open category_theory category_theory.limits opposite topological_space

namespace algebraic_geometry

/-- `Spec ℤ` is the terminal object in the category of schemes. -/
noncomputable
def Spec_Z_is_terminal : is_terminal (Scheme.Spec.obj (op $ CommRing.of ℤ)) :=
@@is_terminal.is_terminal_obj _ _ Scheme.Spec _ infer_instance
  (terminal_op_of_initial CommRing.Z_is_initial)

instance : has_terminal Scheme := has_terminal_of_has_terminal_of_preserves_limit Scheme.Spec

instance : is_affine (⊤_ Scheme.{u}) :=
is_affine_of_iso (preserves_terminal.iso Scheme.Spec).inv

instance : has_finite_limits Scheme :=
has_finite_limits_of_has_terminal_and_pullbacks

section initial

/-- The map from the empty scheme. -/
@[simps]
def Scheme.empty_to (X : Scheme.{u}) : ∅ ⟶ X :=
⟨{ base := ⟨λ x, pempty.elim x, by continuity⟩,
    c := { app := λ U, CommRing.punit_is_terminal.from _ } }, λ x, pempty.elim x⟩

@[ext]
lemma Scheme.empty_ext {X : Scheme.{u}} (f g : ∅ ⟶ X) : f = g :=
by { ext a, exact pempty.elim a }

lemma Scheme.eq_empty_to {X : Scheme.{u}} (f : ∅ ⟶ X) : f = Scheme.empty_to X :=
Scheme.empty_ext f (Scheme.empty_to X)

instance (X : Scheme.{u}) : unique (∅ ⟶ X) :=
⟨⟨Scheme.empty_to _⟩, λ _, Scheme.empty_ext _ _⟩

/-- The empty scheme is the initial object in the category of schemes. -/
def empty_is_initial : is_initial (∅ : Scheme.{u}) :=
is_initial.of_unique _

@[simp]
lemma empty_is_initial_to : empty_is_initial.to = Scheme.empty_to := rfl

instance : is_empty Scheme.empty.carrier :=
show is_empty pempty, by apply_instance

instance Spec_punit_is_empty : is_empty (Scheme.Spec.obj (op $ CommRing.of punit)).carrier :=
⟨prime_spectrum.punit⟩

@[priority 100]
instance is_open_immersion_of_is_empty {X Y : Scheme} (f : X ⟶ Y) [is_empty X.carrier] :
  is_open_immersion f :=
begin
  apply_with is_open_immersion.of_stalk_iso { instances := ff },
  { apply open_embedding_of_continuous_injective_open,
    { continuity },
    { rintro (i : X.carrier), exact is_empty_elim i },
    { intros U hU, convert is_open_empty, ext, apply (iff_false _).mpr,
      exact λ x, is_empty_elim (show X.carrier, from x.some) } },
  { rintro (i : X.carrier), exact is_empty_elim i }
end

@[priority 100]
instance is_iso_of_is_empty {X Y : Scheme} (f : X ⟶ Y) [is_empty Y.carrier] : is_iso f :=
begin
  haveI : is_empty X.carrier := ⟨λ x, is_empty_elim (show Y.carrier, from f.1.base x)⟩,
  haveI : epi f.1.base,
  { rw Top.epi_iff_surjective, rintro (x : Y.carrier), exact is_empty_elim x },
  apply is_open_immersion.to_iso
end

/-- A scheme is initial if its underlying space is empty . -/
noncomputable
def is_initial_of_is_empty {X : Scheme} [is_empty X.carrier] : is_initial X :=
empty_is_initial.of_iso (as_iso $ empty_is_initial.to _)

/-- `Spec 0` is the initial object in the category of schemes. -/
noncomputable
def Spec_punit_is_initial : is_initial (Scheme.Spec.obj (op $ CommRing.of punit)) :=
empty_is_initial.of_iso (as_iso $ empty_is_initial.to _)

@[priority 100]
instance is_affine_of_is_empty {X : Scheme} [is_empty X.carrier] : is_affine X :=
is_affine_of_iso (inv (empty_is_initial.to X) ≫
  empty_is_initial.to (Scheme.Spec.obj (op $ CommRing.of punit)))

instance : has_initial Scheme :=
has_initial_of_unique Scheme.empty

instance initial_is_empty : is_empty (⊥_ Scheme).carrier :=
⟨λ x, ((initial.to Scheme.empty : _).1.base x).elim⟩

lemma bot_is_affine_open (X : Scheme) : is_affine_open (⊥ : opens X.carrier) :=
begin
  convert range_is_affine_open_of_open_immersion (initial.to X),
  ext,
  exact (false_iff _).mpr (λ x, is_empty_elim (show (⊥_ Scheme).carrier, from x.some)),
end

instance : has_strict_initial_objects Scheme :=
has_strict_initial_objects_of_initial_is_strict (λ A f, by apply_instance)

end initial

end algebraic_geometry