/-
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 category_theory.preadditive.projective_resolution
! leanprover-community/mathlib commit 324a7502510e835cdbd3de1519b6c66b51fb2467
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Preadditive.Projective
import Mathbin.Algebra.Homology.Single
import Mathbin.Algebra.Homology.HomotopyCategory

/-!
# Projective resolutions

A projective resolution `P : ProjectiveResolution Z` of an object `Z : C` consists of
a `ℕ`-indexed chain complex `P.complex` of projective objects,
along with a chain map `P.π` from `C` to the chain complex consisting just of `Z` in degree zero,
so that the augmented chain complex is exact.

When `C` is abelian, this exactness condition is equivalent to `π` being a quasi-isomorphism.
It turns out that this formulation allows us to set up the basic theory of derived functors
without even assuming `C` is abelian.

(Typically, however, to show `has_projective_resolutions C`
one will assume `enough_projectives C` and `abelian C`.
This construction appears in `category_theory.abelian.projectives`.)

We show that given `P : ProjectiveResolution X` and `Q : ProjectiveResolution Y`,
any morphism `X ⟶ Y` admits a lift to a chain map `P.complex ⟶ Q.complex`.
(It is a lift in the sense that
the projection maps `P.π` and `Q.π` intertwine the lift and the original morphism.)

Moreover, we show that any two such lifts are homotopic.

As a consequence, if every object admits a projective resolution,
we can construct a functor `projective_resolutions C : C ⥤ homotopy_category C`.
-/

noncomputable section

open CategoryTheory

open CategoryTheory.Limits

universe v u

namespace CategoryTheory

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

open Projective

section

variable [HasZeroObject C] [HasZeroMorphisms C] [HasEqualizers C] [HasImages C]

/--
A `ProjectiveResolution Z` consists of a bundled `ℕ`-indexed chain complex of projective objects,
along with a quasi-isomorphism to the complex consisting of just `Z` supported in degree `0`.

(We don't actually ask here that the chain map is a quasi-iso, just exactness everywhere:
that `π` is a quasi-iso is a lemma when the category is abelian.
Should we just ask for it here?)

Except in situations where you want to provide a particular projective resolution
(for example to compute a derived functor),
you will not typically need to use this bundled object, and will instead use
* `projective_resolution Z`: the `ℕ`-indexed chain complex
  (equipped with `projective` and `exact` instances)
* `projective_resolution.π Z`: the chain map from `projective_resolution Z` to
  `(single C _ 0).obj Z` (all the components are equipped with `epi` instances,
  and when the category is `abelian` we will show `π` is a quasi-iso).
-/
@[nolint has_nonempty_instance]
structure ProjectiveResolution (Z : C) where
  complex : ChainComplex C ℕ
  π : HomologicalComplex.Hom Complex ((ChainComplex.single₀ C).obj Z)
  Projective : ∀ n, Projective (Complex.pt n) := by infer_instance
  exact₀ : Exact (Complex.d 1 0) (π.f 0)
  exact : ∀ n, Exact (Complex.d (n + 2) (n + 1)) (Complex.d (n + 1) n)
  Epi : Epi (π.f 0) := by infer_instance
#align category_theory.ProjectiveResolution CategoryTheory.ProjectiveResolution

attribute [instance] ProjectiveResolution.projective ProjectiveResolution.epi

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`out] [] -/
/-- An object admits a projective resolution.
-/
class HasProjectiveResolution (Z : C) : Prop where
  out : Nonempty (ProjectiveResolution Z)
#align category_theory.has_projective_resolution CategoryTheory.HasProjectiveResolution

section

variable (C)

/-- You will rarely use this typeclass directly: it is implied by the combination
`[enough_projectives C]` and `[abelian C]`.
By itself it's enough to set up the basic theory of derived functors.
-/
class HasProjectiveResolutions : Prop where
  out : ∀ Z : C, HasProjectiveResolution Z
#align category_theory.has_projective_resolutions CategoryTheory.HasProjectiveResolutions

attribute [instance] has_projective_resolutions.out

end

namespace ProjectiveResolution

@[simp]
theorem π_f_succ {Z : C} (P : ProjectiveResolution Z) (n : ℕ) : P.π.f (n + 1) = 0 :=
  by
  apply zero_of_target_iso_zero
  dsimp; rfl
#align category_theory.ProjectiveResolution.π_f_succ CategoryTheory.ProjectiveResolution.π_f_succ

@[simp]
theorem complex_d_comp_π_f_zero {Z : C} (P : ProjectiveResolution Z) :
    P.complex.d 1 0 ≫ P.π.f 0 = 0 :=
  P.exact₀.w
#align category_theory.ProjectiveResolution.complex_d_comp_π_f_zero CategoryTheory.ProjectiveResolution.complex_d_comp_π_f_zero

@[simp]
theorem complex_d_succ_comp {Z : C} (P : ProjectiveResolution Z) (n : ℕ) :
    P.complex.d (n + 2) (n + 1) ≫ P.complex.d (n + 1) n = 0 :=
  (P.exact _).w
#align category_theory.ProjectiveResolution.complex_d_succ_comp CategoryTheory.ProjectiveResolution.complex_d_succ_comp

instance {Z : C} (P : ProjectiveResolution Z) (n : ℕ) : CategoryTheory.Epi (P.π.f n) := by
  cases n <;> infer_instance

/-- A projective object admits a trivial projective resolution: itself in degree 0. -/
def self (Z : C) [CategoryTheory.Projective Z] : ProjectiveResolution Z
    where
  complex := (ChainComplex.single₀ C).obj Z
  π := 𝟙 ((ChainComplex.single₀ C).obj Z)
  Projective n := by
    cases n
    · dsimp
      infer_instance
    · dsimp
      infer_instance
  exact₀ := by
    dsimp
    exact exact_zero_mono _
  exact n := by
    dsimp
    exact exact_of_zero _ _
  Epi := by
    dsimp
    infer_instance
#align category_theory.ProjectiveResolution.self CategoryTheory.ProjectiveResolution.self

/-- Auxiliary construction for `lift`. -/
def liftFZero {Y Z : C} (f : Y ⟶ Z) (P : ProjectiveResolution Y) (Q : ProjectiveResolution Z) :
    P.complex.pt 0 ⟶ Q.complex.pt 0 :=
  factorThru (P.π.f 0 ≫ f) (Q.π.f 0)
#align category_theory.ProjectiveResolution.lift_f_zero CategoryTheory.ProjectiveResolution.liftFZero

/-- Auxiliary construction for `lift`. -/
def liftFOne {Y Z : C} (f : Y ⟶ Z) (P : ProjectiveResolution Y) (Q : ProjectiveResolution Z) :
    P.complex.pt 1 ⟶ Q.complex.pt 1 :=
  Exact.lift (P.complex.d 1 0 ≫ liftFZero f P Q) (Q.complex.d 1 0) (Q.π.f 0) Q.exact₀
    (by simp [lift_f_zero, P.exact₀.w_assoc])
#align category_theory.ProjectiveResolution.lift_f_one CategoryTheory.ProjectiveResolution.liftFOne

/-- Auxiliary lemma for `lift`. -/
@[simp]
theorem liftFOne_zero_comm {Y Z : C} (f : Y ⟶ Z) (P : ProjectiveResolution Y)
    (Q : ProjectiveResolution Z) :
    liftFOne f P Q ≫ Q.complex.d 1 0 = P.complex.d 1 0 ≫ liftFZero f P Q :=
  by
  dsimp [lift_f_zero, lift_f_one]
  simp
#align category_theory.ProjectiveResolution.lift_f_one_zero_comm CategoryTheory.ProjectiveResolution.liftFOne_zero_comm

/-- Auxiliary construction for `lift`. -/
def liftFSucc {Y Z : C} (P : ProjectiveResolution Y) (Q : ProjectiveResolution Z) (n : ℕ)
    (g : P.complex.pt n ⟶ Q.complex.pt n) (g' : P.complex.pt (n + 1) ⟶ Q.complex.pt (n + 1))
    (w : g' ≫ Q.complex.d (n + 1) n = P.complex.d (n + 1) n ≫ g) :
    Σ'g'' : P.complex.pt (n + 2) ⟶ Q.complex.pt (n + 2),
      g'' ≫ Q.complex.d (n + 2) (n + 1) = P.complex.d (n + 2) (n + 1) ≫ g' :=
  ⟨Exact.lift (P.complex.d (n + 2) (n + 1) ≫ g') (Q.complex.d (n + 2) (n + 1))
      (Q.complex.d (n + 1) n) (Q.exact _) (by simp [w]),
    by simp⟩
#align category_theory.ProjectiveResolution.lift_f_succ CategoryTheory.ProjectiveResolution.liftFSucc

/-- A morphism in `C` lifts to a chain map between projective resolutions. -/
def lift {Y Z : C} (f : Y ⟶ Z) (P : ProjectiveResolution Y) (Q : ProjectiveResolution Z) :
    P.complex ⟶ Q.complex :=
  ChainComplex.mkHom _ _ (liftFZero f _ _) (liftFOne f _ _) (liftFOne_zero_comm f _ _)
    fun n ⟨g, g', w⟩ => liftFSucc P Q n g g' w
#align category_theory.ProjectiveResolution.lift CategoryTheory.ProjectiveResolution.lift

/-- The resolution maps intertwine the lift of a morphism and that morphism. -/
@[simp, reassoc.1]
theorem lift_commutes {Y Z : C} (f : Y ⟶ Z) (P : ProjectiveResolution Y)
    (Q : ProjectiveResolution Z) : lift f P Q ≫ Q.π = P.π ≫ (ChainComplex.single₀ C).map f :=
  by
  ext
  dsimp [lift, lift_f_zero]
  apply factor_thru_comp
#align category_theory.ProjectiveResolution.lift_commutes CategoryTheory.ProjectiveResolution.lift_commutes

-- Now that we've checked this property of the lift,
-- we can seal away the actual definition.
end ProjectiveResolution

end

namespace ProjectiveResolution

variable [HasZeroObject C] [Preadditive C] [HasEqualizers C] [HasImages C]

/-- An auxiliary definition for `lift_homotopy_zero`. -/
def liftHomotopyZeroZero {Y Z : C} {P : ProjectiveResolution Y} {Q : ProjectiveResolution Z}
    (f : P.complex ⟶ Q.complex) (comm : f ≫ Q.π = 0) : P.complex.pt 0 ⟶ Q.complex.pt 1 :=
  Exact.lift (f.f 0) (Q.complex.d 1 0) (Q.π.f 0) Q.exact₀
    (congr_fun (congr_arg HomologicalComplex.Hom.f comm) 0)
#align category_theory.ProjectiveResolution.lift_homotopy_zero_zero CategoryTheory.ProjectiveResolution.liftHomotopyZeroZero

/-- An auxiliary definition for `lift_homotopy_zero`. -/
def liftHomotopyZeroOne {Y Z : C} {P : ProjectiveResolution Y} {Q : ProjectiveResolution Z}
    (f : P.complex ⟶ Q.complex) (comm : f ≫ Q.π = 0) : P.complex.pt 1 ⟶ Q.complex.pt 2 :=
  Exact.lift (f.f 1 - P.complex.d 1 0 ≫ liftHomotopyZeroZero f comm) (Q.complex.d 2 1)
    (Q.complex.d 1 0) (Q.exact _) (by simp [lift_homotopy_zero_zero])
#align category_theory.ProjectiveResolution.lift_homotopy_zero_one CategoryTheory.ProjectiveResolution.liftHomotopyZeroOne

/-- An auxiliary definition for `lift_homotopy_zero`. -/
def liftHomotopyZeroSucc {Y Z : C} {P : ProjectiveResolution Y} {Q : ProjectiveResolution Z}
    (f : P.complex ⟶ Q.complex) (n : ℕ) (g : P.complex.pt n ⟶ Q.complex.pt (n + 1))
    (g' : P.complex.pt (n + 1) ⟶ Q.complex.pt (n + 2))
    (w : f.f (n + 1) = P.complex.d (n + 1) n ≫ g + g' ≫ Q.complex.d (n + 2) (n + 1)) :
    P.complex.pt (n + 2) ⟶ Q.complex.pt (n + 3) :=
  Exact.lift (f.f (n + 2) - P.complex.d (n + 2) (n + 1) ≫ g') (Q.complex.d (n + 3) (n + 2))
    (Q.complex.d (n + 2) (n + 1)) (Q.exact _) (by simp [w])
#align category_theory.ProjectiveResolution.lift_homotopy_zero_succ CategoryTheory.ProjectiveResolution.liftHomotopyZeroSucc

/-- Any lift of the zero morphism is homotopic to zero. -/
def liftHomotopyZero {Y Z : C} {P : ProjectiveResolution Y} {Q : ProjectiveResolution Z}
    (f : P.complex ⟶ Q.complex) (comm : f ≫ Q.π = 0) : Homotopy f 0 :=
  Homotopy.mkInductive _ (liftHomotopyZeroZero f comm) (by simp [lift_homotopy_zero_zero])
    (liftHomotopyZeroOne f comm) (by simp [lift_homotopy_zero_one]) fun n ⟨g, g', w⟩ =>
    ⟨liftHomotopyZeroSucc f n g g' w, by simp [lift_homotopy_zero_succ, w]⟩
#align category_theory.ProjectiveResolution.lift_homotopy_zero CategoryTheory.ProjectiveResolution.liftHomotopyZero

/-- Two lifts of the same morphism are homotopic. -/
def liftHomotopy {Y Z : C} (f : Y ⟶ Z) {P : ProjectiveResolution Y} {Q : ProjectiveResolution Z}
    (g h : P.complex ⟶ Q.complex) (g_comm : g ≫ Q.π = P.π ≫ (ChainComplex.single₀ C).map f)
    (h_comm : h ≫ Q.π = P.π ≫ (ChainComplex.single₀ C).map f) : Homotopy g h :=
  Homotopy.equivSubZero.invFun (liftHomotopyZero _ (by simp [g_comm, h_comm]))
#align category_theory.ProjectiveResolution.lift_homotopy CategoryTheory.ProjectiveResolution.liftHomotopy

/-- The lift of the identity morphism is homotopic to the identity chain map. -/
def liftIdHomotopy (X : C) (P : ProjectiveResolution X) : Homotopy (lift (𝟙 X) P P) (𝟙 P.complex) :=
  by apply lift_homotopy (𝟙 X) <;> simp
#align category_theory.ProjectiveResolution.lift_id_homotopy CategoryTheory.ProjectiveResolution.liftIdHomotopy

/-- The lift of a composition is homotopic to the composition of the lifts. -/
def liftCompHomotopy {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (P : ProjectiveResolution X)
    (Q : ProjectiveResolution Y) (R : ProjectiveResolution Z) :
    Homotopy (lift (f ≫ g) P R) (lift f P Q ≫ lift g Q R) := by apply lift_homotopy (f ≫ g) <;> simp
#align category_theory.ProjectiveResolution.lift_comp_homotopy CategoryTheory.ProjectiveResolution.liftCompHomotopy

-- We don't care about the actual definitions of these homotopies.
/-- Any two projective resolutions are homotopy equivalent. -/
def homotopyEquiv {X : C} (P Q : ProjectiveResolution X) : HomotopyEquiv P.complex Q.complex
    where
  Hom := lift (𝟙 X) P Q
  inv := lift (𝟙 X) Q P
  homotopyHomInvId :=
    by
    refine' (lift_comp_homotopy (𝟙 X) (𝟙 X) P Q P).symm.trans _
    simp [category.id_comp]
    apply lift_id_homotopy
  homotopyInvHomId :=
    by
    refine' (lift_comp_homotopy (𝟙 X) (𝟙 X) Q P Q).symm.trans _
    simp [category.id_comp]
    apply lift_id_homotopy
#align category_theory.ProjectiveResolution.homotopy_equiv CategoryTheory.ProjectiveResolution.homotopyEquiv

@[simp, reassoc.1]
theorem homotopyEquiv_hom_π {X : C} (P Q : ProjectiveResolution X) :
    (homotopyEquiv P Q).Hom ≫ Q.π = P.π := by simp [HomotopyEquiv]
#align category_theory.ProjectiveResolution.homotopy_equiv_hom_π CategoryTheory.ProjectiveResolution.homotopyEquiv_hom_π

@[simp, reassoc.1]
theorem homotopyEquiv_inv_π {X : C} (P Q : ProjectiveResolution X) :
    (homotopyEquiv P Q).inv ≫ P.π = Q.π := by simp [HomotopyEquiv]
#align category_theory.ProjectiveResolution.homotopy_equiv_inv_π CategoryTheory.ProjectiveResolution.homotopyEquiv_inv_π

end ProjectiveResolution

section

variable [HasZeroMorphisms C] [HasZeroObject C] [HasEqualizers C] [HasImages C]

/-- An arbitrarily chosen projective resolution of an object. -/
abbrev projectiveResolution (Z : C) [HasProjectiveResolution Z] : ChainComplex C ℕ :=
  (HasProjectiveResolution.out Z).some.complex
#align category_theory.projective_resolution CategoryTheory.projectiveResolution

/-- The chain map from the arbitrarily chosen projective resolution `projective_resolution Z`
back to the chain complex consisting of `Z` supported in degree `0`. -/
abbrev projectiveResolution.π (Z : C) [HasProjectiveResolution Z] :
    projectiveResolution Z ⟶ (ChainComplex.single₀ C).obj Z :=
  (HasProjectiveResolution.out Z).some.π
#align category_theory.projective_resolution.π CategoryTheory.projectiveResolution.π

/-- The lift of a morphism to a chain map between the arbitrarily chosen projective resolutions. -/
abbrev projectiveResolution.lift {X Y : C} (f : X ⟶ Y) [HasProjectiveResolution X]
    [HasProjectiveResolution Y] : projectiveResolution X ⟶ projectiveResolution Y :=
  ProjectiveResolution.lift f _ _
#align category_theory.projective_resolution.lift CategoryTheory.projectiveResolution.lift

end

variable (C) [Preadditive C] [HasZeroObject C] [HasEqualizers C] [HasImages C]
  [HasProjectiveResolutions C]

/-- Taking projective resolutions is functorial,
if considered with target the homotopy category
(`ℕ`-indexed chain complexes and chain maps up to homotopy).
-/
def projectiveResolutions : C ⥤ HomotopyCategory C (ComplexShape.down ℕ)
    where
  obj X := (HomotopyCategory.quotient _ _).obj (projectiveResolution X)
  map X Y f := (HomotopyCategory.quotient _ _).map (projectiveResolution.lift f)
  map_id' X := by
    rw [← (HomotopyCategory.quotient _ _).map_id]
    apply HomotopyCategory.eq_of_homotopy
    apply ProjectiveResolution.lift_id_homotopy
  map_comp' X Y Z f g := by
    rw [← (HomotopyCategory.quotient _ _).map_comp]
    apply HomotopyCategory.eq_of_homotopy
    apply ProjectiveResolution.lift_comp_homotopy
#align category_theory.projective_resolutions CategoryTheory.projectiveResolutions

end CategoryTheory


import logic.function.iterate
import data.nat.basic
import data.nat.order.basic
import tree

/-!
# Conversion of iteration to recursion using a stack

This file essentially describes how to eliminate recursion into iteration.

## Recursion with an explicit stack

For W-types, we can define a function `stack_rec`,
which is similar to `rec` except that it explicitly keeps track of the
arguments on the stack, rather than allowing the recursive function to return
higher-order (non-encodable) functions.

For example, consider checking for equality of trees: the recursor has type `tree → tree → bool`,
the motive is `tree → bool`, and the inductive step calls the inductive hypotheses,
which are `left : tree → bool` and `right : tree bool` on the current left and right subtrees.

This is an issue, because `tree → bool` is not encodable, and indeed, any total
complexity class (e.g. the primitive recursive functions) cannot interpret itself,
so it is not possible to have the motive be a representation of the "code" for `tree → bool`.

In general, for a W-type with nodes labeled by `α` and children by `β : α → Type`,
we write `stack_rec : W_type β → γ → δ`, defined primarily by
  - `pre : Π x, β x → γ → γ`: "prepares" the arguments to the inductive hypothesis,
    given the current node's children `Π x, β x` and the current argument `γ`
  - `post : (Π x, (β x → δ) → δ) → γ → δ`: computes the result given the inductive
  hypotheses `(β x → δ)` and the current argument `γ`.

TODO: generalize `stack_rec` to all W-types. Tactic to automatically convert structural
recursion where the motive is itself a function to `stack_rec`. This will enable us
to write functions naturally in Lean and then automatically prove that they are primitive recursive,
polynomial time, etc. using a tactic.
-/

namespace tree
open_locale tree

variables {α : Type} {β : Type} (base : α → β) (pre₁ pre₂ : tree unit → tree unit → α → α)
  (post : β → β → tree unit → tree unit → α → β)

/-- Recursion with an explicit stack for `tree unit` -/
@[simp]
def stack_rec : tree unit → α → β
| nil d := base d
| (x △ y) d := post (stack_rec x (pre₁ x y d)) (stack_rec y (pre₂ x y d)) x y d

/-- An element on the stack is either the result (`sum.inr (x : β)`), or
  the: tree, the argument α, and potentially what the left branch computed
  if that computation has finished (`option β`)
  -/
abbreviation iterator_stack (α β : Type) := (tree unit × α × option β) ⊕ β

/-- Do a single step of the iteration. In particular,
    - If the top of the stack is a result, pop the value before that and plug in the result.
    - If the top of the stack is a tree with the left branch uncomputed, push to the stack the
        arguments for the left branch, unless the tree is `nil`, in which case we directly
        compute the result.
    - If the top of the stack is a tree with the left branch computed, push to the stack the
      arguments for the right branch.
  This halts when the stack contains fewer than 2 elements, or the top 2 elements are both results
  -/
@[simp] def stack_step : list (iterator_stack α β) → list (iterator_stack α β)
| (sum.inr res :: sum.inl (tree, arg, none) :: xs) := sum.inl (tree, arg, some res) :: xs
| (sum.inr res :: sum.inl (tree, arg, some left_res) :: xs) :=
    sum.inr (post left_res res tree.left tree.right arg) :: xs
| L@(sum.inl (tree, arg, some left_res) :: xs) :=
  sum.inl (tree.right, pre₂ tree.left tree.right arg, none) :: L
| (sum.inl (nil, arg, none) :: xs) := sum.inr (base arg) :: xs
| L@(sum.inl (x △ y, arg, none) :: xs) := sum.inl (x, pre₁ x y arg, none) :: L
| x := x

@[simp] lemma stack_step_nil : stack_step base pre₁ pre₂ post [] = [] := rfl
@[simp] lemma stack_step_singleton (res : β) :
  stack_step base pre₁ pre₂ post [sum.inr res] = [sum.inr res] := rfl

def time_steps (x : tree unit) : ℕ := 5 * x.num_nodes + 1

@[simp] lemma time_steps_nil : time_steps nil = 1 := rfl
lemma time_steps_node (a b) : time_steps (a △ b) = 1 + b.time_steps + 2 + a.time_steps + 1 :=
by { simp only [time_steps, num_nodes, mul_add, show 5 * 1 = 1 + 2 + 1 + 1, from rfl], ac_refl, }

@[simp] lemma stack_step_iterate (x : tree unit) (arg : α) (xs : list (iterator_stack α β)) :
  (stack_step base pre₁ pre₂ post)^[x.time_steps] (sum.inl (x, arg, none) :: xs) =
  (sum.inr $ x.stack_rec base pre₁ pre₂ post arg) :: xs :=
by induction x using tree.unit_rec_on generalizing arg xs; simp [time_steps_node, function.iterate_add, *]

lemma stack_step_iterate' (x : tree unit) (arg : α) {n : ℕ} (hn : x.time_steps ≤ n) :
  (stack_step base pre₁ pre₂ post)^[n] [sum.inl (x, arg, none)] =
    [sum.inr $ x.stack_rec base pre₁ pre₂ post arg] :=
begin
  rcases le_iff_exists_add'.mp hn with ⟨n, rfl⟩,
  simp [function.iterate_add, function.iterate_fixed],
end

lemma stack_step_iterate_min (x : tree unit) (arg : α) (n : ℕ) :
  (stack_step base pre₁ pre₂ post)^[min n x.time_steps] [sum.inl (x, arg, none)] =
    ((stack_step base pre₁ pre₂ post)^[n] [sum.inl (x, arg, none)]) :=
(le_total n x.time_steps).elim
  (λ H, by rw min_eq_left_iff.mpr H)
  (λ H, by rwa [min_eq_right_iff.mpr H, stack_step_iterate, stack_step_iterate'])

end tree

namespace list
variables {α β : Type} {γ : Type*} (base : α → β) (pre : γ → list γ → α → α)
  (post : β → γ → list γ → α → β)

@[simp] def stack_rec : list γ → α → β
| [] a := base a
| (x :: xs) a := post (stack_rec xs (pre x xs a)) x xs a

end list

namespace nat
variables {α β : Type} (base : α → β) (pre : ℕ → α → α) (post : β → ℕ → α → β)

@[simp] def stack_rec : ℕ → α → β
| 0 x := base x
| (n+1) x := post (stack_rec n (pre n x)) n x

end nat


lemma add_left_eq_zero {{a b : mynat}} (H : a + b = 0) : b = 0 :=
begin
cases b with d,
refl,
rw add_succ at H,
have f := succ_ne_zero (a + d) H,
exfalso,
exact f,
end


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import control.traversable.equiv
import data.vector.basic

universes u v w

namespace d_array
variables {n : ℕ} {α : fin n → Type u}

instance [∀ i, inhabited (α i)] : inhabited (d_array n α) :=
⟨⟨λ _, default _⟩⟩

end d_array

namespace array

instance {n α} [inhabited α] : inhabited (array n α) :=
d_array.inhabited

theorem to_list_of_heq {n₁ n₂ α} {a₁ : array n₁ α} {a₂ : array n₂ α}
  (hn : n₁ = n₂) (ha : a₁ == a₂) : a₁.to_list = a₂.to_list :=
by congr; assumption

/- rev_list -/

section rev_list
variables {n : ℕ} {α : Type u} {a : array n α}

theorem rev_list_reverse_aux : ∀ i (h : i ≤ n) (t : list α),
  (a.iterate_aux (λ _, (::)) i h []).reverse_core t = a.rev_iterate_aux (λ _, (::)) i h t
| 0     h t := rfl
| (i+1) h t := rev_list_reverse_aux i _ _

@[simp] theorem rev_list_reverse : a.rev_list.reverse = a.to_list :=
rev_list_reverse_aux _ _ _

@[simp] theorem to_list_reverse : a.to_list.reverse = a.rev_list :=
by rw [←rev_list_reverse, list.reverse_reverse]

end rev_list

/- mem -/

section mem
variables {n : ℕ} {α : Type u} {v : α} {a : array n α}

theorem mem.def : v ∈ a ↔ ∃ i, a.read i = v :=
iff.rfl

theorem mem_rev_list_aux : ∀ {i} (h : i ≤ n),
  (∃ (j : fin n), (j : ℕ) < i ∧ read a j = v) ↔ v ∈ a.iterate_aux (λ _, (::)) i h []
| 0     _ := ⟨λ ⟨i, n, _⟩, absurd n i.val.not_lt_zero, false.elim⟩
| (i+1) h := let IH := mem_rev_list_aux (le_of_lt h) in
  ⟨λ ⟨j, ji1, e⟩, or.elim (lt_or_eq_of_le $ nat.le_of_succ_le_succ ji1)
    (λ ji, list.mem_cons_of_mem _ $ IH.1 ⟨j, ji, e⟩)
    (λ je, by simp [d_array.iterate_aux]; apply or.inl; unfold read at e;
          have H : j = ⟨i, h⟩ := fin.eq_of_veq je; rwa [←H, e]),
  λ m, begin
    simp [d_array.iterate_aux, list.mem] at m,
    cases m with e m',
    exact ⟨⟨i, h⟩, nat.lt_succ_self _, eq.symm e⟩,
    exact let ⟨j, ji, e⟩ := IH.2 m' in
    ⟨j, nat.le_succ_of_le ji, e⟩
  end⟩

@[simp] theorem mem_rev_list : v ∈ a.rev_list ↔ v ∈ a :=
iff.symm $ iff.trans
  (exists_congr $ λ j, iff.symm $
    show j.1 < n ∧ read a j = v ↔ read a j = v,
    from and_iff_right j.2)
  (mem_rev_list_aux _)

@[simp] theorem mem_to_list : v ∈ a.to_list ↔ v ∈ a :=
by rw ←rev_list_reverse; exact list.mem_reverse.trans mem_rev_list

end mem

/- foldr -/

section foldr
variables {n : ℕ} {α : Type u} {β : Type w} {b : β} {f : α → β → β} {a : array n α}

theorem rev_list_foldr_aux : ∀ {i} (h : i ≤ n),
  (d_array.iterate_aux a (λ _, (::)) i h []).foldr f b = d_array.iterate_aux a (λ _, f) i h b
| 0     h := rfl
| (j+1) h := congr_arg (f (read a ⟨j, h⟩)) (rev_list_foldr_aux _)

theorem rev_list_foldr : a.rev_list.foldr f b = a.foldl b f :=
rev_list_foldr_aux _

end foldr

/- foldl -/

section foldl
variables {n : ℕ} {α : Type u} {β : Type w} {b : β} {f : β → α → β} {a : array n α}

theorem to_list_foldl : a.to_list.foldl f b = a.foldl b (function.swap f) :=
by rw [←rev_list_reverse, list.foldl_reverse, rev_list_foldr]

end foldl

/- length -/

section length
variables {n : ℕ} {α : Type u}

theorem rev_list_length_aux (a : array n α) (i h) :
  (a.iterate_aux (λ _, (::)) i h []).length = i :=
by induction i; simp [*, d_array.iterate_aux]

@[simp] theorem rev_list_length (a : array n α) : a.rev_list.length = n :=
rev_list_length_aux a _ _

@[simp] theorem to_list_length (a : array n α) : a.to_list.length = n :=
by rw[←rev_list_reverse, list.length_reverse, rev_list_length]

end length

/- nth -/

section nth
variables {n : ℕ} {α : Type u} {a : array n α}

theorem to_list_nth_le_aux (i : ℕ) (ih : i < n) : ∀ j {jh t h'},
  (∀ k tl, j + k = i → list.nth_le t k tl = a.read ⟨i, ih⟩) →
  (a.rev_iterate_aux (λ _, (::)) j jh t).nth_le i h' = a.read ⟨i, ih⟩
| 0     _  _ _  al := al i _ $ zero_add _
| (j+1) jh t h' al := to_list_nth_le_aux j $ λ k tl hjk,
  show list.nth_le (a.read ⟨j, jh⟩ :: t) k tl = a.read ⟨i, ih⟩, from
  match k, hjk, tl with
  | 0,    e, tl := match i, e, ih with ._, rfl, _ := rfl end
  | k'+1, _, tl := by simp[list.nth_le]; exact al _ _ (by simp [add_comm, add_assoc, *]; cc)
  end

theorem to_list_nth_le (i : ℕ) (h h') : list.nth_le a.to_list i h' = a.read ⟨i, h⟩ :=
to_list_nth_le_aux _ _ _ (λ k tl, absurd tl k.not_lt_zero)

@[simp] theorem to_list_nth_le' (a : array n α) (i : fin n) (h') :
  list.nth_le a.to_list i h' = a.read i :=
by cases i; apply to_list_nth_le

theorem to_list_nth {i v} : list.nth a.to_list i = some v ↔ ∃ h, a.read ⟨i, h⟩ = v :=
begin
  rw list.nth_eq_some,
  have ll := to_list_length a,
  split; intro h; cases h with h e; subst v,
  { exact ⟨ll ▸ h, (to_list_nth_le _ _ _).symm⟩ },
  { exact ⟨ll.symm ▸ h, to_list_nth_le _ _ _⟩ }
end

theorem write_to_list {i v} : (a.write i v).to_list = a.to_list.update_nth i v :=
list.ext_le (by simp) $ λ j h₁ h₂, begin
  have h₃ : j < n, {simpa using h₁},
  rw [to_list_nth_le _ h₃],
  refine let ⟨_, e⟩ := list.nth_eq_some.1 _ in e.symm,
  by_cases ij : (i : ℕ) = j,
  { subst j, rw [show (⟨(i : ℕ), h₃⟩ : fin _) = i, from fin.eq_of_veq rfl,
      array.read_write, list.nth_update_nth_of_lt],
    simp [h₃] },
  { rw [list.nth_update_nth_ne _ _ ij, a.read_write_of_ne,
        to_list_nth.2 ⟨h₃, rfl⟩],
    exact fin.ne_of_vne ij }
end

end nth

/- enum -/

section enum
variables {n : ℕ} {α : Type u} {a : array n α}

theorem mem_to_list_enum {i v} : (i, v) ∈ a.to_list.enum ↔ ∃ h, a.read ⟨i, h⟩ = v :=
by simp [list.mem_iff_nth, to_list_nth, and.comm, and.assoc, and.left_comm]

end enum

/- to_array -/

section to_array
variables {n : ℕ} {α : Type u}

@[simp] theorem to_list_to_array (a : array n α) : a.to_list.to_array == a :=
heq_of_heq_of_eq
  (@@eq.drec_on (λ m (e : a.to_list.length = m), (d_array.mk (λ v, a.to_list.nth_le v.1 v.2)) ==
    (@d_array.mk m (λ _, α) $ λ v, a.to_list.nth_le v.1 $ e.symm ▸ v.2)) a.to_list_length heq.rfl) $
  d_array.ext $ λ ⟨i, h⟩, to_list_nth_le i h _

@[simp] theorem to_array_to_list (l : list α) : l.to_array.to_list = l :=
list.ext_le (to_list_length _) $ λ n h1 h2, to_list_nth_le _ h2 _

end to_array

/- push_back -/

section push_back
variables {n : ℕ} {α : Type u} {v : α} {a : array n α}

lemma push_back_rev_list_aux : ∀ i h h',
  d_array.iterate_aux (a.push_back v) (λ _, (::)) i h [] = d_array.iterate_aux a (λ _, (::)) i h' []
| 0 h h' := rfl
| (i+1) h h' := begin
  simp [d_array.iterate_aux],
  refine ⟨_, push_back_rev_list_aux _ _ _⟩,
  dsimp [read, d_array.read, push_back],
  rw [dif_neg], refl,
  exact ne_of_lt h',
end

@[simp] theorem push_back_rev_list : (a.push_back v).rev_list = v :: a.rev_list :=
begin
  unfold push_back rev_list foldl iterate d_array.iterate,
  dsimp [d_array.iterate_aux, read, d_array.read, push_back],
  rw [dif_pos (eq.refl n)],
  apply congr_arg,
  apply push_back_rev_list_aux
end

@[simp] theorem push_back_to_list : (a.push_back v).to_list = a.to_list ++ [v] :=
by rw [←rev_list_reverse, ←rev_list_reverse, push_back_rev_list, list.reverse_cons]

@[simp] lemma read_push_back_left (i : fin n) : (a.push_back v).read i.cast_succ = a.read i :=
begin
  cases i with i hi,
  have : ¬ i = n := ne_of_lt hi,
  simp [push_back, this, fin.cast_succ, fin.cast_add, fin.cast_le, fin.cast_lt, read, d_array.read]
end

@[simp] lemma read_push_back_right : (a.push_back v).read (fin.last _) = v :=
begin
  cases hn : fin.last n with k hk,
  have : k = n := by simpa [fin.eq_iff_veq ] using hn.symm,
  simp [push_back, this, fin.cast_succ, fin.cast_add, fin.cast_le, fin.cast_lt, read, d_array.read]
end

end push_back

/- foreach -/

section foreach
variables {n : ℕ} {α : Type u} {β : Type v} {i : fin n} {f : fin n → α → β} {a : array n α}

@[simp] theorem read_foreach : (foreach a f).read i = f i (a.read i) :=
rfl

end foreach

/- map -/

section map
variables {n : ℕ} {α : Type u} {β : Type v} {i : fin n} {f : α → β} {a : array n α}

theorem read_map : (a.map f).read i = f (a.read i) :=
read_foreach

end map

/- map₂ -/

section map₂
variables {n : ℕ} {α : Type u} {i : fin n} {f : α → α → α} {a₁ a₂ : array n α}

@[simp] theorem read_map₂ : (map₂ f a₁ a₂).read i = f (a₁.read i) (a₂.read i) :=
read_foreach

end map₂

end array

namespace equiv

/-- The natural equivalence between length-`n` heterogeneous arrays
and dependent functions from `fin n`. -/
def d_array_equiv_fin {n : ℕ} (α : fin n → Type*) : d_array n α ≃ (Π i, α i) :=
⟨d_array.read, d_array.mk, λ ⟨f⟩, rfl, λ f, rfl⟩

/-- The natural equivalence between length-`n` arrays and functions from `fin n`. -/
def array_equiv_fin (n : ℕ) (α : Type*) : array n α ≃ (fin n → α) :=
d_array_equiv_fin _

/-- The natural equivalence between length-`n` vectors and length-`n` arrays. -/
def vector_equiv_array (α : Type*) (n : ℕ) : vector α n ≃ array n α :=
(vector_equiv_fin _ _).trans (array_equiv_fin _ _).symm

end equiv

namespace array
open function
variable {n : ℕ}

instance : traversable (array n) :=
@equiv.traversable (flip vector n) _ (λ α, equiv.vector_equiv_array α n) _

instance : is_lawful_traversable (array n) :=
@equiv.is_lawful_traversable (flip vector n) _ (λ α, equiv.vector_equiv_array α n) _ _

end array


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, ∃ N : ℤ, |y - N * α| < 1 :=
begin
  assume (y : ℝ) (h1 : y ∈ Icc 0 1),
  let S := {x : ℝ | ∃ N : ℤ, x = N * α},
  have h2 : ∀ (i j : ℤ), i ≠ j → {i * α} ≠ {j * α}, from by auto [hα, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (h1 : ¬ is_rat α) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, ∀ ε > 0, ∃ N, ∀ n > N, |(n*α)%ℝ - y| < ε :=
begin
  assume y h2,
  have h3 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h1, is_rat_iff_rat],
  have h4 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h3],
  have h5 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h4],
  have h6 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h5],
  have h7 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h6],
  have h8 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h7],
  have h9 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h8],
  have h10 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h9],
  have h11 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h10],
  have h12 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h11],
  have h13 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h12],
  have h14 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h13],
  have h15 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h14],
  have h16 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h15],
  have h17 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h16],
  have h18 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h17],
  have h19 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h18],
  have h20 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h19],
  have h21 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h20],
  have h22 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h21],
  have h23 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h22],
  have h24 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h23],
  have h25 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h24],
  have h26 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h25],
  have h27 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h26],
  have h28 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h27],
  have h29 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h28],
  have h30 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h29],
  have h31 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h30],
  have h32 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h31],
  have h33 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h32],
  have h34 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h33],
  have h35 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h34],
  have h36 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h35],
  have h37 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h36],
  have h38 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h37],
  have h39 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h38],
  have h40 : ∀ i j : ℤ, i ≠ j → (i*α)%ℝ - (j*α)%ℝ ≠ 0, from by auto [h39],

end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (h : ¬ is_rat α) : ∀ y ∈ Icc 0 1, ∃ x ∈ (set.range (λ n : ℤ, n • α)), |y - x| < 1 :=
begin
  assume y h1,
  have h2 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h3 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h4 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h5 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h6 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h7 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h8 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h9 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h10 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h11 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h12 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h13 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h14 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h15 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h16 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h17 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h18 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h19 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h20 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h21 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h22 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h23 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h24 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h25 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h26 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h27 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h28 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h29 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h30 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h31 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h32 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h33 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h34 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h35 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h36 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h37 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h38 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by auto [h, is_rat_iff_rat],
  have h39 : ∀ i j : ℤ, i ≠ j → (i • α) % 1 ≠ (j • α) % 1, from by
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
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
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
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [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
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by auto [abs_sub_lt_iff] using [linarith],

  --Let $\epsilon > 0$.
  assume (h7 : ε > 0),

  --As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that $\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$
  cases h2 ε h7 with N1 h8,

  --As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that $\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$
  cases h3 ε h7 with N2 h9,

  --Let $N = \max \set {N_1, N_2}$.
  let N := max N1 N2,
  use N,

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by auto [lt_of_le_of_lt, le_max_left, le_max_right],

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\forall n \in \N: y_n \le x_n \le z_n$
  --So $\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by auto [h8, h10, h5, h9],

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by auto [h11] using [linarith],

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by auto [h5, h15],

end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import GMLInit.Data.Basic
import GMLInit.Data.Nat

namespace Int

attribute [local eliminator] Nat.recDiag

protected abbrev mk := Int.subNatNat

scoped infix:55 " ⊖ " => Int.mk

theorem zero_mk_zero : 0 ⊖ 0 = 0 := rfl

theorem zero_mk_succ (n) : (0 ⊖ n + 1) = Int.negSucc n := rfl

theorem succ_mk_zero (m) : (m + 1 ⊖ 0) = Int.ofNat (m+1) := by
  rw [Int.mk, Int.subNatNat, Nat.zero_sub, Nat.sub_zero]

theorem succ_mk_succ (m n) : (m + 1 ⊖ n + 1) = (m ⊖ n) := by
  rw [Int.mk, Int.subNatNat, Int.subNatNat, Nat.succ_sub_succ, Nat.succ_sub_succ]

theorem mk_zero (m) : (m ⊖ 0) = ofNat m := by
  rw [Int.mk, Int.subNatNat, Nat.zero_sub, Nat.sub_zero]

theorem zero_mk (n) : (0 ⊖ n) = negOfNat n :=
  match n with
  | 0 => rfl
  | _+1 => rfl

theorem one_mk_zero : (1 ⊖ 0) = 1 := rfl

protected def recMk.{u} {motive : Int → Sort u} (mk : (m n : Nat) → motive (m ⊖ n)) : (i : Int) → motive i
| Int.ofNat m => mk_zero m ▸ mk m 0
| Int.negSucc n => mk 0 (n + 1)

protected def recMkOn.{u} {motive : Int → Sort u} (i : Int) (mk : (m n : Nat) → motive (m ⊖ n)) : motive i := Int.recMk mk i

protected def casesMkOn.{u} {motive : Int → Sort u} (i : Int) (mk : (m n : Nat) → motive (m ⊖ n)) : motive i := Int.recMk mk i

-- asseert theorem add_zero (x : Int) : x + 0 = x

-- assert theorem zero_add (x : Int) : 0 + x = x

theorem mk_self (m) : (m ⊖ m) = 0 := by
  induction m with
  | zero => rfl
  | succ m ih => rw [succ_mk_succ]; exact ih

theorem add_mk_add_left (k m n) : (k + m ⊖ k + n) = (m ⊖ n) := by
  induction k with
  | zero => rw [Nat.zero_add, Nat.zero_add]
  | succ k ih => rw [Nat.succ_add', Nat.succ_add', succ_mk_succ]; exact ih

theorem add_mk_add_right (k m n) : (m + k ⊖ n + k) = (m ⊖ n) := by
  induction k with
  | zero => rw [Nat.add_zero, Nat.add_zero]
  | succ k ih => rw [Nat.add_succ' m k, Nat.add_succ' n k, succ_mk_succ]; exact ih

theorem mk_add_ofNat (m n k) : (m ⊖ n) + ofNat k = (m + k ⊖ n) := by
  induction m, n with
  | zero_zero => rw [zero_mk_zero, Int.zero_add, Nat.zero_add, mk_zero]
  | zero_succ n => rw [zero_mk_succ, Nat.zero_add]; rfl
  | succ_zero m => rw [succ_mk_zero, mk_zero]; rfl
  | succ_succ m n ih => rw [succ_mk_succ, Nat.succ_add', succ_mk_succ, ih]

theorem mk_add_negSucc (m n k) : (m ⊖ n) + negSucc k = (m ⊖ n + k + 1) := by
  induction m, n with
  | zero_zero => rw [zero_mk_zero, Int.zero_add, Nat.zero_add]; rfl
  | zero_succ n => rw [zero_mk_succ, zero_mk_succ, Nat.succ_add']; rfl
  | succ_zero m => rw [succ_mk_zero, Nat.zero_add]; rfl
  | succ_succ m n ih => rw [succ_mk_succ, Nat.succ_add', succ_mk_succ]; exact ih

theorem mk_add_mk (m₁ n₁ m₂ n₂) : (m₁ ⊖ n₁) + (m₂ ⊖ n₂) = (m₁ + m₂ ⊖ n₁ + n₂) := by
  induction m₂, n₂ with
  | zero_zero => rw [zero_mk_zero, Int.add_zero, Nat.add_zero, Nat.add_zero]
  | zero_succ n₂ => rw [zero_mk_succ, Nat.add_succ', mk_add_negSucc]; rfl
  | succ_zero m₂ => rw [mk_zero, mk_add_ofNat]; rfl
  | succ_succ m₂ n₂ ih => rw [succ_mk_succ, Nat.add_succ' m₁ m₂, Nat.add_succ' n₁ n₂, succ_mk_succ]; exact ih

theorem neg_mk (m n) : -(m ⊖ n) = (n ⊖ m) := by
  induction m, n with
  | zero_zero => rw [zero_mk_zero]; rfl
  | zero_succ n => rw [zero_mk_succ, succ_mk_zero]; rfl
  | succ_zero m => rw [succ_mk_zero, zero_mk_succ]; rfl
  | succ_succ m n ih => rw [succ_mk_succ, succ_mk_succ]; exact ih

theorem mk_sub_mk (m₁ n₁ m₂ n₂) : (m₁ ⊖ n₁) - (m₂ ⊖ n₂) = (m₁ + n₂ ⊖ n₁ + m₂) :=
  show (m₁ ⊖ n₁) + -(m₂ ⊖ n₂) = (m₁ + n₂ ⊖ n₁ + m₂) by rw [neg_mk, mk_add_mk]

theorem nonNeg_mk (m n) : NonNeg (m ⊖ n) ↔ n ≤ m := by
  induction m, n with
  | zero_zero =>
    rw [zero_mk_zero]
    constr
    · intro; reflexivity
    · intro; apply NonNeg.mk
  | zero_succ n =>
    rw [zero_mk_succ]
    constr
    · intro; contradiction
    · intro; contradiction
  | succ_zero m =>
    rw [succ_mk_zero]
    constr
    · intro; apply Nat.zero_le
    · intro; apply NonNeg.mk
  | succ_succ m n ih =>
    rw [succ_mk_succ]
    rw [Nat.succ_le_succ_iff_le]
    exact ih

theorem mk_le_mk (m₁ n₁ m₂ n₂) : (m₁ ⊖ n₁) ≤ (m₂ ⊖ n₂) ↔ n₂ + m₁ ≤ m₂ + n₁ := by
  simp only [LE.le, Int.le]
  rw [mk_sub_mk, nonNeg_mk]
  reflexivity

theorem mk_lt_mk (m₁ n₁ m₂ n₂) : (m₁ ⊖ n₁) < (m₂ ⊖ n₂) ↔ n₂ + m₁ < m₂ + n₁ := by
  simp only [LT.lt, Int.lt, Nat.lt]
  rw [←one_mk_zero, mk_add_mk, mk_le_mk, Nat.add_succ, Nat.add_zero]
  reflexivity

-- assert theorem add_assoc (i j k : Int) : (i + j) + k = i + (j + k)

-- assert theorem add_comm (i j : Int) : i + j = j + i

-- assert theorem add_left_comm (i j k : Int) : i + (j + k) = j + (i + k)

-- assert theorem add_right_comm (i j k : Int) : (i + j) + k = (i + k) + j

protected theorem add_cross_comm (i₁ i₂ j₁ j₂ : Int) : (i₁ + i₂) + (j₁ + j₂) = (i₁ + j₁) + (i₂ + j₂) :=
  calc
  _ = i₁ + (i₂ + (j₁ + j₂)) := by rw [Int.add_assoc]
  _ = i₁ + (j₁ + (i₂ + j₂)) := by rw [Int.add_left_comm i₂ j₁ j₂]
  _ = (i₁ + j₁) + (i₂ + j₂) := by rw [Int.add_assoc]

-- assert theorem neg_zero : -0 = 0

-- assert theorem neg_neg (i : Int) : -(-i) = i

-- assert theorem neg_add (i j : Int) : -(i + j) = -i + -j

protected theorem add_neg_self_left (i : Int) : -i + i = 0 := by
  cases i using Int.casesMkOn with
  | mk mi ni => rw [neg_mk, mk_add_mk, Nat.add_comm mi ni, mk_self]

protected theorem add_neg_self_right (i : Int) : i + -i = 0 := by
  cases i using Int.casesMkOn with
  | mk mi ni => rw [neg_mk, mk_add_mk, Nat.add_comm mi ni, mk_self]

protected theorem sub_eq (i j : Int) : i - j = i + -j := rfl

-- assert theorem sub_zero (i : Int) : i - 0 = i

-- assert theorem zero_sub (i : Int) : 0 - i = -i

-- assert theorem sub_self (i : Int) : i - i = 0

-- assert theorem add_sub_assoc (i j k : Int) : (i + j) - k = i + (j - k)

protected theorem sub_add_assoc (i j k : Int) : (i - j) + k = i - (j - k) :=
  calc
  _ = (i + -j) + k := by rw [Int.sub_eq]
  _ = i + (-j + k) := by rw [Int.add_assoc]
  _ = i + (-j + -(-k)) := by rw [Int.neg_neg]
  _ = i + -(j + -k) := by rw [Int.neg_add]
  _ = i - (j - k) := by rw [Int.sub_eq, Int.sub_eq]

-- assert theorem add_sub_cancel (i j : Int) : (i + j) - j = i

-- assert theorem sub_add_cancel (i j : Int) : (i - j) + j = i

-- assert theorem neg_sub (i j : Int) : -(i - j) = j - i

protected theorem add_left_cancel' (i : Int) {j k : Int} (h : i + j = i + k) : j = k :=
  calc
  _ = 0 + j := by rw [Int.zero_add]
  _ = (-i + i) + j := by rw [Int.add_neg_self_left]
  _ = -i + (i + j) := by rw [Int.add_assoc]
  _ = -i + (i + k) := by rw [h]
  _ = (-i + i) + k := by rw [Int.add_assoc]
  _ = 0 + k := by rw [Int.add_neg_self_left]
  _ = k := by rw [Int.zero_add]

protected theorem add_right_cancel' (i : Int) {j k : Int} (h : j + i = k + i) : j = k :=
  calc
  _ = j + 0 := by rw [Int.add_zero]
  _ = j + (i + -i) := by rw [Int.add_neg_self_right]
  _ = (j + i) + -i := by rw [Int.add_assoc]
  _ = (k + i) + -i := by rw [h]
  _ = k + (i + -i) := by rw [Int.add_assoc]
  _ = k + 0 := by rw [Int.add_neg_self_right]
  _ = k := by rw [Int.add_zero]

-- assert theorem mul_zero (i : Int) : i * 0 = 0

-- assert theorem zero_mul (i : Int) : 0 * i = 0

-- assert theorem mul_one (i : Int) : i * 1 = i

-- assert theorem one_mul (i : Int) : 1 * i = i

theorem mk_mul_ofNat (m n k) : (m ⊖ n) * ofNat k = (m * k ⊖ n * k) := by
  induction m, n with
  | zero_zero => rw [Nat.zero_mul, zero_mk_zero, Int.zero_mul]
  | zero_succ n => rw [Nat.zero_mul, zero_mk, zero_mk]; rfl
  | succ_zero m => rw [Nat.zero_mul, mk_zero, mk_zero]; rfl
  | succ_succ m n ih => rw [Nat.succ_mul, Nat.succ_mul, succ_mk_succ, add_mk_add_right]; exact ih

theorem mk_mul_negSucc (m n k) : (m ⊖ n) * negSucc k = (n * (k + 1) ⊖ m * (k + 1)) := by
  induction m, n with
  | zero_zero => rw [Nat.zero_mul, zero_mk_zero, Int.zero_mul]
  | zero_succ n => rw [Nat.zero_mul, zero_mk, mk_zero]; rfl
  | succ_zero m => rw [Nat.zero_mul, mk_zero, zero_mk]; rfl
  | succ_succ m n ih => rw [Nat.succ_mul, Nat.succ_mul, succ_mk_succ, add_mk_add_right]; exact ih

theorem mk_mul_mk (m₁ n₁ m₂ n₂) : (m₁ ⊖ n₁) * (m₂ ⊖ n₂) = (m₁ * m₂ + n₁ * n₂ ⊖ m₁ * n₂ + n₁ * m₂) := by
  induction m₂, n₂ with
  | zero_zero => simp only [Nat.zero_mul, Nat.mul_zero, Nat.add_zero, Nat.zero_add, zero_mk_zero, Int.mul_zero]
  | zero_succ n₂ => simp only [Nat.zero_mul, Nat.mul_zero, Nat.add_zero, Nat.zero_add, zero_mk_succ, mk_mul_negSucc]
  | succ_zero m₂ => simp only [Nat.zero_mul, Nat.mul_zero, Nat.add_zero, Nat.zero_add, succ_mk_zero, mk_mul_ofNat, Nat.mul_comm]
  | succ_succ m₂ n₂ ih => simp only [Nat.mul_succ, Nat.succ_mul]; rw [succ_mk_succ, Nat.add_cross_comm _ m₁ _ n₁, Nat.add_cross_comm _ m₁ _ n₁, add_mk_add_right]; exact ih

-- assert theorem mul_assoc (i j k : Int) : (i * j) * k = i * (j * k)

-- assert theorem mul_comm (i j : Int) : i * j = j * i

-- assert theorem mul_left_comm (i j k : Int) : i * (j * k) = j * (i * k)

-- assert theorem mul_right_comm (i j k : Int) : (i * j) * k = (i * k) * j

protected theorem mul_cross_comm (i₁ i₂ j₁ j₂ : Int) : (i₁ * i₂) * (j₁ * j₂) = (i₁ * j₁) * (i₂ * j₂) :=
  calc
  _ = i₁ * (i₂ * (j₁ * j₂)) := by rw [Int.mul_assoc]
  _ = i₁ * (j₁ * (i₂ * j₂)) := by rw [Int.mul_left_comm i₂ j₁ j₂]
  _ = (i₁ * j₁) * (i₂ * j₂) := by rw [Int.mul_assoc]

-- assert theorem mul_neg (i j : Int) : i * (-j) = -(i * j)

-- assert theorem neg_mul (i j : Int) : (-i) * j = -(i * j)

-- assert theorem mul_add (i j k : Int) : i * (j + k) = i * j + i * k)

-- assert theorem add_mul (i j k : Int) : (i + j) * k = i * k + j * k]

-- assert theorem mul_sub (i j k : Int) : i * (j - k) = i * j - i * k

-- assert theorem sub_mul (i j k : Int) : (i - j) * k = i * k - j * k

theorem le.intro' (i : Int) (k : Nat) : i ≤ i + k :=
  show (NonNeg ((i+k)-i)) by
  rw [Int.sub_eq, Int.add_right_comm, Int.add_neg_self_right, Int.zero_add]
  apply NonNeg.mk

theorem le.dest' {i j : Int} : i ≤ j → ∃ (k : Nat), j = i + ofNat k := by
  intro (h : NonNeg (j - i))
  match hk : j - i with
  | ofNat k => exists k; rw [←hk, Int.sub_eq, Int.add_left_comm, Int.add_neg_self_right, Int.add_zero]
  | negSucc _ => rw [hk] at h; contradiction

-- assert theorem le_refl (i : Int) : i ≤ i

-- assert theorem le_trans {i j k : Int} : i ≤ j → j ≤ k → i ≤ k

-- assert theorem le_antisymm {i j : Int} : i ≤ j → j ≤ i → i = j

-- assert theorem le_total (i j : Int) : i ≤ j ∨ j ≤ i

-- assert theorem add_le_add_left {i j : Int} : i ≤ j → ∀ (k : Int), k + i ≤ k + j

-- assert theorem add_le_add_right {i j : Int} : i ≤ j → ∀ (k : Int), i + k ≤ j + k

-- assert theorem sub_le_sub_right {i j : Int} : i ≤ j → ∀ (k : Int), i - k ≤ j - k

-- assert theorem le_of_add_le_add_right {i j k : Int} (h : i + k ≤ j + k) : i ≤ j

-- assert theorem le_of_add_le_add_left {i j k : Int} (h : i + j ≤ i + k) : j ≤ k

protected theorem le_succ_self (i : Int) : i ≤ i + 1 := le.intro' ..

protected theorem lt_iff_succ_le (i j : Int) : i < j ↔ i + 1 ≤ j := Iff.rfl

protected theorem le_iff_lt_succ (i j : Int) : i ≤ j ↔ i < j + 1 := by
  rw [Int.lt_iff_succ_le]
  constr
  · apply Int.add_le_add_right (c:=1)
  · apply Int.le_of_add_le_add_right

-- assert theorem le_of_lt {i j : Int} : i < j → i ≤ j

-- assert theorem lt_of_lt_of_le {i j k : Int} : i < j → j ≤ k → i < k

-- assert theorem lt_of_le_of_lt {i j k : Int} : i ≤ j → j < k → i < k

-- assert theorem lt_irrefl (i : Int) : ¬ i < i

-- assert theorem lt_trans {i j k : Int} : i < j → j < k → i < k

protected theorem le_or_gt (i j : Int) : i ≤ j ∨ j < i := by
  induction i using Int.casesMkOn with
  | mk mi ni =>
    induction j using Int.casesMkOn with
    | mk mj nj =>
      rw [mk_le_mk, mk_lt_mk]
      rw [Nat.add_comm mi, Nat.add_comm mj]
      exact Nat.le_or_gt ..

protected theorem lt_or_ge (i j : Int) : i < j ∨ j ≤ i := by
  cases Int.le_or_gt j i with
  | inl h => right; exact h
  | inr h => left; exact h

theorem lt_or_eq_of_le {i j : Int} : i ≤ j → i < j ∨ i = j := by
  intro hle
  match le.dest' hle with
  | ⟨0, (h : j = i + 0)⟩ =>
    right
    rw [h, Int.add_zero]
  | ⟨n+1, (h : j = i + (ofNat n + 1))⟩ =>
    left
    rw [Int.lt_iff_succ_le]
    rw [h, ←Int.add_assoc, Int.add_right_comm]
    apply Int.le.intro'

protected theorem lt_of_le_of_ne {i j : Int} : i ≤ j → i ≠ j → i < j := by
  intro hle hne
  cases lt_or_eq_of_le hle with
  | inl hlt => exact hlt
  | inr heq => absurd heq; exact hne

protected theorem lt_connex {i j : Int} : i ≠ j → i < j ∨ j < i := by
  intro hne
  cases Int.le_or_gt i j with
  | inl hle => left; apply Int.lt_of_le_of_ne hle hne
  | inr hgt => right; exact hgt

protected theorem lt_compare {i j : Int} : i < j → ∀ (k : Int), i < k ∨ k < j := by
  intro hij k
  cases Int.le_or_gt k i with
  | inl hle => right; exact Int.lt_of_le_of_lt hle hij
  | inr hgt => left; exact hgt

instance : Relation.Reflexive (α:=Int) (.≤.) := ⟨Int.le_refl⟩
instance : Relation.Transitive (α:=Int) (.≤.) := ⟨Int.le_trans⟩
instance : Relation.Antisymmetric (α:=Int) (.≤.) := ⟨Int.le_antisymm⟩
instance : Relation.Total (α:=Int) (.≤.) := ⟨Int.le_total⟩
instance : Relation.Irreflexive (α:=Int) (.<.) := ⟨Int.lt_irrefl⟩
instance : Relation.Transitive (α:=Int) (.<.) := ⟨Int.lt_trans⟩
instance : Relation.Comparison (α:=Int) (.<.) := ⟨Int.lt_compare⟩
instance : Relation.Connex (α:=Int) (.<.) := ⟨Int.lt_connex⟩
instance : Relation.HTransitive (α:=Int) (.≤.) (.<.) (.<.) := ⟨Int.lt_of_le_of_lt⟩
instance : Relation.HTransitive (α:=Int) (.<.) (.≤.) (.<.) := ⟨Int.lt_of_lt_of_le⟩

end Int


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

Instances on punit.
-/

import order.basic
import algebra.module algebra.group

universes u

open lattice

namespace punit
variables (x y : punit.{u+1}) (s : set punit.{u+1})

instance : comm_ring punit :=
by refine
{ add := λ _ _, star,
  zero := star,
  neg := λ _, star,
  mul := λ _ _, star,
  one := star,
  .. };
intros; exact subsingleton.elim _ _

instance : comm_group punit :=
{ inv := λ _, star,
  mul_left_inv := λ _, subsingleton.elim _ _,
  .. punit.comm_ring }

instance : complete_boolean_algebra punit :=
by refine
{ le := λ _ _, true,
  le_antisymm := λ _ _ _ _, subsingleton.elim _ _,
  lt := λ _ _, false,
  lt_iff_le_not_le := λ _ _, iff_of_false not_false (λ H, H.2 trivial),
  top := star,
  bot := star,
  sup := λ _ _, star,
  inf := λ _ _, star,
  Sup := λ _, star,
  Inf := λ _, star,
  sub := λ _ _, star,
  .. punit.comm_ring, .. };
intros; trivial

instance : canonically_ordered_monoid punit :=
by refine
{ lt_of_add_lt_add_left := λ _ _ _, id,
  le_iff_exists_add := λ _ _, iff_of_true _ ⟨star, subsingleton.elim _ _⟩,
  .. punit.comm_ring, .. punit.lattice.complete_boolean_algebra, .. };
intros; trivial

instance : decidable_linear_ordered_cancel_comm_monoid punit :=
{ add_left_cancel := λ _ _ _ _, subsingleton.elim _ _,
  add_right_cancel := λ _ _ _ _, subsingleton.elim _ _,
  le_of_add_le_add_left := λ _ _ _ _, trivial,
  le_total := λ _ _, or.inl trivial,
  decidable_le := λ _ _, decidable.true,
  decidable_eq := punit.decidable_eq,
  decidable_lt := λ _ _, decidable.false,
  .. punit.canonically_ordered_monoid }

instance : module punit punit := module.of_core $
by refine
{ smul := λ _ _, star,
  .. punit.comm_ring, .. };
intros; exact subsingleton.elim _ _

@[simp] lemma zero_eq : (0 : punit) = star := rfl
@[simp] lemma one_eq : (1 : punit) = star := rfl
attribute [to_additive punit.zero_eq] punit.one_eq
@[simp] lemma add_eq : x + y = star := rfl
@[simp] lemma mul_eq : x * y = star := rfl
attribute [to_additive punit.add_eq] punit.mul_eq
@[simp] lemma neg_eq : -x = star := rfl
@[simp] lemma inv_eq : x⁻¹ = star := rfl
attribute [to_additive punit.neg_eq] punit.inv_eq
@[simp] lemma smul_eq : x • y = star := rfl
@[simp] lemma top_eq : (⊤ : punit) = star := rfl
@[simp] lemma bot_eq : (⊥ : punit) = star := rfl
@[simp] lemma sup_eq : x ⊔ y = star := rfl
@[simp] lemma inf_eq : x ⊓ y = star := rfl
@[simp] lemma Sup_eq : Sup s = star := rfl
@[simp] lemma Inf_eq : Inf s = star := rfl
@[simp] protected lemma le : x ≤ y := trivial
@[simp] lemma not_lt : ¬(x < y) := not_false

instance {α : Type*} [monoid α] (f : α → punit) : is_monoid_hom f :=
⟨subsingleton.elim _ _, λ _ _, subsingleton.elim _ _⟩

instance {α : Type*} [add_monoid α] (f : α → punit) : is_add_monoid_hom f :=
⟨subsingleton.elim _ _, λ _ _, subsingleton.elim _ _⟩

instance {α : Type*} [group α] (f : α → punit) : is_group_hom f :=
⟨λ _ _, subsingleton.elim _ _⟩

instance {α : Type*} [add_group α] (f : α → punit) : is_add_group_hom f :=
⟨λ _ _, subsingleton.elim _ _⟩

instance {α : Type*} [semiring α] (f : α → punit) : is_semiring_hom f :=
{ .. punit.is_monoid_hom f, .. punit.is_add_monoid_hom f }

instance {α : Type*} [ring α] (f : α → punit) : is_ring_hom f :=
{ .. punit.is_semiring_hom f }

end punit


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

Hahn decomposition theorem

TODO:
* introduce finite measures (into ℝ≥0)
* show general for signed measures (into ℝ)
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.measure_space
import Mathlib.PostPort

universes u_1

namespace Mathlib

namespace measure_theory

-- suddenly this is necessary?!

theorem hahn_decomposition {α : Type u_1} [measurable_space α] {μ : measure α} {ν : measure α}
    (hμ : coe_fn μ set.univ < ⊤) (hν : coe_fn ν set.univ < ⊤) :
    ∃ (s : set α),
        is_measurable s ∧
          (∀ (t : set α), is_measurable t → t ⊆ s → coe_fn ν t ≤ coe_fn μ t) ∧
            ∀ (t : set α), is_measurable t → t ⊆ (sᶜ) → coe_fn μ t ≤ coe_fn ν t :=
  sorry

end Mathlib


/-
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, Johannes Hölzl, Reid Barton
-/
import combinatorics.quiver.basic
import tactic.basic

/-!
# Categories

Defines a category, as a type class parametrised by the type of objects.

## Notations

Introduces notations
* `X ⟶ Y` for the morphism spaces,
* `f ≫ g` for composition in the 'arrows' convention.

Users may like to add `f ⊚ g` for composition in the standard convention, using
```lean
local notation f ` ⊚ `:80 g:80 := category.comp g f    -- type as \oo
```
-/

/--
The typeclass `category C` describes morphisms associated to objects of type `C : Type u`.

The universe levels of the objects and morphisms are independent, and will often need to be
specified explicitly, as `category.{v} C`.

Typically any concrete example will either be a `small_category`, where `v = u`,
which can be introduced as
```
universes u
variables {C : Type u} [small_category C]
```
or a `large_category`, where `u = v+1`, which can be introduced as
```
universes u
variables {C : Type (u+1)} [large_category C]
```

In order for the library to handle these cases uniformly,
we generally work with the unconstrained `category.{v u}`,
for which objects live in `Type u` and morphisms live in `Type v`.

Because the universe parameter `u` for the objects can be inferred from `C`
when we write `category C`, while the universe parameter `v` for the morphisms
can not be automatically inferred, through the category theory library
we introduce universe parameters with morphism levels listed first,
as in
```
universes v u
```
or
```
universes v₁ v₂ u₁ u₂
```
when multiple independent universes are needed.

This has the effect that we can simply write `category.{v} C`
(that is, only specifying a single parameter) while `u` will be inferred.

Often, however, it's not even necessary to include the `.{v}`.
(Although it was in earlier versions of Lean.)
If it is omitted a "free" universe will be used.
-/
library_note "category_theory universes"

universes v u

namespace category_theory

/-- A preliminary structure on the way to defining a category,
containing the data, but none of the axioms. -/
class category_struct (obj : Type u)
extends quiver.{v+1} obj : Type (max u (v+1)) :=
(id       : Π X : obj, hom X X)
(comp     : Π {X Y Z : obj}, (X ⟶ Y) → (Y ⟶ Z) → (X ⟶ Z))

notation `𝟙` := category_struct.id -- type as \b1
infixr ` ≫ `:80 := category_struct.comp -- type as \gg

/--
The typeclass `category C` describes morphisms associated to objects of type `C`.
The universe levels of the objects and morphisms are unconstrained, and will often need to be
specified explicitly, as `category.{v} C`. (See also `large_category` and `small_category`.)

See https://stacks.math.columbia.edu/tag/0014.
-/
class category (obj : Type u)
extends category_struct.{v} obj : Type (max u (v+1)) :=
(id_comp' : ∀ {X Y : obj} (f : hom X Y), 𝟙 X ≫ f = f . obviously)
(comp_id' : ∀ {X Y : obj} (f : hom X Y), f ≫ 𝟙 Y = f . obviously)
(assoc'   : ∀ {W X Y Z : obj} (f : hom W X) (g : hom X Y) (h : hom Y Z),
  (f ≫ g) ≫ h = f ≫ (g ≫ h) . obviously)

-- `restate_axiom` is a command that creates a lemma from a structure field,
-- discarding any auto_param wrappers from the type.
-- (It removes a backtick from the name, if it finds one, and otherwise adds "_lemma".)
restate_axiom category.id_comp'
restate_axiom category.comp_id'
restate_axiom category.assoc'
attribute [simp] category.id_comp category.comp_id category.assoc
attribute [trans] category_struct.comp

/--
A `large_category` has objects in one universe level higher than the universe level of
the morphisms. It is useful for examples such as the category of types, or the category
of groups, etc.
-/
abbreviation large_category (C : Type (u+1)) : Type (u+1) := category.{u} C
/--
A `small_category` has objects and morphisms in the same universe level.
-/
abbreviation small_category (C : Type u) : Type (u+1) := category.{u} C

section
variables {C : Type u} [category.{v} C] {X Y Z : C}

initialize_simps_projections category (to_category_struct_to_quiver_hom → hom,
  to_category_struct_comp → comp, to_category_struct_id → id, -to_category_struct)

/-- postcompose an equation between morphisms by another morphism -/
lemma eq_whisker {f g : X ⟶ Y} (w : f = g) (h : Y ⟶ Z) : f ≫ h = g ≫ h :=
by rw w
/-- precompose an equation between morphisms by another morphism -/
lemma whisker_eq (f : X ⟶ Y) {g h : Y ⟶ Z} (w : g = h) : f ≫ g = f ≫ h :=
by rw w

infixr ` =≫ `:80 := eq_whisker
infixr ` ≫= `:80 := whisker_eq

lemma eq_of_comp_left_eq {f g : X ⟶ Y} (w : ∀ {Z : C} (h : Y ⟶ Z), f ≫ h = g ≫ h) : f = g :=
by { convert w (𝟙 Y), tidy }
lemma eq_of_comp_right_eq {f g : Y ⟶ Z} (w : ∀ {X : C} (h : X ⟶ Y), h ≫ f = h ≫ g) : f = g :=
by { convert w (𝟙 Y), tidy }

lemma eq_of_comp_left_eq' (f g : X ⟶ Y)
  (w : (λ {Z : C} (h : Y ⟶ Z), f ≫ h) = (λ {Z : C} (h : Y ⟶ Z), g ≫ h)) : f = g :=
eq_of_comp_left_eq (λ Z h, by convert congr_fun (congr_fun w Z) h)
lemma eq_of_comp_right_eq' (f g : Y ⟶ Z)
  (w : (λ {X : C} (h : X ⟶ Y), h ≫ f) = (λ {X : C} (h : X ⟶ Y), h ≫ g)) : f = g :=
eq_of_comp_right_eq (λ X h, by convert congr_fun (congr_fun w X) h)

lemma id_of_comp_left_id (f : X ⟶ X) (w : ∀ {Y : C} (g : X ⟶ Y), f ≫ g = g) : f = 𝟙 X :=
by { convert w (𝟙 X), tidy }
lemma id_of_comp_right_id (f : X ⟶ X) (w : ∀ {Y : C} (g : Y ⟶ X), g ≫ f = g) : f = 𝟙 X :=
by { convert w (𝟙 X), tidy }

lemma dite_comp {P : Prop} [decidable P]
  {X Y Z : C} (f : P → (X ⟶ Y)) (f' : ¬P → (X ⟶ Y)) (g : Y ⟶ Z) :
  (if h : P then f h else f' h) ≫ g = (if h : P then f h ≫ g else f' h ≫ g) :=
by { split_ifs; refl }

/--
A morphism `f` is an epimorphism if it can be "cancelled" when precomposed:
`f ≫ g = f ≫ h` implies `g = h`.

See https://stacks.math.columbia.edu/tag/003B.
-/
class epi (f : X ⟶ Y) : Prop :=
(left_cancellation : Π {Z : C} (g h : Y ⟶ Z) (w : f ≫ g = f ≫ h), g = h)

/--
A morphism `f` is a monomorphism if it can be "cancelled" when postcomposed:
`g ≫ f = h ≫ f` implies `g = h`.

See https://stacks.math.columbia.edu/tag/003B.
-/
class mono (f : X ⟶ Y) : Prop :=
(right_cancellation : Π {Z : C} (g h : Z ⟶ X) (w : g ≫ f = h ≫ f), g = h)

instance (X : C) : epi (𝟙 X) :=
⟨λ Z g h w, by simpa using w⟩
instance (X : C) : mono (𝟙 X) :=
⟨λ Z g h w, by simpa using w⟩

lemma cancel_epi (f : X ⟶ Y) [epi f]  {g h : Y ⟶ Z} : (f ≫ g = f ≫ h) ↔ g = h :=
⟨ λ p, epi.left_cancellation g h p, begin intro a, subst a end ⟩
lemma cancel_mono (f : X ⟶ Y) [mono f] {g h : Z ⟶ X} : (g ≫ f = h ≫ f) ↔ g = h :=
⟨ λ p, mono.right_cancellation g h p, begin intro a, subst a end ⟩

lemma cancel_epi_id (f : X ⟶ Y) [epi f] {h : Y ⟶ Y} : (f ≫ h = f) ↔ h = 𝟙 Y :=
by { convert cancel_epi f, simp, }
lemma cancel_mono_id (f : X ⟶ Y) [mono f] {g : X ⟶ X} : (g ≫ f = f) ↔ g = 𝟙 X :=
by { convert cancel_mono f, simp, }

lemma epi_comp {X Y Z : C} (f : X ⟶ Y) [epi f] (g : Y ⟶ Z) [epi g] : epi (f ≫ g) :=
begin
  split, intros Z a b w,
  apply (cancel_epi g).1,
  apply (cancel_epi f).1,
  simpa using w,
end
lemma mono_comp {X Y Z : C} (f : X ⟶ Y) [mono f] (g : Y ⟶ Z) [mono g] : mono (f ≫ g) :=
begin
  split, intros Z a b w,
  apply (cancel_mono f).1,
  apply (cancel_mono g).1,
  simpa using w,
end

lemma mono_of_mono {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [mono (f ≫ g)] : mono f :=
begin
  split, intros Z a b w,
  replace w := congr_arg (λ k, k ≫ g) w,
  dsimp at w,
  rw [category.assoc, category.assoc] at w,
  exact (cancel_mono _).1 w,
end

lemma mono_of_mono_fac {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} {h : X ⟶ Z} [mono h] (w : f ≫ g = h) :
  mono f :=
by { substI h, exact mono_of_mono f g, }

lemma epi_of_epi {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [epi (f ≫ g)] : epi g :=
begin
  split, intros Z a b w,
  replace w := congr_arg (λ k, f ≫ k) w,
  dsimp at w,
  rw [←category.assoc, ←category.assoc] at w,
  exact (cancel_epi _).1 w,
end

lemma epi_of_epi_fac {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} {h : X ⟶ Z} [epi h] (w : f ≫ g = h) :
  epi g :=
by substI h; exact epi_of_epi f g
end

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

universe u'

instance ulift_category : category.{v} (ulift.{u'} C) :=
{ hom  := λ X Y, (X.down ⟶ Y.down),
  id   := λ X, 𝟙 X.down,
  comp := λ _ _ _ f g, f ≫ g }

-- We verify that this previous instance can lift small categories to large categories.
example (D : Type u) [small_category D] : large_category (ulift.{u+1} D) := by apply_instance
end

end category_theory

/--
Many proofs in the category theory library use the `dsimp, simp` pattern,
which typically isn't necessary elsewhere.

One would usually hope that the same effect could be achieved simply with `simp`.

The essential issue is that composition of morphisms involves dependent types.
When you have a chain of morphisms being composed, say `f : X ⟶ Y` and `g : Y ⟶ Z`,
then `simp` can operate succesfully on the morphisms
(e.g. if `f` is the identity it can strip that off).

However if we have an equality of objects, say `Y = Y'`,
then `simp` can't operate because it would break the typing of the composition operations.
We rarely have interesting equalities of objects
(because that would be "evil" --- anything interesting should be expressed as an isomorphism
and tracked explicitly),
except of course that we have plenty of definitional equalities of objects.

`dsimp` can apply these safely, even inside a composition.

After `dsimp` has cleared up the object level, `simp` can resume work on the morphism level ---
but without the `dsimp` step, because `simp` looks at expressions syntactically,
the relevant lemmas might not fire.

There's no bound on how many times you potentially could have to switch back and forth,
if the `simp` introduced new objects we again need to `dsimp`.
In practice this does occur, but only rarely, because `simp` tends to shorten chains of compositions
(i.e. not introduce new objects at all).
-/
library_note "dsimp, simp"


import Mathlib.Tactic.TypeCheck

/-- A term where `inferType` returns `Prop`, but which does not type check. -/
elab "wrong" : term =>
  return Lean.mkApp2 (.const ``id [.zero]) (.sort .zero) (.app (.sort .zero) (.sort .zero))

example : True := by
  type_check Nat -- Type
  type_check Bool.true -- Bool
  type_check nat_lit 1 -- Nat
  type_check (1 : Nat) -- Nat
  type_check (True : _) -- Prop
  type_check ∀ x y : Nat, x = y -- Prop
  type_check fun x : Nat => 2 * x + 1 -- Nat -> Nat
  fail_if_success type_check wrong
  trivial


class category (C : Type) :=
( hom : C → C → Type )
( id : (X : C) → hom X X )
( comp : {X Y Z : C} → hom X Y → hom Y Z → hom X Z )
( id_comp {X Y : C} (f : hom X Y) : comp (id X) f = f )
( comp_id {X Y : C} (f : hom X Y) : comp f (id Y) = f )
( assoc {W X Y Z : C} (f : hom W X) (g : hom X Y) (h : hom Y Z) :
    comp (comp f g) h = comp f (comp g h) )

notation " 𝟙 " => category.id
infixr: 80 " ≫ " => category.comp
infixr: 10 " ⟶ " => category.hom

variable (C : Type) [category C]

inductive prod_coprod : Type
| of_cat' : C → prod_coprod
| init : prod_coprod
| prod : prod_coprod → prod_coprod → prod_coprod
| coprod : prod_coprod → prod_coprod → prod_coprod
| term : prod_coprod

variable {C}

namespace prod_coprod

@[simp] def size : prod_coprod C → Nat
| of_cat' _ => 1
| init => 1
| prod X Y => size X + size Y + 1
| coprod X Y => size X + size Y + 1
| term => 1

inductive syn : (X Y : prod_coprod C) → Type
| of_cat {X Y : C} : (X ⟶ Y) → syn (of_cat' X) (of_cat' Y)
| prod_mk {X Y Z : prod_coprod C} : syn X Y → syn X Z → syn X (Y.prod Z)
| fst {X Y : prod_coprod C} : syn (X.prod Y) X
| snd {X Y : prod_coprod C} : syn (X.prod Y) Y
| coprod_mk {X Y Z : prod_coprod C} : syn X Z → syn Y Z → syn (X.coprod Y) Z
| inl {X Y : prod_coprod C} : syn X (X.coprod Y)
| inr {X Y : prod_coprod C} : syn Y (X.coprod Y)
| id (X : prod_coprod C) : syn X X
| comp {X Y Z : prod_coprod C} : syn X Y → syn Y Z → syn X Z

namespace syn

inductive rel : {X Y : prod_coprod C} → syn X Y → syn X Y → Prop
| refl {X Y : prod_coprod C} (f : syn X Y) : rel f f
| symm {X Y : prod_coprod C} {f g : syn X Y} : rel f g → rel g f
| trans {X Y : prod_coprod C} {f g h : syn X Y} : rel f g → rel g h → rel f h
| comp_congr {X Y Z : prod_coprod C} {f₁ f₂ : syn X Y} {g₁ g₂ : syn Y Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (f₁.comp g₁) (f₂.comp g₂)
| prod_mk_congr {X Y Z : prod_coprod C} {f₁ f₂ : syn X Y} {g₁ g₂ : syn X Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (f₁.prod_mk g₁) (f₂.prod_mk g₂)
| coprod_mk_congr {X Y Z : prod_coprod C} {f₁ f₂ : syn X Z} {g₁ g₂ : syn Y Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (f₁.coprod_mk g₁) (f₂.coprod_mk g₂)
| id_comp {X Y : prod_coprod C} (f : syn X Y) : rel ((syn.id X).comp f) f
| comp_id {X Y : prod_coprod C} (f : syn X Y) : rel (f.comp (syn.id Y)) f
| assoc {W X Y Z : prod_coprod C} (f : syn W X) (g : syn X Y) (h : syn Y Z) :
  rel ((f.comp g).comp h) (f.comp (g.comp h))
| of_cat_id {X : C} : rel (syn.of_cat (𝟙 X)) (syn.id (of_cat' X))
| of_cat_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  rel (syn.of_cat (f ≫ g)) (syn.comp (syn.of_cat f) (syn.of_cat g))
| mk_fst_comp {X Y Z : prod_coprod C} (f : syn X Y) (g : syn X Z) :
  rel (syn.comp (syn.prod_mk f g) syn.fst) f
| mk_snd_comp {X Y Z : prod_coprod C} (f : syn X Y) (g : syn X Z) :
  rel (syn.comp (syn.prod_mk f g) syn.snd) g
| prod_eta {X Y Z : prod_coprod C} (f : syn X (Y.prod Z)) :
  rel (syn.prod_mk (f.comp syn.fst) (f.comp syn.snd)) f
| inl_comp_mk {X Y Z : prod_coprod C} (f : syn X Z) (g : syn Y Z) :
  rel (syn.comp syn.inl (syn.coprod_mk f g)) f
| inr_comp_mk {X Y Z : prod_coprod C} (f : syn X Z) (g : syn Y Z) :
  rel (syn.comp syn.inr (syn.coprod_mk f g)) g
| coprod_eta {X Y Z : prod_coprod C} (f : syn (X.coprod Y) Z) :
  rel (syn.coprod_mk (syn.inl.comp f) (syn.inr.comp f)) f

infixl:50 " ♥ " => rel

instance : Trans (@rel C _ X Y) (@rel C _ X Y) (@rel C _ X Y) where
  trans := rel.trans

theorem rel_prod {X Y Z : prod_coprod C} {f g : syn X (Y.prod Z)}
  (h₁ : rel (f.comp syn.fst) (g.comp syn.fst))
  (h₂ : rel (f.comp syn.snd) (g.comp syn.snd)) :
  rel f g :=
rel.trans (rel.symm (rel.prod_eta f)) (rel.trans (rel.prod_mk_congr h₁ h₂) (rel.prod_eta g))

theorem rel_coprod {X Y Z : prod_coprod C} {f g : syn (X.coprod Y) Z}
  (h₁ : rel (syn.inl.comp f) (syn.inl.comp g))
  (h₂ : rel (syn.inr.comp f) (syn.inr.comp g)) :
  rel f g :=
rel.trans (rel.symm (rel.coprod_eta f)) (rel.trans (rel.coprod_mk_congr h₁ h₂) (rel.coprod_eta g))

end syn

inductive norm_hom : (X Y : prod_coprod C) → Type
| of_cat {X Y : C} (f : X ⟶ Y) : norm_hom (of_cat' X) (of_cat' Y)
| coprod_mk {X Y Z : prod_coprod C} (f : norm_hom X Z) (g : norm_hom Y Z) :
  norm_hom (X.coprod Y) Z
| prod_mk {X Y Z : prod_coprod C} (f : norm_hom X Y) (g : norm_hom X Z) :
  norm_hom X (prod Y Z)
| comp_inl {X Y Z : prod_coprod C} (f : norm_hom X Y) :
  norm_hom X (coprod Y Z)
| comp_inr {X Y Z : prod_coprod C} (f : norm_hom X Z) :
  norm_hom X (coprod Y Z)
| fst_comp {X Y Z : prod_coprod C} (f : norm_hom X Z) :
  norm_hom (prod X Y) Z
| snd_comp {X Y Z : prod_coprod C} (f : norm_hom Y Z) :
  norm_hom (prod X Y) Z
| from_init (X : prod_coprod C) : norm_hom init X
| to_term (X : prod_coprod C) : norm_hom X term

namespace norm_hom

inductive rel : {X Y : prod_coprod C} → norm_hom X Y → norm_hom X Y → Prop
| refl {X Y : prod_coprod C} (f : norm_hom X Y) : rel f f
| symm {X Y : prod_coprod C} {f g : norm_hom X Y} : rel g f → rel f g
| trans {X Y : prod_coprod C} {f g h : norm_hom X Y} : rel f g → rel g h → rel f h
| coprod_mk_congr {X Y Z : prod_coprod C} {f₁ f₂ : norm_hom X Z} {g₁ g₂ : norm_hom Y Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (coprod_mk f₁ g₁) (coprod_mk f₂ g₂)
| prod_mk_congr {X Y Z : prod_coprod C} {f₁ f₂ : norm_hom X Y} {g₁ g₂ : norm_hom X Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (prod_mk f₁ g₁) (prod_mk f₂ g₂)
| comp_inl_congr {X Y Z : prod_coprod C} {f₁ f₂ : norm_hom X Y} :
  rel f₁ f₂ → rel (comp_inl f₁ : norm_hom X (coprod Y Z)) (comp_inl f₂)
| comp_inr_congr {X Y Z : prod_coprod C} {f₁ f₂ : norm_hom X Z} :
  rel f₁ f₂ → rel (comp_inr f₁ : norm_hom X (coprod Y Z)) (comp_inr f₂)
| fst_comp_congr {X Y Z : prod_coprod C} {f₁ f₂ : norm_hom X Z} :
  rel f₁ f₂ → rel (fst_comp f₁ : norm_hom (prod X Y) Z) (fst_comp f₂)
| snd_comp_congr {X Y Z : prod_coprod C} {f₁ f₂ : norm_hom Y Z} :
  rel f₁ f₂ → rel (snd_comp f₁ : norm_hom (prod X Y) Z) (snd_comp f₂)
| fst_comp_prod_mk {W X Y Z : prod_coprod C} (f : norm_hom X Y) (g : norm_hom X Z) :
  rel (fst_comp (prod_mk f g) : norm_hom (prod X W) (prod Y Z)) (prod_mk f.fst_comp g.fst_comp)
| snd_comp_prod_mk {W X Y Z : prod_coprod C} (f : norm_hom X Y) (g : norm_hom X Z) :
  rel (snd_comp (prod_mk f g) : norm_hom (prod W X) (prod Y Z)) (prod_mk f.snd_comp g.snd_comp)
| comp_inl_coprod_mk {W X Y Z : prod_coprod C} (f : norm_hom W Y) (g : norm_hom X Y) :
  rel (comp_inl (coprod_mk f g) : norm_hom (coprod W X) (coprod Y Z))
    (coprod_mk f.comp_inl g.comp_inl)
| comp_inr_coprod_mk {W X Y Z : prod_coprod C} (f : norm_hom W Y) (g : norm_hom X Y) :
  rel (comp_inr (coprod_mk f g) : norm_hom (coprod W X) (coprod Z Y))
    (coprod_mk f.comp_inr g.comp_inr)
| fst_comp_comp_inl {W X Y Z : prod_coprod C} (f : norm_hom W Y) :
  rel (f.fst_comp.comp_inl : norm_hom (prod W X) (coprod Y Z)) f.comp_inl.fst_comp
| snd_comp_comp_inl {W X Y Z : prod_coprod C} (f : norm_hom X Y) :
  rel (f.snd_comp.comp_inl : norm_hom (prod W X) (coprod Y Z)) f.comp_inl.snd_comp
| fst_comp_comp_inr {W X Y Z : prod_coprod C} (f : norm_hom W Z) :
  rel (f.fst_comp.comp_inr : norm_hom (prod W X) (coprod Y Z)) f.comp_inr.fst_comp
| snd_comp_comp_inr {W X Y Z : prod_coprod C} (f : norm_hom X Z) :
  rel (f.snd_comp.comp_inr : norm_hom (prod W X) (coprod Y Z)) f.comp_inr.snd_comp

def to_inj : {X Y Z : prod_coprod C} → (f : norm_hom X (coprod Y Z)) →
  Option ((norm_hom X Y) ⊕ (norm_hom X Z))
| _, _, _, comp_inl f => some (Sum.inl f)
| _, _, _, comp_inr f => some (Sum.inr f)
| _, _, _, fst_comp f =>
  match to_inj f with
  | none => none
  | some (Sum.inl f) => some (Sum.inl (fst_comp f))
  | some (Sum.inr f) => some (Sum.inr (fst_comp f))
| _, _, _, snd_comp f =>
  match to_inj f with
  | none => none
  | some (Sum.inl f) => some (Sum.inl (snd_comp f))
  | some (Sum.inr f) => some (Sum.inr (snd_comp f))
| _, _, _, coprod_mk f g =>
  match to_inj f, to_inj g with
  | some (Sum.inl f), some (Sum.inl g) => some (Sum.inl (coprod_mk f g))
  | some (Sum.inr f), some (Sum.inr g) => some (Sum.inr (coprod_mk f g))
  | _, _ => none
| _, _, _, @from_init _ _ (coprod _ _) => some (Sum.inl (coprod_mk f g))

theorem to_inj_eq_inl : {X Y Z : prod_coprod C} → {f : norm_hom X (coprod Y Z)} →
  {g : norm_hom X Y} → to_inj f = some (Sum.inl g) → rel f g.comp_inl
| _, _, _, comp_inl f, g, h => by
  simp [to_inj] at h
  simp [h]
  exact rel.refl _
  | _, _, _, comp_inr f, g, h => by
  simp [to_inj] at h
| _, _, _, snd_comp f, g, h =>
  have hi : ∃ i, to_inj f = some (Sum.inl i) := by
  { simp [to_inj] at h
    revert h
    match to_inj f with
    | some (Sum.inl i) => intro h; exact ⟨i, rfl⟩
    | some (Sum.inr _) => simp
    | none => simp }
  match hi with
  | ⟨i, hi⟩ => by
  simp [hi, to_inj] at h
  rw [← h]
  exact rel.trans (rel.snd_comp_congr (to_inj_eq_inl hi))
    (rel.snd_comp_comp_inl i).symm
| _, _, _, fst_comp f, g, h =>
  have hi : ∃ i, to_inj f = some (Sum.inl i) := by
  { simp [to_inj] at h
    revert h
    match to_inj f with
    | some (Sum.inl i) => intro h; exact ⟨i, rfl⟩
    | some (Sum.inr _) => simp
    | none => simp }
  match hi with
  | ⟨i, hi⟩ => by
  simp [hi, to_inj] at h
  rw [← h]
  exact rel.trans (rel.fst_comp_congr (to_inj_eq_inl hi))
    (rel.fst_comp_comp_inl i).symm
| _, _, _, coprod_mk f g, i, h =>
  have hi : ∃ f' g', to_inj f = some (Sum.inl f') ∧ to_inj g = some (Sum.inl g') := by
  { simp [to_inj] at h
    revert h
    match to_inj f, to_inj g with
    | some (Sum.inl f'), some (Sum.inl g') => intro h; exact ⟨f', g', rfl, rfl⟩
    | some (Sum.inr _), some (Sum.inr _) => simp
    | none, _ => simp
    | _, none => simp
    | some (Sum.inl _), some (Sum.inr _) => simp
    | some (Sum.inr _), some (Sum.inl _) => simp }
  match hi with
  | ⟨f', g', hf, hg⟩ => by
  simp [hf, hg, to_inj] at h
  rw [← h]
  exact rel.trans (rel.coprod_mk_congr (to_inj_eq_inl hf) (to_inj_eq_inl hg))
    (rel.comp_inl_coprod_mk _ _).symm

theorem to_inj_eq_inr : {X Y Z : prod_coprod C} → {f : norm_hom X (coprod Y Z)} →
  {g : norm_hom X Z} → to_inj f = some (Sum.inr g) → rel f g.comp_inr
| _, _, _, comp_inr f, g, h => by
  simp [to_inj] at h
  simp [h]
  exact rel.refl _
  | _, _, _, comp_inl f, g, h => by
  simp [to_inj] at h
| _, _, _, snd_comp f, g, h =>
  have hi : ∃ i, to_inj f = some (Sum.inr i) := by
  { simp [to_inj] at h
    revert h
    match to_inj f with
    | some (Sum.inr i) => intro h; exact ⟨i, rfl⟩
    | some (Sum.inl _) => simp
    | none => simp }
  match hi with
  | ⟨i, hi⟩ => by
  simp [hi, to_inj] at h
  rw [← h]
  exact rel.trans (rel.snd_comp_congr (to_inj_eq_inr hi))
    (rel.snd_comp_comp_inr i).symm
| _, _, _, fst_comp f, g, h =>
  have hi : ∃ i, to_inj f = some (Sum.inr i) := by
  { simp [to_inj] at h
    revert h
    match to_inj f with
    | some (Sum.inr i) => intro h; exact ⟨i, rfl⟩
    | some (Sum.inl _) => simp
    | none => simp }
  match hi with
  | ⟨i, hi⟩ => by
  simp [hi, to_inj] at h
  rw [← h]
  exact rel.trans (rel.fst_comp_congr (to_inj_eq_inr hi))
    (rel.fst_comp_comp_inr i).symm
| _, _, _, coprod_mk f g, i, h =>
  have hi : ∃ f' g', to_inj f = some (Sum.inr f') ∧ to_inj g = some (Sum.inr g') := by
  { simp [to_inj] at h
    revert h
    match to_inj f, to_inj g with
    | some (Sum.inr f'), some (Sum.inr g') => intro _; exact ⟨f', g', rfl, rfl⟩
    | some (Sum.inl _), some (Sum.inl _) => simp
    | none, _ => simp
    | _, none => simp
    | some (Sum.inr _), some (Sum.inl _) => simp
    | some (Sum.inl _), some (Sum.inr _) => simp }
  match hi with
  | ⟨f', g', hf, hg⟩ => by
  simp [hf, hg, to_inj] at h
  rw [← h]
  exact rel.trans (rel.coprod_mk_congr (to_inj_eq_inr hf) (to_inj_eq_inr hg))
    (rel.comp_inr_coprod_mk _ _).symm

theorem to_inj_eq_none {X Y Z : prod_coprod C} {f : norm_hom X (coprod Y Z)}
  (hf : to_inj f = none) {g : norm_hom X Z} : ¬rel f g.comp_inr := by
intro h
cases h
simp at hf

end norm_hom