/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.types
import category_theory.limits.shapes.products
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.terminal
import tactic.elementwise

/-!
# Special shapes for limits in `Type`.

The general shape (co)limits defined in `category_theory.limits.types`
are intended for use through the limits API,
and the actual implementation should mostly be considered "sealed".

In this file, we provide definitions of the "standard" special shapes of limits in `Type`,
giving the expected definitional implementation:
* the terminal object is `punit`
* the binary product of `X` and `Y` is `X × Y`
* the product of a family `f : J → Type` is `Π j, f j`
* the coproduct of a family `f : J → Type` is `Σ j, f j`
* the binary coproduct of `X` and `Y` is the sum type `X ⊕ Y`
* the equalizer of a pair of maps `(g, h)` is the subtype `{x : Y // g x = h x}`
* the coequalizer of a pair of maps `(f, g)` is the quotient of `Y` by `∀ x : Y, f x ~ g x`
* the pullback of `f : X ⟶ Z` and `g : Y ⟶ Z` is the subtype `{ p : X × Y // f p.1 = g p.2 }`
  of the product

We first construct terms of `is_limit` and `limit_cone`, and then provide isomorphisms with the
types generated by the `has_limit` API.

As an example, when setting up the monoidal category structure on `Type`
we use the `types_has_terminal` and `types_has_binary_products` instances.
-/

universes u

open category_theory
open category_theory.limits

namespace category_theory.limits.types

local attribute [tidy] tactic.discrete_cases

/-- A restatement of `types.lift_π_apply` that uses `pi.π` and `pi.lift`. -/
@[simp]
lemma pi_lift_π_apply
  {β : Type u} (f : β → Type u) {P : Type u} (s : Π b, P ⟶ f b) (b : β) (x : P) :
  (pi.π f b : (∏ f) → f b) (@pi.lift β _ _ f _ P s x) = s b x :=
congr_fun (limit.lift_π (fan.mk P s) ⟨b⟩) x

/-- A restatement of `types.map_π_apply` that uses `pi.π` and `pi.map`. -/
@[simp]
lemma pi_map_π_apply {β : Type u} {f g : β → Type u} (α : Π j, f j ⟶ g j) (b : β) (x) :
  (pi.π g b : (∏ g) → g b) (pi.map α x) = α b ((pi.π f b : (∏ f) → f b) x) :=
limit.map_π_apply _ _ _

/-- The category of types has `punit` as a terminal object. -/
def terminal_limit_cone : limits.limit_cone (functor.empty (Type u)) :=
{ cone :=
  { X := punit,
    π := by tidy, },
  is_limit := by tidy, }

/-- The terminal object in `Type u` is `punit`. -/
noncomputable def terminal_iso : ⊤_ (Type u) ≅ punit :=
limit.iso_limit_cone terminal_limit_cone

/-- The category of types has `pempty` as an initial object. -/
def initial_colimit_cocone : limits.colimit_cocone (functor.empty (Type u)) :=
{ cocone :=
  { X := pempty,
    ι := by tidy, },
  is_colimit := by tidy, }

/-- The initial object in `Type u` is `punit`. -/
noncomputable def initial_iso : ⊥_ (Type u) ≅ pempty :=
colimit.iso_colimit_cocone initial_colimit_cocone

open category_theory.limits.walking_pair

/-- The product type `X × Y` forms a cone for the binary product of `X` and `Y`. -/
-- We manually generate the other projection lemmas since the simp-normal form for the legs is
-- otherwise not created correctly.
@[simps X]
def binary_product_cone (X Y : Type u) : binary_fan X Y :=
binary_fan.mk prod.fst prod.snd

@[simp]
lemma binary_product_cone_fst (X Y : Type u) :
  (binary_product_cone X Y).fst = prod.fst :=
rfl
@[simp]
lemma binary_product_cone_snd (X Y : Type u) :
  (binary_product_cone X Y).snd = prod.snd :=
rfl

/-- The product type `X × Y` is a binary product for `X` and `Y`. -/
@[simps]
def binary_product_limit (X Y : Type u) : is_limit (binary_product_cone X Y) :=
{ lift := λ (s : binary_fan X Y) x, (s.fst x, s.snd x),
  fac' := λ s j, discrete.rec_on j (λ j, walking_pair.cases_on j rfl rfl),
  uniq' := λ s m w, funext $ λ x, prod.ext (congr_fun (w ⟨left⟩) x) (congr_fun (w ⟨right⟩) x) }

/--
The category of types has `X × Y`, the usual cartesian product,
as the binary product of `X` and `Y`.
-/
@[simps]
def binary_product_limit_cone (X Y : Type u) : limits.limit_cone (pair X Y) :=
⟨_, binary_product_limit X Y⟩

/-- The categorical binary product in `Type u` is cartesian product. -/
noncomputable def binary_product_iso (X Y : Type u) : limits.prod X Y ≅ X × Y :=
limit.iso_limit_cone (binary_product_limit_cone X Y)

@[simp, elementwise] lemma binary_product_iso_hom_comp_fst (X Y : Type u) :
  (binary_product_iso X Y).hom ≫ prod.fst = limits.prod.fst :=
limit.iso_limit_cone_hom_π (binary_product_limit_cone X Y) ⟨walking_pair.left⟩

@[simp, elementwise] lemma binary_product_iso_hom_comp_snd (X Y : Type u) :
  (binary_product_iso X Y).hom ≫ prod.snd = limits.prod.snd :=
limit.iso_limit_cone_hom_π (binary_product_limit_cone X Y) ⟨walking_pair.right⟩

@[simp, elementwise] lemma binary_product_iso_inv_comp_fst (X Y : Type u) :
  (binary_product_iso X Y).inv ≫ limits.prod.fst = prod.fst :=
limit.iso_limit_cone_inv_π (binary_product_limit_cone X Y) ⟨walking_pair.left⟩

@[simp, elementwise] lemma binary_product_iso_inv_comp_snd (X Y : Type u) :
  (binary_product_iso X Y).inv ≫ limits.prod.snd = prod.snd :=
limit.iso_limit_cone_inv_π (binary_product_limit_cone X Y) ⟨walking_pair.right⟩

/-- The functor which sends `X, Y` to the product type `X × Y`. -/
-- We add the option `type_md` to tell `@[simps]` to not treat homomorphisms `X ⟶ Y` in `Type*` as
-- a function type
@[simps {type_md := reducible}]
def binary_product_functor : Type u ⥤ Type u ⥤ Type u :=
{ obj := λ X,
  { obj := λ Y, X × Y,
    map := λ Y₁ Y₂ f, (binary_product_limit X Y₂).lift (binary_fan.mk prod.fst (prod.snd ≫ f)) },
  map := λ X₁ X₂ f,
  { app := λ Y, (binary_product_limit X₂ Y).lift (binary_fan.mk (prod.fst ≫ f) prod.snd) } }

/--
The product functor given by the instance `has_binary_products (Type u)` is isomorphic to the
explicit binary product functor given by the product type.
-/
noncomputable def binary_product_iso_prod : binary_product_functor ≅ (prod.functor : Type u ⥤ _) :=
begin
  apply nat_iso.of_components (λ X, _) _,
  { apply nat_iso.of_components (λ Y, _) _,
    { exact ((limit.is_limit _).cone_point_unique_up_to_iso (binary_product_limit X Y)).symm },
    { intros Y₁ Y₂ f,
      ext1;
      simp } },
  { intros X₁ X₂ g,
    ext : 3;
    simp }
end

/-- The sum type `X ⊕ Y` forms a cocone for the binary coproduct of `X` and `Y`. -/
@[simps]
def binary_coproduct_cocone (X Y : Type u) : cocone (pair X Y) :=
binary_cofan.mk sum.inl sum.inr

/-- The sum type `X ⊕ Y` is a binary coproduct for `X` and `Y`. -/
@[simps]
def binary_coproduct_colimit (X Y : Type u) : is_colimit (binary_coproduct_cocone X Y) :=
{ desc := λ (s : binary_cofan X Y), sum.elim s.inl s.inr,
  fac' := λ s j, discrete.rec_on j (λ j, walking_pair.cases_on j rfl rfl),
  uniq' := λ s m w, funext $ λ x, sum.cases_on x (congr_fun (w ⟨left⟩)) (congr_fun (w ⟨right⟩)) }

/--
The category of types has `X ⊕ Y`,
as the binary coproduct of `X` and `Y`.
-/
def binary_coproduct_colimit_cocone (X Y : Type u) : limits.colimit_cocone (pair X Y) :=
⟨_, binary_coproduct_colimit X Y⟩

/-- The categorical binary coproduct in `Type u` is the sum `X ⊕ Y`. -/
noncomputable def binary_coproduct_iso (X Y : Type u) : limits.coprod X Y ≅ X ⊕ Y :=
colimit.iso_colimit_cocone (binary_coproduct_colimit_cocone X Y)

open_locale category_theory.Type

@[simp, elementwise] lemma binary_coproduct_iso_inl_comp_hom (X Y : Type u) :
  limits.coprod.inl ≫ (binary_coproduct_iso X Y).hom = sum.inl :=
colimit.iso_colimit_cocone_ι_hom (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.left⟩

@[simp, elementwise] lemma binary_coproduct_iso_inr_comp_hom (X Y : Type u) :
  limits.coprod.inr ≫ (binary_coproduct_iso X Y).hom = sum.inr :=
colimit.iso_colimit_cocone_ι_hom (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.right⟩

@[simp, elementwise] lemma binary_coproduct_iso_inl_comp_inv (X Y : Type u) :
  ↾(sum.inl : X ⟶ X ⊕ Y) ≫ (binary_coproduct_iso X Y).inv = limits.coprod.inl :=
colimit.iso_colimit_cocone_ι_inv (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.left⟩

@[simp, elementwise] lemma binary_coproduct_iso_inr_comp_inv (X Y : Type u) :
  ↾(sum.inr : Y ⟶ X ⊕ Y) ≫ (binary_coproduct_iso X Y).inv = limits.coprod.inr :=
colimit.iso_colimit_cocone_ι_inv (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.right⟩

/--
The category of types has `Π j, f j` as the product of a type family `f : J → Type`.
-/
def product_limit_cone {J : Type u} (F : J → Type u) : limits.limit_cone (discrete.functor F) :=
{ cone :=
  { X := Π j, F j,
    π := { app := λ j f, f j.as }, },
  is_limit :=
  { lift := λ s x j, s.π.app ⟨j⟩ x,
    uniq' := λ s m w, funext $ λ x, funext $ λ j, (congr_fun (w ⟨j⟩) x : _) } }

/-- The categorical product in `Type u` is the type theoretic product `Π j, F j`. -/
noncomputable def product_iso {J : Type u} (F : J → Type u) : ∏ F ≅ Π j, F j :=
limit.iso_limit_cone (product_limit_cone F)

@[simp, elementwise] lemma product_iso_hom_comp_eval {J : Type u} (F : J → Type u) (j : J) :
  (product_iso F).hom ≫ (λ f, f j) = pi.π F j :=
rfl

@[simp, elementwise] lemma product_iso_inv_comp_π {J : Type u} (F : J → Type u) (j : J) :
  (product_iso F).inv ≫ pi.π F j = (λ f, f j) :=
limit.iso_limit_cone_inv_π (product_limit_cone F) ⟨j⟩

/--
The category of types has `Σ j, f j` as the coproduct of a type family `f : J → Type`.
-/
def coproduct_colimit_cocone {J : Type u} (F : J → Type u) :
  limits.colimit_cocone (discrete.functor F) :=
{ cocone :=
  { X := Σ j, F j,
    ι :=
    { app := λ j x, ⟨j.as, x⟩ }, },
  is_colimit :=
  { desc := λ s x, s.ι.app ⟨x.1⟩ x.2,
    uniq' := λ s m w,
    begin
      ext ⟨j, x⟩,
      have := congr_fun (w ⟨j⟩) x,
      exact this,
    end }, }

/-- The categorical coproduct in `Type u` is the type theoretic coproduct `Σ j, F j`. -/
noncomputable def coproduct_iso {J : Type u} (F : J → Type u) : ∐ F ≅ Σ j, F j :=
colimit.iso_colimit_cocone (coproduct_colimit_cocone F)

@[simp, elementwise] lemma coproduct_iso_ι_comp_hom {J : Type u} (F : J → Type u) (j : J) :
  sigma.ι F j ≫ (coproduct_iso F).hom = (λ x : F j, (⟨j, x⟩ : Σ j, F j)) :=
colimit.iso_colimit_cocone_ι_hom (coproduct_colimit_cocone F) ⟨j⟩

@[simp, elementwise]

section fork
variables {X Y Z : Type u} (f : X ⟶ Y) {g h : Y ⟶ Z} (w : f ≫ g = f ≫ h)

/--
Show the given fork in `Type u` is an equalizer given that any element in the "difference kernel"
comes from `X`.
The converse of `unique_of_type_equalizer`.
-/
noncomputable def type_equalizer_of_unique (t : ∀ (y : Y), g y = h y → ∃! (x : X), f x = y) :
  is_limit (fork.of_ι _ w) :=
fork.is_limit.mk' _ $ λ s,
begin
  refine ⟨λ i, _, _, _⟩,
  { apply classical.some (t (s.ι i) _),
    apply congr_fun s.condition i },
  { ext i,
    apply (classical.some_spec (t (s.ι i) _)).1 },
  { intros m hm,
    ext i,
    apply (classical.some_spec (t (s.ι i) _)).2,
    apply congr_fun hm i },
end

/-- The converse of `type_equalizer_of_unique`. -/
lemma unique_of_type_equalizer (t : is_limit (fork.of_ι _ w)) (y : Y) (hy : g y = h y) :
  ∃! (x : X), f x = y :=
begin
  let y' : punit ⟶ Y := λ _, y,
  have hy' : y' ≫ g = y' ≫ h := funext (λ _, hy),
  refine ⟨(fork.is_limit.lift' t _ hy').1 ⟨⟩, congr_fun (fork.is_limit.lift' t y' _).2 ⟨⟩, _⟩,
  intros x' hx',
  suffices : (λ (_ : punit), x') = (fork.is_limit.lift' t y' hy').1,
    rw ← this,
  apply fork.is_limit.hom_ext t,
  ext ⟨⟩,
  apply hx'.trans (congr_fun (fork.is_limit.lift' t _ hy').2 ⟨⟩).symm,
end

lemma type_equalizer_iff_unique :
  nonempty (is_limit (fork.of_ι _ w)) ↔ (∀ (y : Y), g y = h y → ∃! (x : X), f x = y) :=
⟨λ i, unique_of_type_equalizer _ _ (classical.choice i), λ k, ⟨type_equalizer_of_unique f w k⟩⟩

/-- Show that the subtype `{x : Y // g x = h x}` is an equalizer for the pair `(g,h)`. -/
def equalizer_limit : limits.limit_cone (parallel_pair g h) :=
{ cone := fork.of_ι (subtype.val : {x : Y // g x = h x} → Y) (funext subtype.prop),
  is_limit := fork.is_limit.mk' _ $ λ s,
    ⟨λ i, ⟨s.ι i, by apply congr_fun s.condition i⟩,
     rfl,
     λ m hm, funext $ λ x, subtype.ext (congr_fun hm x)⟩ }

variables (g h)

/-- The categorical equalizer in `Type u` is `{x : Y // g x = h x}`. -/
noncomputable def equalizer_iso : equalizer g h ≅ {x : Y // g x = h x} :=
limit.iso_limit_cone equalizer_limit

@[simp, elementwise] lemma equalizer_iso_hom_comp_subtype :
  (equalizer_iso g h).hom ≫ subtype.val = equalizer.ι g h :=
rfl

@[simp, elementwise] lemma equalizer_iso_inv_comp_ι :
  (equalizer_iso g h).inv ≫ equalizer.ι g h = subtype.val :=
limit.iso_limit_cone_inv_π equalizer_limit walking_parallel_pair.zero

end fork

section cofork
variables {X Y Z : Type u} (f g : X ⟶ Y)

/-- (Implementation) The relation to be quotiented to obtain the coequalizer. -/
inductive coequalizer_rel : Y → Y → Prop
| rel (x : X) : coequalizer_rel (f x) (g x)

/--
Show that the quotient by the relation generated by `f(x) ~ g(x)`
is a coequalizer for the pair `(f, g)`.
-/
def coequalizer_colimit : limits.colimit_cocone (parallel_pair f g) :=
{ cocone := cofork.of_π (quot.mk (coequalizer_rel f g))
    (funext (λ x, quot.sound (coequalizer_rel.rel x))),
  is_colimit := cofork.is_colimit.mk' _ $ λ s,
    ⟨ quot.lift s.π (λ a b (h : coequalizer_rel f g a b),
        by { cases h, exact congr_fun s.condition h_1 }),
      rfl,
      λ m hm, funext $ λ x, quot.induction_on x (congr_fun hm : _) ⟩ }

/-- If `π : Y ⟶ Z` is an equalizer for `(f, g)`, and `U ⊆ Y` such that `f ⁻¹' U = g ⁻¹' U`,
then `π ⁻¹' (π '' U) = U`.
-/
lemma coequalizer_preimage_image_eq_of_preimage_eq (π : Y ⟶ Z)
  (e : f ≫ π = g ≫ π) (h : is_colimit (cofork.of_π π e)) (U : set Y) (H : f ⁻¹' U = g ⁻¹' U) :
    π ⁻¹' (π '' U) = U :=
begin
  have lem : ∀ x y, (coequalizer_rel f g x y) → (x ∈ U ↔ y ∈ U),
  { rintros _ _ ⟨x⟩, change x ∈ f ⁻¹' U ↔ x ∈ g ⁻¹' U, congr' 2 },
  have eqv : _root_.equivalence (λ x y, x ∈ U ↔ y ∈ U) := by tidy,
  ext,
  split,
  { rw ← (show _ = π, from h.comp_cocone_point_unique_up_to_iso_inv
      (coequalizer_colimit f g).2 walking_parallel_pair.one),
    rintro ⟨y, hy, e'⟩,
    dsimp at e',
    replace e' := (mono_iff_injective (h.cocone_point_unique_up_to_iso
      (coequalizer_colimit f g).is_colimit).inv).mp infer_instance e',
    exact (eqv.eqv_gen_iff.mp (eqv_gen.mono lem (quot.exact _ e'))).mp hy },
  { exact λ hx, ⟨x, hx, rfl⟩ }
end

/-- The categorical coequalizer in `Type u` is the quotient by `f g ~ g x`. -/
noncomputable def coequalizer_iso : coequalizer f g ≅ _root_.quot (coequalizer_rel f g) :=
colimit.iso_colimit_cocone (coequalizer_colimit f g)

@[simp, elementwise] lemma coequalizer_iso_π_comp_hom :
  coequalizer.π f g ≫ (coequalizer_iso f g).hom = quot.mk (coequalizer_rel f g) :=
colimit.iso_colimit_cocone_ι_hom (coequalizer_colimit f g) walking_parallel_pair.one

@[simp, elementwise] lemma coequalizer_iso_quot_comp_inv :
  ↾(quot.mk (coequalizer_rel f g)) ≫ (coequalizer_iso f g).inv = coequalizer.π f g :=
rfl

end cofork

section pullback
open category_theory.limits.walking_pair
open category_theory.limits.walking_cospan
open category_theory.limits.walking_cospan.hom

variables {W X Y Z : Type u}
variables (f : X ⟶ Z) (g : Y ⟶ Z)

/--
The usual explicit pullback in the category of types, as a subtype of the product.
The full `limit_cone` data is bundled as `pullback_limit_cone f g`.
-/
@[nolint has_inhabited_instance]
abbreviation pullback_obj : Type u := { p : X × Y // f p.1 = g p.2 }

-- `pullback_obj f g` comes with a coercion to the product type `X × Y`.
example (p : pullback_obj f g) : X × Y := p

/--
The explicit pullback cone on `pullback_obj f g`.
This is bundled with the `is_limit` data as `pullback_limit_cone f g`.
-/
abbreviation pullback_cone : limits.pullback_cone f g :=
pullback_cone.mk (λ p : pullback_obj f g, p.1.1) (λ p, p.1.2) (funext (λ p, p.2))

/--
The explicit pullback in the category of types, bundled up as a `limit_cone`
for given `f` and `g`.
-/
@[simps]
def pullback_limit_cone (f : X ⟶ Z) (g : Y ⟶ Z) : limits.limit_cone (cospan f g) :=
{ cone := pullback_cone f g,
  is_limit := pullback_cone.is_limit_aux _
    (λ s x, ⟨⟨s.fst x, s.snd x⟩, congr_fun s.condition x⟩)
    (by tidy)
    (by tidy)
    (λ s m w, funext $ λ x, subtype.ext $
     prod.ext (congr_fun (w walking_cospan.left) x)
              (congr_fun (w walking_cospan.right) x)) }

/--
The pullback cone given by the instance `has_pullbacks (Type u)` is isomorphic to the
explicit pullback cone given by `pullback_limit_cone`.
-/
noncomputable def pullback_cone_iso_pullback : limit.cone (cospan f g) ≅ pullback_cone f g :=
(limit.is_limit _).unique_up_to_iso (pullback_limit_cone f g).is_limit

/--
The pullback given by the instance `has_pullbacks (Type u)` is isomorphic to the
explicit pullback object given by `pullback_limit_obj`.
-/
noncomputable def pullback_iso_pullback : pullback f g ≅ pullback_obj f g :=
(cones.forget _).map_iso $ pullback_cone_iso_pullback f g

@[simp] lemma pullback_iso_pullback_hom_fst (p : pullback f g) :
  ((pullback_iso_pullback f g).hom p : X × Y).fst = (pullback.fst : _ ⟶ X) p :=
congr_fun ((pullback_cone_iso_pullback f g).hom.w left) p

@[simp] lemma pullback_iso_pullback_hom_snd (p : pullback f g) :
  ((pullback_iso_pullback f g).hom p : X × Y).snd = (pullback.snd : _ ⟶ Y) p :=
congr_fun ((pullback_cone_iso_pullback f g).hom.w right) p

@[simp] lemma pullback_iso_pullback_inv_fst :
  (pullback_iso_pullback f g).inv ≫ pullback.fst = (λ p, (p : X × Y).fst) :=
(pullback_cone_iso_pullback f g).inv.w left

@[simp] lemma pullback_iso_pullback_inv_snd :
  (pullback_iso_pullback f g).inv ≫ pullback.snd = (λ p, (p : X × Y).snd) :=
(pullback_cone_iso_pullback f g).inv.w right

end pullback

end category_theory.limits.types


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.functor
import Mathlib.PostPort

universes v u l u₂ v₂

namespace Mathlib

/-!
# Isomorphisms

This file defines isomorphisms between objects of a category.

## Main definitions

- `structure iso` : a bundled isomorphism between two objects of a category;
- `class is_iso` : an unbundled version of `iso`; note that `is_iso f` is usually *not* a `Prop`,
  because it holds the inverse morphism;
- `as_iso` : convert from `is_iso` to `iso`;
- `of_iso` : convert from `iso` to `is_iso`;
- standard operations on isomorphisms (composition, inverse etc)

## Notations

- `X ≅ Y` : same as `iso X Y`;
- `α ≪≫ β` : composition of two isomorphisms; it is called `iso.trans`

## Tags

category, category theory, isomorphism
-/

namespace category_theory

/--
An isomorphism (a.k.a. an invertible morphism) between two objects of a category.
The inverse morphism is bundled.

See also `category_theory.core` for the category with the same objects and isomorphisms playing
the role of morphisms.

See https://stacks.math.columbia.edu/tag/0017.
-/
structure iso {C : Type u} [category C] (X : C) (Y : C)
where
  hom : X ⟶ Y
  inv : Y ⟶ X
  hom_inv_id' : autoParam (hom ≫ inv = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  inv_hom_id' : autoParam (inv ≫ hom = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem iso.hom_inv_id {C : Type u} [category C] {X : C} {Y : C} (c : iso X Y) : iso.hom c ≫ iso.inv c = 𝟙 := sorry

@[simp] theorem iso.inv_hom_id {C : Type u} [category C] {X : C} {Y : C} (c : iso X Y) : iso.inv c ≫ iso.hom c = 𝟙 := sorry

@[simp] theorem iso.hom_inv_id_assoc {C : Type u} [category C] {X : C} {Y : C} (c : iso X Y) {X' : C} (f' : X ⟶ X') : iso.hom c ≫ iso.inv c ≫ f' = f' := sorry

infixr:10 " ≅ " => Mathlib.category_theory.iso

namespace iso

theorem ext {C : Type u} [category C] {X : C} {Y : C} {α : X ≅ Y} {β : X ≅ Y} (w : hom α = hom β) : α = β := sorry

/-- Inverse isomorphism. -/
def symm {C : Type u} [category C] {X : C} {Y : C} (I : X ≅ Y) : Y ≅ X :=
  mk (inv I) (hom I)

@[simp] theorem symm_hom {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) : hom (symm α) = inv α :=
  rfl

@[simp] theorem symm_inv {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) : inv (symm α) = hom α :=
  rfl

@[simp] theorem symm_mk {C : Type u} [category C] {X : C} {Y : C} (hom : X ⟶ Y) (inv : Y ⟶ X) (hom_inv_id : hom ≫ inv = 𝟙) (inv_hom_id : inv ≫ hom = 𝟙) : symm (mk hom inv) = mk inv hom :=
  rfl

@[simp] theorem symm_symm_eq {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) : symm (symm α) = α := sorry

@[simp] theorem symm_eq_iff {C : Type u} [category C] {X : C} {Y : C} {α : X ≅ Y} {β : X ≅ Y} : symm α = symm β ↔ α = β :=
  { mp := fun (h : symm α = symm β) => symm_symm_eq α ▸ symm_symm_eq β ▸ congr_arg symm h, mpr := congr_arg symm }

/-- Identity isomorphism. -/
@[simp] theorem refl_inv {C : Type u} [category C] (X : C) : inv (refl X) = 𝟙 :=
  Eq.refl (inv (refl X))

protected instance inhabited {C : Type u} [category C] {X : C} : Inhabited (X ≅ X) :=
  { default := refl X }

@[simp] theorem refl_symm {C : Type u} [category C] (X : C) : symm (refl X) = refl X :=
  rfl

/-- Composition of two isomorphisms -/
def trans {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ≅ Y) (β : Y ≅ Z) : X ≅ Z :=
  mk (hom α ≫ hom β) (inv β ≫ inv α)

infixr:80 " ≪≫ " => Mathlib.category_theory.iso.trans

@[simp] theorem trans_mk {C : Type u} [category C] {X : C} {Y : C} {Z : C} (hom : X ⟶ Y) (inv : Y ⟶ X) (hom_inv_id : hom ≫ inv = 𝟙) (inv_hom_id : inv ≫ hom = 𝟙) (hom' : Y ⟶ Z) (inv' : Z ⟶ Y) (hom_inv_id' : hom' ≫ inv' = 𝟙) (inv_hom_id' : inv' ≫ hom' = 𝟙) (hom_inv_id'' : (hom ≫ hom') ≫ inv' ≫ inv = 𝟙) (inv_hom_id'' : (inv' ≫ inv) ≫ hom ≫ hom' = 𝟙) : mk hom inv ≪≫ mk hom' inv' = mk (hom ≫ hom') (inv' ≫ inv) :=
  rfl

@[simp] theorem trans_symm {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ≅ Y) (β : Y ≅ Z) : symm (α ≪≫ β) = symm β ≪≫ symm α :=
  rfl

@[simp] theorem trans_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {Z' : C} (α : X ≅ Y) (β : Y ≅ Z) (γ : Z ≅ Z') : (α ≪≫ β) ≪≫ γ = α ≪≫ β ≪≫ γ := sorry

@[simp] theorem refl_trans {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) : refl X ≪≫ α = α :=
  ext (category.id_comp (hom α))

@[simp] theorem trans_refl {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) : α ≪≫ refl Y = α :=
  ext (category.comp_id (hom α))

@[simp] theorem symm_self_id {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) : symm α ≪≫ α = refl Y :=
  ext (inv_hom_id α)

@[simp] theorem self_symm_id {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) : α ≪≫ symm α = refl X :=
  ext (hom_inv_id α)

@[simp] theorem symm_self_id_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ≅ Y) (β : Y ≅ Z) : symm α ≪≫ α ≪≫ β = β :=
  eq.mpr (id (Eq._oldrec (Eq.refl (symm α ≪≫ α ≪≫ β = β)) (Eq.symm (trans_assoc (symm α) α β))))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((symm α ≪≫ α) ≪≫ β = β)) (symm_self_id α)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (refl Y ≪≫ β = β)) (refl_trans β))) (Eq.refl β)))

@[simp] theorem self_symm_id_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ≅ Y) (β : X ≅ Z) : α ≪≫ symm α ≪≫ β = β :=
  eq.mpr (id (Eq._oldrec (Eq.refl (α ≪≫ symm α ≪≫ β = β)) (Eq.symm (trans_assoc α (symm α) β))))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((α ≪≫ symm α) ≪≫ β = β)) (self_symm_id α)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (refl X ≪≫ β = β)) (refl_trans β))) (Eq.refl β)))

theorem inv_comp_eq {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ≅ Y) {f : X ⟶ Z} {g : Y ⟶ Z} : inv α ≫ f = g ↔ f = hom α ≫ g := sorry

theorem eq_inv_comp {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ≅ Y) {f : X ⟶ Z} {g : Y ⟶ Z} : g = inv α ≫ f ↔ hom α ≫ g = f :=
  iff.symm (inv_comp_eq (symm α))

theorem comp_inv_eq {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ≅ Y) {f : Z ⟶ Y} {g : Z ⟶ X} : f ≫ inv α = g ↔ f = g ≫ hom α := sorry

theorem eq_comp_inv {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ≅ Y) {f : Z ⟶ Y} {g : Z ⟶ X} : g = f ≫ inv α ↔ g ≫ hom α = f :=
  iff.symm (comp_inv_eq (symm α))

theorem inv_eq_inv {C : Type u} [category C] {X : C} {Y : C} (f : X ≅ Y) (g : X ≅ Y) : inv f = inv g ↔ hom f = hom g := sorry

theorem hom_comp_eq_id {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) {f : Y ⟶ X} : hom α ≫ f = 𝟙 ↔ f = inv α :=
  eq.mpr (id (Eq._oldrec (Eq.refl (hom α ≫ f = 𝟙 ↔ f = inv α)) (Eq.symm (propext (eq_inv_comp α)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (f = inv α ≫ 𝟙 ↔ f = inv α)) (category.comp_id (inv α)))) (iff.refl (f = inv α)))

theorem comp_hom_eq_id {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) {f : Y ⟶ X} : f ≫ hom α = 𝟙 ↔ f = inv α :=
  eq.mpr (id (Eq._oldrec (Eq.refl (f ≫ hom α = 𝟙 ↔ f = inv α)) (Eq.symm (propext (eq_comp_inv α)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (f = 𝟙 ≫ inv α ↔ f = inv α)) (category.id_comp (inv α)))) (iff.refl (f = inv α)))

theorem hom_eq_inv {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (β : Y ≅ X) : hom α = inv β ↔ hom β = inv α :=
  eq.mpr (id (Eq._oldrec (Eq.refl (hom α = inv β ↔ hom β = inv α)) (propext (inv_eq_inv (symm α) β))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (hom (symm α) = hom β ↔ hom β = inv α)) (propext eq_comm)))
      (iff.refl (hom β = hom (symm α))))

end iso

/-- `is_iso` typeclass expressing that a morphism is invertible.
    This contains the data of the inverse, but is a subsingleton type. -/
class is_iso {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
where
  inv : Y ⟶ X
  hom_inv_id' : autoParam (f ≫ inv = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  inv_hom_id' : autoParam (inv ≫ f = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

/-- Reinterpret a morphism `f` with an `is_iso f` instance as an `iso`. -/
def as_iso {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [h : is_iso f] : X ≅ Y :=
  iso.mk f (inv f)

@[simp] theorem as_iso_hom {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [is_iso f] : iso.hom (as_iso f) = f :=
  rfl

@[simp] theorem as_iso_inv {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [is_iso f] : iso.inv (as_iso f) = inv f :=
  rfl

namespace is_iso

@[simp] theorem hom_inv_id {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [is_iso f] : f ≫ inv f = 𝟙 :=
  hom_inv_id'

@[simp] theorem inv_hom_id {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [is_iso f] : inv f ≫ f = 𝟙 :=
  inv_hom_id'

@[simp] theorem hom_inv_id_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) [is_iso f] (g : X ⟶ Z) : f ≫ inv f ≫ g = g :=
  iso.hom_inv_id_assoc (as_iso f) g

@[simp] theorem inv_hom_id_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) [is_iso f] (g : Y ⟶ Z) : inv f ≫ f ≫ g = g :=
  iso.inv_hom_id_assoc (as_iso f) g

protected instance id {C : Type u} [category C] (X : C) : is_iso 𝟙 :=
  mk 𝟙

protected instance of_iso {C : Type u} [category C] {X : C} {Y : C} (f : X ≅ Y) : is_iso (iso.hom f) :=
  mk (iso.inv f)

protected instance of_iso_inv {C : Type u} [category C] {X : C} {Y : C} (f : X ≅ Y) : is_iso (iso.inv f) :=
  is_iso.of_iso (iso.symm f)

protected instance inv_is_iso {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} [is_iso f] : is_iso (inv f) :=
  is_iso.of_iso_inv (as_iso f)

protected instance comp_is_iso {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {h : Y ⟶ Z} [is_iso f] [is_iso h] : is_iso (f ≫ h) :=
  is_iso.of_iso (as_iso f ≪≫ as_iso h)

@[simp] theorem inv_id {C : Type u} [category C] {X : C} : inv 𝟙 = 𝟙 :=
  rfl

@[simp] theorem inv_comp {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {h : Y ⟶ Z} [is_iso f] [is_iso h] : inv (f ≫ h) = inv h ≫ inv f :=
  rfl

@[simp] theorem inv_inv {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} [is_iso f] : inv (inv f) = f :=
  rfl

@[simp] theorem iso.inv_inv {C : Type u} [category C] {X : C} {Y : C} (f : X ≅ Y) : inv (iso.inv f) = iso.hom f :=
  rfl

@[simp] theorem iso.inv_hom {C : Type u} [category C] {X : C} {Y : C} (f : X ≅ Y) : inv (iso.hom f) = iso.inv f :=
  rfl

@[simp] theorem inv_comp_eq {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ⟶ Y) [is_iso α] {f : X ⟶ Z} {g : Y ⟶ Z} : inv α ≫ f = g ↔ f = α ≫ g :=
  iso.inv_comp_eq (as_iso α)

@[simp] theorem eq_inv_comp {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ⟶ Y) [is_iso α] {f : X ⟶ Z} {g : Y ⟶ Z} : g = inv α ≫ f ↔ α ≫ g = f :=
  iso.eq_inv_comp (as_iso α)

@[simp] theorem comp_inv_eq {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ⟶ Y) [is_iso α] {f : Z ⟶ Y} {g : Z ⟶ X} : f ≫ inv α = g ↔ f = g ≫ α :=
  iso.comp_inv_eq (as_iso α)

@[simp] theorem eq_comp_inv {C : Type u} [category C] {X : C} {Y : C} {Z : C} (α : X ⟶ Y) [is_iso α] {f : Z ⟶ Y} {g : Z ⟶ X} : g = f ≫ inv α ↔ g ≫ α = f :=
  iso.eq_comp_inv (as_iso α)

protected instance epi_of_iso {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [is_iso f] : epi f :=
  epi.mk
    fun (Z : C) (g h : Y ⟶ Z) (w : f ≫ g = f ≫ h) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (g = h)) (Eq.symm (inv_hom_id_assoc f g))))
        (eq.mpr (id (Eq._oldrec (Eq.refl (inv f ≫ f ≫ g = h)) w))
          (eq.mpr (id (Eq._oldrec (Eq.refl (inv f ≫ f ≫ h = h)) (inv_hom_id_assoc f h))) (Eq.refl h)))

protected instance mono_of_iso {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [is_iso f] : mono f :=
  mono.mk
    fun (Z : C) (g h : Z ⟶ X) (w : g ≫ f = h ≫ f) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (g = h)) (Eq.symm (category.comp_id g))))
        (eq.mpr (id (Eq._oldrec (Eq.refl (g ≫ 𝟙 = h)) (Eq.symm (category.comp_id h))))
          (eq.mpr (id (Eq._oldrec (Eq.refl (g ≫ 𝟙 = h ≫ 𝟙)) (Eq.symm (hom_inv_id f))))
            (eq.mpr (id (Eq._oldrec (Eq.refl (g ≫ f ≫ inv f = h ≫ f ≫ inv f)) (Eq.symm (category.assoc g f (inv f)))))
              (eq.mpr (id (Eq._oldrec (Eq.refl ((g ≫ f) ≫ inv f = h ≫ f ≫ inv f)) w))
                (eq.mpr
                  (id (Eq._oldrec (Eq.refl ((h ≫ f) ≫ inv f = h ≫ f ≫ inv f)) (Eq.symm (category.assoc h f (inv f)))))
                  (Eq.refl ((h ≫ f) ≫ inv f)))))))

end is_iso

theorem eq_of_inv_eq_inv {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} [is_iso f] [is_iso g] (p : inv f = inv g) : f = g := sorry

protected instance is_iso.subsingleton {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) : subsingleton (is_iso f) := sorry

theorem is_iso.inv_eq_inv {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} [is_iso f] [is_iso g] : inv f = inv g ↔ f = g :=
  iso.inv_eq_inv (as_iso f) (as_iso g)

theorem hom_comp_eq_id {C : Type u} [category C] {X : C} {Y : C} (g : X ⟶ Y) [is_iso g] {f : Y ⟶ X} : g ≫ f = 𝟙 ↔ f = inv g :=
  iso.hom_comp_eq_id (as_iso g)

theorem comp_hom_eq_id {C : Type u} [category C] {X : C} {Y : C} (g : X ⟶ Y) [is_iso g] {f : Y ⟶ X} : f ≫ g = 𝟙 ↔ f = inv g :=
  iso.comp_hom_eq_id (as_iso g)

namespace iso

/-!
All these cancellation lemmas can be solved by `simp [cancel_mono]` (or `simp [cancel_epi]`),
but with the current design `cancel_mono` is not a good `simp` lemma,
because it generates a typeclass search.

When we can see syntactically that a morphism is a `mono` or an `epi`
because it came from an isomorphism, it's fine to do the cancellation via `simp`.

In the longer term, it might be worth exploring making `mono` and `epi` structures,
rather than typeclasses, with coercions back to `X ⟶ Y`.
Presumably we could write `X ↪ Y` and `X ↠ Y`.
-/

@[simp] theorem cancel_iso_hom_left {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ≅ Y) (g : Y ⟶ Z) (g' : Y ⟶ Z) : hom f ≫ g = hom f ≫ g' ↔ g = g' := sorry

@[simp] theorem cancel_iso_inv_left {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : Y ≅ X) (g : Y ⟶ Z) (g' : Y ⟶ Z) : inv f ≫ g = inv f ≫ g' ↔ g = g' := sorry

@[simp] theorem cancel_iso_hom_right {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (f' : X ⟶ Y) (g : Y ≅ Z) : f ≫ hom g = f' ≫ hom g ↔ f = f' := sorry

@[simp] theorem cancel_iso_inv_right {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (f' : X ⟶ Y) (g : Z ≅ Y) : f ≫ inv g = f' ≫ inv g ↔ f = f' := sorry

/-
Unfortunately cancelling an isomorphism from the right of a chain of compositions is awkward.
We would need separate lemmas for each chain length (worse: for each pair of chain lengths).

We provide two more lemmas, for case of three morphisms, because this actually comes up in practice,
but then stop.
-/

@[simp] theorem cancel_iso_hom_right_assoc {C : Type u} [category C] {W : C} {X : C} {X' : C} {Y : C} {Z : C} (f : W ⟶ X) (g : X ⟶ Y) (f' : W ⟶ X') (g' : X' ⟶ Y) (h : Y ≅ Z) : f ≫ g ≫ hom h = f' ≫ g' ≫ hom h ↔ f ≫ g = f' ≫ g' := sorry

@[simp] theorem cancel_iso_inv_right_assoc {C : Type u} [category C] {W : C} {X : C} {X' : C} {Y : C} {Z : C} (f : W ⟶ X) (g : X ⟶ Y) (f' : W ⟶ X') (g' : X' ⟶ Y) (h : Z ≅ Y) : f ≫ g ≫ inv h = f' ≫ g' ≫ inv h ↔ f ≫ g = f' ≫ g' := sorry

end iso

namespace functor

/-- A functor `F : C ⥤ D` sends isomorphisms `i : X ≅ Y` to isomorphisms `F.obj X ≅ F.obj Y` -/
def map_iso {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {X : C} {Y : C} (i : X ≅ Y) : obj F X ≅ obj F Y :=
  iso.mk (map F (iso.hom i)) (map F (iso.inv i))

@[simp] theorem map_iso_hom {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {X : C} {Y : C} (i : X ≅ Y) : iso.hom (map_iso F i) = map F (iso.hom i) :=
  rfl

@[simp] theorem map_iso_inv {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {X : C} {Y : C} (i : X ≅ Y) : iso.inv (map_iso F i) = map F (iso.inv i) :=
  rfl

@[simp] theorem map_iso_symm {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {X : C} {Y : C} (i : X ≅ Y) : map_iso F (iso.symm i) = iso.symm (map_iso F i) :=
  rfl

@[simp] theorem map_iso_trans {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {X : C} {Y : C} {Z : C} (i : X ≅ Y) (j : Y ≅ Z) : map_iso F (i ≪≫ j) = map_iso F i ≪≫ map_iso F j :=
  iso.ext (map_comp F (iso.hom i) (iso.hom j))

@[simp] theorem map_iso_refl {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) (X : C) : map_iso F (iso.refl X) = iso.refl (obj F X) :=
  iso.ext (map_id F X)

protected instance map_is_iso {C : Type u} [category C] {X : C} {Y : C} {D : Type u₂} [category D] (F : C ⥤ D) (f : X ⟶ Y) [is_iso f] : is_iso (map F f) :=
  is_iso.of_iso (map_iso F (as_iso f))

@[simp] theorem map_inv {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) [is_iso f] : map F (inv f) = inv (map F f) :=
  rfl

theorem map_hom_inv {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) [is_iso f] : map F f ≫ map F (inv f) = 𝟙 := sorry

theorem map_inv_hom {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) [is_iso f] : map F (inv f) ≫ map F f = 𝟙 := sorry


import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (U : set (euclidean_space ℝ (fin n))) (hU : is_open U) (hcover : ∀ x : euclidean_space ℝ (fin n), ∃ V ∈ U, x ∈ V),
  have h1 : ∀ m : ℕ, ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))) ∧ (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → ∃ (W : set (euclidean_space ℝ (fin n))), W ∈ U ∧ V ⊆ W) ∧ (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → ∃ (W : set (euclidean_space ℝ (fin n))), W ∈ U ∧ V ∩ (closure (ball (0 : euclidean_space ℝ (fin n)) m)) ⊆ W) ∧ (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → ∃ (W : set (euclidean_space ℝ (fin n))), W ∈ U ∧ V ∩ (ball (0 : euclidean_space ℝ (fin n)) m) ⊆ W), from
    assume m : ℕ,
    have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))) ∧ (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → ∃ (W : set (euclidean_space ℝ (fin n))), W ∈ U ∧ V ⊆ W) ∧ (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → ∃ (W : set (euclidean_space ℝ (fin n))), W ∈ U ∧ V ∩ (closure (ball (0 : euclidean_space ℝ (fin n)) m)) ⊆ W), from
      have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))) ∧ (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → ∃ (W : set (euclidean_space ℝ (fin n))), W ∈ U ∧ V ⊆ W), from
        have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))) ∧ (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → ∃ (W : set (euclidean_space ℝ (fin n))), W ∈ U ∧ V ⊆ W), from
          have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))), from
            have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))), from
              have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))), from
                have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))), from
                  have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))), from
                    have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))), from
                      have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))), from
                        have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))), from
                          have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))), from
                            have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), (∀ (V : set (euclidean_space ℝ (fin n))), V ∈ Cm → V ⊆ (euclidean_space ℝ (fin n)) ∖ (closure (ball (0 : euclidean_space ℝ (fin n)) m))), from
                              have h1 : ∃
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import tactic.tidy

-- assembly verification

inductive assembly.expr
| cons : ℕ → assembly.expr
| register : fin 12 → assembly.expr

inductive assembly.cmd
| mov : assembly.expr → assembly.expr → assembly.cmd
| add : assembly.expr → assembly.expr → assembly.cmd

def assembly.program := list assembly.cmd

def assembly.state := fin 12 → ℕ

-- def assembly.run (state : assembly.state) :
--                   assembly.cmd → option assembly.state
-- | (cmd.mov (expr.cons n) (expr.register i)) := some $ λ r,
--                                                if r = i
--                                                then n
--                                                else state r
-- | (cmd.mov (expr.register j) (expr.register i)) := some $ λ r,
--                                                    if r = i
--                                                    then state j
--                                                    else state r
-- | (cmd.add a a_1) := sorry
-- | _  := none

example : ∀ n : ℕ, ∃ m : ℕ, n + 1 = m  :=
begin
    intro n,
    existsi n+1,
    refl,
end


import category_theory.limits.preserves.shapes.zero
import category_theory.abelian.homology

noncomputable theory

open category_theory category_theory.category category_theory.limits

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

namespace category_theory

variable (C)

/- TODO : define the subcategory of complexes with 3 objects, and consider
functor to this category, etc. -/

structure composable_morphisms := {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z)

instance [inhabited C] : inhabited (composable_morphisms C) := ⟨⟨𝟙 default, 𝟙 default⟩⟩

variable {C}

namespace composable_morphisms

@[ext]
structure hom (S₁ S₂ : composable_morphisms C) :=
(τ₁ : S₁.X ⟶ S₂.X) (τ₂ : S₁.Y ⟶ S₂.Y) (τ₃ : S₁.Z ⟶ S₂.Z)
(comm₁₂' : S₁.f ≫ τ₂ = τ₁ ≫ S₂.f) (comm₂₃' : S₁.g ≫ τ₃ = τ₂ ≫ S₂.g)

namespace hom

restate_axiom comm₁₂'
restate_axiom comm₂₃'

attribute [reassoc] comm₁₂
attribute [reassoc] comm₂₃

local attribute [simp] comm₁₂ comm₂₃

@[simps]
def id (S : composable_morphisms C) : hom S S :=
{ τ₁ := 𝟙 _, τ₂ := 𝟙 _, τ₃ := 𝟙 _, comm₁₂' := by simp, comm₂₃' := by simp, }

instance (S : composable_morphisms C) : inhabited (hom S S) := ⟨id S⟩

@[simps]
def comp {S₁ S₂ S₃ : composable_morphisms C} (φ : hom S₁ S₂) (ψ : hom S₂ S₃) :
  hom S₁ S₃ :=
{ τ₁ := φ.τ₁ ≫ ψ.τ₁,
  τ₂ := φ.τ₂ ≫ ψ.τ₂,
  τ₃ := φ.τ₃ ≫ ψ.τ₃,
  comm₁₂' := by simp only [comm₁₂_assoc, comm₁₂, assoc],
  comm₂₃' := by simp only [comm₂₃_assoc, comm₂₃, assoc], }

end hom

instance : category (composable_morphisms C) :=
{ hom := λ S₁ S₂, hom S₁ S₂,
  id := hom.id,
  comp := λ S₁ S₂ S₃, hom.comp, }

@[simp] lemma id_τ₁ (S : composable_morphisms C) : hom.τ₁ (𝟙 S) = 𝟙 _ := rfl
@[simp] lemma id_τ₂ (S : composable_morphisms C) : hom.τ₂ (𝟙 S) = 𝟙 _ := rfl
@[simp] lemma id_τ₃ (S : composable_morphisms C) : hom.τ₃ (𝟙 S) = 𝟙 _ := rfl

@[simp] lemma comp_τ₁ {S₁ S₂ S₃ : composable_morphisms C} (φ : S₁ ⟶ S₂) (ψ : S₂ ⟶ S₃) :
  (φ ≫ ψ).τ₁ = φ.τ₁ ≫ ψ.τ₁ := rfl
@[simp] lemma comp_τ₂ {S₁ S₂ S₃ : composable_morphisms C} (φ : S₁ ⟶ S₂) (ψ : S₂ ⟶ S₃) :
  (φ ≫ ψ).τ₂ = φ.τ₂ ≫ ψ.τ₂ := rfl
@[simp] lemma comp_τ₃ {S₁ S₂ S₃ : composable_morphisms C} (φ : S₁ ⟶ S₂) (ψ : S₂ ⟶ S₃) :
  (φ ≫ ψ).τ₃ = φ.τ₃ ≫ ψ.τ₃ := rfl

def zero (S : composable_morphisms C) [has_zero_morphisms C] : Prop := S.f ≫ S.g = 0

end composable_morphisms

namespace functor

@[simps]
def map_composable_morphisms (F : C ⥤ D) :
  composable_morphisms C ⥤ composable_morphisms D :=
{ obj := λ S, { f := F.map S.f, g := F.map S.g, },
  map := λ S₁ S₂ φ,
  { τ₁ := F.map φ.τ₁,
    τ₂ := F.map φ.τ₂,
    τ₃ := F.map φ.τ₃,
    comm₁₂' := by { dsimp, simp only [← F.map_comp, φ.comm₁₂], },
    comm₂₃' := by { dsimp, simp only [← F.map_comp, φ.comm₂₃], }, }, }

end functor

namespace composable_morphisms

@[simps]
def apply_functor (S : composable_morphisms C) (F : C ⥤ D) := F.map_composable_morphisms.obj S

end composable_morphisms

end category_theory


import data.sign

namespace int

@[elab_as_eliminator] protected lemma induction_on_iff {p : ℤ → Prop}
  (i : ℤ) (hz : p 0) (h : ∀ i : ℤ, p i ↔ p (i + 1)) : p i :=
begin
  induction i using int.induction_on with i IH i IH,
  { exact hz },
  { rwa ← h },
  { rwa [h, sub_add_cancel], }
end

end int


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import topology.continuous_function.basic

/-!
# Cocompact continuous maps

The type of *cocompact continuous maps* are those which tend to the cocompact filter on the
codomain along the cocompact filter on the domain. When the domain and codomain are Hausdorff, this
is equivalent to many other conditions, including that preimages of compact sets are compact. -/

universes u v w

open filter set

/-! ### Cocompact continuous maps -/

/-- A *cocompact continuous map* is a continuous function between topological spaces which
tends to the cocompact filter along the cocompact filter. Functions for which preimages of compact
sets are compact always satisfy this property, and the converse holds for cocompact continuous maps
when the codomain is Hausdorff (see `cocompact_map.tendsto_of_forall_preimage` and
`cocompact_map.compact_preimage`) -/
structure cocompact_map (α : Type u) (β : Type v) [topological_space α] [topological_space β]
  extends continuous_map α β : Type (max u v) :=
(cocompact_tendsto' : tendsto to_fun (cocompact α) (cocompact β))

/-- `cocompact_map_class F α β` states that `F` is a type of cocompact continuous maps.

You should also extend this typeclass when you extend `cocompact_map`. -/
class cocompact_map_class (F : Type*) (α β : out_param $ Type*) [topological_space α]
  [topological_space β] extends continuous_map_class F α β :=
(cocompact_tendsto (f : F) : tendsto f (cocompact α) (cocompact β))

namespace cocompact_map_class

variables {F α β : Type*} [topological_space α] [topological_space β]
  [cocompact_map_class F α β]

instance : has_coe_t F (cocompact_map α β) := ⟨λ f, ⟨f, cocompact_tendsto f⟩⟩

end cocompact_map_class

export cocompact_map_class (cocompact_tendsto)

namespace cocompact_map

section basics
variables {α β γ δ : Type*} [topological_space α] [topological_space β] [topological_space γ]
  [topological_space δ]

instance : cocompact_map_class (cocompact_map α β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_continuous := λ f, f.continuous_to_fun,
  cocompact_tendsto := λ f, f.cocompact_tendsto' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (cocompact_map α β) (λ _, α → β) := fun_like.has_coe_to_fun

@[simp] lemma coe_to_continuous_fun {f : cocompact_map α β} :
  (f.to_continuous_map : α → β) = f := rfl

@[ext] lemma ext {f g : cocompact_map α β} (h : ∀ x, f x = g x) : f = g := fun_like.ext _ _ h

/-- Copy of a `cocompact_map` with a new `to_fun` equal to the old one. Useful
to fix definitional equalities. -/
protected def copy (f : cocompact_map α β) (f' : α → β) (h : f' = f) : cocompact_map α β :=
{ to_fun := f',
  continuous_to_fun := by {rw h, exact f.continuous_to_fun},
  cocompact_tendsto' := by { simp_rw h, exact f.cocompact_tendsto' } }

@[simp] lemma coe_mk (f : C(α, β)) (h : tendsto f (cocompact α) (cocompact β)) :
  ⇑(⟨f, h⟩ : cocompact_map α β) = f := rfl

section
variable (α)
/-- The identity as a cocompact continuous map. -/
protected def id : cocompact_map α α := ⟨continuous_map.id _, tendsto_id⟩
@[simp] lemma coe_id : ⇑(cocompact_map.id α) = id := rfl
end

instance : inhabited (cocompact_map α α) := ⟨cocompact_map.id α⟩

/-- The composition of cocompact continuous maps, as a cocompact continuous map. -/
def comp (f : cocompact_map β γ) (g : cocompact_map α β) : cocompact_map α γ :=
⟨f.to_continuous_map.comp g, (cocompact_tendsto f).comp (cocompact_tendsto g)⟩

@[simp] lemma coe_comp (f : cocompact_map β γ) (g : cocompact_map α β) :
  ⇑(comp f g) = f ∘ g := rfl

@[simp] lemma comp_apply (f : cocompact_map β γ) (g : cocompact_map α β) (a : α) :
  comp f g a = f (g a) := rfl

@[simp] lemma comp_assoc (f : cocompact_map γ δ) (g : cocompact_map β γ)
  (h : cocompact_map α β) : (f.comp g).comp h = f.comp (g.comp h) := rfl

@[simp] lemma id_comp (f : cocompact_map α β) : (cocompact_map.id _).comp f = f :=
ext $ λ _, rfl

@[simp] lemma comp_id (f : cocompact_map α β) : f.comp (cocompact_map.id _) = f :=
ext $ λ _, rfl

lemma tendsto_of_forall_preimage {f : α → β} (h : ∀ s, is_compact s → is_compact (f ⁻¹' s)) :
  tendsto f (cocompact α) (cocompact β) :=
λ s hs, match mem_cocompact.mp hs with ⟨t, ht, hts⟩ :=
  mem_map.mpr (mem_cocompact.mpr ⟨f ⁻¹' t, h t ht, by simpa using preimage_mono hts⟩) end

/-- If the codomain is Hausdorff, preimages of compact sets are compact under a cocompact
continuous map. -/
lemma compact_preimage [t2_space β] (f : cocompact_map α β) ⦃s : set β⦄ (hs : is_compact s) :
  is_compact (f ⁻¹' s) :=
begin
  obtain ⟨t, ht, hts⟩ := mem_cocompact'.mp (by simpa only [preimage_image_preimage, preimage_compl]
    using mem_map.mp (cocompact_tendsto f $ mem_cocompact.mpr ⟨s, hs, compl_subset_compl.mpr
    (image_preimage_subset f _)⟩)),
  exact compact_of_is_closed_subset ht (hs.is_closed.preimage $ map_continuous f)
    (by simpa using hts),
end

end basics

end cocompact_map


import control proof_trace

open polya tactic expr

variables u v w x y z : ℚ

meta def polya_on_hyps' (hys : list name) (rct : bool := tt) : tactic unit :=
do exps ← hys.mmap get_local,
   bb ← add_proof_to_blackboard blackboard.mk_empty `(rat_one_gt_zero),
   bb ← add_proofs_to_blackboard bb exps,
   let pb := polya_bundle.default.set_blackboard bb,
   let (n, pb) := pb.cycle 0,
   trace ("number of cycles:", n),
   trace ("contr found", pb.contr_found),
   if bnot pb.contr_found then /-bb.trace >>-/ fail "polya failed, no contradiction found" else do
   pb.bb.contr.sketch >>= proof_sketch.trace,
   if rct then pb.bb.contr.reconstruct >>= apply >> skip
   else skip

example  (h1 : x > 0) (h2 : x < 1*1) (h3 : rat.pow (1*1 + (-1)*x) (-1) ≤ 1*(rat.pow (1*1 + (-1)*rat.pow x 2) (-1))) : false :=
by
polya_on_hyps' [`h1, `h2, `h3]

example (h1 : u > 0) (h2 : u < 1*v) (h3 : z > 0) (h4 : 1*z + 1*1 < 1*w) (h5 : rat.pow (1*u + 1*v + 1*z) 3 ≥ 1* rat.pow (1*u + 1*v + 1*w + 1*1) 5) : false :=
by  polya_on_hyps' [`h1, `h2, `h3, `h4, `h5]


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Stephen Morgan, Scott Morrison
import .monoidal_category
import categories.products.switch

namespace categories.braided_monoidal_category

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

universe variables u v

/-
-- I don't really understand why the universe annotations are needed in Braiding and in squaredBraiding.
-- My guess is that it is related to
-- https://groups.google.com/d/msg/lean-user/3qzchWkut0g/0QR6_cS8AgAJ
-/

@[reducible] definition Commutor (C : Type u) [𝒞 : monoidal_category.{u v} C] :=
  (𝒞.tensor) ⇔ ((SwitchProductCategory C C) ⋙ 𝒞.tensor)

section
variables {C : Type u} [𝒞 : monoidal_category.{u v} C]
include 𝒞

@[reducible] definition Hexagon_1 (β : Commutor C) :=
  ∀ X Y Z : C,
      ((𝟙 X) ⊗ (β.morphism.components (Y, Z)))
      ≫ (inverse_associator X Z Y)
      ≫ ((β.morphism.components (X, Z)) ⊗ (𝟙 Y)) =
      (inverse_associator X Y Z)
      ≫ (β.morphism.components (X ⊗ Y, Z))
      ≫ (inverse_associator Z X Y)

@[reducible] definition Hexagon_2 (β : Commutor C) :=
  ∀ X Y Z : C,
      ((𝟙 X) ⊗ (β.inverse.components (Z, Y)))
      ≫ (inverse_associator X Z Y)
      ≫ ((β.inverse.components (Z, X)) ⊗ (𝟙 Y)) =
      (inverse_associator X Y Z)
      ≫ (β.inverse.components (Z, X ⊗ Y))
      ≫ (inverse_associator Z X Y)
end

class Braiding (C : Type u) [monoidal_category.{u v} C] :=
  ( braiding: Commutor C )
  ( hexagon_1 : Hexagon_1 braiding )
  ( hexagon_2 : Hexagon_2 braiding )

attribute [ematch] Braiding.hexagon_1 Braiding.hexagon_2
-- PROJECT a theorem showing the hexagons hold as natural transformations

class Symmetry (C : Type u) [monoidal_category.{u v} C] extends Braiding C :=
  (symmetry: Π X Y : C, (braiding.morphism.components ⟨X, Y⟩) ≫ (braiding.morphism.components ⟨Y, X⟩) = 𝟙 (X ⊗ Y) )

attribute [simp,ematch] Symmetry.symmetry

end categories.braided_monoidal_category


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

! This file was ported from Lean 3 source module algebraic_geometry.sheafed_space
! leanprover-community/mathlib commit f384f5d1a4e39f36817b8d22afff7b52af8121d1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicGeometry.PresheafedSpace.HasColimits
import Mathbin.Topology.Sheaves.Functors

/-!
# Sheafed spaces

Introduces the category of topological spaces equipped with a sheaf (taking values in an
arbitrary target category `C`.)

We further describe how to apply functors and natural transformations to the values of the
presheaves.
-/

universe v u

open CategoryTheory

open TopCat

open TopologicalSpace

open Opposite

open CategoryTheory.Limits

open CategoryTheory.Category CategoryTheory.Functor

variable (C : Type u) [Category.{v} C]

attribute [local tidy] tactic.op_induction'

namespace AlgebraicGeometry

/-- A `SheafedSpace C` is a topological space equipped with a sheaf of `C`s. -/
structure SheafedSpace extends PresheafedSpace.{v} C where
  IsSheaf : presheaf.IsSheaf
#align algebraic_geometry.SheafedSpace AlgebraicGeometry.SheafedSpace

variable {C}

namespace SheafedSpace

instance coeCarrier : Coe (SheafedSpace C) TopCat where coe X := X.carrier
#align algebraic_geometry.SheafedSpace.coe_carrier AlgebraicGeometry.SheafedSpace.coeCarrier

/-- Extract the `sheaf C (X : Top)` from a `SheafedSpace C`. -/
def sheaf (X : SheafedSpace C) : Sheaf C (X : TopCat.{v}) :=
  ⟨X.Presheaf, X.IsSheaf⟩
#align algebraic_geometry.SheafedSpace.sheaf AlgebraicGeometry.SheafedSpace.sheaf

@[simp]
theorem as_coe (X : SheafedSpace.{v} C) : X.carrier = (X : TopCat.{v}) :=
  rfl
#align algebraic_geometry.SheafedSpace.as_coe AlgebraicGeometry.SheafedSpace.as_coe

@[simp]
theorem mk_coe (carrier) (presheaf) (h) :
    (({     carrier
            Presheaf
            IsSheaf := h } : SheafedSpace.{v} C) : TopCat.{v}) = carrier :=
  rfl
#align algebraic_geometry.SheafedSpace.mk_coe AlgebraicGeometry.SheafedSpace.mk_coe

instance (X : SheafedSpace.{v} C) : TopologicalSpace X :=
  X.carrier.str

/-- The trivial `unit` valued sheaf on any topological space. -/
def unit (X : TopCat) : SheafedSpace (discrete Unit) :=
  { @PresheafedSpace.const (discrete Unit) _ X ⟨⟨⟩⟩ with IsSheaf := Presheaf.isSheaf_unit _ }
#align algebraic_geometry.SheafedSpace.unit AlgebraicGeometry.SheafedSpace.unit

instance : Inhabited (SheafedSpace (discrete Unit)) :=
  ⟨unit (TopCat.of PEmpty)⟩

instance : Category (SheafedSpace C) :=
  show Category (InducedCategory (PresheafedSpace.{v} C) SheafedSpace.toPresheafedSpace) by
    infer_instance

/-- Forgetting the sheaf condition is a functor from `SheafedSpace C` to `PresheafedSpace C`. -/
def forgetToPresheafedSpace : SheafedSpace.{v} C ⥤ PresheafedSpace.{v} C :=
  inducedFunctor _ deriving Full, Faithful
#align algebraic_geometry.SheafedSpace.forget_to_PresheafedSpace AlgebraicGeometry.SheafedSpace.forgetToPresheafedSpace

instance is_presheafedSpace_iso {X Y : SheafedSpace.{v} C} (f : X ⟶ Y) [IsIso f] :
    @IsIso (PresheafedSpace C) _ _ _ f :=
  SheafedSpace.forgetToPresheafedSpace.map_isIso f
#align algebraic_geometry.SheafedSpace.is_PresheafedSpace_iso AlgebraicGeometry.SheafedSpace.is_presheafedSpace_iso

variable {C}

section

attribute [local simp] id comp

@[simp]
theorem id_base (X : SheafedSpace C) : (𝟙 X : X ⟶ X).base = 𝟙 (X : TopCat.{v}) :=
  rfl
#align algebraic_geometry.SheafedSpace.id_base AlgebraicGeometry.SheafedSpace.id_base

theorem id_c (X : SheafedSpace C) :
    (𝟙 X : X ⟶ X).c = eqToHom (Presheaf.Pushforward.id_eq X.Presheaf).symm :=
  rfl
#align algebraic_geometry.SheafedSpace.id_c AlgebraicGeometry.SheafedSpace.id_c

@[simp]
theorem id_c_app (X : SheafedSpace C) (U) :
    (𝟙 X : X ⟶ X).c.app U =
      eqToHom
        (by
          induction U using Opposite.rec
          cases U
          rfl) :=
  by
  induction U using Opposite.rec
  cases U
  simp only [id_c]
  dsimp
  simp
#align algebraic_geometry.SheafedSpace.id_c_app AlgebraicGeometry.SheafedSpace.id_c_app

@[simp]
theorem comp_base {X Y Z : SheafedSpace C} (f : X ⟶ Y) (g : Y ⟶ Z) :
    (f ≫ g).base = f.base ≫ g.base :=
  rfl
#align algebraic_geometry.SheafedSpace.comp_base AlgebraicGeometry.SheafedSpace.comp_base

@[simp]
theorem comp_c_app {X Y Z : SheafedSpace C} (α : X ⟶ Y) (β : Y ⟶ Z) (U) :
    (α ≫ β).c.app U = β.c.app U ≫ α.c.app (op ((Opens.map β.base).obj (unop U))) :=
  rfl
#align algebraic_geometry.SheafedSpace.comp_c_app AlgebraicGeometry.SheafedSpace.comp_c_app

theorem comp_c_app' {X Y Z : SheafedSpace C} (α : X ⟶ Y) (β : Y ⟶ Z) (U) :
    (α ≫ β).c.app (op U) = β.c.app (op U) ≫ α.c.app (op ((Opens.map β.base).obj U)) :=
  rfl
#align algebraic_geometry.SheafedSpace.comp_c_app' AlgebraicGeometry.SheafedSpace.comp_c_app'

theorem congr_app {X Y : SheafedSpace C} {α β : X ⟶ Y} (h : α = β) (U) :
    α.c.app U = β.c.app U ≫ X.Presheaf.map (eqToHom (by subst h)) :=
  PresheafedSpace.congr_app h U
#align algebraic_geometry.SheafedSpace.congr_app AlgebraicGeometry.SheafedSpace.congr_app

variable (C)

/-- The forgetful functor from `SheafedSpace` to `Top`. -/
def forget : SheafedSpace C ⥤ TopCat
    where
  obj X := (X : TopCat.{v})
  map X Y f := f.base
#align algebraic_geometry.SheafedSpace.forget AlgebraicGeometry.SheafedSpace.forget

end

open TopCat.Presheaf

/-- The restriction of a sheafed space along an open embedding into the space.
-/
def restrict {U : TopCat} (X : SheafedSpace C) {f : U ⟶ (X : TopCat.{v})} (h : OpenEmbedding f) :
    SheafedSpace C :=
  { X.toPresheafedSpace.restrict h with IsSheaf := isSheaf_of_openEmbedding h X.IsSheaf }
#align algebraic_geometry.SheafedSpace.restrict AlgebraicGeometry.SheafedSpace.restrict

/-- The restriction of a sheafed space `X` to the top subspace is isomorphic to `X` itself.
-/
def restrictTopIso (X : SheafedSpace C) : X.restrict (Opens.openEmbedding ⊤) ≅ X :=
  forgetToPresheafedSpace.preimageIso X.toPresheafedSpace.restrictTopIso
#align algebraic_geometry.SheafedSpace.restrict_top_iso AlgebraicGeometry.SheafedSpace.restrictTopIso

/-- The global sections, notated Gamma.
-/
def Γ : (SheafedSpace C)ᵒᵖ ⥤ C :=
  forgetToPresheafedSpace.op ⋙ PresheafedSpace.Γ
#align algebraic_geometry.SheafedSpace.Γ AlgebraicGeometry.SheafedSpace.Γ

theorem Γ_def : (Γ : _ ⥤ C) = forgetToPresheafedSpace.op ⋙ PresheafedSpace.Γ :=
  rfl
#align algebraic_geometry.SheafedSpace.Γ_def AlgebraicGeometry.SheafedSpace.Γ_def

@[simp]
theorem Γ_obj (X : (SheafedSpace C)ᵒᵖ) : Γ.obj X = (unop X).Presheaf.obj (op ⊤) :=
  rfl
#align algebraic_geometry.SheafedSpace.Γ_obj AlgebraicGeometry.SheafedSpace.Γ_obj

theorem Γ_obj_op (X : SheafedSpace C) : Γ.obj (op X) = X.Presheaf.obj (op ⊤) :=
  rfl
#align algebraic_geometry.SheafedSpace.Γ_obj_op AlgebraicGeometry.SheafedSpace.Γ_obj_op

@[simp]
theorem Γ_map {X Y : (SheafedSpace C)ᵒᵖ} (f : X ⟶ Y) : Γ.map f = f.unop.c.app (op ⊤) :=
  rfl
#align algebraic_geometry.SheafedSpace.Γ_map AlgebraicGeometry.SheafedSpace.Γ_map

theorem Γ_map_op {X Y : SheafedSpace C} (f : X ⟶ Y) : Γ.map f.op = f.c.app (op ⊤) :=
  rfl
#align algebraic_geometry.SheafedSpace.Γ_map_op AlgebraicGeometry.SheafedSpace.Γ_map_op

noncomputable instance [HasLimits C] :
    CreatesColimits (forgetToPresheafedSpace : SheafedSpace C ⥤ _) :=
  ⟨fun J hJ =>
    ⟨fun K =>
      creates_colimit_of_fully_faithful_of_iso
        ⟨(PresheafedSpace.colimit_cocone (K ⋙ forget_to_PresheafedSpace)).pt,
          limit_is_sheaf _ fun j => sheaf.pushforward_sheaf_of_sheaf _ (K.obj (unop j)).2⟩
        (colimit.iso_colimit_cocone ⟨_, PresheafedSpace.colimit_cocone_is_colimit _⟩).symm⟩⟩

instance [HasLimits C] : HasColimits (SheafedSpace C) :=
  has_colimits_of_has_colimits_creates_colimits forgetToPresheafedSpace

noncomputable instance [HasLimits C] : PreservesColimits (forget C) :=
  Limits.compPreservesColimits forgetToPresheafedSpace (PresheafedSpace.forget C)

end SheafedSpace

end AlgebraicGeometry


import category_theory.whiskering
import category_theory.adjunction

namespace category_theory.adjunction

open category_theory

variables (C : Type*) {D E : Type*} [category C] [category D] [category E]
  {F : D ⥤ E} {G : E ⥤ D}

def whiskering_right (adj : F ⊣ G) :
  ((whiskering_right C D E).obj F) ⊣ ((whiskering_right C E D).obj G) :=
mk_of_unit_counit
{ unit :=
  { app := λ X, (functor.right_unitor _).inv ≫
      whisker_left X adj.unit ≫ (functor.associator _ _ _).inv,
    naturality' := by { intros, ext, dsimp, simp } },
  counit :=
  { app := λ X, (functor.associator _ _ _).hom ≫
      whisker_left X adj.counit ≫ (functor.right_unitor _).hom,
    naturality' := by { intros, ext, dsimp, simp } },
  left_triangle' := by { ext, dsimp, simp },
  right_triangle' := by { ext, dsimp, simp } } .

@[simp]
lemma whiskering_right_unit (adj : F ⊣ G) (X : C ⥤ D) :
  (adj.whiskering_right C).unit.app X =
  (functor.right_unitor _).inv ≫ whisker_left X adj.unit ≫ (functor.associator _ _ _).inv := rfl

@[simp]
lemma whiskering_right_counit (adj : F ⊣ G) (X : C ⥤ E) :
  (adj.whiskering_right C).counit.app X =
  (functor.associator _ _ _).hom ≫ whisker_left X adj.counit ≫ (functor.right_unitor _).hom := rfl

end category_theory.adjunction


-- Option is a monad, by Lean's type class checker.
example : monad option := by apply_instance

/-
Option is a monad, interpreted by a set-theorist.
-/

namespace ZFC -- There is no such thing as Sort.

/-
By Kevin Buzzard and whoever else writes it.

Note. Stuff like `x` in between back quotes in these docs
is written in a new kind of language called Lean.
It's like how $x$ or $$x$$ is written in TeX.
-/

-- Let X be a set.
variable (X : Type)

/-- `option X` is a new set containing all the elements of X
    and a new element called `none`, which is definitely not in X.
    Note that it is possible to make this kind of construction,
    because of set theory. -/
inductive option
| some (x : X) : option
| none {} : option

/- theorems about this new set, including completely trivial
   ones, all go here in this chapter about `option X` -/
namespace option

variable {X}
/- The principle of induction for `option X`: If you
want to prove something about all the elements of `option X`,
you just have to prove it for `none` and for all the elements of `X`.
-/

def induction : ∀ {X : Type} {P : option X → Prop},
P none → (∀ (x : X), P (some x)) → ∀ (x : option X), P x :=
λ X C h_none h_some, @option.rec X C h_some h_none
/-
Proof: obvious
-/
-- TODO: is there a cool type theory way to switch the variables?
-- ((∘) flip) ∘ (@option.rec) doesn't work?

/- The principle of recursion for `option X`: if you
want to define something on all the elements of `option X`,
you just have to define it on `none` and on all the elements of `X`.
-/
def recursion :  ∀ {X : Type} {C : option X → Type},
C none → (∀ (x : X), C (some x)) → ∀ (x : option X), C x :=
/-
Proof: obvious
-/
λ X C c_none c_some, @option.rec X C c_some c_none

/- On Wikipedia there's a definition of a thing called a monad.
   It's a theorem that `option` is a monad. A lot of computer scientists know
   the proof. A lot of mathematicians will never need to know what this statement means.
-/
def monad : monad option := sorry

/-
Next ideas:

Theorems such as "if there's a bijection $f : X \to Y$ between `X` and` Y` then there's
lso a bijection between `option X` and `option Y`, often also called $f$ or perhaps
a typographical variant such as $f_\infty$ or something.

What else would a mathematician want to know about `option`?

How about a proof that `∀ (n : ℕ), option (fin n) ≃ fin (n+1)`?
A mathematician would say that this was obvious. We should import
`data.equiv.basic`, the theory of bijections, if we want to state and prove this.
-/

-- end of chapter on `option`
end option

-- end of "doing ZFC on a computer"
end ZFC


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module category_theory.category.Pointed
! leanprover-community/mathlib commit 10bf4f825ad729c5653adc039dafa3622e7f93c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.ConcreteCategory.Basic

/-!
# The category of pointed types

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This defines `Pointed`, the category of pointed types.

## TODO

* Monoidal structure
* Upgrade `Type_to_Pointed` to an equivalence
-/

open CategoryTheory

universe u

variable {α β : Type _}

#print Pointed /-
/-- The category of pointed types. -/
structure Pointed : Type (u + 1) where
  pt : Type u
  point : X
#align Pointed Pointed
-/

namespace Pointed

instance : CoeSort Pointed (Type _) :=
  ⟨X⟩

attribute [protected] Pointed.X

#print Pointed.of /-
/-- Turns a point into a pointed type. -/
def of {X : Type _} (point : X) : Pointed :=
  ⟨X, point⟩
#align Pointed.of Pointed.of
-/

#print Pointed.coe_of /-
@[simp]
theorem coe_of {X : Type _} (point : X) : ↥(of point) = X :=
  rfl
#align Pointed.coe_of Pointed.coe_of
-/

alias of ← _root_.prod.Pointed
#align prod.Pointed Prod.Pointed

instance : Inhabited Pointed :=
  ⟨of ((), ())⟩

#print Pointed.Hom /-
/-- Morphisms in `Pointed`. -/
@[ext]
protected structure Hom (X Y : Pointed.{u}) : Type u where
  toFun : X → Y
  map_point : to_fun X.point = Y.point
#align Pointed.hom Pointed.Hom
-/

namespace Hom

#print Pointed.Hom.id /-
/-- The identity morphism of `X : Pointed`. -/
@[simps]
def id (X : Pointed) : Hom X X :=
  ⟨id, rfl⟩
#align Pointed.hom.id Pointed.Hom.id
-/

instance (X : Pointed) : Inhabited (Hom X X) :=
  ⟨id X⟩

#print Pointed.Hom.comp /-
/-- Composition of morphisms of `Pointed`. -/
@[simps]
def comp {X Y Z : Pointed.{u}} (f : Hom X Y) (g : Hom Y Z) : Hom X Z :=
  ⟨g.toFun ∘ f.toFun, by rw [Function.comp_apply, f.map_point, g.map_point]⟩
#align Pointed.hom.comp Pointed.Hom.comp
-/

end Hom

#print Pointed.largeCategory /-
instance largeCategory : LargeCategory Pointed
    where
  Hom := Hom
  id := Hom.id
  comp := @Hom.comp
  id_comp' _ _ _ := Hom.ext _ _ rfl
  comp_id' _ _ _ := Hom.ext _ _ rfl
  assoc' _ _ _ _ _ _ _ := Hom.ext _ _ rfl
#align Pointed.large_category Pointed.largeCategory
-/

#print Pointed.concreteCategory /-
instance concreteCategory : ConcreteCategory Pointed
    where
  forget :=
    { obj := Pointed.X
      map := @Hom.toFun }
  forget_faithful := ⟨@Hom.ext⟩
#align Pointed.concrete_category Pointed.concreteCategory
-/

#print Pointed.Iso.mk /-
/-- Constructs a isomorphism between pointed types from an equivalence that preserves the point
between them. -/
@[simps]
def Iso.mk {α β : Pointed} (e : α ≃ β) (he : e α.point = β.point) : α ≅ β
    where
  Hom := ⟨e, he⟩
  inv := ⟨e.symm, e.symm_apply_eq.2 he.symm⟩
  hom_inv_id' := Pointed.Hom.ext _ _ e.symm_comp_self
  inv_hom_id' := Pointed.Hom.ext _ _ e.self_comp_symm
#align Pointed.iso.mk Pointed.Iso.mk
-/

end Pointed

#print typeToPointed /-
/-- `option` as a functor from types to pointed types. This is the free functor. -/
@[simps]
def typeToPointed : Type u ⥤ Pointed.{u}
    where
  obj X := ⟨Option X, none⟩
  map X Y f := ⟨Option.map f, rfl⟩
  map_id' X := Pointed.Hom.ext _ _ Option.map_id
  map_comp' X Y Z f g := Pointed.Hom.ext _ _ (Option.map_comp_map _ _).symm
#align Type_to_Pointed typeToPointed
-/

#print typeToPointedForgetAdjunction /-
/-- `Type_to_Pointed` is the free functor. -/
def typeToPointedForgetAdjunction : typeToPointed ⊣ forget Pointed :=
  Adjunction.mkOfHomEquiv
    { homEquiv := fun X Y =>
        { toFun := fun f => f.toFun ∘ Option.some
          invFun := fun f => ⟨fun o => o.elim Y.point f, rfl⟩
          left_inv := fun f => by
            ext
            cases x
            exact f.map_point.symm
            rfl
          right_inv := fun f => funext fun _ => rfl }
      homEquiv_naturality_left_symm := fun X' X Y f g =>
        by
        ext
        cases x <;> rfl }
#align Type_to_Pointed_forget_adjunction typeToPointedForgetAdjunction
-/


import GMLInit.Data.Basic
import GMLInit.Logic.Relation
import GMLInit.Meta.Decidable

open Ordering (lt eq gt)

class Std.LinearCmp {α} (cmp : α → α → Ordering) extends TransCmp cmp : Prop where
  eq_strict {x y : α} : cmp x y = eq → x = y

class abbrev OrientedOrd (α) [Ord α] : Prop := Std.OrientedCmp (α:=α) Ord.compare

class abbrev TransOrd (α) [Ord α] : Prop := Std.TransCmp (α:=α) Ord.compare

class abbrev LinearOrd (α) [Ord α] : Prop := Std.LinearCmp (α:=α) Ord.compare

namespace Ord
variable {α} [Ord α]

theorem eq_refl [OrientedOrd α] (x : α) : compare x x = eq := Std.OrientedCmp.cmp_refl

theorem lt_irrefl [OrientedOrd α] (x : α) : compare x x ≠ lt := eq_refl x ▸ Ordering.noConfusion

theorem gt_irrefl [OrientedOrd α] (x : α) : compare x x ≠ gt := eq_refl x ▸ Ordering.noConfusion

theorem ne_irrefl [OrientedOrd α] (x : α) : ¬(compare x x ≠ eq) := absurd (eq_refl x)

theorem le_refl [OrientedOrd α] (x : α) : compare x x ≠ gt := gt_irrefl x

theorem ge_refl [OrientedOrd α] (x : α) : compare x x ≠ lt := lt_irrefl x

theorem eq_symm [OrientedOrd α] {x y : α} : compare x y = eq → compare y x = eq := Std.OrientedCmp.cmp_eq_eq_symm.mp

theorem gt_of_lt_opp [OrientedOrd α] {x y : α} : compare x y = lt → compare y x = gt := Std.OrientedCmp.cmp_eq_gt.mpr

theorem lt_of_gt_opp [OrientedOrd α] {x y : α} : compare x y = gt → compare y x = lt := Std.OrientedCmp.cmp_eq_gt.mp

theorem ge_of_le_opp [OrientedOrd α] {x y : α} : compare x y ≠ gt → compare y x ≠ lt := mt gt_of_lt_opp

theorem le_of_ge_opp [OrientedOrd α] {x y : α} : compare x y ≠ lt → compare y x ≠ gt := mt lt_of_gt_opp

theorem le_total [OrientedOrd α] (x y : α) : compare x y ≠ gt ∨ compare y x ≠ gt :=
  match hxy : compare x y with
  | lt => Or.inl Ordering.noConfusion
  | eq => Or.inl Ordering.noConfusion
  | gt => Or.inr fun h => Ordering.noConfusion (Eq.trans (lt_of_gt_opp h).symm hxy)

theorem ge_total [OrientedOrd α] (x y : α) : compare x y ≠ lt ∨ compare y x ≠ lt :=
  match hxy : compare x y with
  | lt => Or.inr fun h => Ordering.noConfusion (Eq.trans (gt_of_lt_opp h).symm hxy)
  | eq => Or.inl Ordering.noConfusion
  | gt => Or.inl Ordering.noConfusion

theorem lt_asymm [OrientedOrd α] {x y : α} : compare x y = lt → compare y x ≠ lt := fun hxy => gt_of_lt_opp hxy ▸ Ordering.noConfusion

theorem gt_asymm [OrientedOrd α] {x y : α} : compare x y = gt → compare y x ≠ gt := fun hxy => lt_of_gt_opp hxy ▸ Ordering.noConfusion

theorem eq_subst_left [TransOrd α] {x y z : α} : compare x y = eq → compare x z = compare y z := Std.TransCmp.cmp_congr_left

theorem eq_subst_right [TransOrd α] {x y z : α} : compare x y = eq → compare z x = compare z y := Std.TransCmp.cmp_congr_right

theorem eq_trans [TransOrd α] {x y z : α} : compare x y = eq → compare y z = eq → compare x z = eq := fun hxy hyz => eq_subst_left hxy ▸ hyz

theorem lt_trans [TransOrd α] {x y z : α} : compare x y = lt → compare y z = lt → compare x z = lt := Std.TransCmp.lt_trans

theorem gt_trans [TransOrd α] {x y z : α} : compare x y = gt → compare y z = gt → compare x z = gt := Std.TransCmp.gt_trans

theorem le_trans [TransOrd α] {x y z : α} : compare x y ≠ gt → compare y z ≠ gt → compare x z ≠ gt := Std.TransCmp.le_trans

theorem ge_trans [TransOrd α] {x y z : α} : compare x y ≠ lt → compare y z ≠ lt → compare x z ≠ lt := Std.TransCmp.ge_trans

theorem lt_of_lt_of_le [TransOrd α] {x y z : α} : compare x y = lt → compare y z ≠ gt → compare x z = lt :=
  fun hxy nyz => match hyz : compare y z with
  | lt => lt_trans hxy hyz
  | eq => eq_subst_right hyz ▸ hxy
  | gt => absurd hyz nyz

theorem lt_of_le_of_lt [TransOrd α] {x y z : α} : compare x y ≠ gt → compare y z = lt → compare x z = lt :=
  fun nxy hyz => match hxy : compare x y with
  | lt => lt_trans hxy hyz
  | eq => eq_subst_left hxy ▸ hyz
  | gt => absurd hxy nxy

theorem gt_of_gt_of_ge [TransOrd α] {x y z : α} : compare x y = gt → compare y z ≠ lt → compare x z = gt :=
  fun hxy nyz => match hyz : compare y z with
  | gt => gt_trans hxy hyz
  | eq => eq_subst_right hyz ▸ hxy
  | lt => absurd hyz nyz

theorem gt_of_ge_of_gt [TransOrd α] {x y z : α} : compare x y ≠ lt → compare y z = gt → compare x z = gt :=
  fun nxy hyz => match hxy : compare x y with
  | gt => gt_trans hxy hyz
  | eq => eq_subst_left hxy ▸ hyz
  | lt => absurd hxy nxy

theorem le_or_ge [TransOrd α] (x y : α) : compare x y ≠ gt ∨ compare x y ≠ lt :=
  match compare x y with
  | lt => Or.inl Ordering.noConfusion
  | eq => Or.inl Ordering.noConfusion
  | gt => Or.inr Ordering.noConfusion

theorem eq_strict [LinearOrd α] {x y : α} : compare x y = eq → x = y := Std.LinearCmp.eq_strict

theorem connex [LinearOrd α] {x y : α} : x ≠ y → compare x y = lt ∨ compare x y = gt :=
  fun hne => match hxy : compare x y with
  | lt => Or.inl rfl
  | eq => absurd (eq_strict hxy) hne
  | gt => Or.inr rfl

theorem antisymm [LinearOrd α] {x y : α} : compare x y ≠ lt → compare x y ≠ gt → x = y :=
  fun nlt ngt => match hxy : compare x y with
  | lt => absurd hxy nlt
  | eq => eq_strict hxy
  | gt => absurd hxy ngt

theorem le_antisymm [LinearOrd α] {x y : α} : compare x y ≠ gt → compare y x ≠ gt → x = y :=
  fun nxy nyx => antisymm (ge_of_le_opp nyx) nxy

theorem ge_antisymm [LinearOrd α] {x y : α} : compare x y ≠ lt → compare y x ≠ lt → x = y :=
  fun nxy nyx => antisymm nxy (le_of_ge_opp nyx)

theorem lt_or_gt_of_ne {x y : α} : compare x y ≠ eq → compare x y = lt ∨ compare x y = gt :=
  fun hne => match h : compare x y with
  | lt => .inl rfl
  | eq => absurd h hne
  | gt => .inr rfl

theorem lt_connex [LinearOrd α] {x y : α} : x ≠ y → compare x y = lt ∨ compare y x = lt :=
  fun hne => match lt_or_gt_of_ne (mt eq_strict hne) with
  | .inl h => .inl h
  | .inr h => .inr (lt_of_gt_opp h)

theorem gt_connex [LinearOrd α] {x y : α} : x ≠ y → compare x y = gt ∨ compare y x = gt :=
  fun hne => match lt_or_gt_of_ne (mt eq_strict hne) with
  | .inr h => .inl h
  | .inl h => .inr (gt_of_lt_opp h)

section LELT
open Relation

local instance instLE : LE α := ⟨fun x y => compare x y ≠ gt⟩
local instance instLT : LT α := ⟨fun x y => compare x y = lt⟩

instance [OrientedOrd α] : Reflexive (α:=α) (.≤.) := ⟨le_refl⟩
instance [OrientedOrd α] : Irreflexive (α:=α) (.<.) := ⟨lt_irrefl⟩
instance [OrientedOrd α] : Total (α:=α) (.≤.) := ⟨le_total⟩
instance [TransOrd α] : Transitive (α:=α) (.≤.) := ⟨le_trans⟩
instance [TransOrd α] : Transitive (α:=α) (.<.) := ⟨lt_trans⟩
instance [TransOrd α] : HTransitive (α:=α) (β:=α) (γ:=α) (.≤.) (.<.) (.<.) := ⟨lt_of_le_of_lt⟩
instance [TransOrd α] : HTransitive (α:=α) (β:=α) (γ:=α) (.<.) (.≤.) (.<.) := ⟨lt_of_lt_of_le⟩
instance [LinearOrd α] : Antisymmetric (α:=α) (.≤.) := ⟨le_antisymm⟩
instance [LinearOrd α] : Connex (α:=α) (.<.) := ⟨lt_connex⟩

end LELT

end Ord


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.monoidal.discrete
import category_theory.limits.shapes.terminal
import algebra.punit_instances

/-!
# The category of monoids in a monoidal category.
-/

universes v₁ v₂ u₁ u₂ u

open category_theory
open category_theory.monoidal_category

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

/--
A monoid object internal to a monoidal category.

When the monoidal category is preadditive, this is also sometimes called an "algebra object".
-/
structure Mon_ :=
(X : C)
(one : 𝟙_ C ⟶ X)
(mul : X ⊗ X ⟶ X)
(one_mul' : (one ⊗ 𝟙 X) ≫ mul = (λ_ X).hom . obviously)
(mul_one' : (𝟙 X ⊗ one) ≫ mul = (ρ_ X).hom . obviously)
-- Obviously there is some flexibility stating this axiom.
-- This one has left- and right-hand sides matching the statement of `monoid.mul_assoc`,
-- and chooses to place the associator on the right-hand side.
-- The heuristic is that unitors and associators "don't have much weight".
(mul_assoc' : (mul ⊗ 𝟙 X) ≫ mul = (α_ X X X).hom ≫ (𝟙 X ⊗ mul) ≫ mul . obviously)

restate_axiom Mon_.one_mul'
restate_axiom Mon_.mul_one'
restate_axiom Mon_.mul_assoc'
attribute [reassoc] Mon_.one_mul Mon_.mul_one -- We prove a more general `@[simp]` lemma below.
attribute [simp, reassoc] Mon_.mul_assoc

namespace Mon_

/--
The trivial monoid object. We later show this is initial in `Mon_ C`.
-/
@[simps]
def trivial : Mon_ C :=
{ X := 𝟙_ C,
  one := 𝟙 _,
  mul := (λ_ _).hom,
  mul_assoc' :=
    by simp_rw [triangle_assoc, iso.cancel_iso_hom_right, tensor_right_iff, unitors_equal],
  mul_one' := by simp [unitors_equal] }

instance : inhabited (Mon_ C) := ⟨trivial C⟩

variables {C} {M : Mon_ C}

@[simp] lemma one_mul_hom {Z : C} (f : Z ⟶ M.X) : (M.one ⊗ f) ≫ M.mul = (λ_ Z).hom ≫ f :=
by rw [←id_tensor_comp_tensor_id, category.assoc, M.one_mul, left_unitor_naturality]

@[simp] lemma mul_one_hom {Z : C} (f : Z ⟶ M.X) : (f ⊗ M.one) ≫ M.mul = (ρ_ Z).hom ≫ f :=
by rw [←tensor_id_comp_id_tensor, category.assoc, M.mul_one, right_unitor_naturality]

lemma assoc_flip : (𝟙 M.X ⊗ M.mul) ≫ M.mul = (α_ M.X M.X M.X).inv ≫ (M.mul ⊗ 𝟙 M.X) ≫ M.mul :=
by simp

/-- A morphism of monoid objects. -/
@[ext]
structure hom (M N : Mon_ C) :=
(hom : M.X ⟶ N.X)
(one_hom' : M.one ≫ hom = N.one . obviously)
(mul_hom' : M.mul ≫ hom = (hom ⊗ hom) ≫ N.mul . obviously)

restate_axiom hom.one_hom'
restate_axiom hom.mul_hom'
attribute [simp, reassoc] hom.one_hom hom.mul_hom

/-- The identity morphism on a monoid object. -/
@[simps]
def id (M : Mon_ C) : hom M M :=
{ hom := 𝟙 M.X, }

instance hom_inhabited (M : Mon_ C) : inhabited (hom M M) := ⟨id M⟩

/-- Composition of morphisms of monoid objects. -/
@[simps]
def comp {M N O : Mon_ C} (f : hom M N) (g : hom N O) : hom M O :=
{ hom := f.hom ≫ g.hom, }

instance : category (Mon_ C) :=
{ hom := λ M N, hom M N,
  id := id,
  comp := λ M N O f g, comp f g, }

@[simp] lemma id_hom' (M : Mon_ C) : (𝟙 M : hom M M).hom = 𝟙 M.X := rfl
@[simp] lemma comp_hom' {M N K : Mon_ C} (f : M ⟶ N) (g : N ⟶ K) :
  (f ≫ g : hom M K).hom = f.hom ≫ g.hom := rfl

section
variables (C)

/-- The forgetful functor from monoid objects to the ambient category. -/
@[simps]
def forget : Mon_ C ⥤ C :=
{ obj := λ A, A.X,
  map := λ A B f, f.hom, }

end

instance forget_faithful : faithful (@forget C _ _) := { }

instance {A B : Mon_ C} (f : A ⟶ B) [e : is_iso ((forget C).map f)] : is_iso f.hom := e

/-- The forgetful functor from monoid objects to the ambient category reflects isomorphisms. -/
instance : reflects_isomorphisms (forget C) :=
{ reflects := λ X Y f e, by exactI ⟨⟨
{ hom := inv f.hom,
  mul_hom' :=
  begin
    simp only [is_iso.comp_inv_eq, hom.mul_hom, category.assoc, ←tensor_comp_assoc,
      is_iso.inv_hom_id, tensor_id, category.id_comp],
  end }, by tidy⟩⟩ }

instance unique_hom_from_trivial (A : Mon_ C) : unique (trivial C ⟶ A) :=
{ default :=
  { hom := A.one,
    one_hom' := by { dsimp, simp, },
    mul_hom' := by { dsimp, simp [A.one_mul, unitors_equal], } },
  uniq := λ f,
  begin
    ext, simp,
    rw [←category.id_comp f.hom],
    erw f.one_hom,
  end }

open category_theory.limits

instance : has_initial (Mon_ C) :=
has_initial_of_unique (trivial C)

end Mon_

namespace category_theory.lax_monoidal_functor

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

/--
A lax monoidal functor takes monoid objects to monoid objects.

That is, a lax monoidal functor `F : C ⥤ D` induces a functor `Mon_ C ⥤ Mon_ D`.
-/
-- TODO: map_Mod F A : Mod A ⥤ Mod (F.map_Mon A)
@[simps]
def map_Mon (F : lax_monoidal_functor C D) : Mon_ C ⥤ Mon_ D :=
{ obj := λ A,
  { X := F.obj A.X,
    one := F.ε ≫ F.map A.one,
    mul := F.μ _ _ ≫ F.map A.mul,
    one_mul' :=
    begin
      conv_lhs { rw [comp_tensor_id, ←F.to_functor.map_id], },
      slice_lhs 2 3 { rw [F.μ_natural], },
      slice_lhs 3 4 { rw [←F.to_functor.map_comp, A.one_mul], },
      rw [F.to_functor.map_id],
      rw [F.left_unitality],
    end,
    mul_one' :=
    begin
      conv_lhs { rw [id_tensor_comp, ←F.to_functor.map_id], },
      slice_lhs 2 3 { rw [F.μ_natural], },
      slice_lhs 3 4 { rw [←F.to_functor.map_comp, A.mul_one], },
      rw [F.to_functor.map_id],
      rw [F.right_unitality],
    end,
    mul_assoc' :=
    begin
      conv_lhs { rw [comp_tensor_id, ←F.to_functor.map_id], },
      slice_lhs 2 3 { rw [F.μ_natural], },
      slice_lhs 3 4 { rw [←F.to_functor.map_comp, A.mul_assoc], },
      conv_lhs { rw [F.to_functor.map_id] },
      conv_lhs { rw [F.to_functor.map_comp, F.to_functor.map_comp] },
      conv_rhs { rw [id_tensor_comp, ←F.to_functor.map_id], },
      slice_rhs 3 4 { rw [F.μ_natural], },
      conv_rhs { rw [F.to_functor.map_id] },
      slice_rhs 1 3 { rw [←F.associativity], },
      simp only [category.assoc],
    end, },
  map := λ A B f,
  { hom := F.map f.hom,
    one_hom' := by { dsimp, rw [category.assoc, ←F.to_functor.map_comp, f.one_hom], },
    mul_hom' :=
    begin
      dsimp,
      rw [category.assoc, F.μ_natural_assoc, ←F.to_functor.map_comp, ←F.to_functor.map_comp,
        f.mul_hom],
    end },
  map_id' := λ A, by { ext, simp, },
  map_comp' := λ A B C f g, by { ext, simp, }, }

variables (C D)

/-- `map_Mon` is functorial in the lax monoidal functor. -/
def map_Mon_functor : (lax_monoidal_functor C D) ⥤ (Mon_ C ⥤ Mon_ D) :=
{ obj := map_Mon,
  map := λ F G α,
  { app := λ A,
    { hom := α.app A.X, } } }

end category_theory.lax_monoidal_functor

namespace Mon_

open category_theory.lax_monoidal_functor

namespace equiv_lax_monoidal_functor_punit

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
@[simps]
def lax_monoidal_to_Mon : lax_monoidal_functor (discrete punit.{u+1}) C ⥤ Mon_ C :=
{ obj := λ F, (F.map_Mon : Mon_ _ ⥤ Mon_ C).obj (trivial (discrete punit)),
  map := λ F G α, ((map_Mon_functor (discrete punit) C).map α).app _ }

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
@[simps]
def Mon_to_lax_monoidal : Mon_ C ⥤ lax_monoidal_functor (discrete punit.{u+1}) C :=
{ obj := λ A,
  { obj := λ _, A.X,
    map := λ _ _ _, 𝟙 _,
    ε := A.one,
    μ := λ _ _, A.mul,
    map_id' := λ _, rfl,
    map_comp' := λ _ _ _ _ _, (category.id_comp (𝟙 A.X)).symm, },
  map := λ A B f,
  { app := λ _, f.hom,
    naturality' := λ _ _ _, by { dsimp, rw [category.id_comp, category.comp_id], },
    unit' := f.one_hom,
    tensor' := λ _ _, f.mul_hom, }, }

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
@[simps]
def unit_iso :
  𝟭 (lax_monoidal_functor (discrete punit.{u+1}) C) ≅
    lax_monoidal_to_Mon C ⋙ Mon_to_lax_monoidal C :=
nat_iso.of_components (λ F,
  monoidal_nat_iso.of_components
    (λ _, F.to_functor.map_iso (eq_to_iso (by ext)))
    (by tidy) (by tidy) (by tidy))
  (by tidy)

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
@[simps]
def counit_iso : Mon_to_lax_monoidal C ⋙ lax_monoidal_to_Mon C ≅ 𝟭 (Mon_ C) :=
nat_iso.of_components (λ F, { hom := { hom := 𝟙 _, }, inv := { hom := 𝟙 _, } })
  (by tidy)

end equiv_lax_monoidal_functor_punit

open equiv_lax_monoidal_functor_punit

/--
Monoid objects in `C` are "just" lax monoidal functors from the trivial monoidal category to `C`.
-/
@[simps]
def equiv_lax_monoidal_functor_punit : lax_monoidal_functor (discrete punit.{u+1}) C ≌ Mon_ C :=
{ functor := lax_monoidal_to_Mon C,
  inverse := Mon_to_lax_monoidal C,
  unit_iso := unit_iso C,
  counit_iso := counit_iso C, }

end Mon_

/-!
Projects:
* Check that `Mon_ Mon ≌ CommMon`, via the Eckmann-Hilton argument.
  (You'll have to hook up the cartesian monoidal structure on `Mon` first, available in #3463)
* Check that `Mon_ Top ≌ [bundled topological monoids]`.
* Check that `Mon_ AddCommGroup ≌ Ring`.
  (We've already got `Mon_ (Module R) ≌ Algebra R`, in `category_theory.monoidal.internal.Module`.)
* Can you transport this monoidal structure to `Ring` or `Algebra R`?
  How does it compare to the "native" one?
* Show that if `C` is braided then `Mon_ C` is naturally monoidal.
-/