import category_theory.functor.category -- this transitively imports
-- category_theory.category
-- category_theory.functor
-- category_theory.natural_transformation

/-!
# An introduction to category theory in Lean

This is an introduction to the basic usage of category theory (in the mathematical sense) in Lean.
We cover how the basic theory of categories, functors and natural transformations is set up in Lean.
Most of the below is not hard to read off from the files `category_theory/category.lean`,
`category_theory/functor.lean` and `category_theory/natural_transformation.lean`.

## Overview

A category is a collection of objects, and a collection of morphisms (also known as arrows) between
the objects. The objects and morphisms have some extra structure and satisfy some axioms -- see the
[definition on Wikipedia](https://en.wikipedia.org/wiki/Category_%28mathematics%29#Definition) for
details.

One important thing to note is that a morphism in an abstract category may not be an actual function
between two types. In particular, there is new notation `⟶` , typed as `\h` or `\hom` in VS Code,
for a morphism. Nevertheless, in most of the "concrete" categories like `Top` and `Ab`, it is still
possible to write `f x` when `x : X` and `f : X ⟶ Y` is a morphism, as there is an automatic
coercion from morphisms to functions. (If the coercion doesn't fire automatically, sometimes it is
necessary to write `(f : X → Y) x`.)

In some fonts the `⟶` morphism arrow can be virtually indistinguishable from the standard function
arrow `→` . You may want to install the [Deja Vu Sans Mono](https://dejavu-fonts.github.io/) and put
that at the beginning of the `Font Family` setting in VSCode, to get a nice readable font with
excellent unicode coverage.

Another point of confusion can be universe issues. Following Lean's conventions for universe
polymorphism, the objects of a category might live in one universe `u` and the morphisms in another
universe `v`. Note that in many categories showing up in "set-theoretic mathematics", the morphisms
between two objects often form a set, but the objects themselves may or may not form a set. In Lean
this corresponds to the two possibilities `u=v` and `u=v+1`, known as `small_category` and
`large_category` respectively. In order to avoid proving the same statements for both small and
large categories, we usually stick to the general polymorphic situation with `u` and `v` independent
universes, and we do this below.

## Getting started with categories

The structure of a category on a type `C` in Lean is done using typeclasses; terms of `C` then
correspond to objects in the category. The convention in the category theory library is to use
universes prefixed with `u` (e.g. `u`, `u₁`, `u₂`) for the objects, and universes prefixed with `v`
for morphisms. Thus we have `C : Type u`, and if `X : C` and `Y : C` then morphisms `X ⟶ Y : Type v`
(note the non-standard arrow).

We set this up as follows:
-/

open category_theory

section category

variables (C : Type*) [category C]

variables {W X Y Z : C}
variables (f : W ⟶ X) (g : X ⟶ Y) (h : Y ⟶ Z)

/-!
This says "let `C` be a category, let `W`, `X`, `Y`, `Z` be objects of `C`, and let `f : W ⟶ X`, `g
: X ⟶ Y` and `h : Y ⟶ Z` be morphisms in `C` (with the specified source and targets)".

Note that we sometimes need to explicitly tell Lean the universe that the morphisms live in,
by writing `category.{v} C`, because Lean cannot guess this from `C` alone.
However just writing `category C` is often fine: this allows a "free" universe level.

The order in which universes are introduced at the top of the file matters:
we put the universes for morphisms first (typically `v`, `v₁` and so on),
and then universes for objects (typically `u`, `u₁` and so on).
This ensures that in any new definition we make the universe variables for morphisms come first,
so that they can be explicitly specified while still allowing the universe levels of the
objects to be inferred automatically.

## Basic notation

In categories one has morphisms between objects, such as the identity morphism from an object to
itself. One can compose morphisms, and there are standard facts about the composition of a morphism
with the identity morphism, and the fact that morphism composition is associative. In Lean all of
this looks like the following:
-/

-- The identity morphism from `X` to `X` (remember that this is the `\h` arrow):
example : X ⟶ X := 𝟙 X -- type `𝟙` as `\bb1`

-- Function composition `h ∘ g`, a morphism from `X` to `Z`:
example : X ⟶ Z := g ≫ h

/-
Note in particular the order! The "maps on the right" convention was chosen; `g ≫ h` means "`g` then
`h`". Type `≫` with `\gg` in VS Code. Here are the theorems which ensure that we have a category.
-/

open category_theory.category

example : 𝟙 X ≫ g = g := id_comp g
example : g ≫ 𝟙 Y = g := comp_id g
example : (f ≫ g) ≫ h = f ≫ (g ≫ h) := assoc f g h
example : (f ≫ g) ≫ h = f ≫ g ≫ h := assoc f g h -- note \gg is right associative

-- All four examples above can also be proved with `simp`.

-- Monomorphisms and epimorphisms are predicates on morphisms and are implemented as typeclasses.
variables (f' : W ⟶ X) (h' : Y ⟶ Z)

example [mono g] : f ≫ g = f' ≫ g → f = f' := mono.right_cancellation f f'
example [epi g] : g ≫ h = g ≫ h' → h = h' := epi.left_cancellation h h'

end category -- end of section

/-!
## Getting started with functors

A functor is a map between categories. It is implemented as a structure. The notation for a functor
from `C` to `D` is `C ⥤ D`. Type `\func` in VS Code for the symbol. Here we demonstrate how to
evaluate functors on objects and on morphisms, how to show functors preserve the identity morphism
and composition of morphisms, how to compose functors, and show the notation `𝟭` for the identity
functor.
-/

section functor

variables (C : Type*) [category C]
variables (D : Type*) [category D]
variables (E : Type*) [category E]

variables {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z)

-- functors
variables (F : C ⥤ D) (G : D ⥤ E)

example : D := F.obj X -- functor F on objects
example : F.obj Y ⟶ F.obj Z := F.map g -- functor F on morphisms

-- A functor sends identity objects to identity objects
example : F.map (𝟙 X) = 𝟙 (F.obj X) := F.map_id X

-- and preserves compositions
example : F.map (f ≫ g) = (F.map f) ≫ (F.map g) := F.map_comp f g

-- The identity functor is `𝟭`, which you can write as `\sb1`.
example : C ⥤ C := 𝟭 C

-- The identity functor is (definitionally) the identity on objects and morphisms:
example : (𝟭 C).obj X = X := category_theory.functor.id_obj X
example : (𝟭 C).map f = f := category_theory.functor.id_map f

-- Composition of functors; note order:
example : C ⥤ E := F ⋙ G -- typeset with `\ggg`

-- Composition of the identity either way does nothing:
example : F ⋙ 𝟭 D = F := F.comp_id
example : 𝟭 C ⋙ F = F := F.id_comp

-- Composition of functors definitionally does the right thing on objects and morphisms:
example : (F ⋙ G).obj X = G.obj (F.obj X) := F.comp_obj G X -- or rfl
example : (F ⋙ G).map f = G.map (F.map f) := rfl -- or F.comp_map G X Y f

end functor -- end of section

/-!
One can also check that associativity of composition of functors is definitionally true,
although we've observed that relying on this can result in slow proofs. (One should
rather use the natural isomorphisms provided in `src/category_theory/whiskering.lean`.)

## Getting started with natural transformations

A natural transformation is a morphism between functors. If `F` and `G` are functors from `C` to `D`
then a natural transformation is a map `F X ⟶ G X` for each object `X : C` plus the theorem that if
`f : X ⟶ Y` is a morphism then the two routes from `F X` to `G Y` are the same. One might imagine
that this is now another layer of notation, but fortunately the `category_theory.functor_category`
import gives the type of functors from `C` to `D` a category structure, which means that we can just
use morphism notation for natural transformations.
-/

section nat_trans

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

variables (X Y : C)

variable (f : X ⟶ Y)

variables (F G H : C ⥤ D)

variables (α : F ⟶ G) (β : G ⟶ H) -- natural transformations (note it's the usual `\hom` arrow here)

-- Composition of natural transformations is just composition of morphisms:
example : F ⟶ H := α ≫ β

-- Applying natural transformation to an object:
example (X : C) : F.obj X ⟶ G.obj X := α.app X

/- The diagram coming from g and α

    F(f)
F X ---> F Y
 |        |
 |α(X)    |α(Y)
 v        v
G X ---> G Y
    G(f)

commutes.
-/

example : F.map f ≫ α.app Y = (α.app X) ≫ G.map f := α.naturality f

end nat_trans -- section

/-!
## What next?

There are several lean files in the [category theory docs directory of
mathlib](https://github.com/leanprover-community/mathlib/tree/master/docs/tutorial/category_theory)
which give further examples of using the category theory library in Lean.
-/


import tactic.norm_cast

structure hom (α β : Type) :=
(to_fun : α → β)

instance {α β} : has_coe_to_fun (hom α β) (λ _, α → β) :=
⟨hom.to_fun⟩

structure hom_plus (α β) extends hom α β

instance {α β} : has_coe (hom_plus α β) (hom α β) :=
⟨hom_plus.to_hom⟩

instance {α β} : has_coe_to_fun (hom_plus α β) (λ _, α → β) := ⟨λ f, f⟩

@[norm_cast] lemma hom_plus.coe_fn (α β : Type) (a : α) (h : hom_plus α β) :
  (h : hom α β) a = h a :=
rfl

example (α β : Type) (a : α) (h : hom_plus α β) :
  (h : hom α β) a = h a :=
by norm_cast

def f1 (n : ℕ) : hom_plus ℕ ℕ := ⟨⟨λ m, m + n⟩⟩
def f2 : hom ℕ (hom ℕ ℕ) := ⟨λ n, f1 n⟩

@[norm_cast] lemma coe_f1 (n : ℕ) :
  (f1 n : hom ℕ ℕ) = f2 n :=
rfl


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import data.dlist

/-!
# Difference list

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

This file provides a few results about `dlist`, which is defined in core Lean.

A difference list is a function that, given a list, returns the original content of the
difference list prepended to the given list. It is useful to represent elements of a given type
as `a₁ + ... + aₙ` where `+ : α → α → α` is any operation, without actually computing.

This structure supports `O(1)` `append` and `concat` operations on lists, making it
useful for append-heavy uses such as logging and pretty printing.
-/

/-- Concatenates a list of difference lists to form a single difference list. Similar to
`list.join`. -/
def dlist.join {α : Type*} : list (dlist α) → dlist α
 | [] := dlist.empty
 | (x :: xs) := x ++ dlist.join xs

@[simp] lemma dlist_singleton {α : Type*} {a : α} :
  dlist.singleton a = dlist.lazy_of_list ([a]) := rfl

@[simp] lemma dlist_lazy {α : Type*} {l : list α} :
  dlist.lazy_of_list l = dlist.of_list l := rfl


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

! This file was ported from Lean 3 source module tactic.elementwise
! leanprover-community/mathlib commit d6814c584384ddf2825ff038e868451a7c956f31
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.ConcreteCategory.Basic
import Mathbin.Tactic.FreshNames
import Mathbin.Tactic.ReassocAxiom
import Mathbin.Tactic.Slice

/-!
# Tools to reformulate category-theoretic lemmas in concrete categories

## The `elementwise` attribute

The `elementwise` attribute can be applied to a lemma

```lean
@[elementwise]
lemma some_lemma {C : Type*} [category C]
  {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (h : X ⟶ Z) (w : ...) : f ≫ g = h := ...
```

and will produce

```lean
lemma some_lemma_apply {C : Type*} [category C] [concrete_category C]
  {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (h : X ⟶ Z) (w : ...) (x : X) : g (f x) = h x := ...
```

Here `X` is being coerced to a type via `concrete_category.has_coe_to_sort` and
`f`, `g`, and `h` are being coerced to functions via `concrete_category.has_coe_to_fun`.
Further, we simplify the type using `concrete_category.coe_id : ((𝟙 X) : X → X) x = x` and
`concrete_category.coe_comp : (f ≫ g) x = g (f x)`,
replacing morphism composition with function composition.

The name of the produced lemma can be specified with `@[elementwise other_lemma_name]`.
If `simp` is added first, the generated lemma will also have the `simp` attribute.

## Implementation

This closely follows the implementation of the `@[reassoc]` attribute, due to Simon Hudon.
Thanks to Gabriel Ebner for help diagnosing universe issues.

-/

namespace Tactic

open Interactive Lean.Parser CategoryTheory

/-- From an expression `f = g`,
where `f g : X ⟶ Y` for some objects `X Y : V` with `[S : category V]`,
extract the expression for `S`.
-/
unsafe def extract_category : expr → tactic expr
  |
  q(@Eq (@Quiver.Hom _ (@CategoryStruct.toQuiver _ (@Category.toCategoryStruct _ $(S))) _ _) _ _) =>
    pure S
  | _ => failed
#align tactic.extract_category tactic.extract_category

-- This is closely modelled on `reassoc_axiom`.
/-- (internals for `@[elementwise]`)
Given a lemma of the form `f = g`, where `f g : X ⟶ Y` and `X Y : V`,
proves a new lemma of the form
`∀ (x : X), f x = g x`
if we are already in a concrete category, or
`∀ [concrete_category.{w} V] (x : X), f x = g x`
otherwise.

Returns the type and proof of this lemma,
and the universe parameter `w` for the `concrete_category` instance, if it was not synthesized.
-/
unsafe def prove_elementwise (h : expr) : tactic (expr × expr × Option Name) := do
  let (vs, t) ← infer_type h >>= open_pis
  let (f, g) ← match_eq t
  let S ← extract_category t <|> fail "no morphism equation found in statement"
  let q(@Quiver.Hom _ $(H) $(X) $(Y)) ← infer_type f
  let C ← infer_type X
  let CC_type ← to_expr ``(@ConcreteCategory $(C) $(S))
  let (CC, CC_found) ←
    (do
          let CC ← mk_instance CC_type
          pure (CC, tt)) <|>
        do
        let CC ← mk_local' `I BinderInfo.inst_implicit CC_type
        pure (CC, ff)
  let CC_type
    ←-- This is need to fill in universe levels fixed by `mk_instance`:
        instantiate_mvars
        CC_type
  let x_type ←
    to_expr ``(@coeSort $(C) _ (@CategoryTheory.ConcreteCategory.hasCoeToSort $(C) $(S) $(CC)) $(X))
  let x ← mk_local_def `x x_type
  let t' ←
    to_expr
        ``(@coeFn (@Quiver.Hom $(C) $(H) $(X) $(Y)) _
              (@CategoryTheory.ConcreteCategory.hasCoeToFun $(C) $(S) $(CC) $(X) $(Y)) $(f) $(x) =
            @coeFn (@Quiver.Hom $(C) $(H) $(X) $(Y)) _
              (@CategoryTheory.ConcreteCategory.hasCoeToFun $(C) $(S) $(CC) $(X) $(Y)) $(g) $(x))
  let c' := h.mk_app vs
  let (_, pr) ← solve_aux t' (andthen (rewrite_target c') reflexivity)
  let-- The codomain of forget lives in a new universe, which may be now a universe metavariable
    -- if we didn't synthesize an instance:
    [w, _, _]
    ← pure CC_type.get_app_fn.univ_levels
  let n
    ←-- We unify that with a fresh universe parameter.
      match w with
      | level.mvar _ => do
        let n ← get_unused_name_reserved [`w] mk_name_set
        unify (expr.sort (level.param n)) (expr.sort w)
        pure (Option.some n)
      | _ => pure Option.none
  let t' ← instantiate_mvars t'
  let CC ← instantiate_mvars CC
  let x ← instantiate_mvars x
  let-- Now the key step: replace morphism composition with function composition,
  -- and identity morphisms with nothing.
  s := simp_lemmas.mk
  let s ← s.add_simp `` id_apply
  let s ← s.add_simp `` comp_apply
  let (t'', pr', _) ← simplify s [] t' { failIfUnchanged := false }
  let pr' ← mk_eq_mp pr' pr
  let-- Further, if we're in `Type`, get rid of the coercions entirely.
  s := simp_lemmas.mk
  let s ← s.add_simp `` concrete_category.has_coe_to_fun_Type
  let (t'', pr'', _) ← simplify s [] t'' { failIfUnchanged := false }
  let pr'' ← mk_eq_mp pr'' pr'
  let t'' ← pis (vs ++ if CC_found then [x] else [CC, x]) t''
  let pr'' ← lambdas (vs ++ if CC_found then [x] else [CC, x]) pr''
  pure (t'', pr'', n)
#align tactic.prove_elementwise tactic.prove_elementwise

/-- (implementation for `@[elementwise]`)
Given a declaration named `n` of the form `∀ ..., f = g`, proves a new lemma named `n'`
of the form `∀ ... [concrete_category V] (x : X), f x = g x`.
-/
unsafe def elementwise_lemma (n : Name) (n' : Name := n.appendSuffix "_apply") : tactic Unit := do
  let d ← get_decl n
  let c := @expr.const true n d.univ_levels
  let (t'', pr', l') ← prove_elementwise c
  let params := l'.toList ++ d.univ_params
  add_decl <| declaration.thm n' params t'' (pure pr')
  copy_attribute `simp n n'
#align tactic.elementwise_lemma tactic.elementwise_lemma

/-- The `elementwise` attribute can be applied to a lemma

```lean
@[elementwise]
lemma some_lemma {C : Type*} [category C]
  {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (h : X ⟶ Z) (w : ...) : f ≫ g = h := ...
```

and will produce

```lean
lemma some_lemma_apply {C : Type*} [category C] [concrete_category C]
  {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (h : X ⟶ Z) (w : ...) (x : X) : g (f x) = h x := ...
```

Here `X` is being coerced to a type via `concrete_category.has_coe_to_sort` and
`f`, `g`, and `h` are being coerced to functions via `concrete_category.has_coe_to_fun`.
Further, we simplify the type using `concrete_category.coe_id : ((𝟙 X) : X → X) x = x` and
`concrete_category.coe_comp : (f ≫ g) x = g (f x)`,
replacing morphism composition with function composition.

The `[concrete_category C]` argument will be omitted if it is possible to synthesize an instance.

The name of the produced lemma can be specified with `@[elementwise other_lemma_name]`.
If `simp` is added first, the generated lemma will also have the `simp` attribute.
-/
@[user_attribute]
unsafe def elementwise_attr : user_attribute Unit (Option Name)
    where
  Name := `elementwise
  descr := "create a companion lemma for a morphism equation applied to an element"
  parser := optional ident
  after_set :=
    some fun n _ _ => do
      let some n' ← elementwise_attr.get_param n |
        elementwise_lemma n (n.appendSuffix "_apply")
      elementwise_lemma n <| n ++ n'
#align tactic.elementwise_attr tactic.elementwise_attr

add_tactic_doc
  { Name := "elementwise"
    category := DocCategory.attr
    declNames := [`tactic.elementwise_attr]
    tags := ["category theory"] }

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- `elementwise h`, for assumption `w : ∀ ..., f ≫ g = h`, creates a new assumption
`w : ∀ ... (x : X), g (f x) = h x`.

`elementwise! h`, does the same but deletes the initial `h` assumption.
(You can also add the attribute `@[elementwise]` to lemmas to generate new declarations generalized
in this way.)
-/
unsafe def elementwise (del : parse (tk "!")?) (ns : parse ident*) : tactic Unit := do
  ns fun n => do
      let h ← get_local n
      let (t, pr, u) ← prove_elementwise h
      assertv n t pr
      when del (tactic.clear h)
#align tactic.interactive.elementwise tactic.interactive.elementwise

end Interactive

/-- Auxiliary definition for `category_theory.elementwise_of`. -/
unsafe def derive_elementwise_proof : tactic Unit := do
  let q(CalculatedProp $(v) $(h)) ← target
  let (t, pr, n) ← prove_elementwise h
  unify v t
  exact pr
#align tactic.derive_elementwise_proof tactic.derive_elementwise_proof

end Tactic

/-- With `w : ∀ ..., f ≫ g = h` (with universal quantifiers tolerated),
`elementwise_of w : ∀ ... (x : X), g (f x) = h x`.

The type and proof of `elementwise_of h` is generated by `tactic.derive_elementwise_proof`
which makes `elementwise_of` meta-programming adjacent. It is not called as a tactic but as
an expression. The goal is to avoid creating assumptions that are dismissed after one use:

```lean
example (M N K : Mon.{u}) (f : M ⟶ N) (g : N ⟶ K) (h : M ⟶ K) (w : f ≫ g = h) (m : M) :
  g (f m) = h m :=
begin
  rw elementwise_of w,
end
```
-/
theorem CategoryTheory.elementwise_of {α} (hh : α) {β}
    (x : Tactic.CalculatedProp β hh := by derive_elementwise_proof) : β :=
  x
#align category_theory.elementwise_of CategoryTheory.elementwise_of

/-- With `w : ∀ ..., f ≫ g = h` (with universal quantifiers tolerated),
`elementwise_of w : ∀ ... (x : X), g (f x) = h x`.

Although `elementwise_of` is not a tactic or a meta program, its type is generated
through meta-programming to make it usable inside normal expressions.
-/
add_tactic_doc
  { Name := "category_theory.elementwise_of"
    category := DocCategory.tactic
    declNames := [`category_theory.elementwise_of]
    tags := ["category theory"] }


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.concrete_category.bundled_hom
import Mathlib.category_theory.concrete_category.reflects_isomorphisms
import Mathlib.algebra.punit_instances
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Category instances for monoid, add_monoid, comm_monoid, and add_comm_monoid.

We introduce the bundled categories:
* `Mon`
* `AddMon`
* `CommMon`
* `AddCommMon`
along with the relevant forgetful functors between them.
-/

/-- The category of monoids and monoid morphisms. -/
def Mon :=
  category_theory.bundled monoid

/-- The category of additive monoids and monoid morphisms. -/
namespace Mon

protected instance Mathlib.AddMon.bundled_hom : category_theory.bundled_hom add_monoid_hom :=
  category_theory.bundled_hom.mk add_monoid_hom.to_fun add_monoid_hom.id add_monoid_hom.comp

protected instance Mathlib.AddMon.concrete_category : category_theory.concrete_category AddMon :=
  category_theory.bundled_hom.category_theory.bundled.category_theory.concrete_category add_monoid_hom

/-- Construct a bundled `Mon` from the underlying type and typeclass. -/
def Mathlib.AddMon.of (M : Type u) [add_monoid M] : AddMon :=
  category_theory.bundled.of M

/-- Construct a bundled `Mon` from the underlying type and typeclass. -/
-- The default instance for `monoid punit` is derived via `punit.comm_ring`,

protected instance Mathlib.AddMon.inhabited : Inhabited AddMon :=
  { default := AddMon.of PUnit }

-- which breaks to_additive.

protected instance Mathlib.AddMon.add_monoid (M : AddMon) : add_monoid ↥M :=
  category_theory.bundled.str M

@[simp] theorem Mathlib.AddMon.coe_of (R : Type u) [add_monoid R] : ↥(AddMon.of R) = R :=
  rfl

end Mon

/-- The category of commutative monoids and monoid morphisms. -/
def CommMon :=
  category_theory.bundled comm_monoid

/-- The category of additive commutative monoids and monoid morphisms. -/
namespace CommMon

protected instance comm_monoid.to_monoid.category_theory.bundled_hom.parent_projection : category_theory.bundled_hom.parent_projection comm_monoid.to_monoid :=
  category_theory.bundled_hom.parent_projection.mk

protected instance has_coe_to_sort : has_coe_to_sort CommMon :=
  category_theory.bundled.has_coe_to_sort

/-- Construct a bundled `CommMon` from the underlying type and typeclass. -/
def of (M : Type u) [comm_monoid M] : CommMon :=
  category_theory.bundled.of M

/-- Construct a bundled `AddCommMon` from the underlying type and typeclass. -/
-- The default instance for `comm_monoid punit` is derived via `punit.comm_ring`,

protected instance Mathlib.AddCommMon.inhabited : Inhabited AddCommMon :=
  { default := AddCommMon.of PUnit }

-- which breaks to_additive.

protected instance Mathlib.AddCommMon.add_comm_monoid (M : AddCommMon) : add_comm_monoid ↥M :=
  category_theory.bundled.str M

@[simp] theorem coe_of (R : Type u) [comm_monoid R] : ↥(of R) = R :=
  rfl

protected instance Mathlib.AddCommMon.has_forget_to_AddMon : category_theory.has_forget₂ AddCommMon AddMon :=
  category_theory.bundled_hom.forget₂ add_monoid_hom add_comm_monoid.to_add_monoid

end CommMon

-- We verify that the coercions of morphisms to functions work correctly:

-- We verify that when constructing a morphism in `CommMon`,

-- when we construct the `to_fun` field, the types are presented as `↥R`,

-- rather than `R.α` or (as we used to have) `↥(bundled.map comm_monoid.to_monoid R)`.

/-- Build an isomorphism in the category `Mon` from a `mul_equiv` between `monoid`s. -/
def mul_equiv.to_Mon_iso {X : Type u} {Y : Type u} [monoid X] [monoid Y] (e : X ≃* Y) : Mon.of X ≅ Mon.of Y :=
  category_theory.iso.mk (mul_equiv.to_monoid_hom e) (mul_equiv.to_monoid_hom (mul_equiv.symm e))

@[simp] theorem mul_equiv.to_Mon_iso_hom {X : Type u} {Y : Type u} [monoid X] [monoid Y] {e : X ≃* Y} : category_theory.iso.hom (mul_equiv.to_Mon_iso e) = mul_equiv.to_monoid_hom e :=
  rfl

@[simp] theorem add_equiv.to_AddMon_iso_inv {X : Type u} {Y : Type u} [add_monoid X] [add_monoid Y] {e : X ≃+ Y} : category_theory.iso.inv (add_equiv.to_AddMon_iso e) = add_equiv.to_add_monoid_hom (add_equiv.symm e) :=
  rfl

/-- Build an isomorphism in the category `CommMon` from a `mul_equiv` between `comm_monoid`s. -/
def add_equiv.to_AddCommMon_iso {X : Type u} {Y : Type u} [add_comm_monoid X] [add_comm_monoid Y] (e : X ≃+ Y) : AddCommMon.of X ≅ AddCommMon.of Y :=
  category_theory.iso.mk (add_equiv.to_add_monoid_hom e) (add_equiv.to_add_monoid_hom (add_equiv.symm e))

@[simp] theorem add_equiv.to_AddCommMon_iso_hom {X : Type u} {Y : Type u} [add_comm_monoid X] [add_comm_monoid Y] {e : X ≃+ Y} : category_theory.iso.hom (add_equiv.to_AddCommMon_iso e) = add_equiv.to_add_monoid_hom e :=
  rfl

@[simp] theorem add_equiv.to_AddCommMon_iso_inv {X : Type u} {Y : Type u} [add_comm_monoid X] [add_comm_monoid Y] {e : X ≃+ Y} : category_theory.iso.inv (add_equiv.to_AddCommMon_iso e) = add_equiv.to_add_monoid_hom (add_equiv.symm e) :=
  rfl

namespace category_theory.iso

/-- Build a `mul_equiv` from an isomorphism in the category `Mon`. -/
def AddMon_iso_to_add_equiv {X : AddMon} {Y : AddMon} (i : X ≅ Y) : ↥X ≃+ ↥Y :=
  add_monoid_hom.to_add_equiv (hom i) (inv i) (hom_inv_id i) (inv_hom_id i)

/-- Build a `mul_equiv` from an isomorphism in the category `CommMon`. -/
def CommMon_iso_to_add_equiv {X : AddCommMon} {Y : AddCommMon} (i : X ≅ Y) : ↥X ≃+ ↥Y :=
  add_monoid_hom.to_add_equiv (hom i) (inv i) (hom_inv_id i) (inv_hom_id i)

end category_theory.iso

/-- multiplicative equivalences between `monoid`s are the same as (isomorphic to) isomorphisms
in `Mon` -/
def mul_equiv_iso_Mon_iso {X : Type u} {Y : Type u} [monoid X] [monoid Y] : X ≃* Y ≅ Mon.of X ≅ Mon.of Y :=
  category_theory.iso.mk (fun (e : X ≃* Y) => mul_equiv.to_Mon_iso e)
    fun (i : Mon.of X ≅ Mon.of Y) => category_theory.iso.Mon_iso_to_mul_equiv i

/-- multiplicative equivalences between `comm_monoid`s are the same as (isomorphic to) isomorphisms
in `CommMon` -/
def add_equiv_iso_AddCommMon_iso {X : Type u} {Y : Type u} [add_comm_monoid X] [add_comm_monoid Y] : X ≃+ Y ≅ AddCommMon.of X ≅ AddCommMon.of Y :=
  category_theory.iso.mk (fun (e : X ≃+ Y) => add_equiv.to_AddCommMon_iso e)
    fun (i : AddCommMon.of X ≅ AddCommMon.of Y) => category_theory.iso.CommMon_iso_to_add_equiv i

protected instance AddMon.forget_reflects_isos : category_theory.reflects_isomorphisms (category_theory.forget AddMon) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : AddMon) (f : X ⟶ Y)
      (_x : category_theory.is_iso (category_theory.functor.map (category_theory.forget AddMon) f)) =>
      let i :
        category_theory.functor.obj (category_theory.forget AddMon) X ≅
          category_theory.functor.obj (category_theory.forget AddMon) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget AddMon) f);
      let e : ↥X ≃+ ↥Y :=
        add_equiv.mk (add_monoid_hom.to_fun f) (equiv.inv_fun (category_theory.iso.to_equiv i)) sorry sorry sorry;
      category_theory.is_iso.mk (category_theory.iso.inv (add_equiv.to_AddMon_iso e))

protected instance CommMon.forget_reflects_isos : category_theory.reflects_isomorphisms (category_theory.forget CommMon) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : CommMon) (f : X ⟶ Y)
      (_x : category_theory.is_iso (category_theory.functor.map (category_theory.forget CommMon) f)) =>
      let i :
        category_theory.functor.obj (category_theory.forget CommMon) X ≅
          category_theory.functor.obj (category_theory.forget CommMon) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget CommMon) f);
      let e : ↥X ≃* ↥Y :=
        mul_equiv.mk (monoid_hom.to_fun f) (equiv.inv_fun (category_theory.iso.to_equiv i)) sorry sorry sorry;
      category_theory.is_iso.mk (category_theory.iso.inv (mul_equiv.to_CommMon_iso e))


import .basic .backtrack

universes u v
variables (α : Type u) (β : Type v)

namespace two_three.tree
open two_three

inductive zipper
| nil : zipper
| node2_0 : zipper → α → tree α β → zipper
| node2_1 : tree α β → α → zipper → zipper
| node3_0 : zipper → α → tree α β → α → tree α β → zipper
| node3_1 : tree α β → α → zipper → α → tree α β → zipper
| node3_2 : tree α β → α → tree α β → α → zipper → zipper

variables {α β}

namespace zipper

@[pp_nodot]
def close : zipper α β → option α → tree α β → tree α β
| nil k t := t
| (node2_0 z  x t₁) k t := close z k $ node2 t  x t₁
| (node2_1 t₀ x z)  k t := close z none $ node2 t₀ (k.get_or_else x) t
| (node3_0 z  x t₁ y t₂) k t := close z k $ node3 t  x t₁ y t₂
| (node3_1 t₀ x z  y t₂) k t := close z none $ node3 t₀ (k.get_or_else x) t  y t₂
| (node3_2 t₀ x t₁ y z)  k t := close z none $ node3 t₀ x t₁ (k.get_or_else y) t

@[pp_nodot]
def split : zipper α β → option α → tree α β → α → tree α β → tree α β
| nil k ta a tb := node2 ta a tb
| (node2_0 z  x t₁) k ta a tb := close z k $ node3 ta a tb x t₁
| (node2_1 t₀ x z)  k ta a tb := close z none $ node3 t₀ (k.get_or_else x) ta a tb
| (node3_0 z  x t₁ y t₂) k ta a tb := split z k (node2 ta a tb) x (node2 t₁ y t₂)
| (node3_1 t₀ x z  y t₂) k ta a tb := split z none (node2 t₀ (k.get_or_else x) ta) a (node2 tb y t₂)
| (node3_2 t₀ x t₁ y z)  k ta a tb := split z none (node2 t₀ x t₁) (k.get_or_else y) (node2 ta a tb)

section eqv

variables [has_lt α] [@decidable_rel α has_lt.lt]

def insert (k : α) (v : β) : zipper α β → tree α β → tree α β
| xs (leaf k' v') :=
  match cmp k k' with
  | ordering.lt := split xs (some k) (tree.leaf k v) k' (tree.leaf k' v')
  | ordering.eq := close xs (some k') (tree.leaf k' v)
  | ordering.gt := split xs (some k') (tree.leaf k' v') k (tree.leaf k v)
  end
| xs (node2 t₀ x t₁) :=
  if k < x
    then insert (node2_0 xs x t₁) t₀
    else insert (node2_1 t₀ x xs) t₁
| xs (node3 t₀ x t₁ y t₂) :=
  if k < x
    then insert (node3_0 xs x t₁ y t₂) t₀
  else if k < y
    then insert (node3_1 t₀ x xs y t₂) t₁
    else insert (node3_2 t₀ x t₁ y xs) t₂

def insert' (k : α) (v : β) : tree α β → tree α β :=
insert k v zipper.nil

end eqv
open nat

variables {n m : ℕ} {pk : option α} {t t₀ t₁ : tree α β} (x : α) {z : zipper α β}

section defns

variables [has_lt α] [has_le α]

inductive zipper_height (m : ℕ) : ℕ → zipper α β → Prop
| nil : zipper_height m zipper.nil
| node2_0 {n} {z} {x t₁} :
  zipper_height (succ n) z →
  with_height n t₁ →
  zipper_height n (zipper.node2_0 z x t₁)
| node2_1 {n} {z} {t₀ x} :
  zipper_height (succ n) z →
  with_height n t₀ →
  zipper_height n (zipper.node2_1 t₀ x z)
| node3_0 {n} {z} {x t₁ y t₂} :
  zipper_height (succ n) z →
  with_height n t₁ →
  with_height n t₂ →
  zipper_height n (zipper.node3_0 z x t₁ y t₂)
| node3_1 {n} {z} {t₀ x y t₂} :
  zipper_height (succ n) z →
  with_height n t₀ →
  with_height n t₂ →
  zipper_height n (zipper.node3_1 t₀ x z y t₂)
| node3_2 {n} {z} {t₀ x t₁ y} :
  zipper_height (succ n) z →
  with_height n t₀ →
  with_height n t₁ →
  zipper_height n (zipper.node3_2 t₀ x t₁ y z)

lemma with_height_close
  (h : with_height n t)
  (h' : zipper_height m n z) :
  with_height m (close z pk t) ∨ with_height (succ m) (close z pk t) :=
begin
  left,
  induction h' generalizing t pk; dsimp [close] at *,
  repeat { apply h'_ih <|> assumption <|> constructor },
end

lemma with_height_split
  (h₀ : with_height n t₀)
  (h₁ : with_height n t₁)
  (h' : zipper_height m n z) :
  with_height m (split z pk t₀ x t₁) ∨ with_height (succ m) (split z pk t₀ x t₁) :=
begin
  induction h' generalizing t₀ x t₁ pk; dsimp [split],
  { right, constructor; assumption },
  repeat
  { apply with_height_close, constructor; assumption, assumption },
  repeat
  { apply h'_ih, repeat { constructor; assumption } },
end

end defns

section insert_height

variables [linear_order α]
variables {k : α} {v : β}
variables
  (h : zipper_height m n z)
  (h' : with_height n t)
include h h'

lemma with_height_insert : with_height m (insert k v z t) ∨ with_height (succ m) (insert k v z t) :=
begin
  induction h' generalizing z,
  case two_three.with_height.leaf : k' v' z h
  { dsimp [insert], trichotomy k =? k',
    repeat
    { assumption <|> apply with_height_close <|> apply with_height_split <|> constructor } },
  case two_three.with_height.node2 : h'_n h'_x h'_t₀ h'_t₁ h'_a h'_a_1 h'_ih_a h'_ih_a_1 z h
  { dsimp [insert], split_ifs,
    repeat
    { assumption <|> apply h'_ih_a <|> apply h'_ih_a_1 <|> constructor }, },
  case two_three.with_height.node3 : h'_n h'_x h'_y h'_t₀ h'_t₁ h'_t₂ h'_a h'_a_1 h'_a_2 h'_ih_a h'_ih_a_1 h'_ih_a_2 z h
  { dsimp [insert], split_ifs,
    repeat
    { assumption <|> apply h'_ih_a <|> apply h'_ih_a_1 <|> apply h'_ih_a_2 <|> constructor }, },
end

lemma with_height_insert' (h' : with_height m t) : with_height m (insert' k v t) ∨ with_height (succ m) (insert' k v t) :=
with_height_insert (by constructor) h'

end insert_height

section defns

variables [has_lt α] [has_le α]

inductive zipper_sorted : option α → zipper α β → option α → Prop
| nil {a b} : zipper_sorted a zipper.nil b
| node2_0 {a b x t₀ t₁} :
  zipper_sorted a t₀ b →
  x = first t₁ →
  sorted' t₁ →
  above (last t₁) b →
  zipper_sorted a (node2_0 t₀ x t₁) (some x)
| node2_1 {a b x t₀ t₁} :
  zipper_sorted a t₁ b →
  below a (first t₀) →
  sorted' t₀ →
  last t₀ < x →
  zipper_sorted (some x) (node2_1 t₀ x t₁) b

| node3_0 {a b x y t₀ t₁ t₂} :
  zipper_sorted a t₀ b →
  x = first t₁ →
  sorted' t₁ →
  last t₁ < y →
  y = first t₂ →
  sorted' t₂ →
  above (last t₂) b →
  zipper_sorted a (node3_0 t₀ x t₁ y t₂) (some x)
| node3_1 {a b x y t₀ t₁ t₂} :
  zipper_sorted a t₁ b →
  below a (first t₀) →
  sorted' t₀ →
  last t₀ < x →
  y = first t₂ →
  sorted' t₂ →
  above (last t₂) b →
  zipper_sorted (some x) (node3_1 t₀ x t₁ y t₂) (some y)
| node3_2 {a b x y t₀ t₁ t₂} :
  zipper_sorted a t₂ b →
  below a (first t₀) →
  sorted' t₀ →
  last t₀ < x →
  x = first t₁ →
  sorted' t₁ →
  last t₁ < y →
  zipper_sorted (some y) (node3_2 t₀ x t₁ y t₂) b

attribute [pp_nodot]
  zipper_sorted.nil
  zipper_sorted.node2_0
  zipper_sorted.node2_1
  zipper_sorted.node3_0
  zipper_sorted.node3_1
  zipper_sorted.node3_2
  zipper.nil
  zipper.node2_0
  zipper.node2_1
  zipper.node3_0
  zipper.node3_1
  zipper.node3_2

end defns

section insert_sorted
-- variables {pk : option α}
variables  [linear_order α]
open two_three

lemma sorted_close {a b}
  (h' : zipper_sorted a z b)
  (h₀ : below a (first t))
  (h₃ : below pk (first t))
  (h₁ : sorted' t)
  (h₂ : above (last t) b)
  : sorted' (close z pk t) :=
begin
  induction h' generalizing t pk,
  all_goals
  { dsimp [close],
    saturate, subst_vars,
    simp only * { fail_if_unchanged := ff },
    repeat
    { assumption <|> refl <|>
      apply h'_ih <|> constructor <|> cc }, },
end

lemma sorted_split {a x b}
  (h' : zipper_sorted a z b)
  (h₀ : below a (first t₀))
  (h₀ : below pk (first t₀))
  (h₁ : sorted' t₀)
  (h₂ : last t₀ < x)
  (h₃ : first t₁ = x)
  (h₃ : sorted' t₁)
  (h₄ : above (last t₁) b)
  : sorted' (split z pk t₀ x t₁) :=
begin
  induction h' generalizing t₀ x t₁ pk,
  all_goals
  { dsimp [split],
    saturate, subst_vars,
    simp only * { fail_if_unchanged := ff },
    repeat
    { assumption <|> refl <|>
      apply sorted_close <|>
      apply h'_ih <|> constructor }, },
end

section tac
open tactic

@[interactive]
meta def simp_min : tactic unit :=
run_bt $ do
  x ← var,
  y ← var,
  (h, _) ← hyp_with ``(min %%x %%y),
  bt_lift $ do
  (pr, h) ← mcond (succeeds (is_def_eq x y))
  (do p₀ ← to_expr ``(min %%x %%y = %%x),
      n ← get_unused_name `h,
      (h, _) ← local_proof n p₀ (applyc ``min_self),
      pure (h, h))
  (do p₀ ← to_expr ``(%%x ≤ %%y),
      p₁ ← to_expr ``(%%y ≤ %%x),
      n ← get_unused_name `h,
      do { (h, _) ← local_proof n p₀ (assumption <|> applyc ``le_of_lt >> assumption),
           pr ← mk_app ``min_eq_left [h],
           pure (pr, h) } <|>
        do { (h, _) ← local_proof n p₁ (assumption <|> applyc ``le_of_lt >> assumption),
             pr ← mk_app ``min_eq_right [h],
             pure (pr, h) }),
   interactive.loc.apply
     (λ h', try $ rewrite_hyp pr h' >> skip)
     (try $ rewrite_target pr)
     interactive.loc.wildcard,
  skip

end tac

variables {k : α} {v : β} (a b : option α)
variables (h : zipper_sorted a z b)
  (h' : sorted' t)
  (h₀ : below a (min k (first t)))
  (h₁ : above (last t) b)
  (h₂ : above k b)
include h h' h₀ h₁ h₂

lemma sorted_insert : sorted' (insert k v z t) :=
begin
  induction h' generalizing z a b,
  case two_three.sorted'.leaf : k' v' z a b h
  { dsimp [insert], trichotomy k =? k' with h₂,
    all_goals
    { dsimp [first, last] at *,
      subst_vars, simp_min, saturate,
      apply sorted_split <|> apply sorted_close,
      repeat
      { assumption <|>
        constructor <|>
        simp_min <|> above } },  },
  case two_three.sorted'.node2 : h'_x h'_t₀ h'_t₁ h'_a h'_a_1 h'_a_2 h'_a_3 h'_ih_a h'_ih_a_1 z a b h h₀ h₁ h₂
  { dsimp [insert], subst_vars, split_ifs,
    all_goals
    { dsimp [first] at *,
      saturate, simp_min,
      try { have : first h'_t₀ ≤ k, { chain_trans } },
      apply h'_ih_a <|> apply h'_ih_a_1,
      repeat
      { assumption <|>
        constructor <|>
        simp_min <|> above, } } },
  case two_three.sorted'.node3 : h'_x h'_y h'_t₀ h'_t₁ h'_t₂ h'_a h'_a_1 h'_a_2 h'_a_3 h'_a_4 h'_a_5 h'_a_6 h'_ih_a h'_ih_a_1 h'_ih_a_2 z a b h h₀ h₁ h₂
  { dsimp [insert], subst_vars, split_ifs,
    all_goals
    { dsimp [first] at *,
      saturate, simp_min,
      try { have : first h'_t₀ ≤ k, { chain_trans } },
      apply h'_ih_a <|> apply h'_ih_a_1 <|> apply h'_ih_a_2,
      repeat
      { assumption <|>
        constructor <|>
        simp_min <|> above, } } },
end

lemma sorted_insert' : sorted' (insert' k v t) :=
by apply sorted_insert none none _ h'; constructor

end insert_sorted

end zipper

end two_three.tree


import category_theory.sites.dense_subsite

/-!
Content pulled from mathlib PR #14512
-/

universes w v v₁ v₂ v₃ u u₁ u₂ u₃
noncomputable theory
open category_theory
open opposite
open category_theory.presieve.family_of_elements
open category_theory.presieve
open category_theory.limits

variables {C D : Type u} [category.{v} C] [category.{v} D]
variables (A : Type w) [category.{max v u} A] [has_limits A]
variables {J : grothendieck_topology C} {K : grothendieck_topology D}

variables
  [concrete_category.{max v u} A]
  [preserves_limits (forget A)]
  [reflects_isomorphisms (forget A)]
  [Π (X : C), preserves_colimits_of_shape (J.cover X)ᵒᵖ (forget A)]
  [∀ (X : C), has_colimits_of_shape (J.cover X)ᵒᵖ A]
  [Π (X : D), preserves_colimits_of_shape (K.cover X)ᵒᵖ (forget A)]
  [∀ (X : D), has_colimits_of_shape (K.cover X)ᵒᵖ A]

namespace category_theory.sites

/-- The isomorphism exhibiting compatibility between pullback and sheafification. -/
def pullback_sheafification_compatibility
  {G : C ⥤ D} (Hp : cover_preserving J K G)
  (Hl : cover_lifting J K G) (Hc : compatible_preserving K G) :
  (whiskering_left _ _ A).obj G.op ⋙ presheaf_to_Sheaf J A ≅
  presheaf_to_Sheaf K A ⋙ sites.pullback A Hc Hp :=
let A1 : (whiskering_left _ _ A).obj G.op ⊣ _ := Ran.adjunction _ _,
    A2 : presheaf_to_Sheaf J A ⊣ _ := sheafification_adjunction _ _,
    B1 : presheaf_to_Sheaf K A ⊣ _ := sheafification_adjunction _ _,
    B2 : sites.pullback A Hc Hp ⊣ _ := sites.pullback_copullback_adjunction _ _ Hl _,
    A12 := A1.comp A2,
    B12 := B1.comp B2 in
A12.left_adjoint_uniq B12

lemma to_sheafify_pullback_sheafification_compatibility
  {G : C ⥤ D} (Hp : cover_preserving J K G)
  (Hl : cover_lifting J K G) (Hc : compatible_preserving K G) (F) :
  J.to_sheafify (G.op ⋙ F) ≫
  ((pullback_sheafification_compatibility.{w v u} A Hp Hl Hc).hom.app F).val =
  whisker_left _ (K.to_sheafify _) :=
begin
  dsimp [pullback_sheafification_compatibility, adjunction.left_adjoint_uniq],
  apply quiver.hom.op_inj,
  apply coyoneda.map_injective, swap, apply_instance,
  ext E f : 2,
  dsimp [functor.preimage, full.preimage, coyoneda, adjunction.left_adjoints_coyoneda_equiv],
  simp only [adjunction.hom_equiv_unit, functor.comp_map, Sheaf_to_presheaf_map,
    adjunction.hom_equiv_naturality_left_symm, whiskering_left_obj_map,
    adjunction.hom_equiv_counit, Sheaf.category_theory.category_comp_val,
    presheaf_to_Sheaf_map_val],
  dsimp [adjunction.comp],
  simp only [sheafification_adjunction_unit_app, category.comp_id, functor.map_id,
    whisker_left_id', category.assoc, grothendieck_topology.sheafify_map_sheafify_lift,
    category.id_comp, grothendieck_topology.to_sheafify_sheafify_lift],
  ext t,
  dsimp only [whisker_left, nat_trans.comp_app],
  simp only [category.assoc],
  -- for some reason the proof that works in mathllib does not work here...
  -- we have to be a little more forceful.
  erw [(Ran G.op).map_id, category.id_comp],
  congr' 1, simp only [← category.assoc],
  convert category.id_comp _,
  dsimp only [pullback_sheaf],
  have := (Ran.adjunction A G.op).left_triangle,
  apply_fun (λ e, (e.app (K.sheafify F)).app x) at this,
  exact this,
end

@[simp]
lemma pullback_sheafification_compatibility_hom_apply_val
  {G : C ⥤ D} (Hp : cover_preserving J K G)
  (Hl : cover_lifting J K G) (Hc : compatible_preserving K G) (F) :
((pullback_sheafification_compatibility.{w v u} A Hp Hl Hc).hom.app F).val =
  J.sheafify_lift (whisker_left _ $ K.to_sheafify _) (Sheaf.cond _) :=
begin
  apply J.sheafify_lift_unique,
  apply to_sheafify_pullback_sheafification_compatibility,
end

end category_theory.sites

namespace category_theory.cover_dense

variables {G : C ⥤ D} [full G] [faithful G]
variables (Hd : cover_dense K G) (Hp : cover_preserving J K G) (Hl : cover_lifting J K G)

/-- The isomorphism exhibiting the compatibiility of
`Sheaf_equiv_of_cover_preserving_cover_lifting` with sheafification. -/
noncomputable
abbreviation Sheaf_equiv_of_cover_preserving_cover_lifting_sheafification_compatibility :
  (whiskering_left _ _ A).obj G.op ⋙ presheaf_to_Sheaf _ _ ≅
  presheaf_to_Sheaf _ _ ⋙ (Sheaf_equiv_of_cover_preserving_cover_lifting Hd Hp Hl).inverse :=
category_theory.sites.pullback_sheafification_compatibility _ _ Hl _

end category_theory.cover_dense


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.maps
import Mathlib.PostPort

universes u v w x u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Constructions of new topological spaces from old ones

This file constructs products, sums, subtypes and quotients of topological spaces
and sets up their basic theory, such as criteria for maps into or out of these
constructions to be continuous; descriptions of the open sets, neighborhood filters,
and generators of these constructions; and their behavior with respect to embeddings
and other specific classes of maps.

## Implementation note

The constructed topologies are defined using induced and coinduced topologies
along with the complete lattice structure on topologies. Their universal properties
(for example, a map `X → Y × Z` is continuous if and only if both projections
`X → Y`, `X → Z` are) follow easily using order-theoretic descriptions of
continuity. With more work we can also extract descriptions of the open sets,
neighborhood filters and so on.

## Tags

product, sum, disjoint union, subspace, quotient space

-/

protected instance subtype.topological_space {α : Type u} {p : α → Prop} [t : topological_space α] : topological_space (Subtype p) :=
  topological_space.induced coe t

protected instance quot.topological_space {α : Type u} {r : α → α → Prop} [t : topological_space α] : topological_space (Quot r) :=
  topological_space.coinduced (Quot.mk r) t

protected instance quotient.topological_space {α : Type u} {s : setoid α} [t : topological_space α] : topological_space (quotient s) :=
  topological_space.coinduced quotient.mk t

protected instance prod.topological_space {α : Type u} {β : Type v} [t₁ : topological_space α] [t₂ : topological_space β] : topological_space (α × β) :=
  topological_space.induced prod.fst t₁ ⊓ topological_space.induced prod.snd t₂

protected instance sum.topological_space {α : Type u} {β : Type v} [t₁ : topological_space α] [t₂ : topological_space β] : topological_space (α ⊕ β) :=
  topological_space.coinduced sum.inl t₁ ⊔ topological_space.coinduced sum.inr t₂

protected instance sigma.topological_space {α : Type u} {β : α → Type v} [t₂ : (a : α) → topological_space (β a)] : topological_space (sigma β) :=
  supr fun (a : α) => topological_space.coinduced (sigma.mk a) (t₂ a)

protected instance Pi.topological_space {α : Type u} {β : α → Type v} [t₂ : (a : α) → topological_space (β a)] : topological_space ((a : α) → β a) :=
  infi fun (a : α) => topological_space.induced (fun (f : (a : α) → β a) => f a) (t₂ a)

protected instance ulift.topological_space {α : Type u} [t : topological_space α] : topological_space (ulift α) :=
  topological_space.induced ulift.down t

/-- The image of a dense set under `quotient.mk` is a dense set. -/
theorem dense.quotient {α : Type u} [setoid α] [topological_space α] {s : set α} (H : dense s) : dense (quotient.mk '' s) :=
  dense_range.dense_image (function.surjective.dense_range (surjective_quotient_mk α)) continuous_coinduced_rng H

/-- The composition of `quotient.mk` and a function with dense range has dense range. -/
theorem dense_range.quotient {α : Type u} {β : Type v} [setoid α] [topological_space α] {f : β → α} (hf : dense_range f) : dense_range (quotient.mk ∘ f) :=
  dense_range.comp (function.surjective.dense_range (surjective_quotient_mk α)) hf continuous_coinduced_rng

protected instance subtype.discrete_topology {α : Type u} {p : α → Prop} [topological_space α] [discrete_topology α] : discrete_topology (Subtype p) :=
  discrete_topology.mk
    (bot_unique
      fun (s : set (Subtype p)) (hs : topological_space.is_open ⊥ s) =>
        Exists.intro (coe '' s)
          { left := is_open_discrete (coe '' s), right := set.preimage_image_eq s subtype.coe_injective })

protected instance sum.discrete_topology {α : Type u} {β : Type v} [topological_space α] [topological_space β] [hα : discrete_topology α] [hβ : discrete_topology β] : discrete_topology (α ⊕ β) := sorry

protected instance sigma.discrete_topology {α : Type u} {β : α → Type v} [(a : α) → topological_space (β a)] [h : ∀ (a : α), discrete_topology (β a)] : discrete_topology (sigma β) := sorry

/-
The 𝓝 filter and the subspace topology.
-/

theorem mem_nhds_subtype {α : Type u} [topological_space α] (s : set α) (a : Subtype fun (x : α) => x ∈ s) (t : set (Subtype fun (x : α) => x ∈ s)) : t ∈ nhds a ↔ ∃ (u : set α), ∃ (H : u ∈ nhds ↑a), coe ⁻¹' u ⊆ t :=
  mem_nhds_induced coe a t

theorem nhds_subtype {α : Type u} [topological_space α] (s : set α) (a : Subtype fun (x : α) => x ∈ s) : nhds a = filter.comap coe (nhds ↑a) :=
  nhds_induced coe a

theorem continuous_fst {α : Type u} {β : Type v} [topological_space α] [topological_space β] : continuous prod.fst :=
  continuous_inf_dom_left continuous_induced_dom

theorem continuous_at_fst {α : Type u} {β : Type v} [topological_space α] [topological_space β] {p : α × β} : continuous_at prod.fst p :=
  continuous.continuous_at continuous_fst

theorem continuous_snd {α : Type u} {β : Type v} [topological_space α] [topological_space β] : continuous prod.snd :=
  continuous_inf_dom_right continuous_induced_dom

theorem continuous_at_snd {α : Type u} {β : Type v} [topological_space α] [topological_space β] {p : α × β} : continuous_at prod.snd p :=
  continuous.continuous_at continuous_snd

theorem continuous.prod_mk {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [topological_space β] [topological_space γ] {f : γ → α} {g : γ → β} (hf : continuous f) (hg : continuous g) : continuous fun (x : γ) => (f x, g x) :=
  continuous_inf_rng (continuous_induced_rng hf) (continuous_induced_rng hg)

theorem continuous.prod_map {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [topological_space β] [topological_space γ] [topological_space δ] {f : γ → α} {g : δ → β} (hf : continuous f) (hg : continuous g) : continuous fun (x : γ × δ) => (f (prod.fst x), g (prod.snd x)) :=
  continuous.prod_mk (continuous.comp hf continuous_fst) (continuous.comp hg continuous_snd)

theorem filter.eventually.prod_inl_nhds {α : Type u} {β : Type v} [topological_space α] [topological_space β] {p : α → Prop} {a : α} (h : filter.eventually (fun (x : α) => p x) (nhds a)) (b : β) : filter.eventually (fun (x : α × β) => p (prod.fst x)) (nhds (a, b)) :=
  continuous_at_fst h

theorem filter.eventually.prod_inr_nhds {α : Type u} {β : Type v} [topological_space α] [topological_space β] {p : β → Prop} {b : β} (h : filter.eventually (fun (x : β) => p x) (nhds b)) (a : α) : filter.eventually (fun (x : α × β) => p (prod.snd x)) (nhds (a, b)) :=
  continuous_at_snd h

theorem filter.eventually.prod_mk_nhds {α : Type u} {β : Type v} [topological_space α] [topological_space β] {pa : α → Prop} {a : α} (ha : filter.eventually (fun (x : α) => pa x) (nhds a)) {pb : β → Prop} {b : β} (hb : filter.eventually (fun (y : β) => pb y) (nhds b)) : filter.eventually (fun (p : α × β) => pa (prod.fst p) ∧ pb (prod.snd p)) (nhds (a, b)) :=
  filter.eventually.and (filter.eventually.prod_inl_nhds ha b) (filter.eventually.prod_inr_nhds hb a)

theorem continuous_swap {α : Type u} {β : Type v} [topological_space α] [topological_space β] : continuous prod.swap :=
  continuous.prod_mk continuous_snd continuous_fst

theorem continuous_uncurry_left {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [topological_space β] [topological_space γ] {f : α → β → γ} (a : α) (h : continuous (function.uncurry f)) : continuous (f a) :=
  (fun (this : continuous (function.uncurry f ∘ fun (b : β) => (a, b))) => this)
    (continuous.comp h (continuous.prod_mk continuous_const continuous_id'))

theorem continuous_uncurry_right {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [topological_space β] [topological_space γ] {f : α → β → γ} (b : β) (h : continuous (function.uncurry f)) : continuous fun (a : α) => f a b :=
  (fun (this : continuous (function.uncurry f ∘ fun (a : α) => (a, b))) => this)
    (continuous.comp h (continuous.prod_mk continuous_id' continuous_const))

theorem continuous_curry {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [topological_space β] [topological_space γ] {g : α × β → γ} (a : α) (h : continuous g) : continuous (function.curry g a) :=
  (fun (this : continuous (g ∘ fun (b : β) => (a, b))) => this)
    (continuous.comp h (continuous.prod_mk continuous_const continuous_id'))

theorem is_open.prod {α : Type u} {β : Type v} [topological_space α] [topological_space β] {s : set α} {t : set β} (hs : is_open s) (ht : is_open t) : is_open (set.prod s t) :=
  is_open_inter (is_open.preimage continuous_fst hs) (is_open.preimage continuous_snd ht)

theorem nhds_prod_eq {α : Type u} {β : Type v} [topological_space α] [topological_space β] {a : α} {b : β} : nhds (a, b) = filter.prod (nhds a) (nhds b) := sorry

theorem mem_nhds_prod_iff {α : Type u} {β : Type v} [topological_space α] [topological_space β] {a : α} {b : β} {s : set (α × β)} : s ∈ nhds (a, b) ↔ ∃ (u : set α), ∃ (H : u ∈ nhds a), ∃ (v : set β), ∃ (H : v ∈ nhds b), set.prod u v ⊆ s := sorry

theorem filter.has_basis.prod_nhds {α : Type u} {β : Type v} [topological_space α] [topological_space β] {ιa : Type u_1} {ιb : Type u_2} {pa : ιa → Prop} {pb : ιb → Prop} {sa : ιa → set α} {sb : ιb → set β} {a : α} {b : β} (ha : filter.has_basis (nhds a) pa sa) (hb : filter.has_basis (nhds b) pb sb) : filter.has_basis (nhds (a, b)) (fun (i : ιa × ιb) => pa (prod.fst i) ∧ pb (prod.snd i))
  fun (i : ιa × ιb) => set.prod (sa (prod.fst i)) (sb (prod.snd i)) := sorry

protected instance prod.discrete_topology {α : Type u} {β : Type v} [topological_space α] [topological_space β] [discrete_topology α] [discrete_topology β] : discrete_topology (α × β) :=
  discrete_topology.mk (eq_of_nhds_eq_nhds fun (_x : α × β) => sorry)

theorem prod_mem_nhds_sets {α : Type u} {β : Type v} [topological_space α] [topological_space β] {s : set α} {t : set β} {a : α} {b : β} (ha : s ∈ nhds a) (hb : t ∈ nhds b) : set.prod s t ∈ nhds (a, b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (set.prod s t ∈ nhds (a, b))) nhds_prod_eq)) (filter.prod_mem_prod ha hb)

theorem nhds_swap {α : Type u} {β : Type v} [topological_space α] [topological_space β] (a : α) (b : β) : nhds (a, b) = filter.map prod.swap (nhds (b, a)) := sorry

theorem filter.tendsto.prod_mk_nhds {α : Type u} {β : Type v} [topological_space α] [topological_space β] {γ : Type u_1} {a : α} {b : β} {f : filter γ} {ma : γ → α} {mb : γ → β} (ha : filter.tendsto ma f (nhds a)) (hb : filter.tendsto mb f (nhds b)) : filter.tendsto (fun (c : γ) => (ma c, mb c)) f (nhds (a, b)) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (filter.tendsto (fun (c : γ) => (ma c, mb c)) f (nhds (a, b)))) nhds_prod_eq))
    (filter.tendsto.prod_mk ha hb)

theorem filter.eventually.curry_nhds {α : Type u} {β : Type v} [topological_space α] [topological_space β] {p : α × β → Prop} {x : α} {y : β} (h : filter.eventually (fun (x : α × β) => p x) (nhds (x, y))) : filter.eventually (fun (x' : α) => filter.eventually (fun (y' : β) => p (x', y')) (nhds y)) (nhds x) :=
  filter.eventually.curry
    (eq.mp (Eq._oldrec (Eq.refl (filter.eventually (fun (x : α × β) => p x) (nhds (x, y)))) nhds_prod_eq) h)

theorem continuous_at.prod {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [topological_space β] [topological_space γ] {f : α → β} {g : α → γ} {x : α} (hf : continuous_at f x) (hg : continuous_at g x) : continuous_at (fun (x : α) => (f x, g x)) x :=
  filter.tendsto.prod_mk_nhds hf hg

theorem continuous_at.prod_map {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [topological_space β] [topological_space γ] [topological_space δ] {f : α → γ} {g : β → δ} {p : α × β} (hf : continuous_at f (prod.fst p)) (hg : continuous_at g (prod.snd p)) : continuous_at (fun (p : α × β) => (f (prod.fst p), g (prod.snd p))) p :=
  continuous_at.prod (continuous_at.comp hf (continuous.continuous_at continuous_fst))
    (continuous_at.comp hg (continuous.continuous_at continuous_snd))

theorem continuous_at.prod_map' {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [topological_space β] [topological_space γ] [topological_space δ] {f : α → γ} {g : β → δ} {x : α} {y : β} (hf : continuous_at f x) (hg : continuous_at g y) : continuous_at (fun (p : α × β) => (f (prod.fst p), g (prod.snd p))) (x, y) :=
  (fun (hf : continuous_at f (prod.fst (x, y))) =>
      (fun (hg : continuous_at g (prod.snd (x, y))) => continuous_at.prod_map hf hg) hg)
    hf

theorem prod_generate_from_generate_from_eq {α : Type u_1} {β : Type u_2} {s : set (set α)} {t : set (set β)} (hs : ⋃₀s = set.univ) (ht : ⋃₀t = set.univ) : prod.topological_space =
  topological_space.generate_from
    (set_of fun (g : set (α × β)) => ∃ (u : set α), ∃ (H : u ∈ s), ∃ (v : set β), ∃ (H : v ∈ t), g = set.prod u v) := sorry

theorem prod_eq_generate_from {α : Type u} {β : Type v} [topological_space α] [topological_space β] : prod.topological_space =
  topological_space.generate_from
    (set_of fun (g : set (α × β)) => ∃ (s : set α), ∃ (t : set β), is_open s ∧ is_open t ∧ g = set.prod s t) := sorry

theorem is_open_prod_iff {α : Type u} {β : Type v} [topological_space α] [topological_space β] {s : set (α × β)} : is_open s ↔
  ∀ (a : α) (b : β), (a, b) ∈ s → ∃ (u : set α), ∃ (v : set β), is_open u ∧ is_open v ∧ a ∈ u ∧ b ∈ v ∧ set.prod u v ⊆ s := sorry

theorem continuous_uncurry_of_discrete_topology_left {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [topological_space β] [topological_space γ] [discrete_topology α] {f : α → β → γ} (h : ∀ (a : α), continuous (f a)) : continuous (function.uncurry f) := sorry

/-- Given a neighborhood `s` of `(x, x)`, then `(x, x)` has a square open neighborhood
  that is a subset of `s`. -/
theorem exists_nhds_square {α : Type u} [topological_space α] {s : set (α × α)} {x : α} (hx : s ∈ nhds (x, x)) : ∃ (U : set α), is_open U ∧ x ∈ U ∧ set.prod U U ⊆ s := sorry

/-- The first projection in a product of topological spaces sends open sets to open sets. -/
theorem is_open_map_fst {α : Type u} {β : Type v} [topological_space α] [topological_space β] : is_open_map prod.fst := sorry

/-- The second projection in a product of topological spaces sends open sets to open sets. -/
theorem is_open_map_snd {α : Type u} {β : Type v} [topological_space α] [topological_space β] : is_open_map prod.snd := sorry

/-- A product set is open in a product space if and only if each factor is open, or one of them is
empty -/
theorem is_open_prod_iff' {α : Type u} {β : Type v} [topological_space α] [topological_space β] {s : set α} {t : set β} : is_open (set.prod s t) ↔ is_open s ∧ is_open t ∨ s = ∅ ∨ t = ∅ := sorry

theorem closure_prod_eq {α : Type u} {β : Type v} [topological_space α] [topological_space β] {s : set α} {t : set β} : closure (set.prod s t) = set.prod (closure s) (closure t) := sorry

theorem map_mem_closure2 {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [topological_space β] [topological_space γ] {s : set α} {t : set β} {u : set γ} {f : α → β → γ} {a : α} {b : β} (hf : continuous fun (p : α × β) => f (prod.fst p) (prod.snd p)) (ha : a ∈ closure s) (hb : b ∈ closure t) (hu : ∀ (a : α) (b : β), a ∈ s → b ∈ t → f a b ∈ u) : f a b ∈ closure u := sorry

theorem is_closed.prod {α : Type u} {β : Type v} [topological_space α] [topological_space β] {s₁ : set α} {s₂ : set β} (h₁ : is_closed s₁) (h₂ : is_closed s₂) : is_closed (set.prod s₁ s₂) := sorry

/-- The product of two dense sets is a dense set. -/
theorem dense.prod {α : Type u} {β : Type v} [topological_space α] [topological_space β] {s : set α} {t : set β} (hs : dense s) (ht : dense t) : dense (set.prod s t) :=
  fun (x : α × β) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (x ∈ closure (set.prod s t))) closure_prod_eq))
      { left := hs (prod.fst x), right := ht (prod.snd x) }

/-- If `f` and `g` are maps with dense range, then `prod.map f g` has dense range. -/
theorem dense_range.prod_map {β : Type v} {γ : Type w} [topological_space β] [topological_space γ] {ι : Type u_1} {κ : Type u_2} {f : ι → β} {g : κ → γ} (hf : dense_range f) (hg : dense_range g) : dense_range (prod.map f g) := sorry

theorem inducing.prod_mk {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [topological_space β] [topological_space γ] [topological_space δ] {f : α → β} {g : γ → δ} (hf : inducing f) (hg : inducing g) : inducing fun (x : α × γ) => (f (prod.fst x), g (prod.snd x)) := sorry

theorem embedding.prod_mk {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [topological_space β] [topological_space γ] [topological_space δ] {f : α → β} {g : γ → δ} (hf : embedding f) (hg : embedding g) : embedding fun (x : α × γ) => (f (prod.fst x), g (prod.snd x)) := sorry

protected theorem is_open_map.prod {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [topological_space β] [topological_space γ] [topological_space δ] {f : α → β} {g : γ → δ} (hf : is_open_map f) (hg : is_open_map g) : is_open_map fun (p : α × γ) => (f (prod.fst p), g (prod.snd p)) := sorry

protected theorem open_embedding.prod {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α] [topological_space β] [topological_space γ] [topological_space δ] {f : α → β} {g : γ → δ} (hf : open_embedding f) (hg : open_embedding g) : open_embedding fun (x : α × γ) => (f (prod.fst x), g (prod.snd x)) :=
  open_embedding_of_embedding_open (embedding.prod_mk (open_embedding.to_embedding hf) (open_embedding.to_embedding hg))
    (is_open_map.prod (open_embedding.is_open_map hf) (open_embedding.is_open_map hg))

theorem embedding_graph {α : Type u} {β : Type v} [topological_space α] [topological_space β] {f : α → β} (hf : continuous f) : embedding fun (x : α) => (x, f x) :=
  embedding_of_embedding_compose (continuous.prod_mk continuous_id hf) continuous_fst embedding_id

theorem continuous_inl {α : Type u} {β : Type v} [topological_space α] [topological_space β] : continuous sum.inl :=
  continuous_sup_rng_left continuous_coinduced_rng

theorem continuous_inr {α : Type u} {β : Type v} [topological_space α] [topological_space β] : continuous sum.inr :=
  continuous_sup_rng_right continuous_coinduced_rng

theorem continuous_sum_rec {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [topological_space β] [topological_space γ] {f : α → γ} {g : β → γ} (hf : continuous f) (hg : continuous g) : continuous (sum.rec f g) := sorry

theorem is_open_sum_iff {α : Type u} {β : Type v} [topological_space α] [topological_space β] {s : set (α ⊕ β)} : is_open s ↔ is_open (sum.inl ⁻¹' s) ∧ is_open (sum.inr ⁻¹' s) :=
  iff.rfl

theorem is_open_map_sum {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [topological_space β] [topological_space γ] {f : α ⊕ β → γ} (h₁ : is_open_map fun (a : α) => f (sum.inl a)) (h₂ : is_open_map fun (b : β) => f (sum.inr b)) : is_open_map f := sorry

theorem embedding_inl {α : Type u} {β : Type v} [topological_space α] [topological_space β] : embedding sum.inl := sorry

theorem embedding_inr {α : Type u} {β : Type v} [topological_space α] [topological_space β] : embedding sum.inr := sorry

theorem is_open_range_inl {α : Type u} {β : Type v} [topological_space α] [topological_space β] : is_open (set.range sum.inl) := sorry

theorem is_open_range_inr {α : Type u} {β : Type v} [topological_space α] [topological_space β] : is_open (set.range sum.inr) := sorry

theorem open_embedding_inl {α : Type u} {β : Type v} [topological_space α] [topological_space β] : open_embedding sum.inl :=
  open_embedding.mk (embedding.mk (embedding.to_inducing embedding_inl) (embedding.inj embedding_inl)) is_open_range_inl

theorem open_embedding_inr {α : Type u} {β : Type v} [topological_space α] [topological_space β] : open_embedding sum.inr :=
  open_embedding.mk (embedding.mk (embedding.to_inducing embedding_inr) (embedding.inj embedding_inr)) is_open_range_inr

theorem embedding_subtype_coe {α : Type u} [topological_space α] {p : α → Prop} : embedding coe :=
  embedding.mk (inducing.mk rfl) subtype.coe_injective

theorem continuous_subtype_val {α : Type u} [topological_space α] {p : α → Prop} : continuous subtype.val :=
  continuous_induced_dom

theorem continuous_subtype_coe {α : Type u} [topological_space α] {p : α → Prop} : continuous coe :=
  continuous_subtype_val

theorem is_open.open_embedding_subtype_coe {α : Type u} [topological_space α] {s : set α} (hs : is_open s) : open_embedding coe :=
  open_embedding.mk (embedding.mk (inducing.mk rfl) subtype.coe_injective) (Eq.symm subtype.range_coe ▸ hs)

theorem is_open.is_open_map_subtype_coe {α : Type u} [topological_space α] {s : set α} (hs : is_open s) : is_open_map coe :=
  open_embedding.is_open_map (is_open.open_embedding_subtype_coe hs)

theorem is_open_map.restrict {α : Type u} {β : Type v} [topological_space α] [topological_space β] {f : α → β} (hf : is_open_map f) {s : set α} (hs : is_open s) : is_open_map (set.restrict f s) :=
  is_open_map.comp hf (is_open.is_open_map_subtype_coe hs)

theorem is_closed.closed_embedding_subtype_coe {α : Type u} [topological_space α] {s : set α} (hs : is_closed s) : closed_embedding coe :=
  closed_embedding.mk (embedding.mk (inducing.mk rfl) subtype.coe_injective) (Eq.symm subtype.range_coe ▸ hs)

theorem continuous_subtype_mk {α : Type u} {β : Type v} [topological_space α] [topological_space β] {p : α → Prop} {f : β → α} (hp : ∀ (x : β), p (f x)) (h : continuous f) : continuous fun (x : β) => { val := f x, property := hp x } :=
  continuous_induced_rng h

theorem continuous_inclusion {α : Type u} [topological_space α] {s : set α} {t : set α} (h : s ⊆ t) : continuous (set.inclusion h) :=
  continuous_subtype_mk (fun (x : ↥s) => set.inclusion._proof_1 h x) continuous_subtype_coe

theorem continuous_at_subtype_coe {α : Type u} [topological_space α] {p : α → Prop} {a : Subtype p} : continuous_at coe a :=
  iff.mp continuous_iff_continuous_at continuous_subtype_coe a

theorem map_nhds_subtype_coe_eq {α : Type u} [topological_space α] {p : α → Prop} {a : α} (ha : p a) (h : (set_of fun (a : α) => p a) ∈ nhds a) : filter.map coe (nhds { val := a, property := ha }) = nhds a := sorry

theorem nhds_subtype_eq_comap {α : Type u} [topological_space α] {p : α → Prop} {a : α} {h : p a} : nhds { val := a, property := h } = filter.comap coe (nhds a) :=
  nhds_induced coe { val := a, property := h }

theorem tendsto_subtype_rng {α : Type u} [topological_space α] {β : Type u_1} {p : α → Prop} {b : filter β} {f : β → Subtype p} {a : Subtype p} : filter.tendsto f b (nhds a) ↔ filter.tendsto (fun (x : β) => ↑(f x)) b (nhds ↑a) := sorry

theorem continuous_subtype_nhds_cover {α : Type u} {β : Type v} [topological_space α] [topological_space β] {ι : Sort u_1} {f : α → β} {c : ι → α → Prop} (c_cover : ∀ (x : α), ∃ (i : ι), (set_of fun (x : α) => c i x) ∈ nhds x) (f_cont : ∀ (i : ι), continuous fun (x : Subtype (c i)) => f ↑x) : continuous f := sorry

theorem continuous_subtype_is_closed_cover {α : Type u} {β : Type v} [topological_space α] [topological_space β] {ι : Type u_1} {f : α → β} (c : ι → α → Prop) (h_lf : locally_finite fun (i : ι) => set_of fun (x : α) => c i x) (h_is_closed : ∀ (i : ι), is_closed (set_of fun (x : α) => c i x)) (h_cover : ∀ (x : α), ∃ (i : ι), c i x) (f_cont : ∀ (i : ι), continuous fun (x : Subtype (c i)) => f ↑x) : continuous f := sorry

theorem closure_subtype {α : Type u} [topological_space α] {p : α → Prop} {x : Subtype fun (a : α) => p a} {s : set (Subtype fun (a : α) => p a)} : x ∈ closure s ↔ ↑x ∈ closure (coe '' s) :=
  closure_induced fun (x y : Subtype fun (a : α) => p a) => subtype.eq

theorem quotient_map_quot_mk {α : Type u} [topological_space α] {r : α → α → Prop} : quotient_map (Quot.mk r) :=
  { left := quot.exists_rep, right := rfl }

theorem continuous_quot_mk {α : Type u} [topological_space α] {r : α → α → Prop} : continuous (Quot.mk r) :=
  continuous_coinduced_rng

theorem continuous_quot_lift {α : Type u} {β : Type v} [topological_space α] [topological_space β] {r : α → α → Prop} {f : α → β} (hr : ∀ (a b : α), r a b → f a = f b) (h : continuous f) : continuous (Quot.lift f hr) :=
  continuous_coinduced_dom h

theorem quotient_map_quotient_mk {α : Type u} [topological_space α] {s : setoid α} : quotient_map quotient.mk :=
  quotient_map_quot_mk

theorem continuous_quotient_mk {α : Type u} [topological_space α] {s : setoid α} : continuous quotient.mk :=
  continuous_coinduced_rng

theorem continuous_quotient_lift {α : Type u} {β : Type v} [topological_space α] [topological_space β] {s : setoid α} {f : α → β} (hs : ∀ (a b : α), a ≈ b → f a = f b) (h : continuous f) : continuous (quotient.lift f hs) :=
  continuous_coinduced_dom h

theorem continuous_pi {α : Type u} {ι : Type u_1} {π : ι → Type u_2} [topological_space α] [(i : ι) → topological_space (π i)] {f : α → (i : ι) → π i} (h : ∀ (i : ι), continuous fun (a : α) => f a i) : continuous f :=
  continuous_infi_rng fun (i : ι) => continuous_induced_rng (h i)

theorem continuous_apply {ι : Type u_1} {π : ι → Type u_2} [(i : ι) → topological_space (π i)] (i : ι) : continuous fun (p : (i : ι) → π i) => p i :=
  continuous_infi_dom continuous_induced_dom

/-- Embedding a factor into a product space (by fixing arbitrarily all the other coordinates) is
continuous. -/
theorem continuous_update {ι : Type u_1} {π : ι → Type u_2} [DecidableEq ι] [(i : ι) → topological_space (π i)] {i : ι} {f : (i : ι) → π i} : continuous fun (x : π i) => function.update f i x := sorry

theorem nhds_pi {ι : Type u_1} {π : ι → Type u_2} [t : (i : ι) → topological_space (π i)] {a : (i : ι) → π i} : nhds a = infi fun (i : ι) => filter.comap (fun (x : (i : ι) → π i) => x i) (nhds (a i)) := sorry

theorem tendsto_pi {α : Type u} {ι : Type u_1} {π : ι → Type u_2} [t : (i : ι) → topological_space (π i)] {f : α → (i : ι) → π i} {g : (i : ι) → π i} {u : filter α} : filter.tendsto f u (nhds g) ↔ ∀ (x : ι), filter.tendsto (fun (i : α) => f i x) u (nhds (g x)) := sorry

theorem is_open_set_pi {ι : Type u_1} {π : ι → Type u_2} [(a : ι) → topological_space (π a)] {i : set ι} {s : (a : ι) → set (π a)} (hi : set.finite i) (hs : ∀ (a : ι), a ∈ i → is_open (s a)) : is_open (set.pi i s) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_open (set.pi i s))) (set.pi_def i s)))
    (is_open_bInter hi fun (a : ι) (ha : a ∈ i) => is_open.preimage (continuous_apply a) (hs a ha))

theorem set_pi_mem_nhds {ι : Type u_1} {π : ι → Type u_2} [(a : ι) → topological_space (π a)] {i : set ι} {s : (a : ι) → set (π a)} {x : (a : ι) → π a} (hi : set.finite i) (hs : ∀ (a : ι), a ∈ i → s a ∈ nhds (x a)) : set.pi i s ∈ nhds x := sorry

theorem pi_eq_generate_from {ι : Type u_1} {π : ι → Type u_2} [(a : ι) → topological_space (π a)] : Pi.topological_space =
  topological_space.generate_from
    (set_of
      fun (g : set ((a : ι) → π a)) =>
        ∃ (s : (a : ι) → set (π a)), ∃ (i : finset ι), (∀ (a : ι), a ∈ i → is_open (s a)) ∧ g = set.pi (↑i) s) := sorry

theorem pi_generate_from_eq {ι : Type u_1} {π : ι → Type u_2} {g : (a : ι) → set (set (π a))} : Pi.topological_space =
  topological_space.generate_from
    (set_of
      fun (t : set ((a : ι) → π a)) =>
        ∃ (s : (a : ι) → set (π a)), ∃ (i : finset ι), (∀ (a : ι), a ∈ i → s a ∈ g a) ∧ t = set.pi (↑i) s) := sorry

theorem pi_generate_from_eq_fintype {ι : Type u_1} {π : ι → Type u_2} {g : (a : ι) → set (set (π a))} [fintype ι] (hg : ∀ (a : ι), ⋃₀g a = set.univ) : Pi.topological_space =
  topological_space.generate_from
    (set_of
      fun (t : set ((a : ι) → π a)) => ∃ (s : (a : ι) → set (π a)), (∀ (a : ι), s a ∈ g a) ∧ t = set.pi set.univ s) := sorry

theorem continuous_sigma_mk {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {i : ι} : continuous (sigma.mk i) :=
  continuous_supr_rng continuous_coinduced_rng

theorem is_open_sigma_iff {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {s : set (sigma σ)} : is_open s ↔ ∀ (i : ι), is_open (sigma.mk i ⁻¹' s) := sorry

theorem is_closed_sigma_iff {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {s : set (sigma σ)} : is_closed s ↔ ∀ (i : ι), is_closed (sigma.mk i ⁻¹' s) :=
  is_open_sigma_iff

theorem is_open_map_sigma_mk {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {i : ι} : is_open_map (sigma.mk i) := sorry

theorem is_open_range_sigma_mk {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {i : ι} : is_open (set.range (sigma.mk i)) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_open (set.range (sigma.mk i)))) (Eq.symm set.image_univ)))
    (is_open_map_sigma_mk set.univ is_open_univ)

theorem is_closed_map_sigma_mk {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {i : ι} : is_closed_map (sigma.mk i) := sorry

theorem is_closed_sigma_mk {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {i : ι} : is_closed (set.range (sigma.mk i)) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_closed (set.range (sigma.mk i)))) (Eq.symm set.image_univ)))
    (is_closed_map_sigma_mk set.univ is_closed_univ)

theorem open_embedding_sigma_mk {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {i : ι} : open_embedding (sigma.mk i) :=
  open_embedding_of_continuous_injective_open continuous_sigma_mk sigma_mk_injective is_open_map_sigma_mk

theorem closed_embedding_sigma_mk {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {i : ι} : closed_embedding (sigma.mk i) :=
  closed_embedding_of_continuous_injective_closed continuous_sigma_mk sigma_mk_injective is_closed_map_sigma_mk

theorem embedding_sigma_mk {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {i : ι} : embedding (sigma.mk i) :=
  closed_embedding.to_embedding closed_embedding_sigma_mk

/-- A map out of a sum type is continuous if its restriction to each summand is. -/
theorem continuous_sigma {β : Type v} {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] [topological_space β] {f : sigma σ → β} (h : ∀ (i : ι), continuous fun (a : σ i) => f (sigma.mk i a)) : continuous f :=
  continuous_supr_dom fun (i : ι) => continuous_coinduced_dom (h i)

theorem continuous_sigma_map {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {κ : Type u_3} {τ : κ → Type u_4} [(k : κ) → topological_space (τ k)] {f₁ : ι → κ} {f₂ : (i : ι) → σ i → τ (f₁ i)} (hf : ∀ (i : ι), continuous (f₂ i)) : continuous (sigma.map f₁ f₂) := sorry

theorem is_open_map_sigma {β : Type v} {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] [topological_space β] {f : sigma σ → β} (h : ∀ (i : ι), is_open_map fun (a : σ i) => f (sigma.mk i a)) : is_open_map f := sorry

/-- The sum of embeddings is an embedding. -/
theorem embedding_sigma_map {ι : Type u_1} {σ : ι → Type u_2} [(i : ι) → topological_space (σ i)] {τ : ι → Type u_3} [(i : ι) → topological_space (τ i)] {f : (i : ι) → σ i → τ i} (hf : ∀ (i : ι), embedding (f i)) : embedding (sigma.map id f) := sorry

theorem continuous_ulift_down {α : Type u} [topological_space α] : continuous ulift.down :=
  continuous_induced_dom

theorem continuous_ulift_up {α : Type u} [topological_space α] : continuous ulift.up :=
  continuous_induced_rng continuous_id

theorem mem_closure_of_continuous {α : Type u} {β : Type v} [topological_space α] [topological_space β] {f : α → β} {a : α} {s : set α} {t : set β} (hf : continuous f) (ha : a ∈ closure s) (h : set.maps_to f s (closure t)) : f a ∈ closure t :=
  set.mem_of_mem_of_subset (set.mem_of_mem_of_subset (set.mem_image_of_mem f ha) (image_closure_subset_closure_image hf))
    (closure_minimal (set.maps_to.image_subset h) is_closed_closure)

theorem mem_closure_of_continuous2 {α : Type u} {β : Type v} {γ : Type w} [topological_space α] [topological_space β] [topological_space γ] {f : α → β → γ} {a : α} {b : β} {s : set α} {t : set β} {u : set γ} (hf : continuous fun (p : α × β) => f (prod.fst p) (prod.snd p)) (ha : a ∈ closure s) (hb : b ∈ closure t) (h : ∀ (a : α), a ∈ s → ∀ (b : β), b ∈ t → f a b ∈ closure u) : f a b ∈ closure u := sorry


theorem ex6 (f : Nat → Nat) (x y z : Nat) (h : (x, z).1 = (fun x => x) y) : f x = f y := by
  simp (config := { beta := false }) at h
  traceState
  simp at h
  traceState
  simp [h]