/-
Copyright (c) 2019 Robert A. Spencer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert A. Spencer, Markus Himmel
-/
import algebra.category.Group.preadditive
import category_theory.linear.basic
import category_theory.elementwise
import linear_algebra.basic
import category_theory.conj
import category_theory.preadditive.additive_functor

/-!
# The category of `R`-modules

`Module.{v} R` is the category of bundled `R`-modules with carrier in the universe `v`. We show
that it is preadditive and show that being an isomorphism, monomorphism and epimorphism is
equivalent to being a linear equivalence, an injective linear map and a surjective linear map,
respectively.

## Implementation details

To construct an object in the category of `R`-modules from a type `M` with an instance of the
`module` typeclass, write `of R M`. There is a coercion in the other direction.

Similarly, there is a coercion from morphisms in `Module R` to linear maps.

Unfortunately, Lean is not smart enough to see that, given an object `M : Module R`, the expression
`of R M`, where we coerce `M` to the carrier type, is definitionally equal to `M` itself.
This means that to go the other direction, i.e., from linear maps/equivalences to (iso)morphisms
in the category of `R`-modules, we have to take care not to inadvertently end up with an
`of R M` where `M` is already an object. Hence, given `f : M →ₗ[R] N`,
* if `M N : Module R`, simply use `f`;
* if `M : Module R` and `N` is an unbundled `R`-module, use `↿f` or `as_hom_left f`;
* if `M` is an unbundled `R`-module and `N : Module R`, use `↾f` or `as_hom_right f`;
* if `M` and `N` are unbundled `R`-modules, use `↟f` or `as_hom f`.

Similarly, given `f : M ≃ₗ[R] N`, use `to_Module_iso`, `to_Module_iso'_left`, `to_Module_iso'_right`
or `to_Module_iso'`, respectively.

The arrow notations are localized, so you may have to `open_locale Module` to use them. Note that
the notation for `as_hom_left` clashes with the notation used to promote functions between types to
morphisms in the category `Type`, so to avoid confusion, it is probably a good idea to avoid having
the locales `Module` and `category_theory.Type` open at the same time.

If you get an error when trying to apply a theorem and the `convert` tactic produces goals of the
form `M = of R M`, then you probably used an incorrect variant of `as_hom` or `to_Module_iso`.

-/

open category_theory
open category_theory.limits
open category_theory.limits.walking_parallel_pair

universes v u

variables (R : Type u) [ring R]

/-- The category of R-modules and their morphisms.

 Note that in the case of `R = ℤ`, we can not
impose here that the `ℤ`-multiplication field from the module structure is defeq to the one coming
from the `is_add_comm_group` structure (contrary to what we do for all module structures in
mathlib), which creates some difficulties down the road. -/
structure Module :=
(carrier : Type v)
[is_add_comm_group : add_comm_group carrier]
[is_module : module R carrier]

attribute [instance] Module.is_add_comm_group Module.is_module

namespace Module

instance : has_coe_to_sort (Module.{v} R) (Type v) := ⟨Module.carrier⟩

instance Module_category : category (Module.{v} R) :=
{ hom   := λ M N, M →ₗ[R] N,
  id    := λ M, 1,
  comp  := λ A B C f g, g.comp f,
  id_comp' := λ X Y f, linear_map.id_comp _,
  comp_id' := λ X Y f, linear_map.comp_id _,
  assoc' := λ W X Y Z f g h, linear_map.comp_assoc _ _ _ }

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

instance has_forget_to_AddCommGroup : has_forget₂ (Module R) AddCommGroup :=
{ forget₂ :=
  { obj := λ M, AddCommGroup.of M,
    map := λ M₁ M₂ f, linear_map.to_add_monoid_hom f } }

instance (M N : Module R) : linear_map_class (M ⟶ N) R M N :=
{ coe := λ f, f,
  .. linear_map.semilinear_map_class }

/-- The object in the category of R-modules associated to an R-module -/
def of (X : Type v) [add_comm_group X] [module R X] : Module R := ⟨X⟩

@[simp] lemma forget₂_obj (X : Module R) :
  (forget₂ (Module R) AddCommGroup).obj X = AddCommGroup.of X :=
rfl

@[simp] lemma forget₂_obj_Module_of (X : Type v) [add_comm_group X] [module R X] :
  (forget₂ (Module R) AddCommGroup).obj (of R X) = AddCommGroup.of X :=
rfl

@[simp] lemma forget₂_map (X Y : Module R) (f : X ⟶ Y) :
  (forget₂ (Module R) AddCommGroup).map f = linear_map.to_add_monoid_hom f :=
rfl

/-- Typecheck a `linear_map` as a morphism in `Module R`. -/
def of_hom {R : Type u} [ring R] {X Y : Type v} [add_comm_group X] [module R X] [add_comm_group Y]
  [module R Y] (f : X →ₗ[R] Y) : of R X ⟶ of R Y := f

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

instance : inhabited (Module R) := ⟨of R punit⟩

instance of_unique {X : Type v} [add_comm_group X] [module R X] [i : unique X] :
  unique (of R X) := i

@[simp]
lemma coe_of (X : Type v) [add_comm_group X] [module R X] : (of R X : Type v) = X := rfl

variables {R}

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

lemma is_zero_of_subsingleton (M : Module R) [subsingleton M] :
  is_zero M :=
begin
  refine ⟨λ X, ⟨⟨⟨0⟩, λ f, _⟩⟩, λ X, ⟨⟨⟨0⟩, λ f, _⟩⟩⟩,
  { ext, have : x = 0 := subsingleton.elim _ _, rw [this, map_zero, map_zero], },
  { ext, apply subsingleton.elim }
end

instance : has_zero_object (Module.{v} R) :=
⟨⟨of R punit, is_zero_of_subsingleton _⟩⟩

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

@[simp] lemma id_apply (m : M) : (𝟙 M : M → M) m = m := rfl

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

lemma comp_def (f : M ⟶ N) (g : N ⟶ U) : f ≫ g = g.comp f := rfl

end Module

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

/-- Reinterpreting a linear map in the category of `R`-modules. -/
def Module.as_hom [add_comm_group X₁] [module R X₁] [add_comm_group X₂] [module R X₂] :
  (X₁ →ₗ[R] X₂) → (Module.of R X₁ ⟶ Module.of R X₂) := id

localized "notation (name := Module.as_hom) `↟` f : 1024 := Module.as_hom f" in Module

/-- Reinterpreting a linear map in the category of `R`-modules. -/
def Module.as_hom_right [add_comm_group X₁] [module R X₁] {X₂ : Module.{v} R} :
  (X₁ →ₗ[R] X₂) → (Module.of R X₁ ⟶ X₂) := id

localized "notation (name := Module.as_hom_right) `↾` f : 1024 := Module.as_hom_right f" in Module

/-- Reinterpreting a linear map in the category of `R`-modules. -/
def Module.as_hom_left {X₁ : Module.{v} R} [add_comm_group X₂] [module R X₂] :
  (X₁ →ₗ[R] X₂) → (X₁ ⟶ Module.of R X₂) := id

localized "notation (name := Module.as_hom_left) `↿` f : 1024 := Module.as_hom_left f" in Module

/-- Build an isomorphism in the category `Module R` from a `linear_equiv` between `module`s. -/
@[simps]
def linear_equiv.to_Module_iso
  {g₁ : add_comm_group X₁} {g₂ : add_comm_group X₂} {m₁ : module R X₁} {m₂ : module R X₂}
  (e : X₁ ≃ₗ[R] X₂) :
  Module.of R X₁ ≅ Module.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, }

/--
Build an isomorphism in the category `Module R` from a `linear_equiv` between `module`s.

This version is better than `linear_equiv_to_Module_iso` when applicable, because Lean can't see
`Module.of R M` is defeq to `M` when `M : Module R`. -/
@[simps]
def linear_equiv.to_Module_iso' {M N : Module.{v} R} (i : M ≃ₗ[R] N) : M ≅ N :=
{ hom := i,
  inv := i.symm,
  hom_inv_id' := linear_map.ext $ λ x, by simp,
  inv_hom_id' := linear_map.ext $ λ x, by simp }

/--
Build an isomorphism in the category `Module R` from a `linear_equiv` between `module`s.

This version is better than `linear_equiv_to_Module_iso` when applicable, because Lean can't see
`Module.of R M` is defeq to `M` when `M : Module R`. -/
@[simps]
def linear_equiv.to_Module_iso'_left {X₁ : Module.{v} R} {g₂ : add_comm_group X₂} {m₂ : module R X₂}
  (e : X₁ ≃ₗ[R] X₂) : X₁ ≅ Module.of R X₂ :=
{ hom := (e : X₁ →ₗ[R] X₂),
  inv := (e.symm : X₂ →ₗ[R] X₁),
  hom_inv_id' := linear_map.ext $ λ x, by simp,
  inv_hom_id' := linear_map.ext $ λ x, by simp }

/--
Build an isomorphism in the category `Module R` from a `linear_equiv` between `module`s.

This version is better than `linear_equiv_to_Module_iso` when applicable, because Lean can't see
`Module.of R M` is defeq to `M` when `M : Module R`. -/
@[simps]
def linear_equiv.to_Module_iso'_right {g₁ : add_comm_group X₁} {m₁ : module R X₁}
  {X₂ : Module.{v} R} (e : X₁ ≃ₗ[R] X₂) : Module.of R X₁ ≅ X₂ :=
{ hom := (e : X₁ →ₗ[R] X₂),
  inv := (e.symm : X₂ →ₗ[R] X₁),
  hom_inv_id' := linear_map.ext $ λ x, by simp,
  inv_hom_id' := linear_map.ext $ λ x, by simp }

namespace category_theory.iso

/-- Build a `linear_equiv` from an isomorphism in the category `Module R`. -/
@[simps]
def to_linear_equiv {X Y : Module 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_smul' := by tidy, }.

end category_theory.iso

/-- linear equivalences between `module`s are the same as (isomorphic to) isomorphisms
in `Module` -/
@[simps]
def linear_equiv_iso_Module_iso {X Y : Type u} [add_comm_group X] [add_comm_group Y] [module R X]
  [module R Y] :
  (X ≃ₗ[R] Y) ≅ (Module.of R X ≅ Module.of R Y) :=
{ hom := λ e, e.to_Module_iso,
  inv := λ i, i.to_linear_equiv, }

namespace Module

instance : preadditive (Module.{v} R) :=
{ add_comp' := λ P Q R f f' g,
    show (f + f') ≫ g = f ≫ g + f' ≫ g, by { ext, simp },
  comp_add' := λ P Q R f g g',
    show f ≫ (g + g') = f ≫ g + f ≫ g', by { ext, simp } }

instance forget₂_AddCommGroup_additive : (forget₂ (Module.{v} R) AddCommGroup).additive := {}

section
variables {S : Type u} [comm_ring S]

instance : linear S (Module.{v} S) :=
{ hom_module := λ X Y, linear_map.module,
  smul_comp' := by { intros, ext, simp },
  comp_smul' := by { intros, ext, simp }, }

variables {X Y X' Y' : Module.{v} S}

lemma iso.hom_congr_eq_arrow_congr (i : X ≅ X') (j : Y ≅ Y') (f : X ⟶ Y) :
  iso.hom_congr i j f = linear_equiv.arrow_congr i.to_linear_equiv j.to_linear_equiv f := rfl

lemma iso.conj_eq_conj (i : X ≅ X') (f : End X) :
  iso.conj i f = linear_equiv.conj i.to_linear_equiv f := rfl

end

end Module

instance (M : Type u) [add_comm_group M] [module R M] : has_coe (submodule R M) (Module R) :=
⟨ λ N, Module.of R N ⟩


import ...for_mathlib.manifolds

noncomputable theory

open_locale manifold classical big_operators
open set

universe u

/-!
## Reminder on updating the exercises

These instructions are now available at:
https://leanprover-community.github.io/lftcm2020/exercises.html

To get a new copy of the exercises,
run the following commands in your terminal:

```
leanproject get lftcm2020
cp -r lftcm2020/src/exercises_sources/ lftcm2020/src/my_exercises
code lftcm2020
```

To update your exercise files, run the following commands:

```
cd /path/to/lftcm2020
git pull
leanproject get-mathlib-cache
```

Don’t forget to copy the updated files to `src/my_exercises`.

-/

/-!
## An overview of manifolds in Lean, discussing design decisions

Warning: there are sorries in this section, they are not supposed to be filled! The exercises sections
start later, and there you will have plenty of sorries to fill.

What is a manifold?

1) allow field other than `ℝ` or `ℂ`?
2) allow infinite dimension?
3) allow boundary?
4) allow model space depending on the point of the manifold?

Bourbaki: 2, 4 (and just definitions and statements, no proofs!)
Lean: 1, 2, 3

Perelman geometrization theorem : any compact connected irreducible 3-manifold can
be cut along tori into finitely many pieces, each of which has a _geometric structure_ of
finite volume, i.e., it is locally like a model space, with changes of coordinates given
locally by the action of a Lie group

Typical dynamics theorem : let `M` be a compact manifold, and `f : M → M` a map with property
such and such. Then ...

Or : Consider a hyperbolic surface of genus `g`, and a random geodesic of length `T`. How many
times does it typically self-intersect?

Manifold in Lean:

* charted space structure, i.e., set of local homeos to a model space. This is data, fixed
  once and for all (and a typeclass)
* compatibility condition, i.e., the change of coordinates should belong to some subgroup
  of the group of local homeos of the model space. This is Prop (and a typeclass). The same
  manifold can be at the same time an analytic manifold, a smooth manifold and a topological
  manifold (with the same fixed atlas).
* A charted space is a smooth manifold (with corners) if it is compatible with the smooth
  groupoid on the model space. To cover uniformly both situations with and without boundary,
  the smooth groupoid is with respect to a map `I : H → E` (think of `H` as the half-space and
  `E` the full space), which is the identity in the boundaryless situation, the inclusion in
  the half-space situation. This map `I` is called a _model with corners_. The most standard ones
  (identity in `ℝ^n` and inclusion of half-space in `ℝ^n`) have dedicated notations:
  `𝓡 n` and `𝓡∂ n`.
-/

#check charted_space (euclidean_half_space 1) (Icc (0 : ℝ) 1)
#check has_groupoid (Icc (0 : ℝ) 1) (cont_diff_groupoid ∞ (𝓡∂ 1))
#check smooth_manifold_with_corners (𝓡∂ 1) (Icc (0 : ℝ) 1)

-- atlases are not maximal in general

#check (cont_diff_groupoid ∞ (𝓡∂ 1)).maximal_atlas (Icc (0 : ℝ) 1)

-- let's try to put a smooth manifold structure on the sphere
-- (we don't have submanifolds yet, but it's coming in the near future)

@[derive topological_space]
definition sphere (n : ℕ) : Type := metric.sphere (0 : euclidean_space ℝ (fin (n+1))) 1

instance (n : ℕ) : has_coe (sphere n) (euclidean_space ℝ (fin (n+1))) := ⟨subtype.val⟩

instance (n : ℕ) : charted_space (euclidean_space ℝ (fin n)) (sphere n) :=
{ atlas            := begin sorry end,
  chart_at         := begin sorry end,
  mem_chart_source := begin sorry end,
  chart_mem_atlas  := begin sorry end }

instance (n : ℕ) : smooth_manifold_with_corners (𝓡 n) (sphere n) :=
{ compatible := begin
    assume e e' he he',
    sorry
  end }

-- smooth functions

def inc (n : ℕ) : sphere n → euclidean_space ℝ (fin (n+1)) :=
λ p : sphere n, (p : euclidean_space ℝ (fin (n+1)))

lemma inc_smooth (n : ℕ) : cont_mdiff (𝓡 n) (𝓡 (n+1)) ∞ (inc n) :=
begin
  rw cont_mdiff_iff,
  split,
  { exact continuous_subtype_coe, },
  { assume x y,
    sorry }
end

lemma inc_continuous (n : ℕ) : continuous (inc n) :=
(inc_smooth n).continuous

lemma inc_mdifferentiable (n : ℕ) : mdifferentiable (𝓡 n) (𝓡 (n+1)) (inc n) :=
(inc_smooth n).mdifferentiable le_top

-- tangent space and tangent bundles

example (n : ℕ) (p : sphere n) (v : tangent_space (𝓡 n) p) :
  tangent_bundle (𝓡 n) (sphere n) :=
⟨p, v⟩

-- tangent map, derivatives

example (n : ℕ) : cont_mdiff ((𝓡 n).prod (𝓡 n)) ((𝓡 (n+1)).prod (𝓡 (n+1))) ∞
  (tangent_map (𝓡 n) (𝓡 (n+1)) (inc n)) :=
(inc_smooth n).cont_mdiff_tangent_map le_top

example (n : ℕ) (f : sphere n → sphere (n^2)) (p : sphere n) (v : tangent_space (𝓡 n) p) :
  mfderiv (𝓡 n) (𝓡 (n^2)) f p v = (tangent_map (𝓡 n) (𝓡 (n^2)) f ⟨p, v⟩).2 :=
rfl

/- Can you express the sphere eversion theorem, i.e., the fact that there is a smooth isotopy
of immersions between the canonical embedding of the sphere `S^2` and `ℝ^3`, and the antipodal
embedding?

Note that we haven't defined immersions in mathlib, but you can jut require that the fiber
derivative is injective everywhere, which is easy to express if you know that the derivative
of a function `f` from a manifold of dimension `2` to a manifold of dimension `3` at a point `x` is
`mfderiv (𝓡 2) (𝓡 3) f x`.

Don't forget to require the global smoothness of the map! You may need to know that the interval
`[0,1]`, called `Icc (0 : ℝ) 1` in Lean, already has a manifold (with boundary!) structure,
where the corresponding model with corners is called `𝓡∂ 1`.
-/
theorem sphere_eversion :
  ∃ f : (Icc (0 : ℝ) 1) × sphere 2 → euclidean_space ℝ (fin 3),
  cont_mdiff ((𝓡∂ 1).prod (𝓡 2)) (𝓡 3) ∞ f
  ∧ ∀ (t : (Icc (0 : ℝ) 1)), ∀ (p : sphere 2),
    function.injective (mfderiv (𝓡 2) (𝓡 3) (f ∘ λ y, (t, y)) p)
  ∧ ∀ (p : sphere 2), f (0, p) = p
  ∧ ∀ (p : sphere 2), f (1, p) = - p :=
sorry

/- Dicussing three (controversial?) design decisions

#### Local homeos

What is a local homeo `f` between an open subset of `E` and an open subset of `F`?
1) a map defined on a subtype: `f x` only makes sense for `x : f.source`
2) a map defined on the whole space `E`, but taking values in `option F = F ∪ {junk}`, with
  `f x = junk` when `x ∉ f.source`
3) a map defined on the whole space `E`, taking values in `F`, and we don't care about its values
  outside of `f.source`.

Just like division by zero! But worse:

* issue with 1): you keep intersecting chart domains. But the subtype `u ∩ v` is not the same as
  the subtype `v ∩ u`, so you keep adding casts everywhere
* issue with 2): if you want to say that a chart is smooth, then you define to define smooth functions
  between `option E` and `option F` when `E` and `F` are vector spaces. All notions need to be
  redefined with `option`.
* issue with 3): it works perfectly well, but it makes mathematicians unhappy/uneasy (and it is *not*
  equivalent to 1) or 2) when one of the spaces is empty)

I picked 3)

#### Tangent vectors

What is a tangent vector (for a manifold `M` modelled on a vector space `E`)?
1) An equivalence class of germs of curves
2) A derivation
3) Physicist point of view: I don't know what a tangent vector is, but I know in charts.
  Mathematician's interpretation: equivalence class of `(e, v)` where `e` is a chart at `x`, `v` a vector
  in the vector space, and `(e, v) ∼ (e', v')` if `D(e' ∘ e ⁻¹) v = v'`
4) ...

Issues:
1) Pictures are pretty, but this doesn't bring anything compared to 3) when you go down to details.
   And what about boundaries, where you can only have a half-curve
2) Need partitions of unity to show that this is local and coincides with the usual point of view.
   Doesn't work well in finite smoothness, nor in complex manifolds
3) Fine, works in all situations, but requires a lot of work to define the equivalence classes,
   the topology, check that the topology is compatible with the vector space structure, and so on.
   In a vector space, the tangent space is not defeq to the vector space itself
4) Pick one favorite chart at `x`, say `e_x`, and *define* the tangent space at `x` to be `E`,
   but "seen" in the chart `e_x` (this will show up in the definition of the derivative : the
   derivative of `f : M → M'` at `x` is defined to be the derivative of the map
   `e_{f x} ∘ f ∘ e_x⁻¹`). Works perfectly fine, but makes mathematicians unhappy/uneasy.
   (Axiom of choice? In fact we put the choice of `e_x` in the *definition* of charted spaces,
   so not further choice)

I picked 4)

#### Smooth functions in manifolds with boundary

Usual definition of smooth functions in a half space: extend to a smooth function a little bit
beyond the boundary, so one only really needs to speak of smooth functions in open subsets of
vector spaces.

When you define the derivative, you will need to check that it does not depend on the choice
of the extension. Even worse when you want to define the tangent bundle: choose an open extension
of your manifold with boundary, and then check that the restriction of the tangent bundle does
not depend on the choice of the extension. Very easy when handwaving, nightmare to formalize.
(What is the extension of the manifold with boundary? Another type?)

Instead, if you define derivatives in (non-open) domains, you can talk of smooth functions in
domains, and do everything without extending. Need to know this early enough: when starting to
define derivatives, you should already think of manifolds with boundaries! That's what we did
in mathlib.

Difficulty: if a domain `s` is too small (think `s = ℝ ⊆ ℝ^2`), the values of `f` on `s` do not
prescribe uniquely a derivative, so `fderiv_within_at ℝ f s x` may behave badly: the derivative of
a sum might be different from sum of derivatives, as there is an arbitrary choice to be made.
This does not happen with the half-space, as it is large enough: derivatives within domains only
work well if the tangent directions span the whole space. Predicate `unique_diff_on` for sets
in vector spaces. You won't find this in books!
-/

/-! ## Exercises -/

/-! ### Local homeomorphisms

Local homeomorphisms are globally defined maps with a globally defined "inverse", but the only
relevant set is the *source*, which should be mapped homeomorphically to the *target*.
-/

-- set up a simple helper simp lemma to simplify our life later.
@[simp] lemma neg_mem_Ioo_minus_one_one (x : ℝ) : -x ∈ Ioo (-1 : ℝ) 1 ↔ x ∈ Ioo (-1 : ℝ) 1 :=
begin
  sorry
end

/- Define a local homeomorphism from `ℝ` to `ℝ` which is just `x ↦ -x`, but on `(-1, 1)`. In
Lean, the interval `(-1, 1)` is denoted by `Ioo (-1 : ℝ) 1` (where `o` stands for _open_). -/

def my_first_local_homeo : local_homeomorph ℝ ℝ :=
{ to_fun := λ x, -x,
  inv_fun := λ x, -x,
  source := Ioo (-1) 1,
  target := sorry,
  map_source' :=
  begin
    sorry
  end,
  map_target' :=
  begin
    sorry
  end,
  left_inv' :=
  begin
    sorry
  end,
  right_inv' :=
  begin
    sorry
  end,
  open_source := sorry,
  open_target := sorry,
  continuous_to_fun := sorry,
  continuous_inv_fun := sorry }

/- Two simple lemmas that will prove useful below. You can leave them sorried if you like. -/

lemma ne_3_of_mem_Ioo {x : ℝ} (h : x ∈ Ioo (-1 : ℝ) 1) : x ≠ 3 :=
begin
  sorry
end

lemma neg_ne_3_of_mem_Ioo {x : ℝ} (h : x ∈ Ioo (-1 : ℝ) 1) : -x ≠ 3 :=
begin
sorry
end

/- Now, define a second local homeomorphism which is almost like the previous one.  You may find the
following lemma useful for `continuous_to_fun`: -/
#check continuous_on.congr

def my_second_local_homeo : local_homeomorph ℝ ℝ :=
{ to_fun := λ x, if x = 3 then 0 else - x,
  inv_fun := λ x, -x,
  source := Ioo (-1) 1,
  target := sorry,
  map_source' := sorry,
  map_target' := sorry,
  left_inv' := sorry,
  right_inv' := sorry,
  open_source := sorry,
  open_target := sorry,
  continuous_to_fun :=
  begin
    sorry
  end,
  continuous_inv_fun := sorry }

/- Although the two above local homeos are the same for all practical purposes as they coincide
where relevant, they are not *equal*: -/

lemma my_first_local_homeo_ne_my_second_local_homeo :
  my_first_local_homeo ≠ my_second_local_homeo :=
begin
  sorry
end

/- The right equivalence relation for local homeos is not equality, but `eq_on_source`.
Indeed, the two local homeos we have defined above coincide from this point of view. -/

#check local_homeomorph.eq_on_source

lemma eq_on_source_my_first_local_homeo_my_second_local_homeo :
  local_homeomorph.eq_on_source my_first_local_homeo my_second_local_homeo :=
begin
  sorry
end

/-! ### An example of a charted space structure on `ℝ`

A charted space is a topological space together with a set of local homeomorphisms to a model space,
whose sources cover the whole space. For instance, `ℝ` is already endowed with a charted space
structure with model space `ℝ`, where the unique chart is the identity:
-/

#check charted_space_self ℝ

/- For educational purposes only, we will put another charted space structure on `ℝ` using the
local homeomorphisms we have constructed above. To avoid using too much structure of `ℝ` (and to
avoid confusing Lean), we will work with a copy of `ℝ`, on which we will only register the
topology. -/

@[derive topological_space]
def myℝ : Type := ℝ

instance : charted_space ℝ myℝ :=
{ atlas := { local_homeomorph.refl ℝ, my_first_local_homeo },
  chart_at := λ x, if x ∈ Ioo (-1 : ℝ) 1 then my_first_local_homeo else local_homeomorph.refl ℝ,
  mem_chart_source :=
  begin
  sorry
  end,
  chart_mem_atlas :=
  begin
    sorry
  end }

/- Now come more interesting bits. We have endowed `myℝ` with a charted space structure, with charts
taking values in `ℝ`. We want to say that this is a smooth structure, i.e., the changes of
coordinates are smooth. In Lean, this is written with `has_groupoid`. A groupoid is a set
of local homeomorphisms of the model space (for example, local homeos that are smooth on their
domain). A charted space admits the groupoid as a structure groupoid if all the changes of
coordinates belong to the groupoid.

There is a difficulty that the definitions are set up to be able to also speak of smooth manifolds
with boundary or with corners, so the name of the smooth groupoid on `ℝ` has the slightly strange
name `cont_diff_groupoid ∞ (model_with_corners_self ℝ ℝ)`. To avoid typing again and again
`model_with_corners_self ℝ ℝ`, let us introduce a shortcut
-/

abbreviation 𝓡1 := model_with_corners_self ℝ ℝ

/- In the library, there are such shortcuts for manifolds modelled on `ℝ^n`, denoted with `𝓡 n`,
but for `n = 1` this does not coincide with the above one, as `ℝ^1` (a.k.a. `fin 1 → ℝ`) is not
the same as `ℝ`! Still, since they are of the same nature, the notation we have just introduced
is very close, compare `𝓡1` with `𝓡 1` (and try not to get confused): -/

instance smooth_myℝ : has_groupoid myℝ (cont_diff_groupoid ∞ 𝓡1) :=
begin
  -- in theory, we should prove that all compositions of charts are diffeos, i.e., they are smooth
  -- and their inverse are smooth. For symmetry reasons, it suffices to check one direction
  apply has_groupoid_of_pregroupoid,
  -- take two charts `e` and `e'`
  assume e e' he he',
  -- if next line is a little bit slow for your taste, you can replace `simp` with `squeeze_simp`
  -- and then follow the advice
  simp [atlas] at he he',
  dsimp,
  -- to continue, some hints:
  -- (1) don't hesitate to use the fact that the restriction of a smooth function to a
  -- subset is still smooth there (`cont_diff.cont_diff_on`)
  -- (2) hopefully, there is a theorem saying that the negation function is smooth.
  -- you can either try to guess its name, or hope that `suggest` will help you there.
  sorry
end

/- The statement of the previous instance is not very readable. There is a shortcut notation: -/

instance : smooth_manifold_with_corners 𝓡1 myℝ := { .. smooth_myℝ }

/- We will now study a very simple map from `myℝ` to `ℝ`, the identity. -/

def my_map : myℝ → ℝ := λ x, x

/- The map `my_map` is a map going from the type `myℝ` to the type `ℝ`. From the point of view of
the kernel of Lean, it is just the identity, but from the point of view of structures on `myℝ`
and `ℝ` it might not be trivial, as we have registered different instances on these two types. -/

/- The continuity should be trivial, as the topologies on `myℝ` and `ℝ` are definitionally the
same. So `continuous_id` might help. -/

lemma continuous_my_map : continuous my_map :=
sorry

/- Smoothness should not be obvious, though, as the manifold structures are not the same: the atlas
on `myℝ` has two elements, while the atlas on `ℝ` has one single element.
Note that `myℝ` is not a vector space, nor a normed space, so one can not ask whether `my_map`
is smooth in the usual sense (as a map between vector spaces): -/

-- lemma cont_diff_my_map : cont_diff ℝ ∞ my_map := sorry

/- does not make sense (try uncommenting it!) However, we can ask whether `my_map` is a smooth
map between manifolds, i.e., whether it is smooth when read in the charts. When we mention the
smoothness of a map, we should always specify explicitly the model with corners we are using,
because there might be several around (think of a complex manifold that you may want to consider
as a real manifold, to talk about functions which are real-smooth but not holomorphic) -/

lemma cont_mdiff_my_map : cont_mdiff 𝓡1 𝓡1 ∞ my_map :=
begin
  -- put things in a nicer form. The simpset `mfld_simps` registers many simplification rules for
  -- manifolds. `simp` is used heavily in manifold files to bring everything into manageable form.
  rw cont_mdiff_iff,
  simp only [continuous_my_map] with mfld_simps,
  -- simp has erased the chart in the target, as it knows that the only chart in the manifold `ℝ`
  -- is the identity.
  assume x y,
  sorry
end

/- Now, let's go to tangent bundles. We have a smooth manifold, so its tangent bundle should also
be a smooth manifold. -/

-- the type `tangent_bundle 𝓡1 myℝ` makes sense
#check tangent_bundle 𝓡1 myℝ

/- The tangent space above a point of `myℝ` is just a one-dimensional vector space (identified with `ℝ`).
So, one can prescribe an element of the tangent bundle as a pair (more on this below) -/
example : tangent_bundle 𝓡1 myℝ := ⟨(4 : ℝ), 0⟩

/- Construct the smooth manifold structure on the tangent bundle. Hint: the answer is a one-liner,
and this instance is not really needed. -/
instance tangent_bundle_myℝ : smooth_manifold_with_corners (𝓡1.prod 𝓡1) (tangent_bundle 𝓡1 myℝ) :=
sorry

/-
NB: the model space for the tangent bundle to a product manifold or a tangent space is not
`ℝ × ℝ`, but a copy called `model_prod ℝ ℝ`. Otherwise, `ℝ × ℝ` would have two charted space
structures with model `ℝ × ℝ`, the identity one and the product one, which are not definitionally
equal. And this would be bad.
-/
#check tangent_bundle.charted_space 𝓡1 myℝ

/- A smooth map between manifolds induces a map between their tangent bundles. In `mathlib` this is
called the `tangent_map` (you might instead know it as the "differential" or "pushforward" of the
map).  Let us check that the `tangent_map` of `my_map` is smooth. -/
lemma cont_mdiff_tangent_map_my_map :
  cont_mdiff (𝓡1.prod 𝓡1) (𝓡1.prod 𝓡1) ∞ (tangent_map 𝓡1 𝓡1 my_map) :=
begin
  -- hopefully, there is a theorem providing the general result, i.e. the tangent map to a smooth
  -- map is smooth.
  -- you can either try to guess its name, or hope that `suggest` will help you there.
  sorry
end

/- (Harder question) Can you show that this tangent bundle is homeomorphic to `ℝ × ℝ`? You could
try to build the homeomorphism by hand, using `tangent_map 𝓡1 𝓡1 my_map` in one direction and a
similar map in the other direction, but it is probably more efficient to use one of the charts of
the tangent bundle.

Remember, the model space for `tangent_bundle 𝓡1 myℝ` is `model_prod ℝ ℝ`, not `ℝ × ℝ`. But the
topologies on `model_prod ℝ ℝ` and `ℝ × ℝ` are the same, so it is by definition good enough to
construct a homeomorphism with `model_prod ℝ ℝ`.
 -/

def my_homeo : tangent_bundle 𝓡1 myℝ ≃ₜ (ℝ × ℝ) :=
begin
  sorry
end

/- Up to now, we have never used the definition of the tangent bundle, and this corresponds to
the usual mathematical practice: one doesn't care if the tangent space is defined using germs of
curves, or spaces of derivations, or whatever equivalent definition. Instead, one relies all the
time on functoriality (i.e., a smooth map has a well defined derivative, and they compose well,
together with the fact that the tangent bundle to a vector space is the product).

If you want to know more about the internals of the tangent bundle in mathlib, you can browse
through the next section, but it is maybe wiser to skip it on first reading, as it is not needed
to use the library
-/

section you_should_probably_skip_this

/- If `M` is a manifold modelled on a vector space `E`, then the underlying type for the tangent
bundle is just `Σ (x : M), tangent_space x M` (i.e., the disjoint union of the tangent spaces,
indexed by `x` -- this is a basic object in dependent type theory). And `tangent_space x M`
is just (a copy of) `E` by definition. -/

lemma tangent_bundle_myℝ_is_prod : tangent_bundle 𝓡1 myℝ = Σ (x : myℝ), ℝ :=
sorry

/- This means that you can specify a point in the tangent bundle as a pair `⟨x, v⟩`.
However, in general, a tangent bundle is not trivial: the topology on `tangent_bundle 𝓡1 myℝ` is *not*
the product topology. Instead, the tangent space at a point `x` is identified with `ℝ` through some
preferred chart at `x`, called `chart_at ℝ x`, but the way they are glued together depends on the
manifold and the charts.

In vector spaces, the tangent space is canonically the product space, with the same topology, as
there is only one chart so there is no strange gluing at play. The fact that the canonical map
from the sigma type to the product type (called `equiv.sigma_equiv_prod`) is a homeomorphism is
given in the library by `tangent_bundle_model_space_homeomorph` (note that this is a definition,
constructing the homeomorphism, instead of a proposition asserting that `equiv.sigma_equiv_prod`
is a homeomorphism, because we use bundled homeomorphisms in mathlib).

Let us register the identification explicitly, as a homeomorphism. You can use the relevant fields
of `tangent_bundle_model_space_homeomorph` to fill the nontrivial fields here.
-/

def tangent_bundle_vector_space_triv (E : Type u) [normed_add_comm_group E] [normed_space ℝ E] :
  tangent_bundle (model_with_corners_self ℝ E) E ≃ₜ E × E :=
{ to_fun := λ p, (p.1, p.2),
  inv_fun := λ p, ⟨p.1, p.2⟩,
  left_inv := sorry,
  right_inv := sorry,
  continuous_to_fun := begin
    sorry
  end,
  continuous_inv_fun :=
  begin
    sorry
  end }

/- Even though the tangent bundle to `myℝ` is trivial abstractly, with this construction the
tangent bundle is *not* the product space with the product topology, as we have used various charts
so the gluing is not trivial. The following exercise unfolds the definition to see what is going on.
It is not a reasonable exercise, in the sense that one should never ever do this when working
with a manifold! -/

lemma crazy_formula_after_identifications (x : ℝ) (v : ℝ) :
  let p : tangent_bundle 𝓡1 myℝ := ⟨(3 : ℝ), 0⟩ in
  chart_at (model_prod ℝ ℝ) p ⟨x, v⟩ = if x ∈ Ioo (-1 : ℝ) 1 then (x, -v) else (x, v) :=
begin
  -- this exercise is not easy (and shouldn't be: you are not supposed to use the library like this!)
  -- if you really want to do this, you should unfold as much as you can using simp and dsimp, until you
  -- are left with a statement speaking of derivatives of real functions, without any manifold code left.
  sorry
end

end you_should_probably_skip_this

/-!
### The language of manifolds

In this paragraph, we will try to write down interesting statements of theorems, without proving them. The
goal here is that Lean should not complain on the statement, but the proof should be sorried.
-/

/- Here is a first example, already filled up, to show you how diffeomorphisms are currently named
(we will probably introduce an abbreviation, but this hasn't been done yet).
Don't try to fill the sorried proof! -/

/-- Two zero-dimensional connected manifolds are diffeomorphic. -/
theorem diffeomorph_of_zero_dim_connected
  (M M' : Type*) [topological_space M] [topological_space M']
  [charted_space (euclidean_space ℝ (fin 0)) M] [charted_space (euclidean_space ℝ (fin 0)) M']
  [connected_space M] [connected_space M'] :
  nonempty (structomorph (cont_diff_groupoid ∞ (𝓡 0)) M M') :=
sorry

/- Do you think that this statement is correct? (note that we have not assumed that our manifolds
are smooth, nor that they are separated, but this is maybe automatic in zero dimension).

Now, write down a version of this theorem in dimension 1, replacing the first sorry with meaningful content
(and adding what is needed before the colon).
Don't try to fill the sorried proof! -/

/-- Two one-dimensional smooth compact connected manifolds are diffeomorphic. -/
theorem diffeomorph_of_one_dim_compact_connected

  :
  sorry
:= sorry

/- You will definitely need to require smoothness and separation in this case, as it is wrong otherwise.
Note that Lean won't complain if you don't put these assumptions, as the theorem would still make
sense, but it would just turn out to be wrong.

The previous statement is not really satisfactory: we would instead like to express that any such
manifold is diffeomorphic to the circle. The trouble is that we don't have the circle as a smooth
manifold yet. Since we have cheated and introduced it (with sorries) at the beginning of the tutorial,
let's cheat again and use it to reformulate the previous statement.
-/

-- the next result is not trivial, leave it sorried (but you can work on it if you don't like
-- manifolds and prefer topology -- then please PR it to mathlib!).
instance connected_sphere (n : ℕ) : connected_space (sphere (n+1)) := sorry

/- The next two instances are easier to prove, you can prove them or leave them sorried
as you like. For the second one, you may need to use facts of the library such as -/
#check is_compact_iff_compact_space
#check metric.compact_iff_closed_bounded

instance (n : ℕ) : t2_space (sphere n) :=
begin
  sorry
end

instance (n : ℕ) : compact_space (sphere n) :=
begin
  sorry
end

/- Now, you can prove that any one-dimensional compact connected manifold is diffeomorphic to
the circle. Here, you should fill the `sorry` (but luckily you may use
`diffeomorph_of_one_dim_compact_connected`). -/
theorem diffeomorph_circle_of_one_dim_compact_connected
  (M : Type*) [topological_space M] [charted_space (euclidean_space ℝ (fin 1)) M]
  [connected_space M] [compact_space M] [t2_space M] [smooth_manifold_with_corners (𝓡 1) M] :
  nonempty (structomorph (cont_diff_groupoid ∞ (𝓡 1)) M (sphere 1)) :=
sorry

/- What about trying to say that there are uncountably many different smooth structures on `ℝ⁴`?
(see https://en.wikipedia.org/wiki/Exotic_R4). The library is not really designed with this in mind,
as in general we only work with one differentiable structure on a space, but it is perfectly
capable of expressing this fact if one uses the `@` version of some definitions.

Don't try to fill the sorried proof!
-/

theorem exotic_ℝ4 :
  sorry
  :=
sorry

/-!
### Smooth functions on `[0, 1]`

In this paragraph, you will prove several (math-trivial but Lean-nontrivial) statements on the smooth
structure of `[0,1]`. These facts should be Lean-trivial, but they are not (yet) since there is essentially
nothing in this direction for now in the library.

The goal is as much to be able to write the statements as to prove them. Most of the necessary vocabulary
has been introduced above, so don't hesitate to browse the file if you are stuck. Additionally, you will
need the notion of a smooth function on a subset: it is `cont_diff_on` for functions between vector
spaces and `cont_mdiff_on` for functions between manifolds.

Try to formulate the next math statements in Lean, and prove them (but see below for hints):

Lemma cont_mdiff_g : the inclusion `g` of `[0, 1]` in `ℝ` is smooth.

Lemma msmooth_of_smooth : Consider a function `f : ℝ → [0, 1]`, which is smooth in the usual sense as a function
from `ℝ` to `ℝ` on a set `s`. Then it is manifold-smooth on `s`.

Definition : construct a function `f` from `ℝ` to `[0,1]` which is the identity on `[0, 1]`.

Theorem : the tangent bundle to `[0, 1]` is homeomorphic to `[0, 1] × ℝ`

Hint for the last theorem: don't try to unfold the definition of the tangent bundle, it will only get you
into trouble. Instead, use the derivatives of the maps `f` and `g`, and rely on functoriality
to check that they are inverse to each other. (This advice is slightly misleading as these derivatives
do not go between the right spaces, so you will need to massage them a little bit).

A global advice: don't hesitate to use and abuse `simp`, it is the main workhorse in this
area of mathlib.
-/

/- After doing the exercise myself, I realized it was (way!) too hard. So I will give at least the statements
of the lemmas, to guide you a little bit more. To let you try the original version if you want,
I have left a big blank space to avoid spoilers. -/

def g : Icc (0 : ℝ) 1 → ℝ := subtype.val

-- smoothness results for `euclidean_space` are expressed for general `L^p` spaces
-- (as `euclidean_space` has the `L^2` norm), in:
#check pi_Lp.cont_diff_coord
#check pi_Lp.cont_diff_on_iff_coord

lemma cont_mdiff_g : cont_mdiff (𝓡∂ 1) 𝓡1 ∞ g :=
begin
  sorry
end

lemma msmooth_of_smooth {f : ℝ → Icc (0 : ℝ) 1} {s : set ℝ} (h : cont_diff_on ℝ ∞ (λ x, (f x : ℝ)) s) :
  cont_mdiff_on 𝓡1 (𝓡∂ 1) ∞ f s :=
begin
  sorry
end

/- A function from `ℝ` to `[0,1]` which is the identity on `[0,1]`. -/
def f : ℝ → Icc (0 : ℝ) 1 :=
λ x, ⟨max (min x 1) 0, by simp [le_refl, zero_le_one]⟩

lemma cont_mdiff_on_f : cont_mdiff_on 𝓡1 (𝓡∂ 1) ∞ f (Icc 0 1) :=
begin
  sorry
end

lemma fog : f ∘ g = id :=
begin
  sorry
end

lemma gof : ∀ x ∈ Icc (0 : ℝ) 1, g (f x) = x :=
begin
  sorry
end

def G : tangent_bundle (𝓡∂ 1) (Icc (0 : ℝ) 1) → (Icc (0 : ℝ) 1) × ℝ :=
λ p, (p.1, ((tangent_bundle_vector_space_triv ℝ) (tangent_map (𝓡∂ 1) 𝓡1 g p)).2)

lemma continuous_G : continuous G :=
begin
  sorry
end

def F : (Icc (0 : ℝ) 1) × ℝ → tangent_bundle (𝓡∂ 1) (Icc (0 : ℝ) 1) :=
λ p, tangent_map_within 𝓡1 (𝓡∂ 1) f (Icc 0 1)
  ((tangent_bundle_vector_space_triv ℝ).symm (p.1, p.2))

lemma continuous_F : continuous F :=
begin
  sorry
end

lemma FoG : F ∘ G = id :=
begin
  sorry
end

lemma GoF : G ∘ F = id :=
begin
  sorry
end

def my_tangent_homeo : tangent_bundle (𝓡∂ 1) (Icc (0 : ℝ) 1) ≃ₜ (Icc (0 : ℝ) 1) × ℝ :=
sorry

/-!
### Further things to do

1) can you prove `diffeomorph_of_zero_dim_connected` or `connected_sphere`?

2) Try to express and then prove the local inverse theorem in real manifolds: if a map between
real manifolds (without boundary, modelled on a complete vector space) is smooth, then it is
a local homeomorphism around each point. We already have versions of this statement in mathlib
for functions between vector spaces, but this is very much a work in progress.

3) What about trying to prove `diffeomorph_of_one_dim_compact_connected`? (I am not sure mathlib
is ready for this, as the proofs I am thinking of are currently a little bit too high-powered.
If you manage to do it, you should absolutely PR it!)

4) Why not contribute to the proof of `sphere_eversion`? You can have a look at
https://leanprover-community.github.io/sphere-eversion/ to learn more about this project
by Patrick Massot.
-/


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

! This file was ported from Lean 3 source module algebraic_geometry.locally_ringed_space.has_colimits
! leanprover-community/mathlib commit d39590fc8728fbf6743249802486f8c91ffe07bc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicGeometry.LocallyRingedSpace
import Mathbin.Algebra.Category.Ring.Constructions
import Mathbin.AlgebraicGeometry.OpenImmersion
import Mathbin.CategoryTheory.Limits.Constructions.LimitsOfProductsAndEqualizers

/-!
# Colimits of LocallyRingedSpace

We construct the explicit coproducts and coequalizers of `LocallyRingedSpace`.
It then follows that `LocallyRingedSpace` has all colimits, and
`forget_to_SheafedSpace` preserves them.

-/

namespace AlgebraicGeometry

universe v u

open CategoryTheory CategoryTheory.Limits Opposite TopologicalSpace

namespace SheafedSpace

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

variable {J : Type v} [Category.{v} J] (F : J ⥤ SheafedSpace C)

theorem isColimit_exists_rep {c : Cocone F} (hc : IsColimit c) (x : c.pt) :
    ∃ (i : J)(y : F.obj i), (c.ι.app i).base y = x :=
  Concrete.isColimit_exists_rep (F ⋙ SheafedSpace.forget _)
    (isColimitOfPreserves (SheafedSpace.forget _) hc) x
#align algebraic_geometry.SheafedSpace.is_colimit_exists_rep AlgebraicGeometry.SheafedSpace.isColimit_exists_rep

theorem colimit_exists_rep (x : colimit F) : ∃ (i : J)(y : F.obj i), (colimit.ι F i).base y = x :=
  Concrete.isColimit_exists_rep (F ⋙ SheafedSpace.forget _)
    (isColimitOfPreserves (SheafedSpace.forget _) (colimit.isColimit F)) x
#align algebraic_geometry.SheafedSpace.colimit_exists_rep AlgebraicGeometry.SheafedSpace.colimit_exists_rep

instance {X Y : SheafedSpace C} (f g : X ⟶ Y) : Epi (coequalizer.π f g).base :=
  by
  erw [←
    show _ = (coequalizer.π f g).base from
      ι_comp_coequalizer_comparison f g (SheafedSpace.forget C)]
  rw [← preserves_coequalizer.iso_hom]
  apply epi_comp

end SheafedSpace

namespace LocallyRingedSpace

section HasCoproducts

variable {ι : Type u} (F : Discrete ι ⥤ LocallyRingedSpace.{u})

/-- The explicit coproduct for `F : discrete ι ⥤ LocallyRingedSpace`. -/
noncomputable def coproduct : LocallyRingedSpace
    where
  toSheafedSpace := colimit (F ⋙ forgetToSheafedSpace : _)
  LocalRing x :=
    by
    obtain ⟨i, y, ⟨⟩⟩ := SheafedSpace.colimit_exists_rep (F ⋙ forget_to_SheafedSpace) x
    haveI : _root_.local_ring (((F ⋙ forget_to_SheafedSpace).obj i).toPresheafedSpace.stalk y) :=
      (F.obj i).LocalRing _
    exact
      (as_iso
              (PresheafedSpace.stalk_map (colimit.ι (F ⋙ forget_to_SheafedSpace) i : _)
                y)).symm.commRingIsoToRingEquiv.LocalRing
#align algebraic_geometry.LocallyRingedSpace.coproduct AlgebraicGeometry.LocallyRingedSpace.coproduct

/-- The explicit coproduct cofan for `F : discrete ι ⥤ LocallyRingedSpace`. -/
noncomputable def coproductCofan : Cocone F
    where
  pt := coproduct F
  ι :=
    { app := fun j => ⟨colimit.ι (F ⋙ forgetToSheafedSpace) j, inferInstance⟩
      naturality' := fun j j' f => by
        cases j
        cases j'
        tidy }
#align algebraic_geometry.LocallyRingedSpace.coproduct_cofan AlgebraicGeometry.LocallyRingedSpace.coproductCofan

/-- The explicit coproduct cofan constructed in `coproduct_cofan` is indeed a colimit. -/
noncomputable def coproductCofanIsColimit : IsColimit (coproductCofan F)
    where
  desc s :=
    ⟨colimit.desc (F ⋙ forgetToSheafedSpace) (forgetToSheafedSpace.mapCocone s),
      by
      intro x
      obtain ⟨i, y, ⟨⟩⟩ := SheafedSpace.colimit_exists_rep (F ⋙ forget_to_SheafedSpace) x
      have :=
        PresheafedSpace.stalk_map.comp (colimit.ι (F ⋙ forget_to_SheafedSpace) i : _)
          (colimit.desc (F ⋙ forget_to_SheafedSpace) (forget_to_SheafedSpace.map_cocone s)) y
      rw [← is_iso.comp_inv_eq] at this
      erw [← this,
        PresheafedSpace.stalk_map.congr_hom _ _
          (colimit.ι_desc (forget_to_SheafedSpace.map_cocone s) i : _)]
      haveI :
        IsLocalRingHom
          (PresheafedSpace.stalk_map ((forget_to_SheafedSpace.map_cocone s).ι.app i) y) :=
        (s.ι.app i).2 y
      infer_instance⟩
  fac s j := LocallyRingedSpace.Hom.ext _ _ (colimit.ι_desc _ _)
  uniq s f h :=
    LocallyRingedSpace.Hom.ext _ _
      (IsColimit.uniq _ (forgetToSheafedSpace.mapCocone s) f.1 fun j =>
        congr_arg LocallyRingedSpace.Hom.val (h j))
#align algebraic_geometry.LocallyRingedSpace.coproduct_cofan_is_colimit AlgebraicGeometry.LocallyRingedSpace.coproductCofanIsColimit

instance : HasCoproducts.{u} LocallyRingedSpace.{u} := fun ι =>
  ⟨fun F => ⟨⟨⟨_, coproductCofanIsColimit F⟩⟩⟩⟩

noncomputable instance (J : Type _) : PreservesColimitsOfShape (Discrete J) forgetToSheafedSpace :=
  ⟨fun G =>
    preservesColimitOfPreservesColimitCocone (coproductCofanIsColimit G)
      ((colimit.isColimit _).ofIsoColimit (Cocones.ext (Iso.refl _) fun j => Category.comp_id _))⟩

end HasCoproducts

section HasCoequalizer

variable {X Y : LocallyRingedSpace.{v}} (f g : X ⟶ Y)

namespace HasCoequalizer

instance coequalizer_π_app_isLocalRingHom
    (U : TopologicalSpace.Opens (coequalizer f.val g.val).carrier) :
    IsLocalRingHom ((coequalizer.π f.val g.val : _).c.app (op U)) :=
  by
  have := ι_comp_coequalizer_comparison f.1 g.1 SheafedSpace.forget_to_PresheafedSpace
  rw [← preserves_coequalizer.iso_hom] at this
  erw [SheafedSpace.congr_app this.symm (op U)]
  rw [PresheafedSpace.comp_c_app, ←
    PresheafedSpace.colimit_presheaf_obj_iso_componentwise_limit_hom_π]
  infer_instance
#align algebraic_geometry.LocallyRingedSpace.has_coequalizer.coequalizer_π_app_is_local_ring_hom AlgebraicGeometry.LocallyRingedSpace.HasCoequalizer.coequalizer_π_app_isLocalRingHom

/-!
We roughly follow the construction given in [MR0302656]. Given a pair `f, g : X ⟶ Y` of morphisms
of locally ringed spaces, we want to show that the stalk map of
`π = coequalizer.π f g` (as sheafed space homs) is a local ring hom. It then follows that
`coequalizer f g` is indeed a locally ringed space, and `coequalizer.π f g` is a morphism of
locally ringed space.

Given a germ `⟨U, s⟩` of `x : coequalizer f g` such that `π꙳ x : Y` is invertible, we ought to show
that `⟨U, s⟩` is invertible. That is, there exists an open set `U' ⊆ U` containing `x` such that the
restriction of `s` onto `U'` is invertible. This `U'` is given by `π '' V`, where `V` is the
basic open set of `π⋆x`.

Since `f ⁻¹' V = Y.basic_open (f ≫ π)꙳ x = Y.basic_open (g ≫ π)꙳ x = g ⁻¹' V`, we have
`π ⁻¹' (π '' V) = V` (as the underlying set map is merely the set-theoretic coequalizer).
This shows that `π '' V` is indeed open, and `s` is invertible on `π '' V` as the components of `π꙳`
are local ring homs.
-/

variable (U : Opens (coequalizer f.1 g.1).carrier)

variable (s : (coequalizer f.1 g.1).Presheaf.obj (op U))

/-- (Implementation). The basic open set of the section `π꙳ s`. -/
noncomputable def imageBasicOpen : Opens Y :=
  Y.toRingedSpace.basicOpen
    (show Y.Presheaf.obj (op (unop _)) from ((coequalizer.π f.1 g.1).c.app (op U)) s)
#align algebraic_geometry.LocallyRingedSpace.has_coequalizer.image_basic_open AlgebraicGeometry.LocallyRingedSpace.HasCoequalizer.imageBasicOpen

theorem imageBasicOpen_image_preimage :
    (coequalizer.π f.1 g.1).base ⁻¹' ((coequalizer.π f.1 g.1).base '' (imageBasicOpen f g U s).1) =
      (imageBasicOpen f g U s).1 :=
  by
  fapply types.coequalizer_preimage_image_eq_of_preimage_eq f.1.base g.1.base
  · ext
    simp_rw [types_comp_apply, ← TopCat.comp_app, ← PresheafedSpace.comp_base]
    congr 2
    exact coequalizer.condition f.1 g.1
  · apply is_colimit_cofork_map_of_is_colimit (forget TopCat)
    apply is_colimit_cofork_map_of_is_colimit (SheafedSpace.forget _)
    exact coequalizer_is_coequalizer f.1 g.1
  · suffices
      (TopologicalSpace.Opens.map f.1.base).obj (image_basic_open f g U s) =
        (TopologicalSpace.Opens.map g.1.base).obj (image_basic_open f g U s)
      by injection this
    delta image_basic_open
    rw [preimage_basic_open f, preimage_basic_open g]
    dsimp only [functor.op, unop_op]
    rw [← comp_apply, ← SheafedSpace.comp_c_app', ← comp_apply, ← SheafedSpace.comp_c_app',
      SheafedSpace.congr_app (coequalizer.condition f.1 g.1), comp_apply]
    erw [X.to_RingedSpace.basic_open_res]
    apply inf_eq_right.mpr
    refine' (RingedSpace.basic_open_le _ _).trans _
    rw [coequalizer.condition f.1 g.1]
    exact fun _ h => h
#align algebraic_geometry.LocallyRingedSpace.has_coequalizer.image_basic_open_image_preimage AlgebraicGeometry.LocallyRingedSpace.HasCoequalizer.imageBasicOpen_image_preimage

theorem imageBasicOpen_image_open :
    IsOpen ((coequalizer.π f.1 g.1).base '' (imageBasicOpen f g U s).1) :=
  by
  rw [←
    (TopCat.homeoOfIso (preserves_coequalizer.iso (SheafedSpace.forget _) f.1 g.1)).isOpen_preimage,
    TopCat.coequalizer_isOpen_iff, ← Set.preimage_comp]
  erw [← coe_comp]
  rw [preserves_coequalizer.iso_hom, ι_comp_coequalizer_comparison]
  dsimp only [SheafedSpace.forget]
  rw [image_basic_open_image_preimage]
  exact (image_basic_open f g U s).2
#align algebraic_geometry.LocallyRingedSpace.has_coequalizer.image_basic_open_image_open AlgebraicGeometry.LocallyRingedSpace.HasCoequalizer.imageBasicOpen_image_open

instance coequalizer_π_stalk_isLocalRingHom (x : Y) :
    IsLocalRingHom (PresheafedSpace.stalkMap (coequalizer.π f.val g.val : _) x) :=
  by
  constructor
  rintro a ha
  rcases TopCat.Presheaf.germ_exist _ _ a with ⟨U, hU, s, rfl⟩
  erw [PresheafedSpace.stalk_map_germ_apply (coequalizer.π f.1 g.1 : _) U ⟨_, hU⟩] at ha
  let V := image_basic_open f g U s
  have hV : (coequalizer.π f.1 g.1).base ⁻¹' ((coequalizer.π f.1 g.1).base '' V.1) = V.1 :=
    image_basic_open_image_preimage f g U s
  have hV' :
    V = ⟨(coequalizer.π f.1 g.1).base ⁻¹' ((coequalizer.π f.1 g.1).base '' V.1), hV.symm ▸ V.2⟩ :=
    SetLike.ext' hV.symm
  have V_open : IsOpen ((coequalizer.π f.val g.val).base '' V.1) :=
    image_basic_open_image_open f g U s
  have VleU : (⟨(coequalizer.π f.val g.val).base '' V.1, V_open⟩ : TopologicalSpace.Opens _) ≤ U :=
    set.image_subset_iff.mpr (Y.to_RingedSpace.basic_open_le _)
  have hxV : x ∈ V := ⟨⟨_, hU⟩, ha, rfl⟩
  erw [←
    (coequalizer f.val g.val).Presheaf.germ_res_apply (hom_of_le VleU)
      ⟨_, @Set.mem_image_of_mem _ _ (coequalizer.π f.val g.val).base x V.1 hxV⟩ s]
  apply RingHom.isUnit_map
  rw [← isUnit_map_iff ((coequalizer.π f.val g.val : _).c.app _), ← comp_apply,
    nat_trans.naturality, comp_apply, TopCat.Presheaf.pushforwardObj_map, ←
    isUnit_map_iff (Y.presheaf.map (eq_to_hom hV').op), ← comp_apply, ← functor.map_comp]
  convert@RingedSpace.is_unit_res_basic_open Y.to_RingedSpace (unop _)
      (((coequalizer.π f.val g.val).c.app (op U)) s)
  infer_instance
#align algebraic_geometry.LocallyRingedSpace.has_coequalizer.coequalizer_π_stalk_is_local_ring_hom AlgebraicGeometry.LocallyRingedSpace.HasCoequalizer.coequalizer_π_stalk_isLocalRingHom

end HasCoequalizer

/-- The coequalizer of two locally ringed space in the category of sheafed spaces is a locally
ringed space. -/
noncomputable def coequalizer : LocallyRingedSpace
    where
  toSheafedSpace := coequalizer f.1 g.1
  LocalRing x :=
    by
    obtain ⟨y, rfl⟩ :=
      (TopCat.epi_iff_surjective (coequalizer.π f.val g.val).base).mp inferInstance x
    exact (PresheafedSpace.stalk_map (coequalizer.π f.val g.val : _) y).domain_localRing
#align algebraic_geometry.LocallyRingedSpace.coequalizer AlgebraicGeometry.LocallyRingedSpace.coequalizer

/-- The explicit coequalizer cofork of locally ringed spaces. -/
noncomputable def coequalizerCofork : Cofork f g :=
  @Cofork.ofπ _ _ _ _ f g (coequalizer f g) ⟨coequalizer.π f.1 g.1, inferInstance⟩
    (LocallyRingedSpace.Hom.ext _ _ (coequalizer.condition f.1 g.1))
#align algebraic_geometry.LocallyRingedSpace.coequalizer_cofork AlgebraicGeometry.LocallyRingedSpace.coequalizerCofork

theorem isLocalRingHom_stalkMap_congr {X Y : RingedSpace} (f g : X ⟶ Y) (H : f = g) (x)
    (h : IsLocalRingHom (PresheafedSpace.stalkMap f x)) :
    IsLocalRingHom (PresheafedSpace.stalkMap g x) :=
  by
  rw [PresheafedSpace.stalk_map.congr_hom _ _ H.symm x]
  infer_instance
#align algebraic_geometry.LocallyRingedSpace.is_local_ring_hom_stalk_map_congr AlgebraicGeometry.LocallyRingedSpace.isLocalRingHom_stalkMap_congr

/-- The cofork constructed in `coequalizer_cofork` is indeed a colimit cocone. -/
noncomputable def coequalizerCoforkIsColimit : IsColimit (coequalizerCofork f g) :=
  by
  apply cofork.is_colimit.mk'
  intro s
  have e : f.val ≫ s.π.val = g.val ≫ s.π.val := by injection s.condition
  use coequalizer.desc s.π.1 e
  · intro x
    rcases(TopCat.epi_iff_surjective (coequalizer.π f.val g.val).base).mp inferInstance x with
      ⟨y, rfl⟩
    apply isLocalRingHom_of_comp _ (PresheafedSpace.stalk_map (coequalizer_cofork f g).π.1 _)
    change IsLocalRingHom (_ ≫ PresheafedSpace.stalk_map (coequalizer_cofork f g).π.val y)
    erw [← PresheafedSpace.stalk_map.comp]
    apply is_local_ring_hom_stalk_map_congr _ _ (coequalizer.π_desc s.π.1 e).symm y
    infer_instance
  constructor
  · exact LocallyRingedSpace.hom.ext _ _ (coequalizer.π_desc _ _)
  intro m h
  replace h : (coequalizer_cofork f g).π.1 ≫ m.1 = s.π.1 :=
    by
    rw [← h]
    rfl
  apply LocallyRingedSpace.hom.ext
  apply (colimit.is_colimit (parallel_pair f.1 g.1)).uniq (cofork.of_π s.π.1 e) m.1
  rintro ⟨⟩
  · rw [← (colimit.cocone (parallel_pair f.val g.val)).w walking_parallel_pair_hom.left,
      category.assoc]
    change _ ≫ _ ≫ _ = _ ≫ _
    congr
    exact h
  · exact h
#align algebraic_geometry.LocallyRingedSpace.coequalizer_cofork_is_colimit AlgebraicGeometry.LocallyRingedSpace.coequalizerCoforkIsColimit

instance : HasCoequalizer f g :=
  ⟨⟨⟨_, coequalizerCoforkIsColimit f g⟩⟩⟩

instance : HasCoequalizers LocallyRingedSpace :=
  hasCoequalizers_of_hasColimit_parallelPair _

noncomputable instance preservesCoequalizer :
    PreservesColimitsOfShape WalkingParallelPair forgetToSheafedSpace.{v} :=
  ⟨fun F => by
    apply preserves_colimit_of_iso_diagram _ (diagram_iso_parallel_pair F).symm
    apply preserves_colimit_of_preserves_colimit_cocone (coequalizer_cofork_is_colimit _ _)
    apply (is_colimit_map_cocone_cofork_equiv _ _).symm _
    dsimp only [forget_to_SheafedSpace]
    exact coequalizer_is_coequalizer _ _⟩
#align algebraic_geometry.LocallyRingedSpace.preserves_coequalizer AlgebraicGeometry.LocallyRingedSpace.preservesCoequalizer

end HasCoequalizer

instance : HasColimits LocallyRingedSpace :=
  has_colimits_of_hasCoequalizers_and_coproducts

noncomputable instance : PreservesColimits LocallyRingedSpace.forgetToSheafedSpace :=
  preservesColimitsOfPreservesCoequalizersAndCoproducts _

end LocallyRingedSpace

end AlgebraicGeometry


import .pseudominor

noncomputable theory
open set
open function

variables {E E₀ E₁ E₂ : Type*} [finite E] [finite E₀] [finite E₁] [finite E₂]
  {e f : E} {M : matroid E} {M₀ : matroid E₀} {M₁ : matroid E₁} {M₂ : matroid E₂}
  {X Y D C F B I I₀ R: set E}

namespace matroid

/-- A structure encoding the fact that `M₀` is isomorphic to a minor of `M` -/
structure minor_embedding (M₀ : matroid E₀) (M : matroid E) :=
(contr : set E)
(to_embedding : E₀ ↪ E)
(disj : disjoint (range to_embedding) contr)
(indep_iff' : ∀ X, M₀.indep X ↔ (M ⟋ contr).indep (to_embedding '' X))

namespace minor_embedding

infix ` →m ` :25 :=  minor_embedding

instance : has_coe_to_fun (minor_embedding M₀ M) (λ a, E₀ → E) := ⟨λ φ, φ.to_embedding⟩

/-- Two `minor_embedding`s are equivalent if they differ only in choice of their contract and
  delete-sets-/
def equiv (φ₁ φ₂ : M₀ →m M) :=
  (φ₁ : E₀ → E) = (φ₂ : E₀ → E)

@[simp] lemma coe_to_embedding (φ : M₀ →m M) :
  (φ.to_embedding : E₀ → E) = (φ : E₀ → E) :=
rfl

@[simp] lemma inj (φ : M₀ →m M) {x y : E₀} :
  φ x = φ y ↔ x = y :=
φ.to_embedding.injective.eq_iff

lemma injective (φ : M₀ →m M) :
  function.injective φ :=
φ.to_embedding.injective

/-- The contract-set of a `minor_embedding` -/
def C (φ : M₀ →m M) : set E :=
  φ.contr

/-- The ground set in `M` of a `minor_embedding` -/
def ground (φ : M₀ →m M) : set E :=
  set.range φ

/-- The delete-set of a `minor_embedding` --/
def D (φ : M₀ →m M) : set E :=
  (φ.C ∪ φ.ground)ᶜ

lemma mem_ground (φ : M₀ →m M) (x : E₀) :
  φ x ∈ φ.ground :=
mem_range_self _

lemma image_subset_ground (φ : M₀ →m M) (I : set E₀) :
  φ '' I ⊆ φ.ground :=
image_subset_range _ _

lemma not_mem_C (φ : M₀ →m M) (x : E₀) :
  φ x ∉ φ.C :=
λ h, φ.disj.ne_of_mem ⟨x,rfl⟩ h rfl

lemma not_mem_D (φ : M₀ →m M) (x : E₀) :
  φ x ∉ φ.D :=
not_mem_compl_iff.mpr (or.inr (φ.mem_ground _))

lemma C_disjoint_ground (φ : M₀ →m M) :
  disjoint φ.C φ.ground :=
disjoint_iff_forall_ne.mpr (by {rintro x hx _ ⟨y,rfl⟩ rfl, exact φ.not_mem_C _ hx})

lemma D_disjoint_ground (φ : M₀ →m M) :
  disjoint φ.D φ.ground :=
disjoint_iff_forall_ne.mpr (by {rintro x hx _ ⟨y,rfl⟩ rfl, exact φ.not_mem_D _ hx})

lemma indep_iff (φ : M₀ →m M) {I₀ : set E₀} :
  M₀.indep I₀ ↔ (M ⟋ φ.C).indep (φ '' I₀) :=
φ.indep_iff' I₀

lemma basis_iff (φ : M₀ →m M) {I₀ X₀ : set E₀} :
  M₀.basis I₀ X₀ ↔ (M ⟋ φ.C).basis (φ '' I₀) (φ '' X₀) :=
begin
  simp_rw [basis_iff, ←φ.indep_iff, image_subset_image_iff φ.injective],
  split,
  { rintro ⟨hi,hss,h⟩,
    refine ⟨hi,hss,λ J hJ hssJ hJss, _⟩,
    have h'J : ∃ J₀, φ '' J₀ = J,
    { rw [←subset_range_iff_exists_image_eq],
      exact hJss.trans (φ.image_subset_ground X₀)} ,
    obtain ⟨J₀,rfl⟩ := h'J,
    rw [image_subset_image_iff φ.injective] at hssJ hJss,
    rw [←φ.indep_iff] at hJ,
    rw [h _ hJ hssJ hJss]},
  rintro ⟨hi, hss, h⟩,
  refine ⟨hi, hss, λ J₀ hJ₀ hssJ₀ hJ₀ss, hssJ₀.antisymm _⟩,
  specialize h (φ '' J₀) (φ.indep_iff.mp hJ₀) ((image_subset_image_iff φ.injective).mpr hssJ₀)
    ((image_subset_image_iff φ.injective).mpr hJ₀ss),
  rw ←(image_subset_image_iff φ.injective),
  exact h.symm.subset,
end

lemma indep_project_iff (φ : M₀ →m M) (I₀ C₀ : set E₀) :
  (M₀ ⟋ C₀).indep I₀ ↔ (M ⟋ φ.C ⟋ (φ '' C₀)).indep (φ '' I₀) :=
begin
  obtain ⟨IC₀,hIC₀⟩ := M₀.exists_basis C₀,
  have h''  := φ.basis_iff.mp hIC₀,
  obtain (hI₀ | hI₀) := em (M₀.indep I₀),
  { rw [←hIC₀.project_eq_project,  ←h''.project_eq_project,
      indep.project_indep_iff h''.indep (φ.indep_iff.mp hI₀), ←image_union,
      ←φ.indep_iff, disjoint_image_iff φ.injective, indep.project_indep_iff hIC₀.indep hI₀]},

  apply iff_of_false (λ hI₀', hI₀ (indep_of_project_indep hI₀')) (λ hI₀', hI₀ _),
  have h' := indep_of_project_indep hI₀',
  rwa [←φ.indep_iff] at h',
end

/-- If `M₀` is a minor of `M₁` and `M₁` is a minor of `M₂`, then `M₀` is a minor of `M₂` -/
def trans (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) :
  M₀ →m M₂ :=
{ contr := (φ₁₂ '' φ₀₁.C) ∪ φ₁₂.C ,
  to_embedding := φ₀₁.to_embedding.trans φ₁₂.to_embedding,
  disj := begin
    refine disjoint_iff_forall_ne.mpr _,
    simp_rw [mem_range, embedding.trans_apply, coe_to_embedding],
    rintro x ⟨x₀,rfl⟩ y (⟨x₁,hx₁,rfl⟩ | hy) he,
    { simp_rw [minor_embedding.inj] at he,
      subst he,
      exact φ₀₁.not_mem_C _ hx₁},
    subst he,
    exact φ₁₂.not_mem_C _ hy,
  end,
  indep_iff' :=
  begin
    intro X,
    simp only [embedding.trans_apply, coe_to_embedding ],
    nth_rewrite 1 ←image_image,
    dsimp only,
    rw [←project_project, project_project_comm, ←φ₁₂.indep_project_iff, φ₀₁.indep_iff],
  end }

@[simp] lemma trans_apply (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) (x : E₀) :
  (φ₀₁.trans φ₁₂) x = φ₁₂ (φ₀₁ x) :=
rfl

@[simp] lemma trans_apply_image (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) (X : set E₀) :
  (φ₀₁.trans φ₁₂) '' X = φ₁₂ '' (φ₀₁ '' X) :=
by {ext, simp only [trans_apply, mem_image, exists_exists_and_eq_and]}

@[simp] lemma trans_apply_C (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) :
  (φ₀₁.trans φ₁₂).C = (φ₁₂ '' φ₀₁.C) ∪ φ₁₂.C :=
rfl

@[simp] lemma trans_apply_ground (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) :
  (φ₀₁.trans φ₁₂).ground = φ₁₂ '' (φ₀₁.ground) :=
by {ext, simp [ground]}

/- What a mess! Should be trivial -/
@[simp] lemma trans_apply_D (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) :
  (φ₀₁.trans φ₁₂).D = (φ₁₂ '' φ₀₁.D) ∪ φ₁₂.D :=
begin
  apply compl_injective,
  simp only [D, trans_apply_C, trans_apply_ground, ground, compl_compl,
    compl_union, φ₁₂.injective.compl_image, compl_inter, image_union],
  rw [inter_distrib_right, inter_eq_left_iff_subset.mpr (image_subset_range φ₁₂ _),
    compl_inter_self, union_empty, ←range_comp, inter_distrib_left, inter_distrib_right,
    inter_eq_right_iff_subset.mpr
      (subset_compl_iff_disjoint_right.mpr φ₁₂.C_disjoint_ground : φ₁₂.C ⊆ (range φ₁₂)ᶜ),
    union_eq_right_iff_subset.mpr (inter_subset_right _ _), inter_distrib_right,
    compl_inter_self, union_empty, inter_distrib_right,
    inter_eq_left_iff_subset.mpr (range_comp_subset_range _ _),
    union_distrib_right, union_distrib_left,
    union_eq_left_iff_subset.mpr (range_comp_subset_range _ _), ←union_assoc,
    union_comm φ₁₂.C, eq_comm],

  convert inter_eq_left_iff_subset.mpr (union_subset (union_subset _ (subset_union_left _ _)) _),
  { exact (image_subset_range _ _).trans (subset_union_right _ _)},
  exact (range_comp_subset_range _ _).trans (subset_union_right _ _),
end

/-- A `minor_embedding` gives rise to a dual embedding -/
def dual (φ : M₀ →m M) :
  M₀.dual →m M.dual :=
{ contr := φ.D,
  to_embedding := φ.to_embedding,
  disj := φ.D_disjoint_ground.symm,
  indep_iff' := begin
    intro X,

    -- rw [dual_indep_iff_coindep],
  end  }

/-- The scum theorem; every `minor_embedding`, has an equivalent embedding whose contract-set is
  independent and whose delete-set is coindependent -/
theorem exists_indep_coindep_embedding (φ : M₀ →m M) :
  ∃ (ψ : M₀ →m M), ψ.equiv φ ∧ M.indep ψ.C ∧ M.coindep φ.D :=
sorry

end minor_embedding

/-- `M₀` is isomorphic to a minor of `M` if there is a `minor_embedding` from `M₀` to `M` -/
def is_iso_minor (M₀ : matroid E₀) (M : matroid E) : Prop :=
  nonempty (M₀ →m M)

/-- A matroid `M₀` on a subtype is a minor of `M` if there is a `minor_embedding` whose associated
  embedding function is the inclusion map. -/
def is_minor {X : set E} (M₀ : matroid X) (M : matroid E) : Prop :=
  ∃ (φ : M₀ →m M), (φ : X → E) = coe

infix ` ≤m ` : 25 := is_iso_minor

end matroid


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.lattice
import Mathlib.PostPort

universes u v l u_1 w x u_2 u_3

namespace Mathlib

/-- A `pequiv` is a partial equivalence, a representation of a bijection between a subset
  of `α` and a subset of `β` -/
structure pequiv (α : Type u) (β : Type v) where
  to_fun : α → Option β
  inv_fun : β → Option α
  inv : ∀ (a : α) (b : β), a ∈ inv_fun b ↔ b ∈ to_fun a

infixr:25 " ≃. " => Mathlib.pequiv

namespace pequiv

protected instance has_coe_to_fun {α : Type u} {β : Type v} : has_coe_to_fun (α ≃. β) :=
  has_coe_to_fun.mk (fun (x : α ≃. β) => α → Option β) to_fun

@[simp] theorem coe_mk_apply {α : Type u} {β : Type v} (f₁ : α → Option β) (f₂ : β → Option α)
    (h : ∀ (a : α) (b : β), a ∈ f₂ b ↔ b ∈ f₁ a) (x : α) : coe_fn (mk f₁ f₂ h) x = f₁ x :=
  rfl

theorem ext {α : Type u} {β : Type v} {f : α ≃. β} {g : α ≃. β}
    (h : ∀ (x : α), coe_fn f x = coe_fn g x) : f = g :=
  sorry

theorem ext_iff {α : Type u} {β : Type v} {f : α ≃. β} {g : α ≃. β} :
    f = g ↔ ∀ (x : α), coe_fn f x = coe_fn g x :=
  { mp := congr_fun ∘ congr_arg fun {f : α ≃. β} (x : α) => coe_fn f x, mpr := ext }

protected def refl (α : Type u_1) : α ≃. α := mk some some sorry

protected def symm {α : Type u} {β : Type v} (f : α ≃. β) : β ≃. α :=
  mk (inv_fun f) (to_fun f) sorry

theorem mem_iff_mem {α : Type u} {β : Type v} (f : α ≃. β) {a : α} {b : β} :
    a ∈ coe_fn (pequiv.symm f) b ↔ b ∈ coe_fn f a :=
  inv f

theorem eq_some_iff {α : Type u} {β : Type v} (f : α ≃. β) {a : α} {b : β} :
    coe_fn (pequiv.symm f) b = some a ↔ coe_fn f a = some b :=
  inv f

protected def trans {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) (g : β ≃. γ) : α ≃. γ :=
  mk (fun (a : α) => option.bind (coe_fn f a) ⇑g)
    (fun (a : γ) => option.bind (coe_fn (pequiv.symm g) a) ⇑(pequiv.symm f)) sorry

@[simp] theorem refl_apply {α : Type u} (a : α) : coe_fn (pequiv.refl α) a = some a := rfl

@[simp] theorem symm_refl {α : Type u} : pequiv.symm (pequiv.refl α) = pequiv.refl α := rfl

@[simp] theorem symm_symm {α : Type u} {β : Type v} (f : α ≃. β) :
    pequiv.symm (pequiv.symm f) = f :=
  sorry

theorem symm_injective {α : Type u} {β : Type v} : function.injective pequiv.symm :=
  function.left_inverse.injective symm_symm

theorem trans_assoc {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} (f : α ≃. β) (g : β ≃. γ)
    (h : γ ≃. δ) : pequiv.trans (pequiv.trans f g) h = pequiv.trans f (pequiv.trans g h) :=
  ext fun (_x : α) => option.bind_assoc (coe_fn f _x) ⇑g ⇑h

theorem mem_trans {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) (g : β ≃. γ) (a : α) (c : γ) :
    c ∈ coe_fn (pequiv.trans f g) a ↔ ∃ (b : β), b ∈ coe_fn f a ∧ c ∈ coe_fn g b :=
  option.bind_eq_some'

theorem trans_eq_some {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) (g : β ≃. γ) (a : α)
    (c : γ) :
    coe_fn (pequiv.trans f g) a = some c ↔ ∃ (b : β), coe_fn f a = some b ∧ coe_fn g b = some c :=
  option.bind_eq_some'

theorem trans_eq_none {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) (g : β ≃. γ) (a : α) :
    coe_fn (pequiv.trans f g) a = none ↔ ∀ (b : β) (c : γ), ¬b ∈ coe_fn f a ∨ ¬c ∈ coe_fn g b :=
  sorry

@[simp] theorem refl_trans {α : Type u} {β : Type v} (f : α ≃. β) :
    pequiv.trans (pequiv.refl α) f = f :=
  ext fun (x : α) => option.ext fun (a : β) => id (iff.refl (a ∈ coe_fn f x))

@[simp] theorem trans_refl {α : Type u} {β : Type v} (f : α ≃. β) :
    pequiv.trans f (pequiv.refl β) = f :=
  sorry

protected theorem inj {α : Type u} {β : Type v} (f : α ≃. β) {a₁ : α} {a₂ : α} {b : β}
    (h₁ : b ∈ coe_fn f a₁) (h₂ : b ∈ coe_fn f a₂) : a₁ = a₂ :=
  sorry

theorem injective_of_forall_ne_is_some {α : Type u} {β : Type v} (f : α ≃. β) (a₂ : α)
    (h : ∀ (a₁ : α), a₁ ≠ a₂ → ↥(option.is_some (coe_fn f a₁))) : function.injective ⇑f :=
  sorry

theorem injective_of_forall_is_some {α : Type u} {β : Type v} {f : α ≃. β}
    (h : ∀ (a : α), ↥(option.is_some (coe_fn f a))) : function.injective ⇑f :=
  sorry

def of_set {α : Type u} (s : set α) [decidable_pred s] : α ≃. α :=
  mk (fun (a : α) => ite (a ∈ s) (some a) none) (fun (a : α) => ite (a ∈ s) (some a) none) sorry

theorem mem_of_set_self_iff {α : Type u} {s : set α} [decidable_pred s] {a : α} :
    a ∈ coe_fn (of_set s) a ↔ a ∈ s :=
  sorry

theorem mem_of_set_iff {α : Type u} {s : set α} [decidable_pred s] {a : α} {b : α} :
    a ∈ coe_fn (of_set s) b ↔ a = b ∧ a ∈ s :=
  sorry

@[simp] theorem of_set_eq_some_iff {α : Type u} {s : set α} {h : decidable_pred s} {a : α} {b : α} :
    coe_fn (of_set s) b = some a ↔ a = b ∧ a ∈ s :=
  mem_of_set_iff

@[simp] theorem of_set_eq_some_self_iff {α : Type u} {s : set α} {h : decidable_pred s} {a : α} :
    coe_fn (of_set s) a = some a ↔ a ∈ s :=
  mem_of_set_self_iff

@[simp] theorem of_set_symm {α : Type u} (s : set α) [decidable_pred s] :
    pequiv.symm (of_set s) = of_set s :=
  rfl

@[simp] theorem of_set_univ {α : Type u} : of_set set.univ = pequiv.refl α := rfl

@[simp] theorem of_set_eq_refl {α : Type u} {s : set α} [decidable_pred s] :
    of_set s = pequiv.refl α ↔ s = set.univ :=
  sorry

theorem symm_trans_rev {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) (g : β ≃. γ) :
    pequiv.symm (pequiv.trans f g) = pequiv.trans (pequiv.symm g) (pequiv.symm f) :=
  rfl

theorem trans_symm {α : Type u} {β : Type v} (f : α ≃. β) :
    pequiv.trans f (pequiv.symm f) =
        of_set (set_of fun (a : α) => ↥(option.is_some (coe_fn f a))) :=
  sorry

theorem symm_trans {α : Type u} {β : Type v} (f : α ≃. β) :
    pequiv.trans (pequiv.symm f) f =
        of_set (set_of fun (b : β) => ↥(option.is_some (coe_fn (pequiv.symm f) b))) :=
  sorry

theorem trans_symm_eq_iff_forall_is_some {α : Type u} {β : Type v} {f : α ≃. β} :
    pequiv.trans f (pequiv.symm f) = pequiv.refl α ↔ ∀ (a : α), ↥(option.is_some (coe_fn f a)) :=
  sorry

protected instance has_bot {α : Type u} {β : Type v} : has_bot (α ≃. β) :=
  has_bot.mk (mk (fun (_x : α) => none) (fun (_x : β) => none) sorry)

@[simp] theorem bot_apply {α : Type u} {β : Type v} (a : α) : coe_fn ⊥ a = none := rfl

@[simp] theorem symm_bot {α : Type u} {β : Type v} : pequiv.symm ⊥ = ⊥ := rfl

@[simp] theorem trans_bot {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) :
    pequiv.trans f ⊥ = ⊥ :=
  sorry

@[simp] theorem bot_trans {α : Type u} {β : Type v} {γ : Type w} (f : β ≃. γ) :
    pequiv.trans ⊥ f = ⊥ :=
  sorry

theorem is_some_symm_get {α : Type u} {β : Type v} (f : α ≃. β) {a : α}
    (h : ↥(option.is_some (coe_fn f a))) :
    ↥(option.is_some (coe_fn (pequiv.symm f) (option.get h))) :=
  sorry

def single {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] (a : α) (b : β) : α ≃. β :=
  mk (fun (x : α) => ite (x = a) (some b) none) (fun (x : β) => ite (x = b) (some a) none) sorry

theorem mem_single {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] (a : α) (b : β) :
    b ∈ coe_fn (single a b) a :=
  if_pos rfl

theorem mem_single_iff {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] (a₁ : α) (a₂ : α)
    (b₁ : β) (b₂ : β) : b₁ ∈ coe_fn (single a₂ b₂) a₁ ↔ a₁ = a₂ ∧ b₁ = b₂ :=
  sorry

@[simp] theorem symm_single {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] (a : α)
    (b : β) : pequiv.symm (single a b) = single b a :=
  rfl

@[simp] theorem single_apply {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] (a : α)
    (b : β) : coe_fn (single a b) a = some b :=
  if_pos rfl

theorem single_apply_of_ne {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] {a₁ : α}
    {a₂ : α} (h : a₁ ≠ a₂) (b : β) : coe_fn (single a₁ b) a₂ = none :=
  if_neg (ne.symm h)

theorem single_trans_of_mem {α : Type u} {β : Type v} {γ : Type w} [DecidableEq α] [DecidableEq β]
    [DecidableEq γ] (a : α) {b : β} {c : γ} {f : β ≃. γ} (h : c ∈ coe_fn f b) :
    pequiv.trans (single a b) f = single a c :=
  sorry

theorem trans_single_of_mem {α : Type u} {β : Type v} {γ : Type w} [DecidableEq α] [DecidableEq β]
    [DecidableEq γ] {a : α} {b : β} (c : γ) {f : α ≃. β} (h : b ∈ coe_fn f a) :
    pequiv.trans f (single b c) = single a c :=
  symm_injective (single_trans_of_mem c (iff.mpr (mem_iff_mem f) h))

@[simp] theorem single_trans_single {α : Type u} {β : Type v} {γ : Type w} [DecidableEq α]
    [DecidableEq β] [DecidableEq γ] (a : α) (b : β) (c : γ) :
    pequiv.trans (single a b) (single b c) = single a c :=
  single_trans_of_mem a (mem_single b c)

@[simp] theorem single_subsingleton_eq_refl {α : Type u} [DecidableEq α] [subsingleton α] (a : α)
    (b : α) : single a b = pequiv.refl α :=
  sorry

theorem trans_single_of_eq_none {β : Type v} {γ : Type w} {δ : Type x} [DecidableEq β]
    [DecidableEq γ] {b : β} (c : γ) {f : δ ≃. β} (h : coe_fn (pequiv.symm f) b = none) :
    pequiv.trans f (single b c) = ⊥ :=
  sorry

theorem single_trans_of_eq_none {α : Type u} {β : Type v} {δ : Type x} [DecidableEq α]
    [DecidableEq β] (a : α) {b : β} {f : β ≃. δ} (h : coe_fn f b = none) :
    pequiv.trans (single a b) f = ⊥ :=
  symm_injective (trans_single_of_eq_none a h)

theorem single_trans_single_of_ne {α : Type u} {β : Type v} {γ : Type w} [DecidableEq α]
    [DecidableEq β] [DecidableEq γ] {b₁ : β} {b₂ : β} (h : b₁ ≠ b₂) (a : α) (c : γ) :
    pequiv.trans (single a b₁) (single b₂ c) = ⊥ :=
  single_trans_of_eq_none a (single_apply_of_ne (ne.symm h) c)

protected instance partial_order {α : Type u} {β : Type v} : partial_order (α ≃. β) :=
  partial_order.mk (fun (f g : α ≃. β) => ∀ (a : α) (b : β), b ∈ coe_fn f a → b ∈ coe_fn g a)
    (preorder.lt._default fun (f g : α ≃. β) => ∀ (a : α) (b : β), b ∈ coe_fn f a → b ∈ coe_fn g a)
    sorry sorry sorry

theorem le_def {α : Type u} {β : Type v} {f : α ≃. β} {g : α ≃. β} :
    f ≤ g ↔ ∀ (a : α) (b : β), b ∈ coe_fn f a → b ∈ coe_fn g a :=
  iff.rfl

protected instance order_bot {α : Type u} {β : Type v} : order_bot (α ≃. β) :=
  order_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance semilattice_inf_bot {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] :
    semilattice_inf_bot (α ≃. β) :=
  semilattice_inf_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry
    (fun (f g : α ≃. β) =>
      mk (fun (a : α) => ite (coe_fn f a = coe_fn g a) (coe_fn f a) none)
        (fun (b : β) =>
          ite (coe_fn (pequiv.symm f) b = coe_fn (pequiv.symm g) b) (coe_fn (pequiv.symm f) b) none)
        sorry)
    sorry sorry sorry

end pequiv

namespace equiv

def to_pequiv {α : Type u_1} {β : Type u_2} (f : α ≃ β) : α ≃. β :=
  pequiv.mk (some ∘ ⇑f) (some ∘ ⇑(equiv.symm f)) sorry

@[simp] theorem to_pequiv_refl {α : Type u_1} : to_pequiv (equiv.refl α) = pequiv.refl α := rfl

theorem to_pequiv_trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α ≃ β) (g : β ≃ γ) :
    to_pequiv (equiv.trans f g) = pequiv.trans (to_pequiv f) (to_pequiv g) :=
  rfl

theorem to_pequiv_symm {α : Type u_1} {β : Type u_2} (f : α ≃ β) :
    to_pequiv (equiv.symm f) = pequiv.symm (to_pequiv f) :=
  rfl

theorem to_pequiv_apply {α : Type u_1} {β : Type u_2} (f : α ≃ β) (x : α) :
    coe_fn (to_pequiv f) x = some (coe_fn f x) :=
  rfl

end Mathlib


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.lint.default
import Mathlib.tactic.ext
import Mathlib.PostPort

universes u_1 u_4 u_2 u_3 u_5 u_6

namespace Mathlib

namespace sigma

protected instance inhabited {α : Type u_1} {β : α → Type u_4} [Inhabited α] [Inhabited (β Inhabited.default)] : Inhabited (sigma β) :=
  { default := mk Inhabited.default Inhabited.default }

protected instance decidable_eq {α : Type u_1} {β : α → Type u_4} [h₁ : DecidableEq α] [h₂ : (a : α) → DecidableEq (β a)] : DecidableEq (sigma β) :=
  sorry

@[simp] theorem mk.inj_iff {α : Type u_1} {β : α → Type u_4} {a₁ : α} {a₂ : α} {b₁ : β a₁} {b₂ : β a₂} : mk a₁ b₁ = mk a₂ b₂ ↔ a₁ = a₂ ∧ b₁ == b₂ := sorry

@[simp] theorem eta {α : Type u_1} {β : α → Type u_4} (x : sigma fun (a : α) => β a) : mk (fst x) (snd x) = x :=
  cases_on x
    fun (x_fst : α) (x_snd : β x_fst) =>
      idRhs (mk (fst (mk x_fst x_snd)) (snd (mk x_fst x_snd)) = mk (fst (mk x_fst x_snd)) (snd (mk x_fst x_snd))) rfl

theorem ext {α : Type u_1} {β : α → Type u_4} {x₀ : sigma β} {x₁ : sigma β} (h₀ : fst x₀ = fst x₁) (h₁ : snd x₀ == snd x₁) : x₀ = x₁ := sorry

theorem ext_iff {α : Type u_1} {β : α → Type u_4} {x₀ : sigma β} {x₁ : sigma β} : x₀ = x₁ ↔ fst x₀ = fst x₁ ∧ snd x₀ == snd x₁ :=
  cases_on x₀ fun (x₀_fst : α) (x₀_snd : β x₀_fst) => cases_on x₁ fun (x₁_fst : α) (x₁_snd : β x₁_fst) => mk.inj_iff

@[simp] theorem forall {α : Type u_1} {β : α → Type u_4} {p : (sigma fun (a : α) => β a) → Prop} : (∀ (x : sigma fun (a : α) => β a), p x) ↔ ∀ (a : α) (b : β a), p (mk a b) := sorry

@[simp] theorem exists {α : Type u_1} {β : α → Type u_4} {p : (sigma fun (a : α) => β a) → Prop} : (∃ (x : sigma fun (a : α) => β a), p x) ↔ ∃ (a : α), ∃ (b : β a), p (mk a b) := sorry

/-- Map the left and right components of a sigma -/
def map {α₁ : Type u_2} {α₂ : Type u_3} {β₁ : α₁ → Type u_5} {β₂ : α₂ → Type u_6} (f₁ : α₁ → α₂) (f₂ : (a : α₁) → β₁ a → β₂ (f₁ a)) (x : sigma β₁) : sigma β₂ :=
  mk (f₁ (fst x)) (f₂ (fst x) (snd x))

end sigma

theorem sigma_mk_injective {α : Type u_1} {β : α → Type u_4} {i : α} : function.injective (sigma.mk i) := sorry

theorem function.injective.sigma_map {α₁ : Type u_2} {α₂ : Type u_3} {β₁ : α₁ → Type u_5} {β₂ : α₂ → Type u_6} {f₁ : α₁ → α₂} {f₂ : (a : α₁) → β₁ a → β₂ (f₁ a)} (h₁ : function.injective f₁) (h₂ : ∀ (a : α₁), function.injective (f₂ a)) : function.injective (sigma.map f₁ f₂) := sorry

theorem function.surjective.sigma_map {α₁ : Type u_2} {α₂ : Type u_3} {β₁ : α₁ → Type u_5} {β₂ : α₂ → Type u_6} {f₁ : α₁ → α₂} {f₂ : (a : α₁) → β₁ a → β₂ (f₁ a)} (h₁ : function.surjective f₁) (h₂ : ∀ (a : α₁), function.surjective (f₂ a)) : function.surjective (sigma.map f₁ f₂) := sorry

/-- Interpret a function on `Σ x : α, β x` as a dependent function with two arguments. -/
def sigma.curry {α : Type u_1} {β : α → Type u_4} {γ : (a : α) → β a → Type u_2} (f : (x : sigma β) → γ (sigma.fst x) (sigma.snd x)) (x : α) (y : β x) : γ x y :=
  f (sigma.mk x y)

/-- Interpret a dependent function with two arguments as a function on `Σ x : α, β x` -/
def sigma.uncurry {α : Type u_1} {β : α → Type u_4} {γ : (a : α) → β a → Type u_2} (f : (x : α) → (y : β x) → γ x y) (x : sigma β) : γ (sigma.fst x) (sigma.snd x) :=
  f (sigma.fst x) (sigma.snd x)

/-- Convert a product type to a Σ-type. -/
@[simp] def prod.to_sigma {α : Type u_1} {β : Type u_2} : α × β → sigma fun (_x : α) => β :=
  sorry

@[simp] theorem prod.fst_to_sigma {α : Type u_1} {β : Type u_2} (x : α × β) : sigma.fst (prod.to_sigma x) = prod.fst x :=
  prod.cases_on x fun (x_fst : α) (x_snd : β) => Eq.refl (sigma.fst (prod.to_sigma (x_fst, x_snd)))

@[simp] theorem prod.snd_to_sigma {α : Type u_1} {β : Type u_2} (x : α × β) : sigma.snd (prod.to_sigma x) = prod.snd x :=
  prod.cases_on x fun (x_fst : α) (x_snd : β) => Eq.refl (sigma.snd (prod.to_sigma (x_fst, x_snd)))

namespace psigma

/-- Nondependent eliminator for `psigma`. -/
def elim {α : Sort u_1} {β : α → Sort u_2} {γ : Sort u_3} (f : (a : α) → β a → γ) (a : psigma β) : γ :=
  cases_on a f

@[simp] theorem elim_val {α : Sort u_1} {β : α → Sort u_2} {γ : Sort u_3} (f : (a : α) → β a → γ) (a : α) (b : β a) : elim f (mk a b) = f a b :=
  rfl

protected instance inhabited {α : Sort u_1} {β : α → Sort u_2} [Inhabited α] [Inhabited (β Inhabited.default)] : Inhabited (psigma β) :=
  { default := mk Inhabited.default Inhabited.default }

protected instance decidable_eq {α : Sort u_1} {β : α → Sort u_2} [h₁ : DecidableEq α] [h₂ : (a : α) → DecidableEq (β a)] : DecidableEq (psigma β) :=
  sorry

theorem mk.inj_iff {α : Sort u_1} {β : α → Sort u_2} {a₁ : α} {a₂ : α} {b₁ : β a₁} {b₂ : β a₂} : mk a₁ b₁ = mk a₂ b₂ ↔ a₁ = a₂ ∧ b₁ == b₂ := sorry

theorem ext {α : Sort u_1} {β : α → Sort u_2} {x₀ : psigma β} {x₁ : psigma β} (h₀ : fst x₀ = fst x₁) (h₁ : snd x₀ == snd x₁) : x₀ = x₁ := sorry

theorem ext_iff {α : Sort u_1} {β : α → Sort u_2} {x₀ : psigma β} {x₁ : psigma β} : x₀ = x₁ ↔ fst x₀ = fst x₁ ∧ snd x₀ == snd x₁ :=
  cases_on x₀ fun (x₀_fst : α) (x₀_snd : β x₀_fst) => cases_on x₁ fun (x₁_fst : α) (x₁_snd : β x₁_fst) => mk.inj_iff

/-- Map the left and right components of a sigma -/
def map {α₁ : Sort u_3} {α₂ : Sort u_4} {β₁ : α₁ → Sort u_5} {β₂ : α₂ → Sort u_6} (f₁ : α₁ → α₂) (f₂ : (a : α₁) → β₁ a → β₂ (f₁ a)) : psigma β₁ → psigma β₂ :=
  sorry


import topology.opens
import topology.algebra.continuous_functions

import for_mathlib.filter
import for_mathlib.data.set.basic

open topological_space function

local notation `𝓝` x:70 := nhds x
local notation f `∘₂` g := function.bicompr f g

-- We need to think whether we could directly use the class t2_space (which is not using opens though)
definition is_hausdorff (α : Type*) [topological_space α] : Prop :=
  ∀ x y, x ≠ y → ∃ u v : opens α, x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅

open set filter

instance regular_of_discrete {α : Type*} [topological_space α] [discrete_topology α] :
  regular_space α :=
{ t1 := λ x, is_open_discrete _,
  regular :=
  begin
    intros s a s_closed a_not,
    refine ⟨s, is_open_discrete s, subset.refl s, _⟩,
    erw [← empty_in_sets_eq_bot, mem_inf_sets],
    use {a},
    rw nhds_discrete α,
    simp,
    refine ⟨s, subset.refl s, _ ⟩,
    rintro x ⟨xa, xs⟩,
    rw ← mem_singleton_iff.1 xa at a_not,
    exact a_not xs
  end }

lemma continuous_of_const {α : Type*} {β : Type*}
  [topological_space α] [topological_space β]
  {f : α → β} (h : ∀a b, f a = f b) :
  continuous f :=
λ s _, by convert @is_open_const _ _ (∃ a, f a ∈ s); exact
  set.ext (λ a, ⟨λ fa, ⟨_, fa⟩,
    λ ⟨b, fb⟩, show f a ∈ s, from h b a ▸ fb⟩)

section
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]

def continuous₂ (f : α → β → γ) := continuous (function.uncurry' f)

lemma continuous₂_def (f : α → β → γ) : continuous₂ f ↔ continuous (function.uncurry' f) := iff.rfl

lemma continuous₂_curry (f : α × β → γ) : continuous₂ (function.curry f) ↔ continuous f :=
by rw  [←function.uncurry'_curry f] {occs := occurrences.pos [2]} ; refl

lemma continuous₂.comp {f : α → β → γ} {g : γ → δ} (hf : continuous₂ f)(hg : continuous g) :
  continuous₂ (g ∘₂ f) := hg.comp hf

section
open set filter lattice function

/-
    f
  α → β
g ↓   ↓ h
  γ → δ
    i
-/
variables {f : α → β} {g : α → γ} {i : γ → δ} {h : β → δ}

lemma continuous_of_continuous_on_of_induced (H : h ∘ f = i ∘ g) (hi : continuous_on i $ range g)
  (hg : ‹topological_space α› = induced g ‹topological_space γ›)
  (hh : ‹topological_space β› = induced h ‹topological_space δ›) : continuous f :=
begin
  rw continuous_iff_continuous_at,
  intro x,
  dsimp [continuous_at, tendsto],
  rw [hg, hh, nhds_induced, nhds_induced, ← map_le_iff_le_comap, map_comm H],
  specialize hi (g x) ⟨x, rfl⟩,
  have := calc
    nhds_within (g x) (range g) = 𝓝 g x ⊓ principal (range g) : rfl
    ... = 𝓝 g x ⊓ map g (principal univ) : by rw [← image_univ, ← map_principal]
    ... = 𝓝 g x ⊓ map g ⊤ : by rw principal_univ,
  rw [continuous_within_at, this, ← comp_app i g, ← congr_fun H x] at hi, clear this,
  have := calc
    map g (comap g 𝓝 g x) = map g (comap  g 𝓝 g x ⊓ ⊤) : by rw inf_top_eq
    ... ≤ map g (comap g 𝓝 g x) ⊓ map g ⊤ : map_inf_le
    ... ≤ 𝓝 g x ⊓ map g ⊤ : inf_le_inf map_comap_le (le_refl _),
  exact le_trans (map_mono this) hi,
end

variables  (eg : embedding g) (eh : embedding h)
include eg

lemma embedding.nhds_eq_comap (a : α) : nhds a = comap g (nhds $ g a) :=
by rw [eg.induced, nhds_induced]

include eh

lemma embedding.tendsto_iff (H : h ∘ f = i ∘ g) (a : α) : continuous_at i (g a) → continuous_at f a:=
begin
  let N := nhds a, let Nf := nhds (f a),
  let Nhf := nhds (h $ f a), let Ng := nhds (g a),
  have Neq1 : Nf = comap h Nhf, from eh.nhds_eq_comap (f a),
  have Neq2 : N = comap g Ng, from eg.nhds_eq_comap a,
  intro hyp,
  replace hyp : Ng ≤ comap i Nhf,
  { unfold continuous_at at hyp,
    rw ← show h (f a) = i (g a), from congr_fun H a at hyp,
    rwa tendsto_iff_comap at hyp },
  rw calc
      continuous_at f a ↔ tendsto f N Nf : iff.rfl
      ... ↔ N ≤ comap f Nf : tendsto_iff_comap
      ... ↔ comap g Ng ≤ comap f (comap h Nhf) : by rw [Neq1, Neq2]
      ... ↔ comap g Ng ≤ comap g (comap i Nhf) : by rw comap_comm H,
  exact comap_mono hyp
end
end
end

namespace dense_inducing
open set function filter
variables {α : Type*} {β : Type*} {δ : Type*} {γ : Type*}
variables [topological_space α] [topological_space β] [topological_space δ] [topological_space γ]

/-
    f
  α → β
g ↓   ↓ h
  γ → δ
    i
-/
variables {f : α → β} {g : α → γ} {i : γ → δ} {h : β → δ}

lemma comp (dh : dense_inducing h) (df : dense_inducing f) : dense_inducing (h ∘ f) :=
{ dense := dense_range.comp _ dh.dense df.dense dh.continuous,
  induced := (dh.to_inducing.comp df.to_inducing).induced }

lemma of_comm_square (dg : dense_inducing g) (di : dense_inducing i)
  (dh : dense_inducing h) (H : h ∘ f = i ∘ g) : dense_inducing f :=
have dhf : dense_inducing (h ∘ f),
  by {rw H, exact di.comp dg },
{ dense := begin
    intro x,
    have H := dhf.dense (h x),
    rw mem_closure_iff_nhds at H ⊢,
    intros t ht,
    rw [dh.nhds_eq_comap x, mem_comap_sets] at ht,
    rcases ht with ⟨u, hu, hinc⟩,
    rcases H u hu with ⟨v, hv1, a, rfl⟩,
    use f a,
    split, swap, apply mem_range_self,
    apply mem_of_mem_of_subset _ hinc,
    rwa mem_preimage,
  end ,
--  inj := λ a b H, dhf.inj (by {show h (f a) = _, rw H}),
  induced := by rw [dg.induced, di.induced, induced_compose, ← H, ← induced_compose, dh.induced] }
end dense_inducing

namespace dense_embedding
open set function filter
variables {α : Type*} {β : Type*} {δ : Type*} {γ : Type*}

variables [topological_space α] [topological_space β] [topological_space δ] [topological_space γ]

/-
    f
  α → β
g ↓   ↓ h
  γ → δ
    i
-/
variables {f : α → β} {g : α → γ} {i : γ → δ} {h : β → δ}

-- TODO: fix implicit argument in dense_range.comp before PRing

lemma comp (dh : dense_embedding h) (df : dense_embedding f) : dense_embedding (h ∘ f) :=
{ dense := dense_range.comp _ dh.dense df.dense dh.to_dense_inducing.continuous,
  inj :=  function.injective_comp dh.inj df.inj,
  induced := (dh.to_inducing.comp df.to_inducing).induced }

lemma of_homeo (h : α ≃ₜ β) : dense_embedding h :=
{ dense := dense_range_iff_closure_range.mpr $
             (range_iff_surjective.mpr h.to_equiv.surjective).symm ▸ closure_univ,
  inj := h.to_equiv.injective,
  induced := h.induced_eq.symm, }

lemma of_comm_square (dg : dense_embedding g) (di : dense_embedding i)
  (dh : dense_embedding h) (H : h ∘ f = i ∘ g) : dense_embedding f :=
{ inj := begin
    intros a b hab,
    have : (h ∘ f) a = (h ∘ f) b := by convert congr_arg h hab,
    rw H at this,
    exact dg.inj (di.inj this),
  end,
  ..dense_inducing.of_comm_square dg.to_dense_inducing di.to_dense_inducing dh.to_dense_inducing H }
end dense_embedding

section
open filter
variables  {α : Type*} [topological_space α] {β : Type*} [topological_space β] [discrete_topology β]

lemma continuous_into_discrete_iff (f : α → β) : continuous f ↔ ∀ b : β, is_open (f ⁻¹' {b}) :=
begin
  split,
  { intros hf b,
    exact hf _ (is_open_discrete _) },
  { intro h,
    rw continuous_iff_continuous_at,
    intro x,
    have key : f ⁻¹' {f x} ∈ nhds x,
      from mem_nhds_sets (h $ f x) (set.mem_insert (f x) ∅),
    calc map f (nhds x) ≤ pure (f x) : le_pure_iff.mpr key
        ... ≤ nhds (f x) : pure_le_nhds _ }
end

lemma discrete_iff_open_singletons : discrete_topology α ↔ ∀ x, is_open ({x} : set α) :=
⟨by introsI ; exact is_open_discrete _, λ h, ⟨eq_bot_of_singletons_open h⟩⟩

lemma discrete_iff_nhds_eq_pure {X : Type*} [topological_space X] :
  discrete_topology X ↔ ∀ x : X, nhds x = pure x :=
begin
  split,
  { introsI h,
    exact congr_fun (nhds_discrete X) },
  { intro h,
    constructor,
    apply eq_bot_of_singletons_open,
    intro x,
    change _root_.is_open {x},
    rw is_open_iff_nhds,
    simp [h] },
end

lemma discrete_of_embedding_discrete {X : Type*} {Y : Type*} [topological_space X] [topological_space Y]
  {f : X → Y} (hf : embedding f) [discrete_topology Y] : discrete_topology X :=
begin
  rw discrete_iff_nhds_eq_pure,
  intro x,
  rw [hf.to_inducing.nhds_eq_comap, nhds_discrete, comap_pure hf.inj]
end

lemma is_open_singleton_iff {X : Type*} [topological_space X] {x : X} :
  is_open ({x} : set X) ↔ {x} ∈ nhds x :=
begin
  rw is_open_iff_nhds,
  split ; intro h,
  { apply h x (mem_singleton _),
    simp },
  { intros y y_in,
    rw mem_singleton_iff at y_in,
    simp [*] },
end

end

-- tools for proving that a product of top rings is a top ring
def continuous_pi₁ {I : Type*} {R : I → Type*} {S : I → Type*}
  [∀ i, topological_space (R i)] [∀ i, topological_space (S i)]
  {f : Π (i : I), (R i) → (S i)} (Hfi : ∀ i, continuous (f i)) :
  continuous (λ rs i, f i (rs i) : (Π (i : I), R i) → Π (i : I), S i) :=
continuous_pi (λ i,  (Hfi i).comp (continuous_apply i))

def continuous_pi₂ {I : Type*} {R : I → Type*} {S : I → Type*} {T : I → Type*}
  [∀ i, topological_space (R i)] [∀ i, topological_space (S i)] [∀ i, topological_space (T i)]
  {f : Π (i : I), (R i) × (S i) → (T i)} (Hfi : ∀ i, continuous (f i)) :
continuous (λ rs i, f i ⟨rs.1 i, rs.2 i⟩ : (Π (i : I), R i) × (Π (i : I), S i) → Π (i : I), T i) :=
continuous_pi (λ i, (Hfi i).comp
  (continuous.prod_mk ((continuous_apply i).comp continuous_fst) $
                      (continuous_apply i).comp continuous_snd))

/-
The following class probably won't have global instances, but is meant to model proofs where
we implictly fix a neighborhood filter basis.
-/

class nhds_basis (α : Type*) [topological_space α] :=
(B : α → filter_basis α)
(is_nhds : ∀ x, 𝓝 x = (B x).filter)

namespace nhds_basis
open filter set

variables {α : Type*} {ι : Type*} [topological_space α] [nhds_basis α]
variables {β : Type*} [topological_space β] {δ : Type*}

lemma mem_nhds_iff (x : α) (U : set α) : U ∈ 𝓝 x ↔ ∃ V ∈ B x, V ⊆ U :=
by rw [is_nhds x, filter_basis.mem_filter]

lemma mem_nhds_of_basis {x : α} {U : set α} (U_in : U ∈ B x) : U ∈ 𝓝 x :=
(is_nhds x).symm ▸ filter_basis.mem_filter_of_mem U_in

lemma tendsto_from {f : α → δ} {x : α} {y : filter δ} :
  tendsto f (𝓝 x) y ↔ ∀ {V}, V ∈ y → ∃ U ∈ B x, U ⊆ f ⁻¹' V :=
by split ; intros h V V_in ; specialize h V_in ; rwa [← mem_nhds_iff x] at *

lemma continuous_from {f : α → β} : continuous f ↔ ∀ x, ∀ {V}, V ∈ 𝓝 f x → ∃ U ∈ B x, U ⊆ f ⁻¹' V :=
by simp [continuous_iff_continuous_at, continuous_at, tendsto_from]

lemma tendsto_into {f : δ → α} {x : filter δ} {y : α} : tendsto f x 𝓝 y ↔ ∀ U ∈ B y, f ⁻¹' U ∈ x :=
begin
  split ; intros h,
  { rintro U U_in,
    exact h (mem_nhds_of_basis U_in)  },
  { intros V V_in,
    rcases (mem_nhds_iff _ _).1 V_in with ⟨W, W_in, hW⟩,
    filter_upwards [h W W_in],
    exact preimage_mono hW }
end

lemma continuous_into {f : β → α} : continuous f ↔ ∀ x, ∀ U ∈ B (f x), f ⁻¹' U ∈ 𝓝 x :=
by simp [continuous_iff_continuous_at, continuous_at, tendsto_into]

lemma tendsto_both [nhds_basis β] {f : α → β} {x : α} {y : β} :
  tendsto f (𝓝 x) 𝓝 y ↔ ∀ U ∈ B y, ∃ V ∈ B x, V ⊆ f ⁻¹' U :=
begin
  rw tendsto_into,
  split ; introv h U_in ; specialize h U U_in ; rwa mem_nhds_iff x at *
end

lemma continuous_both [nhds_basis β] {f : α → β} :
  continuous f ↔ ∀ x, ∀ U ∈ B (f x), ∃ V ∈ B x, V ⊆ f ⁻¹' U :=
by simp [continuous_iff_continuous_at, continuous_at, tendsto_both]

end nhds_basis

lemma dense_range.mem_nhds {α : Type*} [topological_space α] {β : Type*} [topological_space β]
  {f : α → β} (h : dense_range f) {b : β} {U : set β} (U_in : U ∈ nhds b) :
  ∃ a : α, f a ∈ U :=
begin
  rcases (mem_closure_iff_nhds.mp
    ((dense_range_iff_closure_range.mp h).symm ▸ mem_univ b : b ∈ closure (range f)) U U_in)
    with ⟨_, h, a, rfl⟩,
  exact ⟨a, h⟩
end

lemma mem_closure_union {α : Type*} [topological_space α] {s₁ s₂ : set α} {x : α}
  (h : x ∈ closure (s₁ ∪ s₂)) (h₁ : -s₁ ∈ 𝓝 x) : x ∈ closure s₂ :=
begin
  rw closure_eq_nhds at *,
  have := calc
    𝓝 x ⊓ principal (s₁ ∪ s₂) = 𝓝 x ⊓ (principal s₁ ⊔ principal s₂) : by rw sup_principal
    ... = (𝓝 x ⊓ principal s₁) ⊔ (𝓝 x ⊓ principal s₂) : by rw lattice.inf_sup_left
    ... = ⊥ ⊔ 𝓝 x ⊓ principal s₂ : by rw inf_principal_eq_bot h₁
    ... = 𝓝 x ⊓ principal s₂ : by rw lattice.bot_sup_eq,
  dsimp,
  rwa ← this
end

open lattice

lemma mem_closure_image {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  {f : α → β} {x : α} {s : set α} (hf : continuous_at f x) (hx : x ∈ closure s) :
  f x ∈ closure (f '' s) :=
begin
  rw [closure_eq_nhds, mem_set_of_eq] at *,
  rw ← bot_lt_iff_ne_bot,
  calc
    ⊥   < map f (𝓝 x ⊓ principal s) : bot_lt_iff_ne_bot.mpr (map_ne_bot hx)
    ... ≤ (map f 𝓝 x) ⊓ (map f $ principal s) : map_inf_le
    ... = (map f 𝓝 x) ⊓ (principal $ f '' s) : by rw map_principal
    ... ≤ 𝓝 (f x) ⊓ (principal $ f '' s) : inf_le_inf hf (le_refl _)
end

lemma continuous_at.prod_mk {α : Type*} {β : Type*} {γ : Type*} [topological_space α]
  [topological_space β] [topological_space γ] {f : γ → α} {g : γ → β} {x : γ}
  (hf : continuous_at f x) (hg : continuous_at g x) : continuous_at (λ x, prod.mk (f x) $ g x) x :=
calc
  map (λ (x : γ), (f x, g x)) (𝓝 x) ≤ (map f 𝓝 x).prod (map g 𝓝 x) : filter.map_prod_mk _ _ _
  ... ≤ (𝓝 f x).prod (𝓝 g x) : filter.prod_mono hf hg
  ... = 𝓝 (f x, g x) : by rw nhds_prod_eq

lemma continuous_at.congr_aux {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  {f g : α → β} {a : α}  (h : {x | f x = g x } ∈ 𝓝 a) (hf : continuous_at f a) : continuous_at g a :=
begin
  intros U U_in,
  rw show g a = f a, from (mem_of_nhds h).symm at U_in,
  let V := {x : α | g x ∈ U} ∩ {x | f x = g x},
  suffices : V ∈ 𝓝 a,
  { rw mem_map,
    exact mem_sets_of_superset this (inter_subset_left _ _) },
  have : V = {x : α | f x ∈ U} ∩ {x | f x = g x},
  { ext x,
    split ; rintros ⟨hl, hr⟩ ; rw mem_set_of_eq at hr hl ;
    [ rw ← hr at hl, rw hr at hl ] ; exact ⟨hl, hr⟩ },
  rw this,
  exact filter.inter_mem_sets (hf U_in) ‹_›
end

lemma continuous_at.congr {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  {f g : α → β} {a : α}  (h : {x | f x = g x } ∈ 𝓝 a) : continuous_at f a ↔ continuous_at g a :=
begin
  split ; intro h',
  { exact continuous_at.congr_aux h h' },
  { apply continuous_at.congr_aux _ h',
    convert h,
    ext x,
    rw eq_comm }
end


import algebra.homology.homotopy
import category_theory.limits.shapes.zero_objects

import for_mathlib.Cech.split
import for_mathlib.abelian_category

noncomputable theory

universes v u v' u'

namespace category_theory
open_locale simplicial
open category_theory.limits

namespace arrow

section contravariant
variables {P : Type u} {N : Type u'} [category.{v} P] [category.{v'} N] (M : Pᵒᵖ ⥤ N)
variables (f : arrow P)
variables [∀ n : ℕ, has_wide_pullback f.right (λ i : (fin (n+1)), f.left) (λ i, f.hom)]
variables [arrow.split f] [preadditive N]

def contracting_homotopy' : homotopy (𝟙 (f.conerve M).to_cocomplex) 0 :=
{ hom := λ i j, if h : j + 1 = i then eq_to_hom (by subst h) ≫ f.contracting_homotopy M j else 0,
  zero' := λ i j h, dif_neg h,
  comm := λ i, begin
    simp only [homological_complex.id_f, homotopy.d_next_cochain_complex,
      homological_complex.zero_f_apply, add_zero],
    rcases i with _|_|i,
    { rw [← is_contracting_homotopy_zero, homotopy.prev_d_zero_cochain_complex],
      simp only [eq_self_iff_true, dif_pos, eq_to_hom_refl, category.id_comp, add_zero], },
    { rw [← is_contracting_homotopy_one, homotopy.prev_d_succ_cochain_complex],
      simp only [eq_self_iff_true, dif_pos, eq_to_hom_refl, category.id_comp, add_zero], },
    { rw [← is_contracting_homotopy, homotopy.prev_d_succ_cochain_complex],
      simp only [eq_self_iff_true, dif_pos, eq_to_hom_refl, category.id_comp, add_zero], },
  end }

variables [has_equalizers N] [has_cokernels N] [has_images N] [has_image_maps N]

lemma conerve_to_cocomplex_homology_is_zero (i : ℕ) :
  is_zero ((f.conerve M).to_cocomplex.homology i) :=
begin
  rw is_zero_iff_id_eq_zero,
  simpa only [category_theory.functor.map_id, functor.map_zero] using
    homology_map_eq_of_homotopy (f.contracting_homotopy' M) i,
end

end contravariant

section covariant

variables {P : Type u} {N : Type u'} [category.{v} P] [category.{v'} N] (M : P ⥤ N)
variables (f : arrow P)
variables [∀ n : ℕ, has_wide_pullback f.right (λ i : (fin (n+1)), f.left) (λ i, f.hom)]
variables [arrow.split f] [preadditive N]

def covariant_contracting_homotopy' : homotopy (𝟙 (f.nerve M).to_complex) 0 :=
{ hom := λ i j, if h : i + 1 = j then
    f.covariant_contracting_homotopy M i ≫ eq_to_hom (by subst h) else 0,
  zero' := λ i j h, dif_neg h,
  comm := λ i, begin
    simp only [homological_complex.id_f, homotopy.d_next_cochain_complex,
      homological_complex.zero_f_apply, add_zero],
    rcases i with _|_|i,
    { rw [← covariant_is_contracting_homotopy_zero, homotopy.d_next_zero_chain_complex],
      simp only [eq_self_iff_true, eq_to_hom_refl, dite_eq_ite, if_true,
        homotopy.prev_d_chain_complex, category.comp_id, zero_add] },
    { rw [← covariant_is_contracting_homotopy_one, homotopy.d_next_succ_chain_complex],
      simp only [simplicial_object.augmented.to_complex_d_2, eq_self_iff_true,
        eq_to_hom_refl, category.id_comp, dite_eq_ite, if_true,
        category.comp_id, homotopy.prev_d_chain_complex],
      rw add_comm },
    { rw [← covariant_is_contracting_homotopy, homotopy.d_next_succ_chain_complex],
      simp only [simplicial_object.augmented.to_complex_d_2, eq_self_iff_true,
        eq_to_hom_refl, category.id_comp, dite_eq_ite, if_true,
        category.comp_id, homotopy.prev_d_chain_complex],
      rw add_comm },
  end }

variables [has_equalizers N] [has_cokernels N] [has_images N] [has_image_maps N]

lemma nerve_to_complex_homology_is_zero (i : ℕ) :
  is_zero ((f.nerve M).to_complex.homology i) :=
begin
  rw is_zero_iff_id_eq_zero,
  simpa only [category_theory.functor.map_id, functor.map_zero] using
    homology_map_eq_of_homotopy (f.covariant_contracting_homotopy' M) i,
end

end covariant

end arrow

end category_theory