/-
Copyright (c) 2017 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.limits.limits
import Mathlib.category_theory.concrete_category.basic
import Mathlib.PostPort

universes v u

namespace Mathlib

/-!
# Facts about (co)limits of functors into concrete categories
-/

namespace category_theory.limits

-- We now prove a lemma about naturality of cones over functors into bundled categories.

namespace cone

/-- Naturality of a cone over functors to a concrete category. -/
@[simp] theorem w_apply {J : Type v} [small_category J] {C : Type u} [category C]
    [concrete_category C] {F : J ⥤ C} (s : cone F) {j : J} {j' : J} (f : j ⟶ j') (x : ↥(X s)) :
    coe_fn (functor.map F f) (coe_fn (nat_trans.app (π s) j) x) =
        coe_fn (nat_trans.app (π s) j') x :=
  sorry

@[simp] theorem w_forget_apply {J : Type v} [small_category J] {C : Type u} [category C]
    [concrete_category C] (F : J ⥤ C) (s : cone (F ⋙ forget C)) {j : J} {j' : J} (f : j ⟶ j')
    (x : X s) : coe_fn (functor.map F f) (nat_trans.app (π s) j x) = nat_trans.app (π s) j' x :=
  congr_fun (w s f) x

end cone

namespace cocone

/-- Naturality of a cocone over functors into a concrete category. -/
@[simp] theorem w_apply {J : Type v} [small_category J] {C : Type u} [category C]
    [concrete_category C] {F : J ⥤ C} (s : cocone F) {j : J} {j' : J} (f : j ⟶ j')
    (x : ↥(functor.obj F j)) :
    coe_fn (nat_trans.app (ι s) j') (coe_fn (functor.map F f) x) =
        coe_fn (nat_trans.app (ι s) j) x :=
  sorry

@[simp] theorem w_forget_apply {J : Type v} [small_category J] {C : Type u} [category C]
    [concrete_category C] (F : J ⥤ C) (s : cocone (F ⋙ forget C)) {j : J} {j' : J} (f : j ⟶ j')
    (x : ↥(functor.obj F j)) :
    nat_trans.app (ι s) j' (coe_fn (functor.map F f) x) = nat_trans.app (ι s) j x :=
  congr_fun (w s f) x

end cocone

@[simp] theorem limit.lift_π_apply {J : Type v} [small_category J] {C : Type u} [category C]
    [concrete_category C] (F : J ⥤ C) [has_limit F] (s : cone F) (j : J) (x : ↥(cone.X s)) :
    coe_fn (limit.π F j) (coe_fn (limit.lift F s) x) = coe_fn (nat_trans.app (cone.π s) j) x :=
  sorry

@[simp] theorem limit.w_apply {J : Type v} [small_category J] {C : Type u} [category C]
    [concrete_category C] (F : J ⥤ C) [has_limit F] {j : J} {j' : J} (f : j ⟶ j') (x : ↥(limit F)) :
    coe_fn (functor.map F f) (coe_fn (limit.π F j) x) = coe_fn (limit.π F j') x :=
  sorry

@[simp] theorem colimit.ι_desc_apply {J : Type v} [small_category J] {C : Type u} [category C]
    [concrete_category C] (F : J ⥤ C) [has_colimit F] (s : cocone F) (j : J)
    (x : ↥(functor.obj F j)) :
    coe_fn (colimit.desc F s) (coe_fn (colimit.ι F j) x) =
        coe_fn (nat_trans.app (cocone.ι s) j) x :=
  sorry

@[simp] theorem colimit.w_apply {J : Type v} [small_category J] {C : Type u} [category C]
    [concrete_category C] (F : J ⥤ C) [has_colimit F] {j : J} {j' : J} (f : j ⟶ j')
    (x : ↥(functor.obj F j)) :
    coe_fn (colimit.ι F j') (coe_fn (functor.map F f) x) = coe_fn (colimit.ι F j) x :=
  sorry

end Mathlib


--TODO: Port Theorems.
import Mathlib
import HOLFloat.Common
import HOLFloat.Fixed
import HOLFloat.Float
import Aesop
set_option trace.aesop.steps true
--set_option trace.aesop.ruleSet true
--set_option aesop.maxRuleApplications 400
@[simp]
theorem flformat_radix_lt_0 (fmt:flformat) : 0 < fmt.val.r := by
  linarith [fmt.prop.left]

@[simp]
theorem flformat_radix_lt_1 (fmt:flformat) : 1 < fmt.val.r := by
  linarith [fmt.prop.left]

@[simp]
theorem flformat_radix_le_2 (fmt:flformat): 2 ≤ fmt.val.r := by
  linarith [fmt.prop.left]

@[simp]
theorem flformat_radix_lt_0_real (fmt : flformat): 0 < (fmt.val.r : ℝ) := by
  norm_cast
  linarith [fmt.prop.left]

@[simp]
theorem flformat_radix_lt_1_real (fmt: flformat) : 1 < (fmt.val.r : ℝ) := by
  norm_cast
  linarith [fmt.prop.left]

@[simp, norm_cast]
theorem cast_two: ((2 : ℤ) : ℝ) = 2 :=
  Int.cast_ofNat 2

@[simp]
theorem flformat_radix_le_2_real (fmt: flformat) : 2 ≤ (fmt.val.r : ℝ) := by
  norm_cast
  linarith [Int.lt_add_one_iff.2 fmt.prop.left, fmt.prop.left]

@[simp]
theorem float_radix_ipow_lt_0 (fmt: flformat)(e : ℤ) : 0 < (fmt.val.r: ℝ) ^ e := by
  have h : 0 < fmt.val.r := by apply Int.one_lt_zero_lt; exact fmt.prop.left
  apply ipow_lt_zero
  simp_all only [Int.one_lt_zero_le_iff, zero_add, Int.cast_pos]

@[simp]
theorem float_ipow_le_real (fmt :flformat)(x : ℝ) : ∃(e : ℤ), x ≤ ((fmt.val.r : ℝ ) ^ e) := by
  apply ipow_le_real --FIXME: wait for port
  case a =>
    simp [flformat_radix_le_2]

@[simp]
theorem float_ipow_le_real_2 (fmt :flformat)(x : ℝ) : 0 < x → ∃(e:ℤ), x ≤(fmt.val.r : ℝ) ^ e  := by
  norm_cast
  intros
  apply ipow_le_real
  simp_all only [flformat_radix_le_2_real]

@[aesop unsafe]
def is_greatest_e (fmt : flformat)(x : ℝ)(e : ℤ) : Prop :=
--TODO: use LUB
  (fmt.val.r : ℝ) ^ e  ≤ |x| ∧
  ∀(e' : ℤ), (fmt.val.r : ℝ) ^ e' ≤ |x| → e' ≤ e

@[simp]
theorem pow_le_real (a x : ℝ) (ha1 : a ≠ 1) (hx0 : x ≠ 0) : ∃ (z : ℤ), a ^ z ≤ abs x :=
-- Chris proof
  if ha0 : a ≤ 0
  then ⟨1, (zpow_one a).symm ▸ le_trans ha0 (abs_nonneg _)⟩
  else if hal1 : a < 1
    then let ⟨k, hk⟩ := pow_unbounded_of_one_lt (abs x)⁻¹ (one_lt_inv (lt_of_not_ge ha0) hal1)
      ⟨k, (inv_le_inv (abs_pos.2 hx0) (pow_pos (lt_of_not_ge ha0) _)).1
        (le_of_lt $ by simpa using hk)⟩
    else let ⟨k, hk⟩ := pow_unbounded_of_one_lt (abs x)⁻¹ (lt_of_le_of_ne (le_of_not_gt hal1) ha1.symm)
      ⟨-k, (inv_le_inv (abs_pos.2 hx0) (zpow_pos_of_pos (lt_of_not_ge ha0) _)).1
        (le_of_lt $ by simpa)⟩

#check Set
@[simp]
theorem float_int_bounded (S : ℤ → Prop)(b : ℤ): (Set.Nonempty s) → (∀(e : ℤ), e ∈ setOf S → e ≤ b) → (∃(e' : ℤ), is_sup_int S e'):= by
  intro hn ha
  simp [setOf] at ha
  simp [is_sup_int, IsLUB, IsLeast, lowerBounds, upperBounds]
  --NOTE: :)
  sorry

@[simp]
theorem float_greatest_e_exists (fmt:flformat) (x : ℝ)(e : ℤ) : x ≠ 0 → e = greatest_e fmt x → is_greatest_e fmt x e :=  by
  have ⟨fmt_val, FMT⟩ := fmt
  intro hx he
  simp only [greatest_e, is_greatest_e] at *
  simp only [ne_eq, Int.cast_eq_zero]
  apply And.intro

  have R_GT_1 : 1 < fmt_val.r := FMT.left;
  suffices e ∈  { z : ℤ | (fmt_val.r : ℝ) ^ z ≤ abs x } by {
    have H := this.out;
    have R_GT_1 : 1 < fmt_val.r := FMT.left;
    norm_cast at H;
  }

  case left =>
    norm_cast

    rw[he];
    apply Int.csupₛ_mem;

    case h1 => {

      simp[Set.Nonempty];
      -- show the existnece of a negative z that makes this true.
      -- please kill me
      apply pow_le_real
      norm_cast
      aesop_subst he
      simp_all only [ne_eq, Int.one_lt_zero_le_iff, Int.one_lt_ne_one, not_false_iff]
      aesop_subst he
      simp_all only [ne_eq, Int.one_lt_zero_le_iff, not_false_iff]
    }
    case h2 => {
      --NOTE: exists 42 -- fake bound, need log.
      sorry
    }
  case right =>
    intro e1 hp
    aesop_subst he
    have he1: e1 ∈ { z | (fmt_val.r: ℝ) ^ z ≤ abs x } :=  by
      simp_all only [ne_eq, Int.cast_eq_zero, Set.mem_setOf_eq]
    apply le_csupₛ
    case h₂ =>
      simp_all only [ne_eq, Int.cast_eq_zero, Set.mem_setOf_eq]
    case h₁ =>
      sorry

#check le_supₛ
#check CompleteSemilatticeSup ℤ
#check le_csupₛ
def is_greatest_m (fmt:flformat) (x: ℝ) (m : ℤ): Prop :=
  m * (fmt.val.r : ℝ) ^ (greatest_e fmt x) ≤ |x| ∧
  ∃(m' : ℤ), m * (fmt.val.r : ℝ)  ^ (greatest_e fmt x) ≤ |x| → m' <= m

--NOTE: theorems for mantissa
@[simp]
theorem float_greatest_m_exists (fmt : flformat)(x : ℝ) (m : ℤ):
  x ≠ 0
  → greatest_m fmt x = m
  → is_greatest_m fmt x m ∧ 1 ≤ m ∧ m < fmt.val.r := by
  sorry

--NOTE: theorems for exponent
@[simp]
theorem is_greatest_e_exist_greatest_e (fmt :flformat)( e : ℤ) : x ≠ 0 → is_greatest_e fmt x e → greatest_e fmt x = e := by
  intro hx he
  simp_all only [is_greatest_e, greatest_e]

  sorry
#check pow_le_real
--TODO: theorem float_normalize_real
@[simp]
theorem float_normalize_real (fmt : flformat) (x : ℝ) : x < 0 → x = greatest_m fmt x * (fmt.val.r : ℝ) ^ greatest_e fmt x + greatest_r fmt x := by
  intro h
  sorry

@[simp]
theorem float_real_le_1_le (x : ℝ)(m :ℤ) : 0 < x → 1 ≤ m → x ≤ m * x := by
  intro h₁ h₂
  norm_cast
  rw [le_mul_iff_one_le_left]
  norm_cast
  exact h₁

@[simp]
theorem float_pow_int_eq_le (r : ℤ)(x : ℝ)(m : ℤ)(e : ℤ) : x ≠ 0 →1 ≤ m → abs x = m * (r:ℝ) ^ e → (r:ℝ) ^ e ≤ abs x := by
  intro hx hm he
  norm_cast
  rw [he]
  apply float_real_le_1_le
  case a =>
    norm_cast
    suffices abs x > 0 by simp_all only [lt_self_iff_false, ne_eq, Int.cast_lt_zero, Int.one_lt_zero_le_iff, Int.cast_eq_zero, gt_iff_lt, Int.cast_pos, zero_add, zero_lt_mul_left]
    simp; exact hx
  case a =>
    exact hm

@[simp]
theorem float_eq_ipow (fmt : flformat) (x : ℝ)(e : ℤ)(m : ℝ) :
  x ≠ 0 → 1 ≤ m → m < fmt.val.r → |x| = m * (fmt.val.r : ℝ) ^ e
  → greatest_e fmt x  = e ∧ greatest_m fmt x = m  := by
  intros hx hm hr he
  apply And.intro
  case left =>
    rw [greatest_e]
    norm_cast
    simp only [he]
    have H : e ∈ {z : ℤ | (fmt.val.r : ℝ) ^ z ≤ abs x} := by
      rw [he]
      simp [float_real_le_1_le]
      norm_cast
    sorry
  case right =>
    rw [greatest_m]
    sorry


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

import ..monoidal_category

open categories
open categories.monoidal_category

namespace categories.examples

universe u

local attribute [ematch] semigroup.mul_assoc

definition turtle (α : Type u) : Type u := punit.{u+1}
definition atuin (α : Type u) : turtle α := punit.star
local attribute [applicable] atuin

instance (α : Type u) [monoid α] : small_category (turtle α) :=
{ Hom      := λ _ _, α,
  compose  := λ _ _ _ f g, f * g,
  identity := λ _, 1 }

local attribute [applicable] has_one.one
@[simp] lemma monoid_as_category.compose (α : Type u) [monoid α] (f g : atuin α ⟶ atuin α) : f ≫ g = (f : α) * (g : α) := by refl

local attribute [ematch] semigroup.mul_assoc comm_semigroup.mul_comm

definition comm_monoid_as_monoidal_category (α : Type) [comm_monoid α] : monoidal_category (turtle α) :=
{ tensor := --sorry,
    { onObjects     := λ _, atuin α,
      onMorphisms   := λ _ _ p, p.1 * p.2 },
  tensor_unit := sorry, --atuin α,
  -- TODO: ugh, it sucks that by obviously is so much slower in the following:
  associator_transformation   := sorry, --{ morphism := { components := by obviously, naturality := by obviously }, inverse := { components := by obviously, naturality := by obviously }, witness_1 := by obviously, witness_2 := by obviously },
  left_unitor_transformation  := sorry, --{ morphism := { components := by obviously, naturality := by obviously }, inverse := { components := by obviously, naturality := by obviously }, witness_1 := by obviously, witness_2 := by obviously },
  right_unitor_transformation := sorry, --{ morphism := { components := by obviously, naturality := by obviously }, inverse := { components := by obviously, naturality := by obviously }, witness_1 := by obviously, witness_2 := by obviously }, }
}

end categories.examples


import condensed.projective_resolution

open category_theory.limits
open category_theory

namespace Condensed

--TODO: generalize (as needed...)
universe u
variables {A B : Condensed.{u} Ab.{u+1}} (f : A ⟶ B)

noncomputable theory

def kernel_diagram_iso {A B : Condensed.{u} Ab.{u+1}} (S : ExtrDisc) (f : A ⟶ B) :
  parallel_pair f 0 ⋙ Condensed.evaluation Ab S.val ≅
    parallel_pair ((Condensed.evaluation Ab S.val).map f) 0 :=
nat_iso.of_components (λ X,
  match X with
  | walking_parallel_pair.zero := iso.refl _
  | walking_parallel_pair.one := iso.refl _
  end) $ by { rintros (a|a) (b|b) (f|f), tidy }

def cokernel_diagram_iso {A B : Condensed.{u} Ab.{u+1}} (S : ExtrDisc) (f : A ⟶ B) :
  limits.parallel_pair ((Condensed.evaluation Ab S.val).map f) 0 ≅
    limits.parallel_pair f 0 ⋙ Condensed.evaluation Ab S.val :=
nat_iso.of_components (λ X,
  match X with
  | walking_parallel_pair.zero := iso.refl _
  | walking_parallel_pair.one := iso.refl _
  end) $ by { rintros (a|a) (b|b) (f|f), tidy }

def kernel_iso (S : ExtrDisc.{u}) :
  (Condensed.evaluation _ S.val).obj (kernel f) ≅
  kernel ((Condensed.evaluation _ S.val).map f) :=
(is_limit_of_preserves (Condensed.evaluation _ S.val)
  (limit.is_limit (parallel_pair f 0))).cone_point_unique_up_to_iso
  (limit.is_limit _) ≪≫ has_limit.iso_of_nat_iso (kernel_diagram_iso _ _)

@[simp, reassoc]
lemma kernel_iso_hom (S : ExtrDisc.{u}) :
  (kernel_iso f S).hom ≫ kernel.ι _ = (Condensed.evaluation _ S.val).map (kernel.ι _) :=
begin
  dsimp [kernel_iso, kernel_diagram_iso],
  simp only [category.assoc, has_limit.iso_of_nat_iso_hom_π,
    nat_iso.of_components.hom_app, limit.cone_point_unique_up_to_iso_hom_comp_assoc,
    functor.map_cone_π_app, equalizer.fork_π_app_zero,
    equalizer_as_kernel, Condensed.evaluation_map],
  apply category.comp_id,
end

def cokernel_iso (S : ExtrDisc.{u}) :
  cokernel ((Condensed.evaluation _ S.val).map f) ≅
  (Condensed.evaluation _ S.val).obj (cokernel f) :=
has_colimit.iso_of_nat_iso (cokernel_diagram_iso _ _) ≪≫
  (colimit.is_colimit _).cocone_point_unique_up_to_iso
  (is_colimit_of_preserves (Condensed.evaluation _ _)
  (colimit.is_colimit (parallel_pair f 0)))

@[simp, reassoc]
lemma cokernel_iso_hom (S : ExtrDisc.{u}) :
  cokernel.π _ ≫ (cokernel_iso f S).hom = (Condensed.evaluation _ S.val).map (cokernel.π _) :=
begin
  dsimp [cokernel_iso, cokernel_diagram_iso],
  simp only [has_colimit.iso_of_nat_iso_ι_hom_assoc, nat_iso.of_components.hom_app,
  colimit.comp_cocone_point_unique_up_to_iso_hom, functor.map_cocone_ι_app,
  coequalizer.cofork_ι_app_one, coequalizer_as_cokernel, Condensed.evaluation_map],
  apply category.id_comp,
end

end Condensed


import category_theory.category

import category_theory.concrete_category

open category_theory

section

universes u_1 u_2

inductive my_empty : Type u_1

inductive my_unit : Type u_1
| star : my_unit

-- typical example for c is a typeclass, like topological_space , with hom being something like continuous.
variables (c : Type u_1 -> Type u_2) (hom : (Pi {alpha beta : Type u_1}, c alpha -> c beta -> (alpha -> beta) -> Prop))

-- `c alpha` and `c beta` are like two objects of the category (I think), and alpha and beta are the underlying sets.
-- so, the element of (alpha -> beta) is a particular function between the sets
-- and the Prop is whether that particular function is a morphism ?
-- so, for `c x` to be free over x, then, need need that, for any
-- wait, that doesn't seem right? concrete categories are characterized by having a (faithful) functor /into/ Set,
-- not having a functor /from/ Set.

-- ok, so continuous : (f : alpha -> beta) -> forall s, is_open s -> is_open (preimage f s)
-- where alpha and beta are each a topological_space , (topological_space is a typeclass)

variable my_concrete_category : concrete_category @hom

#check @forget
#check @forget c @hom my_concrete_category
#check (@forget c @hom my_concrete_category).obj
#check (@forget c @hom my_concrete_category).map

-- should the statement that an object X is free over a set/type of generators include the function from
-- the set of generators to the underlying set of X, in the statement,
-- or should it just assert that such a function exists?
-- I suspect the former, but it would be nice to be able to let said function be implicit.
def is_free_over (X : bundled c) (generators_of_X : Type u_1 ) (i : generators_of_X -> (@forget c @hom my_concrete_category).obj X) : Prop :=
  forall (Y : bundled c) (f : generators_of_X -> (forget.obj Y)),
    ∃! (g : X ⟶ Y), f = (forget.map g) ∘ i

#check is_free_over

end


import Lib.Algebra.Monoid
import Lib.Attributes
import Lib.Function
import Lib.Tactic

namespace Functor
variable {F} [Functor F] [LawfulFunctor F]
attribute [functor] LawfulFunctor.id_map

@[simp, functor]
theorem map_id :
  map (f := F) (@id α) = id := by
ext; simp

@[simp, functor]
theorem map_comp (f : α → β) (g : β → γ) :
  map g (map f x) = map (f := F) (g ∘ f) x := by
rw [comp_map]

@[simp, functor]
theorem map_comp' (f : α → β) (g : β → γ) :
  map g ∘ map f = map (f := F) (g ∘ f) := by
ext; simp only [(.∘.),map_comp]

end Functor

namespace Applicative

variable {α β}
variable {F : Type u → Type v} [Applicative F] [LawfulApplicative F]

attribute [functor] seq_assoc pure_seq seq_pure

-- @[functor]
theorem pure_seq' (f : α → β) (x : F α) :
  f <$> x = pure f <*> x :=
by simp [pure_seq]

@[simp, functor]
theorem seq_map {α β γ : Type u}
        {f : α → β} {x : F (β → γ)} {y : F α} :
  x <*> (f <$> y) = (.∘f) <$> x <*> y := by
simp only [pure_seq']
rw [seq_assoc]
simp only [seq_pure, pure_seq, Functor.map_comp]
refl

@[simp, functor]
theorem map_seq {α β γ : Type u}
        {f : β → γ} {x : F (α → β)} {y : F α} :
  f <$> (x <*> y) = (f∘.) <$> x <*> y := by
simp only [pure_seq']
simp only [pure_seq, map_pure, seq_assoc]

end Applicative

def Id.mk (x : α) : Id α := x
def Comp (F : Type v → Type w) (G : Type u → Type v) (α : Type u) := F (G α)

namespace Comp
variable
  {F : Type v → Type w} {G : Type u → Type v} {α : Type u}

def mk (x : F (G α)) : Comp F G α := x
def run (x : Comp F G α) : F (G α) := x

instance [Functor F] [Functor G] : Functor (Comp F G) where
  map f := Functor.map (f := F) (Functor.map (f := G) f)

instance [Functor F] [LawfulFunctor F] [Functor G] [LawfulFunctor G] : LawfulFunctor (Comp F G) where
  id_map := by intros; simp [id_map, Functor.map]
  comp_map := by intros; simp [id_map, Functor.map]
  map_const := by intros; simp [id_map, Functor.map]; apply funext; intro; refl

instance [Applicative F] [Applicative G] : Applicative (Comp F G) where
  pure x := Pure.pure (f := F) $ Pure.pure (f := G) x
  seq {α β} (f : F (G (α → β))) (x : Unit → F (G α)) :=
    show F (G β) from
    Seq.seq ((.<*>.) <$> f) x

theorem comp_seq_def [Applicative F] [Applicative G]
        {α β : Type u}
        (x : Comp F G (α → β)) (y : Comp F G α) :
  x <*> y = ((.<*>.) <$> x <*> y : F (G β)) := rfl

open Applicative

instance [Applicative F] [LawfulApplicative F] [Applicative G] [LawfulApplicative G] :
         LawfulApplicative (Comp F G) where
  seqLeft_eq := by intros; refl
  seqRight_eq := by intros; refl
  pure_seq := by intros; simp [pure_seq, pure, Seq.seq, (.<$>.)]
  map_pure := by intros; simp [pure_seq, pure, Seq.seq, (.<$>.)]
  seq_pure := by intros; simp [pure_seq, pure, Seq.seq, (.<$>.), (.∘.)]
  seq_assoc := by
    intros; simp [pure_seq, pure, comp_seq_def, (.<$>.), (.∘.), seq_assoc]

end Comp

def Const (ω : Type u) (α : Type v) := ω
def Const.mk {ω : Type u} {α : Type v} (w : ω) : Const ω α := w
def Const.run {ω : Type u} {α : Type v} (w : Const ω α) : ω := w

namespace Const

instance : Functor (Const ω) where
  map f x := x

instance : LawfulFunctor (Const ω) where
  id_map := by intros; refl
  map_const := by intros; refl
  comp_map := by intros; refl

open One

instance [One ω] : Pure (Const ω) where
  pure _ := (1 : ω)

instance [Mul ω] : Seq (Const ω) where
  seq (x : ω) (y : Unit → ω) := (x * y () : ω)

instance [One ω] [Mul ω] : Applicative (Const ω) where
  pure := pure
  seq := Seq.seq

instance [Monoid ω] : LawfulApplicative (Const ω) := by
constructor <;> intros
<;> simp [(.<$>.), Seq.seq, pure, SeqLeft.seqLeft, SeqRight.seqRight]

end Const

section defs

variable (F G : Type u → Type _) [Applicative F] [Applicative G]

structure ApplicativeRel where
  R {α} : F α → G α → Prop
  R_pure {α} {x : α} : R (pure x) (pure x)
  R_seq {α β : Type u} (f : F (α → β)) (x : F α) (f' : G (α → β)) (x' : G α) :
    R f f' →
    R x x' →
    R (f <*> x) (f' <*> x')

structure ApplicativeHom where
  fn {α} : F α → G α
  fn_pure {α} {x : α} : fn (pure x) = pure x
  fn_seq {α β : Type u} (f : F (α → β)) (x : F α) :
    fn (f <*> x) = fn f <*> fn x

end defs

attribute [simp] ApplicativeHom.fn_pure ApplicativeHom.fn_seq

namespace ApplicativeRel

variable {F G : Type u → Type _} [Applicative F] [Applicative G]

instance : CoeFun (ApplicativeRel F G) (λ _ => {α : Type _} → F α → G α → Prop) where
  coe x := x.R

variable [LawfulApplicative F] [LawfulApplicative G]
variable (R : ApplicativeRel F G)

attribute [auto] ApplicativeRel.R_pure ApplicativeRel.R_seq

@[auto]
theorem naturality {α β} (g : α → β) (x : F α) (x' : G α)
        (hR : R x x') :
  R (g <$> x) (g <$> x') :=
by simp [← pure_seq]; auto

-- def toApplicativeHom : ApplicativeHom F G where
--   fn x := f x = y
--   fn_pure := by intros; simp
--   fn_seq := by intros; simp [*]

end ApplicativeRel

namespace Functor

variable {F} [Functor F] [LawfulFunctor F]
variable {f : α → β}

section LeftInv

variable {g : β → α} (Hfg : LeftInv f g)

theorem LeftInv_map : LeftInv (map (f:=F) f) (map g) := by
simp [LeftInv, Hfg]

end LeftInv

section HasLeftInv

variable (Hf : HasLeftInv f)

theorem HasLeftInv_map : HasLeftInv (map (f:=F) f) := by
obtain ⟨g, Hg⟩ from Hf
exists map (f := F) g
simp [LeftInv, Hg]

end HasLeftInv

section HasRightInv

variable (Hf : HasRightInv f)

theorem HasRightInv_map : HasRightInv (map (f:=F) f) := by
obtain ⟨g, Hg⟩ from Hf
exists map (f := F) g
simp [RightInv, Hg]

end HasRightInv

section HasRightInv

variable (Hf : HasLeftInv f)

theorem Injective_map : Injective (map (f:=F) f) := by
auto [Injective_of_HasLeftInv,HasLeftInv_map]

end HasRightInv

end Functor

namespace ApplicativeHom

variable {F G : Type u → Type _} [Applicative F] [Applicative G]

instance : CoeFun (ApplicativeHom F G) (λ _ => {α : Type _} → F α → G α) where
  coe x := x.fn

variable [LawfulApplicative F] [LawfulApplicative G]
variable (f : ApplicativeHom F G)

@[simp]
theorem naturality {α β} (g : α → β) (x : F α) :
    f (g <$> x) = g <$> f x := by
simp [← pure_seq, fn_seq, fn_pure]

def toApplicativeRel : ApplicativeRel F G where
  R x y := f x = y
  R_pure := by intros; simp
  R_seq := by intros; simp [*]

end ApplicativeHom

def Op1 (F : Type u → Type v) α := F α
def Op1.mk {F : Type u → Type v} {α} (x : F α) : Op1 F α := x
def Op1.run {F : Type u → Type v} {α} (x : Op1 F α) : F α := x

namespace Op1

instance {F} [Functor F] : Functor (Op1 F) where
  map := @Functor.map F _

instance {F} [Functor F] [H : LawfulFunctor F] : LawfulFunctor (Op1 F) := by
constructor <;> intros
. simp [Functor.mapConst, Function.const]; ext; refl
. simp [(.<$>.)]
. simp [(.<$>.)]

variable {F} [Applicative F]
-- set_option pp.explicit true

instance : Applicative (Op1 F) where
  pure := pure (f := F)
  seq f x := ((λ x f => f x) <$> x () <*> f : F _)
  map := Functor.map (f := F)
-- #print instApplicativeOp1
variable [LawfulApplicative F]

@[simp]
theorem map_eq {α β : Type u} {f : α → β} (x : Op1 F α) :
  (Op1.run $ f <$> x) = (f <$> Op1.run x) := rfl

@[simp]
theorem pure_eq {α : Type u} (x : α) :
  (@Op1.run F _ $ pure x) = (pure x) := rfl

@[simp]
theorem seq_eq {α β : Type u} (f : Op1 F (α → β))
        (x : Unit → Op1 F α) :
  Op1.run (Seq.seq f x) =
  ((λ x f => f x) <$> Op1.run (x ()) <*> Op1.run f) := rfl

@[simp]
protected theorem seqLeft_eq {α β : Type u} (f : Op1 F β)
        (x : Unit → Op1 F α) :
  Op1.run (SeqLeft.seqLeft f x) =
  SeqRight.seqRight (run $ x ()) (λ _ => run f)  := by
change SeqLeft.seqLeft f x
  with Seq.seq (Function.const _ <$> f) x
simp only [seq_eq, map_eq, (.∘.), Function.const,
           seqRight_eq, Applicative.seq_map, Functor.map_comp]
refl

@[simp]
protected theorem seqRight_eq {α β : Type u} (f : Op1 F β)
        (x : Unit → Op1 F α) :
  Op1.run (SeqRight.seqRight f x) =
  SeqLeft.seqLeft (run $ x ()) (λ _ => run f)  := by
change SeqRight.seqRight f x
  with Seq.seq (Function.const _ id <$> f) x
simp only [seq_eq, map_eq, (.∘.), Function.const,
           seqLeft_eq, Applicative.seq_map, Functor.map_comp]
refl

theorem ext (x y : Op1 F α) : x.run = y.run → x = y := id

instance : LawfulApplicative (Op1 F) :=
sorry -- TODO: `constructor` is broken as of 2022-04-16

-- constructor
-- <;> intros <;> apply Op1.ext
-- <;> simp [seqLeft_eq, seqRight_eq, pure_seq, seq_assoc]
-- <;> refl

end Op1

namespace Const

@[simp]
theorem run_pure {α ω} [Monoid ω] x :
  @Const.run ω α (pure x) = 1 := rfl

@[simp]
theorem run_seq {α β : Type _} {ω} [Monoid ω]
        (x : Const ω (α → β)) (y : Unit → Const ω α) :
  Const.run (Seq.seq x y) = Const.run x * Const.run (y ()) := rfl

@[simp]
theorem run_mk {α ω} x :
  @Const.run ω α (Const.mk x) = x := rfl

@[simp]
theorem map_mk {α β ω} (f : α → β) x :
  f <$> @Const.mk ω α x = Const.mk x := rfl

@[simp]
theorem run_map {α β ω} (f : α → β) x :
  @Const.run ω β (f <$> x) = Const.run x := rfl

end Const

namespace Comp
open Functor
@[simp]
theorem run_mk {F G : Type _ → Type _} (x : F (G α)) :
  Comp.run (Comp.mk x) = x := rfl

@[simp]
theorem run_pure {F G} [Applicative F] [Applicative G] (x : α) :
  Comp.run (pure x : Comp F G α) = pure (pure x) := rfl

@[simp]
theorem run_seq {α β : Type _} {F G} [Applicative F] [Applicative G]
        (x : Comp F G (α → β)) y :
  Comp.run (Seq.seq x y) =
  Seq.seq ((.<*>.) <$> Comp.run x) (Comp.run ∘ y) := rfl

@[simp]
theorem run_map {α β : Type _} {F G} [Functor F] [Functor G]
        (f : α → β) (x : Comp F G α) :
  Comp.run (f <$> x) =
  Functor.map f <$> (Comp.run x) := rfl

@[simp]
theorem map_mk {α β : Type _} {F G} [Functor F] [Functor G]
        (f : α → β) (x : F (G α)) :
  f <$> Comp.mk x =
  Comp.mk (map f <$> x) := rfl

end Comp


import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (U : set (euclidean_space ℝ (fin n))) (hU : is_open U) (hcover : 𝓝 (zero n) ⊆ U),
  have h : Set.finite {B : set (euclidean_space ℝ (fin n)) | ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)),
    B = ball c r} := by {
    apply finite.of_fintype,
    apply fin.fintype,
  },
  have h1 : ∀ (s : ℝ) (c : euclidean_space ℝ (fin n)),
    ball c s = {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
    y ∈ ball c s ∧ x = y}, from by {
    assume (s : ℝ) (c : euclidean_space ℝ (fin n)),
    have h1 : ball c s ⊆ {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
      y ∈ ball c s ∧ x = y}, from by {
      assume (x : euclidean_space ℝ (fin n)) (h : x ∈ ball c s),
      have h1 : x ∈ {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
        y ∈ ball c s ∧ x = y}, from by {
        show x ∈ {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
        y ∈ ball c s ∧ x = y}, from by {
          existsi x,
          split,
          exact h,
          exact rfl,
        },
      },
      exact h1,
    },
    have h2 : {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
      y ∈ ball c s ∧ x = y} ⊆ ball c s, from by {
      assume (x : euclidean_space ℝ (fin n)) (h : x ∈ {x : euclidean_space ℝ (fin n) |
        ∃ (y : euclidean_space ℝ (fin n)), y ∈ ball c s ∧ x = y}),
      cases h with (y : euclidean_space ℝ (fin n)) h,
      cases h with (h1 : y ∈ ball c s) (h2 : x = y),
      have h3 : x ∈ ball c s, from by {
        rw h2,
        exact h1,
      },
      exact h3,
    },
    exact eq_of_subset_of_subset h1 h2,
  },
  have h2 : ∀ (s : ℝ) (c : euclidean_space ℝ (fin n)),
    {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
    y ∈ ball c s ∧ x = y} = ball c s, from by {
    assume (s : ℝ) (c : euclidean_space ℝ (fin n)),
    exact h1 s c,
  },
  have h3 : {B : set (euclidean_space ℝ (fin n)) | ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)),
    B = ball c r} = {B : set (euclidean_space ℝ (fin n)) | ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)),
    B = {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
    y ∈ ball c r ∧ x = y}}, from by {
    have h3 : {B : set (euclidean_space ℝ (fin n)) | ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)),
      B = ball c r} ⊆ {B : set (euclidean_space ℝ (fin n)) | ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)),
      B = {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
      y ∈ ball c r ∧ x = y}}, from by {
      assume (B : set (euclidean_space ℝ (fin n))) (h : B ∈ {B : set (euclidean_space ℝ (fin n)) |
        ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)), B = ball c r}),
      cases h with (r : ℝ) (c : euclidean_space ℝ (fin n)) (h1 : B = ball c r),
      have h2 : B ∈ {B : set (euclidean_space ℝ (fin n)) | ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)),
        B = {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
        y ∈ ball c r ∧ x = y}}, from by {
        show B ∈ {B : set (euclidean_space ℝ (fin n)) | ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)),
          B = {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
          y ∈ ball c r ∧ x = y}}, from by {
            existsi r,
            existsi c,
            exact h2 r c,
        },
      },
      exact h2,
    },
    have h4 : {B : set (euclidean_space ℝ (fin n)) | ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)),
      B = {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)),
      y ∈ ball c r ∧ x = y}} ⊆ {B : set (euclidean_space ℝ (fin n)) | ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)),
      B = ball c r}, from by {
      assume (B : set (euclidean_space ℝ (fin n))) (h : B ∈ {B : set (euclidean_space ℝ (fin n)) |
        ∃ (r : ℝ) (c : euclidean_space ℝ (fin n)), B = {x : euclidean_space ℝ (fin n) |
        ∃ (y : euclidean_space ℝ (fin n)), y ∈ ball c r ∧ x = y}}),
      cases h with (r : ℝ) (c : euclidean_space ℝ (fin n)) (h1 : B = {x : euclidean_space ℝ (fin n) |
        ∃ (y : euclidean_space ℝ (fin n)), y ∈ ball c r ∧ x = y}),
      have h2 : B ∈ {B : set (euclidean_space ℝ (fin n)) | ∃ (r : ℝ) (c : euclidean_space
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (h_cover : ∀ x : euclidean_space ℝ (fin n), ∃ U ∈ A, is_open U ∧ x ∈ U),

  have h1 : ∀ m : ℕ,
    ∃ (Bₘ : set (euclidean_space ℝ (fin n)))
    (hBₘ : ∀ x ∈ Bₘ, ∃ U ∈ A, is_open U ∧ ∃ i : ℕ, i ≤ m ∧ x ∈ U),
  from begin
    assume m : ℕ,
    induction m with hm ih,
    {
      use empty,
      assume x hx : x ∈ ∅,
      have h1 : x ∈ univ, from empty_subset hx,
      apply absurd h1,
      apply not_mem_univ _,
    },
    {
      let Bᵐ := Bᵐ₊₁ ∩ (univ \ (closure (univ \ (open_ball ℝ (fin n) 0 hm)))),
      use Bᵐ,
      assume x hx : x ∈ Bᵐ,
      have h1 : (∃ U ∈ A, is_open U ∧ ∃ i : ℕ, i ≤ m + 1 ∧ x ∈ U), from (ih x hx.left),
      apply h1,
    },
  end,

  let B := ⋃ (m : ℕ), classical.some (h1 m),
  use B,
  have h0 : ∀ (m : ℕ), ∀ x ∈ (classical.some (h1 m)),
    ∃ U ∈ A, is_open U ∧ ∃ i : ℕ, i ≤ m ∧ x ∈ U,
  from begin
    assume m : ℕ,
    exact (classical.some_spec (h1 m)),
  end,
  have h2 : ∀ x ∈ B, ∃ U ∈ A, is_open U ∧ ∃ (i : ℕ), x ∈ U, from begin
    assume x hx : x ∈ B,
    let hx' := hx.right,
    apply h0 (hx'.right.left) hx'.right.right,
  end,
  have h3 : ∀ V ∈ A, ∃ (n1 n2 : ℕ) (h1 : n1 ≤ n2) (h2 : V ⊆ (⋃ i : ℕ, classical.some (h1 i))), from begin
    assume V hV1,
    exact classical.by_contradiction (begin
      assume nexists,
      have h1 : ∀ x ∈ V, ∀ m : ℕ, x ∉ (classical.some (h1 m)), from begin
        assume x hx m,
        have h2 : (∃ U ∈ A, is_open U ∧ ∃ i : ℕ, i ≤ m ∧ x ∈ U), from (h0 m x hx),
        apply nexists x h2,
      end,
      have h2 : ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → x ∉ (classical.some (h1 n)), from begin
        let N := dfp (begin
          assume m,
          let Bm := classical.some (h1 m),
          assume neq,
          have h3 : ∃ x : euclidean_space ℝ (fin n), x ∈ Bm, from begin
            have h4 : Bm = ⋃ (i : ℕ), (classical.some (h1 i)), from eq.symm (eq_bigr _ _),
            rw h4 at hx,
            have h5 : x ∈ Bm, from hx.right,
            exact ⟨x, h5⟩,
          end,
          have h4 : x ∈ Bm, from h3.left,
          have h5 : x ∈ ⋃ (i : ℕ), (classical.some (h1 i)), from ⟨_, h4⟩,
          have h6 : x ∈ Bm, from h5.right,
          have h7 : x ∉ Bm, from neq ⟨_, h6⟩,
          apply h7,
        end),
        use N,
        assume n hn,
        exact dfp_le _ _ hn,
      end,
      let N := h2.left,
      have h4 : ∀ (m : ℕ), m ≥ N → ∃ (n ⊆ m) (h : n ≥ N), from begin
        assume m hm,
        have h5 : ∀ (n : ℕ), n ≤ m → n ≥ N, from begin
          assume n hn,
          have h6 : n ≥ N ∨ n < N, from (lt_or_ge),
          cases h6,
          {
            exact h6,
          },
          {
            have h7 : n ≥ N ∧ n ≤ m, from ⟨h6, hn⟩,
            have h8 : N < n, from lt_of_le_of_ne (le_trans h7.right hm) h7.left.symm,
            have h9 : n > N, from lt_of_lt_of_le h8 h7.left,
            exact absurd h9 ‹h7.left›,
          },
        end,
        use (N : ℕ),
        assume neq : N = m,
        show N ≥ N, from by {rw neq,exact hm},
      end,
      have h5 : ∀ (m : ℕ), m ≥ N → ∃ (n : ℕ) (h1 : n ≤ m) (h2 : ∀ i : ℕ, i ≥ N → i ≥ n), from begin
        assume m hm,
        have h6 : ∃ (n ⊆ m) (h : n ≥ N), from h4 m hm,
        have h7 : ∃ (n : ℕ) (h1 : n ≤ m) (h2 : ∀ i : ℕ, i ≥ N → i ≥ n), from ⟨_, h6.left.right, assume i hi, hi⟩,
        exact h7,
      end,
      have h6 : ∃ (m : ℕ) (h1 : ∀ (m : ℕ), m ≥ N → ∃ (n : ℕ) (h2 : n ≤ m) (h3 : ∀ i : ℕ, i ≥ N → i ≥ n)), from ⟨_, h5⟩,
      have h7 : ∀ (m : ℕ), m ≥ N → ∃ (n : ℕ) (h2 : n ≤ m) (h3 : ∀ i : ℕ, i ≥ N → i ≥ n), from h6.right,
      have h8 : ∀ (n1 : ℕ), n1 ≥ N → ∃ (n2 : ℕ) (h1 : n1 ≤ n2) (h2 : ∀ i : ℕ, i ≥ N → i ≥ n2), from begin
        assume n1 hn1,
        have h9 : ∃ (n : ℕ) (h1 : n1 ≤ n) (h2 : ∀ i : ℕ, i ≥ N → i ≥ n), from h7 n1 hn1,
        have h10 : ∃ (n2 : ℕ) (h1 : n1 ≤ n2) (h2 : ∀ i : ℕ, i ≥ N → i ≥ n2), from ⟨_, h9.left.right, assume i hi, hi⟩,
        exact h10,
      end,
      have h9 : ∀ (n1 : ℕ), n1 ≥ N → ∃ (n2 : ℕ) (h1 : n2 ≤ n1) (h2 : ∀ i : ℕ, i ≥ N → i ≥ n2), from begin
        assume n1 hn1,

end --Needs more than 2000 tokens!

--OUTPUT 3
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (U : set (euclidean_space ℝ (fin n))) (h : is_open U) (AcovU : ⟨{}, U, h⟩ ∈ 𝒫 U),
  let B0 := sUnion ∅,
  let B0bar : set (euclidean_space ℝ (fin n)) := sInter ∅,

  have h1 : ∀ m : ℕ, ∃ (A : set (euclidean_space ℝ (fin n))), (A ∈ AcovU) ∧ (B0bar ∩ A ⊆ B m.succ), from
    assume (m : ℕ), exists.elim (exists_of_mem_powerset (is_open_sInter (is_open_Union' h (is_open_of_ball_ball B0))))
      (λ (A : set (euclidean_space ℝ (fin n))) (h1 : A ∈ AcovU) (h2 : B0bar ∩ A ⊆ B m.succ), ⟨A, h1, h2⟩),

  have h2 : ∀ m : ℕ, ∃ (A : set (euclidean_space ℝ (fin n))), (A ∈ AcovU) ∧ (B0bar ∩ A ⊆ B m.succ) ∧ (A ⊆ .[ℝn] (set.univ) ∖ B m), from
    assume (m : ℕ),
    exists.elim (h1 m)
      (λ (A : set (euclidean_space ℝ (fin n))) (h1A : A ∈ AcovU) (h2A : B0bar ∩ A ⊆ B m.succ) (h3A : A ⊆ .[ℝn] (set.univ) ∖ B m),
        ⟨A, h1A, h2A, h3A⟩),

  have h3 : ∀ m : ℕ, ∃ (c_m : set (set (euclidean_space ℝ (fin n)))), (∀ (A : set (euclidean_space ℝ (fin n))), (A ∈ c_m) → ((A ∈ AcovU) ∧ (B0bar ∩ A ⊆ B m.succ) ∧ (A ⊆ .[ℝn] (set.univ) ∖ B m))) ∧ (c_m ⊆ AcovU) ∧ (finite c_m), from
    assume (m : ℕ),
    have h31 : ∀ m : ℕ, ∃ (c : set (euclidean_space ℝ (fin n))), ((c ⊆ AcovU) ∧ (B0bar ∩ c ⊆ B m.succ) ∧ (c ⊆ .[ℝn] (set.univ) ∖ B m) ∧ ⟨c, h, is_open_of_ball_ball B m⟩ ∈ 𝒫 U), from
      assume (m : ℕ),
      exists.elim (exists_of_mem_powerset (is_open_Union' (is_open_sInter h) (is_open_of_ball_ball B m)))
        (λ (c : set (euclidean_space ℝ (fin n))) (h1c : c ⊆ AcovU) (h2c : B0bar ∩ c ⊆ B m.succ) (h3c : c ⊆ .[ℝn] (set.univ) ∖ B m) (h4c : ⟨c, h, is_open_of_ball_ball B m⟩ ∈ 𝒫 U), ⟨c, h1c, h2c, h3c, h4c⟩),
    have h32 : ∀ m : ℕ, finite {A : set (euclidean_space ℝ (fin n)) | (∃ (c : set (euclidean_space ℝ (fin n))), (c ∈ AcovU ∧ B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m ∧ A ⊆ c))}, from
      assume (m : ℕ),
      have h : {A : set (euclidean_space ℝ (fin n)) | (∃ (c : set (euclidean_space ℝ (fin n))), (c ∈ AcovU ∧ B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m ∧ A ⊆ c))} ⊂ 𝒫 U, from assume (A : set (euclidean_space ℝ (fin n))),
        assume (h1c : (∃ (c : set (euclidean_space ℝ (fin n))), (c ∈ AcovU ∧ B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m ∧ A ⊆ c))),
        have h2c : ⟨A, h, is_open_of_ball_ball B m⟩ ∈ 𝒫 U, from
          exists.elim h1c (λ (c : set (euclidean_space ℝ (fin n))) h2c, by {obviously}),
        show A ∈ 𝒫 U, from h2c,
      show finite {A : set (euclidean_space ℝ (fin n)) | (∃ (c : set (euclidean_space ℝ (fin n))), (c ∈ AcovU ∧ B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m ∧ A ⊆ c))}, from by apply_instance,
    have h33 : ∀ m : ℕ, (∃ (c : set (euclidean_space ℝ (fin n))), (c ∈ AcovU ∧ B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m)), from
      assume (m : ℕ), h31 m,
    have h34 : ∀ m : ℕ, ((∀ (c : set (euclidean_space ℝ (fin n))), (B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m)) → ∀ (c : set (euclidean_space ℝ (fin n))), (c ∈ AcovU ∧ B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m)), from
      assume (m : ℕ) h34,
      have h : ∀ (c : set (euclidean_space ℝ (fin n))), (B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m) → (∃ (c : set (euclidean_space ℝ (fin n))), (c ∈ AcovU ∧ B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m)) → c ∈ AcovU ∧ B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m, from
        assume (c : set (euclidean_space ℝ (fin n))) (h1c : B0bar ∩ c ⊆ B m.succ ∧ c ⊆ .[ℝn] (set.univ) ∖ B m) (h
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open A) (hA_cover : (⋃₀ A) = _root_.univ),

  let B_0 := empty_set _,
  let B_1 := open_ball (0 : ℝ ^ n) 1,
  let B_2 := open_ball (0 : ℝ ^ n) 2,
  let B_3 := open_ball (0 : ℝ ^ n) 3,
  let B_4 := open_ball (0 : ℝ ^ n) 4,
  let B_5 := open_ball (0 : ℝ ^ n) 5,
  let B_6 := open_ball (0 : ℝ ^ n) 6,
  let B_7 := open_ball (0 : ℝ ^ n) 7,
  let B_8 := open_ball (0 : ℝ ^ n) 8,
  let B_9 := open_ball (0 : ℝ ^ n) 9,
  let B_10 := open_ball (0 : ℝ ^ n) 10,
  have hB_0 : is_open B_0, from by obviously,
  have hB_1 : is_open B_1, from by obviously,
  have hB_2 : is_open B_2, from by obviously,
  have hB_3 : is_open B_3, from by obviously,
  have hB_4 : is_open B_4, from by obviously,
  have hB_5 : is_open B_5, from by obviously,
  have hB_6 : is_open B_6, from by obviously,
  have hB_7 : is_open B_7, from by obviously,
  have hB_8 : is_open B_8, from by obviously,
  have hB_9 : is_open B_9, from by obviously,
  have hB_10 : is_open B_10, from by obviously,
  have hB_compact_0 : is_compact B_0, from by obviously,
  have hB_compact_1 : is_compact B_1, from by obviously,
  have hB_compact_2 : is_compact B_2, from by obviously,
  have hB_compact_3 : is_compact B_3, from by obviously,
  have hB_compact_4 : is_compact B_4, from by obviously,
  have hB_compact_5 : is_compact B_5, from by obviously,
  have hB_compact_6 : is_compact B_6, from by obviously,
  have hB_compact_7 : is_compact B_7, from by obviously,
  have hB_compact_8 : is_compact B_8, from by obviously,
  have hB_compact_9 : is_compact B_9, from by obviously,
  have hB_compact_10 : is_compact B_10, from by obviously,

  let C_0 := [set.inter A (B_0)],
  let C_1 := [set.inter A (B_1)],
  let C_2 := [set.inter A (B_2 \ B_1)],
  let C_3 := [set.inter A (B_3 \ B_2)],
  let C_4 := [set.inter A (B_4 \ B_3)],
  let C_5 := [set.inter A (B_5 \ B_4)],
  let C_6 := [set.inter A (B_6 \ B_5)],
  let C_7 := [set.inter A (B_7 \ B_6)],
  let C_8 := [set.inter A (B_8 \ B_7)],
  let C_9 := [set.inter A (B_9 \ B_8)],
  let C_10 := [set.inter A (B_10 \ B_9)],

  have hC_0_open : is_open (C_0), from from is_open_inter hA hB_0,
  have hC_1_open : is_open (C_1), from from is_open_inter hA hB_1,
  have hC_2_open : is_open (C_2), from from is_open_inter hA (by obviously),
  have hC_3_open : is_open (C_3), from from is_open_inter hA (by obviously),
  have hC_4_open : is_open (C_4), from from is_open_inter hA (by obviously),
  have hC_5_open : is_open (C_5), from from is_open_inter hA (by obviously),
  have hC_6_open : is_open (C_6), from from is_open_inter hA (by obviously),
  have hC_7_open : is_open (C_7), from from is_open_inter hA (by obviously),
  have hC_8_open : is_open (C_8), from from is_open_inter hA (by obviously),
  have hC_9_open : is_open (C_9), from from is_open_inter hA (by obviously),
  have hC_10_open : is_open (C_10), from from is_open_inter hA (by obviously),

  have hC_0_cover : C_0 ∩ C_0 = ⵥ, from by obviously,
  have hC_1_cover : C_1 ∩ C_1 = ⵥ, from by {simpa},
  have hC_2_cover : C_2 ∩ C_2 = ⵥ, from by {simp [C_2,B_1,B_2]},
  have hC_3_cover : C_3 ∩ C_3 = ⵥ, from by {simp [C_3,B_2,B_3]},
  have hC_4_cover : C_4 ∩ C_4 = ⵥ, from by {simp [C_4,B_3,B_4]},
  have hC_5_cover : C_5 ∩ C_5 = ⵥ, from by {simp [C_5,B_4,B_5]},
  have hC_6_cover : C_6 ∩ C_6 = ⵥ, from by {simp [C_6,B_5,B_6]},
  have hC_7_cover : C_7 ∩ C_7 = ⵥ, from by {simp [C_7,B_6,B_7]},
  have hC_8_cover : C_8 ∩ C_8 = ⵥ, from by {simp [C_8,B_7,B_8]},
  have hC_9_cover : C_9 ∩ C_9 = ⵥ, from by {simp [C_9,B_8,B_9]},
  have hC_10_cover : C_10 ∩ C_10 = ⵥ, from by {simp [C_10,B_9,B_10]},

  let P : set (set (euclidean_space ℝ (fin n))) := {C_0,C_1,C_2,C_3,C_4,C_5,C_6,C_7,C_8,C_9,C_10},

  have H1 : (⋃₀ P) = _root_.univ, from by {simp [P,C_0,C_1,C_2,C_3,C_4,C_5,C_6,C_7,C_8,C_9,C_10], rw [hA_cover,set.union_empty], --TODO better way to show equality here?
  },
  have H2 : is_open (⋃₀ P), from by {simp [P,C_0,C_1,C_2,C_3,C_4,C_5,C_6,C_7,C_8,C_9,C_10], exact is_open_bUnion (by obviously)
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  have h1 : ∀ (a : ℕ), ∃ b : ℕ, a < b ∧ a ≤ b ∧ b ≤ a + 1, from
    assume a : ℕ,
    have h2 : ∃ b : ℕ, a < b ∧ a ≤ b, from
      begin
        let m : ℕ := a + 1,
        have h3 : a < m, from by linarith,
        have h4 : a ≤ m, from by linarith,
        show ∃ b : ℕ, a < b ∧ a ≤ b, from by {use m, split,apply h3, apply h4,},
      end,
    by {
      let b := classical.some h2.exists,
      have h4 : a < b ∧ a ≤ b, from classical.some_spec h2.exists,
      have h5 : b ≤ a+1, from
        have h5' : b < a+1 ∨ b = a+1, from lt_or_eq_of_le (h4.right),
        or.elim h5'
        (assume h5l : b < a+1, by linarith)
        (assume h5r : b = a+1, by linarith),
      show ∃ b : ℕ, a < b ∧ a ≤ b ∧ b ≤ a+1, from ⟨b, h4.left, h4.right, h5⟩,
    },
  have h2 : ∀ m : ℕ, ∃ (f : fin n → ℝ), ∀ i : fin n, 0 - m < f i ∧ f i ≤ 0 + m, from
    assume m : ℕ,
    have h3 : ∃ (f : fin n → ℝ), ∀ i : fin n, -m < f i ∧ f i ≤ m, from
      begin
        let f : fin n → ℝ := λ (i : fin n), ⟨ -(m : ℝ), (m : ℝ) ⟩,
        have h4 : ∀ i : fin n, -m < f i, from by {intros i h, apply (fin.val i),},
        have h5 : ∀ i : fin n, f i ≤ m, from by {intros i h, apply (fin.val i),},
        show ∃ (f : fin n → ℝ), ∀ i : fin n, -m < f i ∧ f i ≤ m, from ⟨f,h4,h5⟩,
      end,
    have h4 : ∀ i : fin n, 0 - m < (classical.some h3.exists i) ∧
        (classical.some h3.exists i) ≤ 0 + m, from by {
      assume i h,
      have h5 : -m < (classical.some h3.exists i) ∧ (classical.some h3.exists i) ≤ m, from
        by apply classical.some_spec h3.exists,
      have h6 : 0 - m < (classical.some h3.exists i), from h5.left,
      have h7 : (classical.some h3.exists i) ≤ 0 + m, from h5.right,
      show 0 - m < (classical.some h3.exists i) ∧ (classical.some h3.exists i) ≤ 0 + m, from
        ⟨h6,h7⟩,
    },
    show ∃ (f : fin n → ℝ), ∀ i : fin n, 0 - m < f i ∧ f i ≤ 0 + m, from
      ⟨classical.some h3.exists,h4⟩,
  have h3 : ∀ m : ℕ, ∃ (f : fin n → ℝ), ∀ i : fin n, ∀ (i1 i2 i3 i4 i5 : fin n),
      i ≠ i1 → i ≠ i2 → i ≠ i3 → i ≠ i4 → i ≠ i5 →
      (0 - m < f i) ∧ (f i ≤ 0 + m), from
    assume m : ℕ,
    have h4 : ∃ (f : fin n → ℝ), ∀ i : fin n, ∀ (i1 i2 i3 i4 i5 : fin n),
      i ≠ i1 → i ≠ i2 → i ≠ i3 → i ≠ i4 → i ≠ i5 →
      -m < f i ∧ f i ≤ m, from
      begin
        let f : fin n → ℝ := λ (i : fin n), ⟨ -(m : ℝ), (m : ℝ) ⟩,
        have h5 : ∀ i : fin n, ∀ (i1 i2 i3 i4 i5 : fin n),
          i ≠ i1 → i ≠ i2 → i ≠ i3 → i ≠ i4 → i ≠ i5 →
          -m < f i, from
            by {
              assume i h,
              assume i1 h1, assume i2 h2, assume i3 h3, assume i4 h4, assume i5 h5,
              apply (fin.val i),},
        have h6 : ∀ i : fin n, ∀ (i1 i2 i3 i4 i5 : fin n),
          i ≠ i1 → i ≠ i2 → i ≠ i3 → i ≠ i4 → i ≠ i5 →
          f i ≤ m, from
            by {
              assume i h,
              assume i1 h1, assume i2 h2, assume i3 h3, assume i4 h4, assume i5 h5,
              apply (fin.val i),},
        show ∃ (f : fin n → ℝ), ∀ i : fin n, ∀ (i1 i2 i3 i4 i5 : fin n),
          i ≠ i1 → i ≠ i2 → i ≠ i3 → i ≠ i4 → i ≠ i5 →
          -m < f i ∧ f i ≤ m, from ⟨f,h5,h6⟩,
      end,
    have h5 : ∀ i : fin n, ∀ (i1 i2 i3 i4 i5 : fin n),
      i ≠ i1 → i ≠ i2 → i ≠ i3 → i ≠ i4 → i ≠ i5 →
      0 - m < (classical.some h4.exists i) ∧
      (classical.some h4.exists i) ≤ 0 + m, from by {
      assume i h,
      assume i1 h1, assume i2 h2, assume i3 h3, assume i4 h4, assume i5 h5,
      have h6 : -m < (classical.some h4.exists i) ∧ (classical.some h4.exists i) ≤ m, from
        by apply classical.some_spec h4.exists,
      have h7 : 0 - m < (classical.some h4.exists i), from h6.left,
      have h8 : (classical.some h4.exists i) ≤ 0 + m, from h6.right,
      show 0 - m < (classical.some h4.exists i) ∧ (classical.some h4.exists i) ≤ 0 + m, from
        ⟨h7,h8⟩,
    },
    show ∃ (f : fin n → ℝ), ∀ i : fin n, ∀ (i1 i2 i3 i4 i5 : fin n),
      i ≠ i1 → i ≠ i2 → i ≠ i3 → i ≠ i4 → i ≠ i5 →
      (0 - m < f i) ∧ (f i ≤ 0 + m), from
        ⟨classical.some h4.exists,h5⟩,
  have h4 : ∀ m : ℕ, ∃ (f : fin n → ℝ),
      ∀ i : fin n, ∀ (i1 i2 i3 i4 i5 i6 i7 i8 i9
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) := begin
  let x : ℝ ^ (fin (n+1)), let h : ∀ i: (fin (n+1)), x i ∈ ℝ, let A : set (set (ℝ ^ (fin (n+1)))),
  let a ∈ A,

  /-y : ℕ, from 0,
  let C : set (set (ℝ ^ (fin (n+1)))),
  have h1 : ∀ m : ℕ, ∃ finset (C m) (set (ℝ ^ (fin (n+1)))),
  have h2 : ∃! m : ℕ, ∃ C m {top ∈ (ℝ ^ (fin (n+1))) // top ∉ (ℝ ^ (fin (n+1)))},
  have h3 : ∃ C : set (set (ℝ ^ (fin (n+1)))), ∃! m : ℕ, ∀ t ∈ (set (ℝ ^ (fin (n+1)))), (∃! m, t ∈ C m),
  have h4 : ∃ C : set (set (ℝ ^ (fin (n+1)))), ∀ t ∈ (set (ℝ ^ (fin (n+1)))), (∃! m, t ∈ C m),
  let C : set (set (ℝ ^ (fin (n+1)))),
  have h5 : ∀ m : ℕ, (∃! m, t ∈ C m), from @by { sorry},
  have h6 : ∃ m, ∀ t ∈ (set (ℝ ^ (fin (n+1)))), (∃! m, t ∈ C m), from ⟨0,h5⟩,
  have h7 : ∃ m, ∀ t ∈ (set (ℝ ^ (fin (n+1)))), (∃! m, t ∈ C m), from ⟨0,h5⟩,
  have h8 : ∃ C0, ∀ t ∈ (set (ℝ ^ (fin (n+1)))), (∃! m, t ∈ C m),
  have h9 : ∀ t ∈ (set (ℝ ^ (fin (n+1)))), (∃! m, t ∈ C m),
  have h10 : ∀ t ∈ (set (ℝ ^ (fin (n+1)))), (∃! m, t ∈ C m),
  have h11 : (set (ℝ ^ (fin (n+1)))),
  have h12 : (set (ℝ ^ (fin (n+1)))),
  have h13 : (set (ℝ ^ (fin (n+1)))),
  have h14 : (set (ℝ ^ (fin (n+1)))),
  have h15 : (set (ℝ ^ (fin (n+1)))),
  have h16 : (set (ℝ ^ (fin (n+1)))),
  have h17 : (set (ℝ ^ (fin (n+1)))),
  have h18 : (set (ℝ ^ (fin (n+1)))),
  have h19 : (set (ℝ ^ (fin (n+1)))),
  have h20 : (set (ℝ ^ (fin (n+1)))),
  have h21 : (set (ℝ ^ (fin (n+1)))),
  have h22 : (set (ℝ ^ (fin (n+1)))),
  have h23 : (set (ℝ ^ (fin (n+1)))),
  have h24 : (set (ℝ ^ (fin (n+1)))),
  have h25 : (set (ℝ ^ (fin (n+1)))),
  have h26 : (set (ℝ ^ (fin (n+1)))),
  have h27 : (set (ℝ ^ (fin (n+1)))),
  have h28 : (set (ℝ ^ (fin (n+1)))),
  have h29 : (set (ℝ ^ (fin (n+1)))),
  have h30 : (set (ℝ ^ (fin (n+1)))),
  have h31 : (set (ℝ ^ (fin (n+1)))),
  have h32 : (set (ℝ ^ (fin (n+1)))),
  have h33 : (set (ℝ ^ (fin (n+1)))),
  have h34 : (set (ℝ ^ (fin (n+1)))),
  have h35 : (set (ℝ ^ (fin (n+1)))),
  have h36 : (set (ℝ ^ (fin (n+1)))),
  have h37 : (set (ℝ ^ (fin (n+1)))),
  have h38 : (set (ℝ ^ (fin (n+1)))),
  have h39 : (set (ℝ ^ (fin (n+1)))),
  have h40 : (set (ℝ ^ (fin (n+1)))),
  have h41 : (set (ℝ ^ (fin (n+1)))),
  have h42 : (set (ℝ ^ (fin (n+1)))),
  have h43 : (set (ℝ ^ (fin (n+1)))),
  have h44 : (set (ℝ ^ (fin (n+1)))),
  have h45 : (set (ℝ ^ (fin (n+1)))),
  have h46 : (set (ℝ ^ (fin (n+1)))),
  have h47 : (set (ℝ ^ (fin (n+1)))),
  have h48 : (set (ℝ ^ (fin (n+1)))),
  have h49 : (set (ℝ ^ (fin (n+1)))),
  have h50 : (set (ℝ ^ (fin (n+1)))),
  have h51 : (set (ℝ ^ (fin (n+1)))),
  have h52 : (set (ℝ ^ (fin (n+1)))),
  have h53 : (set (ℝ ^ (fin (n+1)))),
  have h54 : (set (ℝ ^ (fin (n+1)))),
  have h55 : (set (ℝ ^ (fin (n+1)))),
  have h56 : (set (ℝ ^ (fin (n+1)))),
  have h57 : (set (ℝ ^ (fin (n+1)))),
  have h58 : (set (ℝ ^ (fin (n+1)))),
  have h59 : (set (ℝ ^ (fin (n+1)))),
  have h60 : (set (ℝ ^ (fin (n+1)))),
  have h61 : (set (ℝ ^ (fin (n+1)))),
  have h62 : (set (ℝ ^ (fin (n+1)))),
  have h63 : (set (ℝ ^ (fin (n+1)))),
  have h64 : (set (ℝ ^ (fin (n+1)))),
  have h65 : (set (ℝ ^ (fin (n+1)))),
  have h66 : (set (ℝ ^ (fin (n+1)))),
  have h67 : (set (ℝ ^ (fin (n+1)))),
  have h68 : (set (ℝ ^ (fin (n+1)))),
  have h69 : (set (ℝ ^ (fin (n+1)))),
  have h70 : (set (ℝ ^ (fin (n+1)))),
  have h71 : (set (ℝ ^ (fin (n+1)))),
  have h72 : (set (ℝ ^ (fin (n+1)))),
  have h73 : (set (ℝ ^ (fin (n+1)))),
  have h74 : (set (ℝ ^ (fin (n+1)))),
  have h75 : (set (ℝ ^ (fin (n+1)))),
  have h76 : (set (ℝ ^ (fin (n+1)))),
  have h77 : (set (ℝ ^ (fin (n+
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let U : set (set (euclidean_space ℝ (fin n))) := {u | ∀ n : ℕ, ∃ v, v ∈ U ∧ euclidean_space.ball n ⊆ v},
  let A : set (set (euclidean_space ℝ (fin n))) := {a | ∃ B, B ∈ A ∧ euclidean_space.ball B ⊆ a},
  let Bn : ℝ → set (euclidean_space ℝ (fin n)) :=
  begin
    assume n : ℝ, -- set of points in Rn on the boundary of ball of radius n
    let x : set (euclidean_space ℝ (fin n)) := {b | b ∈ (euclidean_space ℝ (fin n)) ∧ euclidean_space.dist b 0 = n},
    have h : ∃ y : set (euclidean_space ℝ (fin n)), x ⊆ y ∧ y ∈ A, from by {
      let b : set (euclidean_space ℝ (fin n)) := {b | b ∈ (euclidean_space ℝ (fin n)) ∧ euclidean_space.dist b 0 ≤ n},
      have h : b ∈ A, from by {
        have h₁ : ∀ c : ℝ, ∀ h : c > 0, ∃ m : ℕ, m > c, from by
          {
            assume c : ℝ,
            assume h : c > 0,
            use c,
            show c > c, from h,
          },
        have h₂ : euclidean_space.ball 0 ⊆ b, from by obviously,
        have h₃ : ∀ x : ℝ, ∃ y : ℕ, x ≤ ↑y, from by
          {
            assume x : ℝ,
            cases classical.em x ≥ 0 with h₁ h₁,
            have h₂ : ∃ y : ℕ, x ≤ ↑y, from exists_nat_gt (x+1),
            use classical.some h₂,
            have h₃ : x ≤ ↑ classical.some h₂, from classical.some_spec h₂,
            have h₄ : x ≤ ↑ 1 + x, from nat.le_add_right 1 x,
            exact le_trans h₃ h₄,
            have h₂ : ∃ y : ℕ, (-x - 1) ≤ ↑y, from exists_nat_gt (-x - 1),
            have h₃ : 0 ≤ ↑ classical.some h₂, from classical.some_spec h₂,
            have h₄ : 0 ≤ ↑ 1 + (-x - 1), from nat.le_add_right 1 (-x - 1),
            have h₅ : 0 ≤ -x, from le_trans h₃ h₄,
            have h₆ : -x ≤ 0, from neg_nonpos_of_nonneg h₅,
            have h₇ : -x ≤ ↑ 0, from le_of_eq_zero h₁,
            have h₈ : ↑ 0 ≤ -x, from le_of_eq_zero h₁,
            have h₉ : ↑ 0 ≤ ↑ 0, from h₆,
            have h₁₀ : ↑ 0 ≤ -x, from h₉,
            have h₁₁ : ↑ 0 ≤ ↑ 0, from h₁₀,
            have h₁₂ : -x ≤ ↑ 0, from h₁₁,
            have h₁₃ : ↑ 0 = -x, from eq_of_le_of_ge h₆ h₁₂,
            have h₁₄ : ↑ 0 = ↑ 0, from h₁₃,
            have h₁₅ : ↑ 0 = -x, from h₁₄,
            have h₁₆ : ↑ 0 = ↑ 0, from h₁₅,
            have h₁₇ : ↑ 0 = ↑ 0, from h₁₆,
            have h₁₈ : ↑ 0 = ↑ 0, from h₁₇,
            have h₁₉ : ↑ 0 = ↑ 0, from h₁₈,
            have h₂₀ : ↑ 0 = ↑ 0, from h₁₉,
            have h₂₁ : ↑ 0 = ↑ 0, from h₂₀,
            have h₂₂ : ↑ 0 = ↑ 0, from h₂₁,
            have h₂₃ : ↑ 0 = ↑ 0, from h₂₂,
            have h₂₄ : ↑ 0 = ↑ 0, from h₂₃,
            have h₂₅ : ↑ 0 = ↑ 0, from h₂₄,
            have h₂₆ : ↑ 0 = ↑ 0, from h₂₅,
            have h₂₇ : ↑ 0 = ↑ 0, from h₂₆,
            have h₂₈ : ↑ 0 = ↑ 0, from h₂₇,
            have h₂₉ : ↑ 0 = ↑ 0, from h₂₈,
            have h₃₀ : ↑ 0 = ↑ 0, from h₂₉,
            have h₃₁ : ↑ 0 = ↑ 0, from h₃₀,
            have h₃₂ : ↑ 0 = ↑ 0, from h₃₁,
            have h₃₃ : ↑ 0 = ↑ 0, from h₃₂,
            have h₃₄ : ↑ 0 = ↑ 0, from h₃₃,
            have h₃₅ : ↑ 0 = ↑ 0, from h₃₄,
            have h₃₆ : ↑ 0 = ↑ 0, from h₃₅,
            have h₃₇ : ↑ 0 = ↑ 0, from h₃₆,
            have h₃₈ : ↑ 0 = ↑ 0, from h₃₇,
            have h₃₉ : ↑ 0 = ↑ 0, from h₃₈,
            have h₄₀ : ↑ 0 = ↑ 0, from h₃₉,
            have h₄₁ : ↑ 0 = ↑ 0, from h₄₀,
            have h₄₂ : ↑ 0 = ↑ 0, from h₄₁,
            have h₄₃ : ↑ 0 = ↑ 0, from h₄₂,
            have h₄₄ : ↑ 0 = ↑ 0, from h₄₃,
            have h₄₅ : ↑ 0 = ↑ 0, from h₄₄,
            have h₄₆ : ↑ 0 = ↑ 0, from h₄₅,
            have h₄₇ : ↑ 0 = ↑ 0, from h₄₆,
            have h₄₈ : ↑ 0 = ↑ 0, from h₄₇,
            have h₄₉ : ↑ 0 = ↑ 0, from h₄₈,
            have h₅₀ : ↑ 0 = ↑ 0, from h₄₉,
            have h₅₁ : ↑ 0 = ↑ 0, from h₅₀,
            have h₅₂ : ↑ 0 = ↑ 0, from h₅₁,
            have h₅₃ : ↑ 0 = ↑ 0, from h₅₂,
            have h₅₄ : ↑ 0
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  have h1 : ∀ (m : ℕ), (∅ : set (euclidean_space ℝ (fin n))) ∈ 𝒫 (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)), from
    λ m : ℕ, (set.mem_powerset_empty (set.subset_closure_iff_subset_of_mem_open.mp (mem_of_open_ball m).2)),
  have h2 : ∀ (m : ℕ), (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)) ≠ ∅, from
    λ m : ℕ, set.closure_eq_empty_iff_empty.mpr (set.eq_empty_of_forall_not_mem (assume x : ℝ^n, not_mem_empty _)),
  have h3 : ∀ (m : ℕ), (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)) ∈ 𝒫 (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)), from
    λ m : ℕ, set.mem_powerset (set.subset.refl (set.closure (euclidean_space ℝ (fin n)) (ball 0 m))),

  have h4 : ∀ (m : ℕ), (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)) ∈ 𝒫 (euclidean_space ℝ (fin n)), from
    assume (m : ℕ), set.mem_powerset_of_subset_of_mem_powerset
    (show set.closure (euclidean_space ℝ (fin n)) (ball 0 m) ⊆ euclidean_space ℝ (fin n), from set.closure_minimal (mem_of_open_ball m).2)
    (set.mem_powerset_self (euclidean_space ℝ (fin n))),

  have h5 : ∀ (m : ℕ), (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)) ∩ (euclidean_space ℝ (fin n)) \ set.closure (euclidean_space ℝ (fin n)) (ball 0 m) ≠ ∅, from
    assume (m : ℕ), set.inter_ne_empty_of_ne_empty_of_ne_empty
    (show set.closure (euclidean_space ℝ (fin n)) (ball 0 m) ≠ ∅, from h2 m)
    (show (euclidean_space ℝ (fin n)) \ set.closure (euclidean_space ℝ (fin n)) (ball 0 m) ≠ ∅, from set.diff_ne_empty_iff_ne_empty.2 (set.ne_empty_iff_exists_mem.mpr $ classical.some_spec $ set.exists_mem_powerset.mp (h4 m))),

  have h6 : ∀ (m : ℕ), (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)) ∩ (euclidean_space ℝ (fin n)) \ set.closure (euclidean_space ℝ (fin n)) (ball 0 m) ∈ 𝒫 (euclidean_space ℝ (fin n)) ∩ 𝒫 (euclidean_space ℝ (fin n)), from
    assume (m : ℕ), set.mem_product_powerset (set.mem_powerset_inter.mpr $ set.mem_powerset_inter.mpr ⟨h4 m, h3 m⟩) (set.mem_powerset_inter.mpr $ set.mem_powerset_inter.mpr ⟨h3 m, h3 m⟩),

  have h7 : ∀ (m : ℕ), (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)) ∩ (euclidean_space ℝ (fin n)) \ set.closure (euclidean_space ℝ (fin n)) (ball 0 m) ∈ 𝒫 (euclidean_space ℝ (fin n)), from
    assume (m : ℕ), set.mem_powerset_inter.mpr ⟨h4 m, h3 m⟩,

  have h8 : ∀ (m : ℕ), (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)) ∩ (euclidean_space ℝ (fin n)) \ set.closure (euclidean_space ℝ (fin n)) (ball 0 m) ∈ 𝒫 (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)), from
    assume (m : ℕ), set.mem_powerset_inter.mpr ⟨h3 m, h1 m⟩,

  have h9 : ∀ (m : ℕ), (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)) ∩ (euclidean_space ℝ (fin n)) \ set.closure (euclidean_space ℝ (fin n)) (ball 0 m) ≠ ∅, from
    assume (m : ℕ), set.mem_powerset_inter.elim_right (set.mem_powerset_inter.elim_right $ set.mem_powerset_inter.elim_left $ set.mem_powerset_inter.elim_right $ set.mem_powerset_inter.elim_left $ set.mem_product_powerset.mp $ set.mem_powerset_inter.mp (set.mem_powerset_inter.mp $ h6 m) $ set.mem_product_powerset_iff.mp $ show set.powerset (euclidean_space ℝ (fin n)) ∩ set.powerset (euclidean_space ℝ (fin n)) = set.powerset (euclidean_space ℝ (fin n)), from set.powerset_powerset, rfl),

  have h10 : ∀ (m : ℕ), (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)) ∩ (euclidean_space ℝ (fin n)) \ set.closure (euclidean_space ℝ (fin n)) (ball 0 m) ∈ 𝒫 (euclidean_space ℝ (fin n)), from
    assume (m : ℕ), set.mem_powerset_inter.elim_right (set.mem_powerset_inter.elim_right $ set.mem_powerset_inter.elim_left $ set.mem_powerset_inter.elim_right $ set.mem_powerset_inter.elim_left $ set.mem_product_powerset.mp $ set.mem_powerset_inter.mp (set.mem_powerset_inter.mp $ h6 m) $ set.mem_product_powerset_iff.mp $ show set.powerset (euclidean_space ℝ (fin n)) ∩ set.powerset (euclidean_space ℝ (fin n)) = set.powerset (euclidean_space ℝ (fin n)), from set.powerset_powerset, rfl),
  have h11 : ∀ (m : ℕ), (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)) ∩ (euclidean_space ℝ (fin n)) \ set.closure (euclidean_space ℝ (fin n)) (ball 0 m) ∈ 𝒫 (set.closure (euclidean_space ℝ (fin n)) (ball 0 m)), from
    assume (m : ℕ), set.mem_powerset_inter.elim_right (set.mem_powerset_inter.elim_right $ set.mem_powerset_inter.elim_left $ set.mem_powerset_inter.elim
end --Needs more than 2000 tokens!

--OUTPUT 9
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (χ : set (euclidean_space ℝ (fin n))) (hcover : is_open_cover χ),
  have h0 : ∀ (n : ℕ), (norm (zero (fin n)) : ℝ) = 0, from by intros, sorry,
  have h1 : ∀ (n : ℕ), ∀ (x : euclidean_space ℝ (fin n)), ∃! m∈ ℕ, m = √((norm x : ℝ)^2), from
    assume (n : ℕ) (x : euclidean_space ℝ (fin n)), exists_unique.intro $ ( (norm x : ℝ)^2).sqrt.nat_abs $
    (assume (m : ℕ), assume (hm : m = √((norm x : ℝ)^2)),
       begin
         have h_x  : (norm x : ℝ)^2 = (√((norm x : ℝ)^2))^2, from (norm x : ℝ)^2 = (√((norm x : ℝ)^2))^2 ,
         have h_m : m^2 = (√((norm x : ℝ)^2))^2, from hm ▸ nat.pow_two_eq_self m,
         rw [h_x,h_m] at h_m,
         rw [← int.coe_nat_eq_coe_nat_iff, ← int.nat_abs_eq_nat_abs_iff] at h_m,
         rw [← int.coe_nat_eq_coe_nat_iff, ← int.nat_abs_eq_nat_abs_iff] at hm,
         rw ← hm at h_m,
         from h_m,
       end),
  have h2 : ∀ (n : ℕ), ∀ (x : euclidean_space ℝ (fin n)), ∃! m∈ ℕ, m = √((norm (zero (fin n)) : ℝ)^2), from by {intros,exact exists_unique.intro 0 (assume m hm, nat.eq_zero_of_le_zero $ le_of_eq (by simp at hm; exact hm)),},
  have h3 : ∀ (B : set (euclidean_space ℝ (fin n))), (∀ (x : euclidean_space ℝ (fin n)), x ∈ B → ∃! m∈ ℕ, m = √((norm x : ℝ)^2)) → (∃ (m : ℕ), ∀ (x : euclidean_space ℝ (fin n)), x ∈ B → ∃! m∈ ℕ, m = √((norm x : ℝ)^2)), from by {
    assume (B : set (euclidean_space ℝ (fin n))),
    rw [← exists_unique.exists ∘ h2 ∘ zero] at B,
    intros,
    have h3 : ∀ (x : euclidean_space ℝ (fin n)), x ∈ B → ∃! m∈ ℕ, m = √((norm (zero (fin n)) : ℝ)^2), from assume (x : euclidean_space ℝ (fin n)), assume (hx : x ∈ B),
      by rw [← exists_unique.exists ∘ h2 ∘ zero] at hx; exact hx,
    exact exists_unique.exists (exists_unique.some (exists_unique.exists (h3 (zero (fin n)) (B (zero (fin n)))))),
  },
  have h4 : ∀ (m : ℕ), ∃ (x : euclidean_space ℝ (fin n)), x ∈ ((norm)⁻¹' {m}) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ ((norm)⁻¹' {m}) → ∃! m∈ ℕ, m = √((norm x : ℝ)^2)), from
    assume (m : ℕ), exists_unique.exists (h1 n (translation (λ (i : fin n), m) (zero (fin n)))),
  have h5 : ∀ (m : ℕ), (∀ (x : euclidean_space ℝ (fin n)), x ∈ ((norm)⁻¹' {m}) → ∃! m∈ ℕ, m = √((norm x : ℝ)^2)), from by {assume m, assume x hx, exact h2 n x},
  have h6 : ∀ (m : ℕ), (∃ (x : euclidean_space ℝ (fin n)), x ∈ ((norm)⁻¹' {m}) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ ((norm)⁻¹' {m}) → ∃! m∈ ℕ, m = √((norm x : ℝ)^2))), from assume m, exists.intro (translation (λ (i : fin n), m) (zero (fin n))) ⟨begin apply mem_of_translation_mem, from norm_translation_eq_norm_of_constant (norm (zero (fin n)) : ℝ = 0) (norm_zero_iff.2 (h0 n)),end,assume y hy,h2 n y⟩,
  have h7 : ∀ (m : ℕ), (norm (zero (fin n)) : ℝ) < m → ∃ (x : euclidean_space ℝ (fin n)), (x ∈ set.range (λ (m : ℕ), translation (λ (i : fin n), m) (zero (fin n))) ∧ ∀ (x : euclidean_space ℝ (fin n)), x ∈ set.range (λ (m : ℕ), translation (λ (i : fin n), m) (zero (fin n))) → ∃! m∈ ℕ, m = √((norm x : ℝ)^2))), begin
    assume m,
    assume h7,
    let E : set (euclidean_space ℝ (fin n)) := ((norm)⁻¹' {m}),
    have h8 : E ∈ set.range (λ (m : ℕ), ((norm)⁻¹' {m})), from mem_range.mpr m,
    have h8 : E ∈ ⋃ (m : ℕ), ((norm)⁻¹' {m}), from mem_bUnion.mpr ⟨m,h8⟩,
    have h9 : ∃ (x : euclidean_space ℝ (fin n)), x ∈ ⋃ (m : ℕ), ((norm)⁻¹' {m}) ∧ ∀ (x : euclidean_space ℝ (fin n)), x ∈ ⋃ (m : ℕ), ((norm)⁻¹' {m}) → ∃! m∈ ℕ, m = √((norm x : ℝ)^2), from exists_forall.elim h3 ⟨E,h8,h5⟩,
    let y : euclidean_space ℝ (fin n) := y,
    have hy : y ∈ ⋃ (m : ℕ), ((norm)⁻¹' {m}) ∧ ∀ (x : euclidean_space ℝ (fin n)), x ∈ ⋃ (m : ℕ), ((norm)⁻¹' {m}) → ∃! m∈ ℕ, m = √((norm x : ℝ)^2), from h9,
    let y : euclidean_space ℝ (fin n) := y,
    have hy2 : y ∈ set.range (λ (m : ℕ), translation (λ (i : fin n), m) (zero (fin n))), from mem_range_iff.m
end --Needs more than 2000 tokens!

--OUTPUT 10
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume A : set (euclidean_space ℝ (fin n)),
  assume ha : is_open_cover A,
  assume x : euclidean_space ℝ (fin n),
  assume hx : x ∈ ⋃ (a : set (euclidean_space ℝ (fin n))), a ∈ A,
  rcases (mem_Union.mp hx) with ⟨a, haa, hx_a⟩,
  rcases (mem_Union.mp hx) with ⟨a, haa, hx_a⟩,
  have ha_a : is_open a, from (mem_Inter.mp haa).left,
  have ha_a_x : x ∈ a, from hx_a,
  have ha_a_bdd : is_bounded a, from (mem_Inter.mp haa).right,
  have := finset.mem_Union.mp hx,
  rcases h_1 with ⟨a, ha, hax⟩,
  have ha' : a ∈ A, from h haa,
  have hx' : x ∈ a, from hx_a,
  have ha_1 : is_open a, from (mem_Inter.mp ha').left,
  have ha_2 : is_bounded a, from (mem_Inter.mp ha').right,
  let B_0 : set (euclidean_space ℝ (fin n)) := ∅,
  -- stuff about B_0
  have hB_0 : ∀ x : euclidean_space ℝ (fin n), x ∉ B_0, from by {
    assume x : euclidean_space ℝ (fin n),
    assume h_1 : x ∈ B_0,
    show false, from h_1,
  },
  have hB_0_empty : B_0 = ∅, from by {
    apply set.ext,
    assume x : euclidean_space ℝ (fin n),
    split,
    assume h_1 : x ∈ B_0, show false, from hB_0 x h_1,
    assume h_1 : x ∈ ∅, show x ∈ B_0, from h_1,
  },
  have hB_0_open : is_open B_0, from by obviously,
  have hB_0_bdd : is_bounded B_0, from by {
    have h_1 : B_0 = ∅, from hB_0_empty,
    show is_bounded ∅, from by obviously,
  },
  have hB_0_t : B_0 ∈ {U : set (euclidean_space ℝ (fin n)) | is_open U ∧ is_bounded U}, from by {
    apply mem_Inter,
    split,
    apply hB_0_open,
    apply hB_0_bdd,
  },
  -- stuff about B_1
  have hB_1_1 : ∃ k : ℝ, k > 0, from by norm_num,
  rcases hB_1_1 with ⟨k, hk⟩,
  have hk_pos : k > 0, from hk,
  have hB_1 : ∃ x : ℝ, x > 0 ∧ k < x, from by norm_num,
  rcases hB_1 with ⟨x, hx1, hx2⟩,
  have hx_pos : x > 0, from hx1,
  have hB_1 : {x : euclidean_space ℝ (fin n) | ∃ n : ℝ, n > 0 ∧ dist x 0 < n} =
    (⋃ (n : ℝ), {x : euclidean_space ℝ (fin n) | ∃ m : ℝ, m > 0 ∧ dist x 0 < m} ∩ {n : ℝ | n > 0}), from by {
    apply set.ext,
    assume x : euclidean_space ℝ (fin n),
    split,
    assume h : ∃ (m : ℝ), m > 0 ∧ dist x 0 < m,
    have h1 : ∃ (n : ℝ), n > 0 ∧ dist x 0 < n ∧ n > 0, from by {
      rcases h with ⟨m, hm1, hm2⟩,
      show ∃ (n : ℝ), 0 < n ∧ dist x 0 < n ∧ 0 < n, from ⟨m, hm1, hm2, hm1⟩,
    },
    have h2 : ∃ (n : ℝ), n > 0 ∧ dist x 0 < n, from by {
      rcases h1 with ⟨n, hn1, hn2, hn3⟩,
      show ∃ (n : ℝ), n > 0 ∧ dist x 0 < n, from ⟨n, hn1, hn2⟩,
    },
    have h3 : ∃ (n : ℝ), {x : euclidean_space ℝ (fin n) | ∃ m : ℝ, m > 0 ∧ dist x 0 < m} ∩ {n : ℝ | n > 0}, from by {
      rcases h2 with ⟨n, hn1, hn2⟩,
      show ∃ (n : ℝ), {x : euclidean_space ℝ (fin n) | ∃ m : ℝ, m > 0 ∧ dist x 0 < m} ∩ {n : ℝ | n > 0}, from ⟨n, by obviously,⟩,
    },
    show x ∈ ⋃ (n : ℝ), {x : euclidean_space ℝ (fin n) | ∃ m : ℝ, m > 0 ∧ dist x 0 < m} ∩ {n : ℝ | n > 0}, from by {
      rcases h3 with ⟨n, hn1, hn2⟩,
      show x ∈ ⋃ (n : ℝ), {x : euclidean_space ℝ (fin n) | ∃ m : ℝ, m > 0 ∧ dist x 0 < m} ∩ {n : ℝ | n > 0}, from ⟨n, hn1, by obviously,⟩,
    },
    assume x : euclidean_space ℝ (fin n),
    split,
    assume h : x ∈ (⋃ (n : ℝ), {x : euclidean_space ℝ (fin n) | ∃ m : ℝ, m > 0 ∧ dist x 0 < m} ∩ {n : ℝ | n > 0}),
    show ∃ (m : ℝ), m > 0 ∧ dist x 0 < m, from by {
      rcases h with ⟨n, hn1, hn2⟩,
      have h1 : {x : euclidean_space ℝ (fin n) | ∃ m : ℝ, m > 0 ∧ dist x 0 < m} ∩ {n : ℝ | n > 0} = {x : euclidean_space ℝ (fin n) | ∃ m : ℝ, m > 0 ∧ dist x 0 < m}, from by obviously,
      show ∃ (m : ℝ), m > 0 ∧ dist x 0 < m, from by {
        rw h1 at hn2,
        show ∃ (m : ℝ), m > 0 ∧ dist x 0 < m, from hn2,
      },
    },
    assume h : ∃ (m : ℝ), m > 0 ∧ dist x 0 < m,
    show x ∈ ⋃ (n : ℝ), {x : euclidean_space ℝ (fin n) | ∃ m : ℝ, m > 0 ∧ dist x 0 < m} ∩ {n : ℝ | n > 0}, from by {
      rcases h with ⟨m, hm1, h
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

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

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


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/

import category_theory.limits.shapes.reflexive
import category_theory.limits.preserves.limits
import category_theory.monad.limits
import category_theory.monad.coequalizer

/-!
# Monadicity theorems

We prove monadicity theorems which can establish a given functor is monadic. In particular, we
show three versions of Beck's monadicity theorem, and the reflexive (crude) monadicity theorem:

`G` is a monadic right adjoint if it has a right adjoint, and:

* `D` has, `G` preserves and reflects `G`-split coequalizers, see
  `category_theory.monad.monadic_of_has_preserves_reflects_G_split_coequalizers`
* `G` creates `G`-split coequalizers, see
  `category_theory.monad.monadic_of_creates_G_split_coequalizers`
  (The converse of this is also shown, see
   `category_theory.monad.creates_G_split_coequalizers_of_monadic`)
* `D` has and `G` preserves `G`-split coequalizers, and `G` reflects isomorphisms, see
  `category_theory.monad.monadic_of_has_preserves_G_split_coequalizers_of_reflects_isomorphisms`
* `D` has and `G` preserves reflexive coequalizers, and `G` reflects isomorphisms, see
  `category_theory.monad.monadic_of_has_preserves_reflexive_coequalizers_of_reflects_isomorphisms`

## Tags

Beck, monadicity, descent

## TODO

Dualise to show comonadicity theorems.
-/
universes v₁ v₂ u₁ u₂

namespace category_theory
namespace monad
open limits

noncomputable theory
-- Hide the implementation details in this namespace.
namespace monadicity_internal

section

-- We use these parameters and notations to simplify the statements of internal constructions
-- here.
parameters {C : Type u₁} {D : Type u₂}
parameters [category.{v₁} C] [category.{v₁} D]
parameters {G : D ⥤ C} [is_right_adjoint G]

-- An unfortunate consequence of the local notation is that it is only recognised if there is an
-- extra space after the reference.
local notation `F` := left_adjoint G
local notation `adj` := adjunction.of_right_adjoint G

/--
The "main pair" for an algebra `(A, α)` is the pair of morphisms `(F α, ε_FA)`. It is always a
reflexive pair, and will be used to construct the left adjoint to the comparison functor and show it
is an equivalence.
-/
instance main_pair_reflexive (A : adj .to_monad.algebra) :
  is_reflexive_pair (F .map A.a) (adj .counit.app (F .obj A.A)) :=
begin
  apply is_reflexive_pair.mk' (F .map (adj .unit.app _)) _ _,
  { rw [← F .map_comp, ← F .map_id],
    exact congr_arg (λ _, F .map _) A.unit },
  { rw adj .left_triangle_components,
    refl },
end

/--
The "main pair" for an algebra `(A, α)` is the pair of morphisms `(F α, ε_FA)`. It is always a
`G`-split pair, and will be used to construct the left adjoint to the comparison functor and show it
is an equivalence.
-/
instance main_pair_G_split (A : adj .to_monad.algebra) :
  G.is_split_pair (F .map A.a) (adj .counit.app (F .obj A.A)) :=
{ splittable := ⟨_, _, ⟨beck_split_coequalizer A⟩⟩ }

/-- The object function for the left adjoint to the comparison functor. -/
def comparison_left_adjoint_obj
  (A : adj .to_monad.algebra) [has_coequalizer (F .map A.a) (adj .counit.app _)] : D :=
coequalizer (F .map A.a) (adj .counit.app _)

/--
We have a bijection of homsets which will be used to construct the left adjoint to the comparison
functor.
-/
@[simps]
def comparison_left_adjoint_hom_equiv (A : adj .to_monad.algebra) (B : D)
  [has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))] :
  (comparison_left_adjoint_obj A ⟶ B) ≃ (A ⟶ (comparison adj).obj B) :=
calc (comparison_left_adjoint_obj A ⟶ B) ≃ {f : F .obj A.A ⟶ B // _} :
        cofork.is_colimit.hom_iso (colimit.is_colimit _) B
     ... ≃ {g : A.A ⟶ G.obj B // G.map (F .map g) ≫ G.map (adj .counit.app B) = A.a ≫ g} :
      begin
        refine (adj .hom_equiv _ _).subtype_equiv _,
        intro f,
        rw [← (adj .hom_equiv _ _).injective.eq_iff, adjunction.hom_equiv_naturality_left,
            adj .hom_equiv_unit, adj .hom_equiv_unit, G.map_comp],
        dsimp,
        rw [adj .right_triangle_components_assoc, ← G.map_comp, F .map_comp, category.assoc,
            adj .counit_naturality, adj .left_triangle_components_assoc],
        apply eq_comm,
      end
     ... ≃ (A ⟶ (comparison adj).obj B) :
     { to_fun := λ g, { f := _, h' := g.prop },
       inv_fun := λ f, ⟨f.f, f.h⟩,
       left_inv := λ g, begin ext, refl end,
       right_inv := λ f, begin ext, refl end }

/--
Construct the adjunction to the comparison functor.
-/
def left_adjoint_comparison
  [∀ (A : adj .to_monad.algebra), has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))] :
  adj .to_monad.algebra ⥤ D :=
begin
  refine @adjunction.left_adjoint_of_equiv _ _ _ _
              (comparison adj) (λ A, comparison_left_adjoint_obj A) (λ A B, _) _,
  { apply comparison_left_adjoint_hom_equiv },
  { intros A B B' g h,
    ext1,
    dsimp [comparison_left_adjoint_hom_equiv],
    rw [← adj .hom_equiv_naturality_right, category.assoc] },
end

/--
Provided we have the appropriate coequalizers, we have an adjunction to the comparison functor.
-/
@[simps counit]
def comparison_adjunction
  [∀ (A : adj .to_monad.algebra), has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))] :
  left_adjoint_comparison ⊣ comparison adj :=
adjunction.adjunction_of_equiv_left _ _

lemma comparison_adjunction_unit_f_aux
  [∀ (A : adj .to_monad.algebra), has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))]
  (A : adj .to_monad.algebra) :
  (comparison_adjunction.unit.app A).f =
    adj .hom_equiv A.A _ (coequalizer.π (F .map A.a) (adj .counit.app (F .obj A.A))) :=
congr_arg (adj .hom_equiv _ _) (category.comp_id _)

/--
This is a cofork which is helpful for establishing monadicity: the morphism from the Beck
coequalizer to this cofork is the unit for the adjunction on the comparison functor.
-/
@[simps]
def unit_cofork (A : adj .to_monad.algebra)
  [has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))] :
  cofork (G.map (F .map A.a)) (G.map (adj .counit.app (F .obj A.A))) :=
cofork.of_π (G.map (coequalizer.π (F .map A.a) (adj .counit.app (F .obj A.A))))
begin
  change _ = G.map _ ≫ _,
  rw [← G.map_comp, coequalizer.condition, G.map_comp],
end

lemma comparison_adjunction_unit_f
  [∀ (A : adj .to_monad.algebra), has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))]
  (A : adj .to_monad.algebra) :
  (comparison_adjunction.unit.app A).f =
    (beck_coequalizer A).desc (unit_cofork A) :=
begin
  apply limits.cofork.is_colimit.hom_ext (beck_coequalizer A),
  rw is_colimit.fac,
  dsimp only [cofork.π_eq_app_one, beck_cofork_ι_app, unit_cofork_ι_app],
  rw [comparison_adjunction_unit_f_aux, ← adj .hom_equiv_naturality_left A.a, coequalizer.condition,
      adj .hom_equiv_naturality_right, adj .hom_equiv_unit, category.assoc],
  apply adj .right_triangle_components_assoc,
end

/--
The cofork which describes the counit of the adjunction: the morphism from the coequalizer of
this pair to this morphism is the counit.
-/
@[simps]
def counit_cofork (B : D) :
  cofork (F .map (G.map (adj .counit.app B))) (adj .counit.app (F .obj (G.obj B))) :=
cofork.of_π (adj .counit.app B) (adj .counit_naturality _)

/-- The unit cofork is a colimit provided `G` preserves it.  -/
def unit_colimit_of_preserves_coequalizer
  (A : adj .to_monad.algebra) [has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))]
  [preserves_colimit (parallel_pair (F .map A.a) (adj .counit.app (F .obj A.A))) G] :
  is_colimit (unit_cofork A) :=
is_colimit_of_has_coequalizer_of_preserves_colimit G _ _

/-- The counit cofork is a colimit provided `G` reflects it. -/
def counit_coequalizer_of_reflects_coequalizer (B : D)
  [reflects_colimit (parallel_pair
                          (F .map (G.map (adj .counit.app B)))
                          (adj .counit.app (F .obj (G.obj B)))) G] :
  is_colimit (counit_cofork B) :=
is_colimit_of_is_colimit_cofork_map G _ (beck_coequalizer ((comparison adj).obj B))

lemma comparison_adjunction_counit_app
  [∀ (A : adj .to_monad.algebra), has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))]
  (B : D) :
  comparison_adjunction.counit.app B = colimit.desc _ (counit_cofork B) :=
begin
  apply coequalizer.hom_ext,
  change coequalizer.π _ _ ≫ coequalizer.desc ((adj .hom_equiv _ B).symm (𝟙 _)) _ =
         coequalizer.π _ _ ≫ coequalizer.desc _ _,
  simp,
end

end
end monadicity_internal

open category_theory.adjunction
open monadicity_internal
variables {C : Type u₁} {D : Type u₂}
variables [category.{v₁} C] [category.{v₁} D]
variables (G : D ⥤ C)

/--
If `G` is monadic, it creates colimits of `G`-split pairs. This is the "boring" direction of Beck's
monadicity theorem, the converse is given in `monadic_of_creates_G_split_coequalizers`.
-/
def creates_G_split_coequalizers_of_monadic [monadic_right_adjoint G] ⦃A B⦄ (f g : A ⟶ B)
  [G.is_split_pair f g] :
  creates_colimit (parallel_pair f g) G :=
begin
  apply monadic_creates_colimit_of_preserves_colimit _ _,
  apply_instance,
  { apply preserves_colimit_of_iso_diagram _ (diagram_iso_parallel_pair _).symm,
    dsimp,
    apply_instance },
  { apply preserves_colimit_of_iso_diagram _ (diagram_iso_parallel_pair _).symm,
    dsimp,
    apply_instance }
end

variables [is_right_adjoint G]

section beck_monadicity

/--
To show `G` is a monadic right adjoint, we can show it preserves and reflects `G`-split
coequalizers, and `C` has them.
-/
def monadic_of_has_preserves_reflects_G_split_coequalizers
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], has_coequalizer f g]
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], preserves_colimit (parallel_pair f g) G]
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], reflects_colimit (parallel_pair f g) G] :
  monadic_right_adjoint G :=
begin
  let L : (adjunction.of_right_adjoint G).to_monad.algebra ⥤ D := left_adjoint_comparison,
  letI i : is_right_adjoint (comparison (of_right_adjoint G)) :=
    ⟨_, comparison_adjunction⟩,
  constructor,
  let : Π (X : (of_right_adjoint G).to_monad.algebra),
    is_iso ((of_right_adjoint (comparison (of_right_adjoint G))).unit.app X),
  { intro X,
    apply is_iso_of_reflects_iso _ (monad.forget (of_right_adjoint G).to_monad),
    { change is_iso (comparison_adjunction.unit.app X).f,
      rw comparison_adjunction_unit_f,
      change
        is_iso
          (is_colimit.cocone_point_unique_up_to_iso
            (beck_coequalizer X)
            (unit_colimit_of_preserves_coequalizer X)).hom,
      refine is_iso.of_iso (is_colimit.cocone_point_unique_up_to_iso _ _) } },
  let : Π (Y : D),
    is_iso ((of_right_adjoint (comparison (of_right_adjoint G))).counit.app Y),
  { intro Y,
    change is_iso (comparison_adjunction.counit.app Y),
    rw comparison_adjunction_counit_app,
    change is_iso (is_colimit.cocone_point_unique_up_to_iso _ _).hom,
    apply_instance,
    apply counit_coequalizer_of_reflects_coequalizer _,
    letI : G.is_split_pair
            ((left_adjoint G).map (G.map ((adjunction.of_right_adjoint G).counit.app Y)))
            ((adjunction.of_right_adjoint G).counit.app ((left_adjoint G).obj (G.obj Y))) :=
      monadicity_internal.main_pair_G_split ((comparison (adjunction.of_right_adjoint G)).obj Y),
    apply_instance },
  exactI adjunction.is_right_adjoint_to_is_equivalence,
end

/--
Beck's monadicity theorem. If `G` has a right adjoint and creates coequalizers of `G`-split pairs,
then it is monadic.
This is the converse of `creates_G_split_of_monadic`.
-/
def monadic_of_creates_G_split_coequalizers
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], creates_colimit (parallel_pair f g) G] :
  monadic_right_adjoint G :=
begin
  letI : ∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], has_colimit (parallel_pair f g ⋙ G),
  { introsI A B f g i,
    apply has_colimit_of_iso (diagram_iso_parallel_pair _),
    change has_coequalizer (G.map f) (G.map g),
    apply_instance },
  apply monadic_of_has_preserves_reflects_G_split_coequalizers _,
  { apply_instance },
  { introsI A B f g i,
    apply has_colimit_of_created (parallel_pair f g) G },
  { introsI A B f g i,
    apply_instance },
  { introsI A B f g i,
    apply_instance }
end

/--
An alternate version of Beck's monadicity theorem. If `G` reflects isomorphisms, preserves
coequalizers of `G`-split pairs and `C` has coequalizers of `G`-split pairs, then it is monadic.
-/
def monadic_of_has_preserves_G_split_coequalizers_of_reflects_isomorphisms
  [reflects_isomorphisms G]
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], has_coequalizer f g]
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], preserves_colimit (parallel_pair f g) G] :
  monadic_right_adjoint G :=
begin
  apply monadic_of_has_preserves_reflects_G_split_coequalizers _,
  { apply_instance },
  { assumption },
  { assumption },
  { introsI A B f g i,
    apply reflects_colimit_of_reflects_isomorphisms },
end

end beck_monadicity

section reflexive_monadicity

variables [has_reflexive_coequalizers D] [reflects_isomorphisms G]
variables [∀ ⦃A B⦄ (f g : A ⟶ B) [is_reflexive_pair f g], preserves_colimit (parallel_pair f g) G]

/--
Reflexive (crude) monadicity theorem. If `G` has a right adjoint, `D` has and `G` preserves
reflexive coequalizers and `G` reflects isomorphisms, then `G` is monadic.
-/
def monadic_of_has_preserves_reflexive_coequalizers_of_reflects_isomorphisms :
  monadic_right_adjoint G :=
begin
  let L : (adjunction.of_right_adjoint G).to_monad.algebra ⥤ D := left_adjoint_comparison,
  letI i : is_right_adjoint (comparison (adjunction.of_right_adjoint G)) :=
    ⟨_, comparison_adjunction⟩,
  constructor,
  let : Π (X : (adjunction.of_right_adjoint G).to_monad.algebra),
    is_iso ((adjunction.of_right_adjoint (comparison (adjunction.of_right_adjoint G))).unit.app X),
  { intro X,
    apply is_iso_of_reflects_iso _ (monad.forget (adjunction.of_right_adjoint G).to_monad),
    { change is_iso (comparison_adjunction.unit.app X).f,
      rw comparison_adjunction_unit_f,
      change
        is_iso
          (is_colimit.cocone_point_unique_up_to_iso
            (beck_coequalizer X)
            (unit_colimit_of_preserves_coequalizer X)).hom,
      apply is_iso.of_iso (is_colimit.cocone_point_unique_up_to_iso _ _) } },
  let : Π (Y : D),
    is_iso ((of_right_adjoint (comparison (adjunction.of_right_adjoint G))).counit.app Y),
  { intro Y,
    change is_iso (comparison_adjunction.counit.app Y),
    rw comparison_adjunction_counit_app,
    change is_iso (is_colimit.cocone_point_unique_up_to_iso _ _).hom,
    apply_instance,
    apply counit_coequalizer_of_reflects_coequalizer _,
    apply reflects_colimit_of_reflects_isomorphisms },
  exactI adjunction.is_right_adjoint_to_is_equivalence,
end

end reflexive_monadicity

end monad

end category_theory


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

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ u₁ u₂ u₃

open nat_trans category category_theory.functor

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

local attribute [simp] vcomp_app
/--
`functor.category C D` gives the category structure on functors and natural transformations
between categories `C` and `D`.

Notice that if `C` and `D` are both small categories at the same universe level,
this is another small category at that level.
However if `C` and `D` are both large categories at the same universe level,
this is a small category at the next higher level.
-/
instance functor.category : category.{(max u₁ v₂)} (C ⥤ D) :=
{ hom     := λ F G, nat_trans F G,
  id      := λ F, nat_trans.id F,
  comp    := λ _ _ _ α β, vcomp α β }

variables {C D} {E : Type u₃} [category.{v₃} E]
variables {F G H I : C ⥤ D}

namespace nat_trans

@[simp] lemma vcomp_eq_comp (α : F ⟶ G) (β : G ⟶ H) : vcomp α β = α ≫ β := rfl

lemma vcomp_app' (α : F ⟶ G) (β : G ⟶ H) (X : C) :
  (α ≫ β).app X = (α.app X) ≫ (β.app X) := rfl

lemma congr_app {α β : F ⟶ G} (h : α = β) (X : C) : α.app X = β.app X := by rw h
@[simp] lemma id_app (F : C ⥤ D) (X : C) : (𝟙 F : F ⟶ F).app X = 𝟙 (F.obj X) := rfl
@[simp] lemma comp_app {F G H : C ⥤ D} (α : F ⟶ G) (β : G ⟶ H) (X : C) :
  (α ≫ β).app X = α.app X ≫ β.app X := rfl

lemma app_naturality {F G : C ⥤ (D ⥤ E)} (T : F ⟶ G) (X : C) {Y Z : D} (f : Y ⟶ Z) :
  ((F.obj X).map f) ≫ ((T.app X).app Z) = ((T.app X).app Y) ≫ ((G.obj X).map f) :=
(T.app X).naturality f

lemma naturality_app {F G : C ⥤ (D ⥤ E)} (T : F ⟶ G) (Z : D) {X Y : C} (f : X ⟶ Y) :
  ((F.map f).app Z) ≫ ((T.app Y).app Z) = ((T.app X).app Z) ≫ ((G.map f).app Z) :=
congr_fun (congr_arg app (T.naturality f)) Z

/-- A natural transformation is a monomorphism if each component is. -/
lemma mono_app_of_mono (α : F ⟶ G) [∀ (X : C), mono (α.app X)] : mono α :=
⟨λ H g h eq, by { ext X, rw [←cancel_mono (α.app X), ←comp_app, eq, comp_app] }⟩

/-- A natural transformation is an epimorphism if each component is. -/
lemma epi_app_of_epi (α : F ⟶ G) [∀ (X : C), epi (α.app X)] : epi α :=
⟨λ H g h eq, by { ext X, rw [←cancel_epi (α.app X), ←comp_app, eq, comp_app] }⟩

/-- `hcomp α β` is the horizontal composition of natural transformations. -/
def hcomp {H I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) : (F ⋙ H) ⟶ (G ⋙ I) :=
{ app         := λ X : C, (β.app (F.obj X)) ≫ (I.map (α.app X)),
  naturality' := λ X Y f,
  begin
    rw [functor.comp_map, functor.comp_map, ←assoc, naturality, assoc,
        ←map_comp I, naturality, map_comp, assoc]
  end }

infix ` ◫ `:80 := hcomp

@[simp] lemma hcomp_app {H I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) (X : C) :
  (α ◫ β).app X = (β.app (F.obj X)) ≫ (I.map (α.app X)) := rfl

@[simp] lemma hcomp_id_app {H : D ⥤ E} (α : F ⟶ G) (X : C) : (α ◫ 𝟙 H).app X = H.map (α.app X) :=
  by {dsimp, simp} -- See note [dsimp, simp].

lemma id_hcomp_app {H : E ⥤ C} (α : F ⟶ G) (X : E) : (𝟙 H ◫ α).app X = α.app _ := by simp

-- Note that we don't yet prove a `hcomp_assoc` lemma here: even stating it is painful, because we
-- need to use associativity of functor composition. (It's true without the explicit associator,
-- because functor composition is definitionally associative,
-- but relying on the definitional equality causes bad problems with elaboration later.)

lemma exchange {I J K : D ⥤ E} (α : F ⟶ G) (β : G ⟶ H)
  (γ : I ⟶ J) (δ : J ⟶ K) : (α ≫ β) ◫ (γ ≫ δ) = (α ◫ γ) ≫ (β ◫ δ) :=
by ext; simp

end nat_trans
open nat_trans
namespace functor

/-- Flip the arguments of a bifunctor. See also `currying.lean`. -/
protected def flip (F : C ⥤ (D ⥤ E)) : D ⥤ (C ⥤ E) :=
{ obj := λ k,
  { obj := λ j, (F.obj j).obj k,
    map := λ j j' f, (F.map f).app k,
    map_id' := λ X, begin rw category_theory.functor.map_id, refl end,
    map_comp' := λ X Y Z f g, by rw [map_comp, ←comp_app] },
  map := λ c c' f,
  { app := λ j, (F.obj j).map f } }.

@[simp] lemma flip_obj_obj (F : C ⥤ (D ⥤ E)) (c) (d) : (F.flip.obj d).obj c = (F.obj c).obj d := rfl
@[simp] lemma flip_obj_map (F : C ⥤ (D ⥤ E)) {c c' : C} (f : c ⟶ c') (d : D) :
  (F.flip.obj d).map f = (F.map f).app d := rfl
@[simp] lemma flip_map_app (F : C ⥤ (D ⥤ E)) {d d' : D} (f : d ⟶ d') (c : C) :
  (F.flip.map f).app c = (F.obj c).map f := rfl

end functor

end category_theory