/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.equiv_rw
import control.equiv_functor.instances -- these make equiv_rw more powerful!

-- Uncomment this line to observe the steps of constructing appropriate equivalences.
-- set_option trace.equiv_rw_type true

import tactic.equiv_rw

-- This fails if we use `occurs` rather than `kdepends_on` in `equiv_rw_type`.
instance : equiv_functor set :=
{ map := λ α β e s, by { equiv_rw e.symm, assumption, } }

-- Rewriting a hypothesis along an equivalence.
example {α β : Type} (e : α ≃ β)
  (f : α → ℕ) (h : ∀ b : β, f (e.symm b) = 0) (i : α) : f i = 0 :=
begin
  equiv_rw e at i,
  apply h,
end

-- Check that dependent hypotheses are reverted and reintroduced.
example {α β : Type} (e : α ≃ β) (Z : α → Type) (f : Π a, Z a → ℕ)
  (h : ∀ (b : β) (x : Z (e.symm b)), f (e.symm b) x = 0)
  (i : α) (x : Z i) : f i x = 0 :=
begin
  equiv_rw e at i,
  guard_hyp i : β,
  guard_target f (e.symm i) x = 0,
  guard_hyp x : Z ((e.symm) i),
  exact h i x,
end

-- Rewriting the goal along an equivalence.
example {α β : Type} (e : α ≃ β) (b : β) : α :=
begin
  equiv_rw e,
  exact b,
end

-- Fail if the equivalence can't be used.
example {α β γ : Type} (e : β ≃ γ) (a : α) : α :=
begin
  success_if_fail { equiv_rw e at a },
  success_if_fail { equiv_rw e },
  exact a,
end

-- Verify that `equiv_rw` will rewrite under `equiv_functor` instances.
example {α β : Type} (u : unique α) (e : α ≃ β) : β :=
begin
  equiv_rw e at u,
  apply inhabited.default,
end

example {α β : Type} (p : equiv.perm α) (e : α ≃ β) : equiv.perm β :=
begin
  equiv_rw e at p,
  exact p,
end

-- We can rewrite the goal under functors.
example {α β : Type} (e : α ≃ β) (b : β) : option α :=
begin
  equiv_rw e,
  exact some b,
end

-- We can rewrite hypotheses under functors.
example {α β : Type} (e : α ≃ β) (b : option α) : option β :=
begin
  equiv_rw e at b,
  exact b,
end

-- We can rewrite hypotheses under compositions of functors.
example {α β : Type} (e : α ≃ β) (b : list (list α)) : list β :=
begin
  equiv_rw e at b,
  exact b.join,
end

-- Check that we can rewrite in the target position of function types.
example {α β γ : Type} (e : α ≃ β) (f : γ → β) : γ → α :=
begin
  equiv_rw e,
  exact f,
end

-- Check that we can rewrite in the source position of function types.
example {α β γ : Type} (e : α ≃ β) (f : β → γ) : α → γ :=
begin
  equiv_rw e,
  exact f,
end

-- Rewriting under multiple functors.
example {α β : Type} (e : α ≃ β) (b : β) : list (option α) :=
begin
  equiv_rw e,
  exact [none, some b],
end

-- Rewriting under multiple functors, including functions.
example {α β γ : Type} (e : α ≃ β) (b : β) : γ → list (option α) :=
begin
  equiv_rw e,
  exact (λ g, [none, some b]),
end

-- Rewriting in multiple positions.
example {α β : Type*} [has_add β] (e : α ≃ β) : α → α :=
begin
  have : (α → α) ≃ _, {
    apply equiv.arrow_congr,
    apply e,
    apply e,
  },
  equiv_rw e,
  exact (@id β),
end

-- Rewriting in multiple positions.
example {α β : Type} [has_add β] (e : α ≃ β) : β → α → α :=
begin
  equiv_rw e,
  exact (+),
end

-- Rewriting in multiple positions.
example {α β : Type} [has_add β] (e : α ≃ β) : α → α → α :=
begin
  equiv_rw e,
  exact (+),
end

example {α β γ : Type} (e : α ≃ β) (s : β ⊕ γ) : α ⊕ γ :=
begin
  equiv_rw e,
  exact s,
end

example {α β γ : Type} (e : α ≃ β) (s : β ⊕ γ) : (α ⊕ γ) × (γ ⊕ α) :=
begin
  equiv_rw e,
  exact (s, s.swap),
end

example {α β γ : Type} (e : α ≃ β) (s : α ⊕ γ) : (β ⊕ γ) × (γ ⊕ β) :=
begin
  equiv_rw e at s,
  exact (s, s.swap),
end

example {α β γ : Type} (e : α ≃ β) (s : (α ⊕ γ) × β) : (β ⊕ γ) :=
begin
  success_if_fail { equiv_rw e at s {max_depth := 4} },
  equiv_rw e at s,
  exact s.1,
end

-- Test generating the actual equivalence using `equiv_rw_type`.
example {α β : Type} (e : α ≃ β) (b : β) : α × (ℕ ⊕ ℕ) :=
begin
  have e' : α × (ℕ ⊕ ℕ) ≃ _ := by equiv_rw_type e,
  apply e'.inv_fun,
  exact (b, sum.inl 0)
end

example {α β : Type} (e : α ≃ β) (P : α → Prop) (h : { a // P a }) : β :=
begin
  equiv_rw e at h,
  exact h.val,
end

example {α β : Type} (e : α ≃ β) (P : α → Prop) (h : ∀ a, P a) (b : β) : { a // P a } :=
begin
  equiv_rw e,
  use b,
  apply h,
end

example {α β : Type} (e : α ≃ β) (P : α → Prop) (h : ∀ a : α, P a) (b : β) : P (e.symm b) :=
begin
  equiv_rw e.symm at b,
  exact h b,
end

example {α β : Type} (e : α ≃ β) (P : α → Sort*) (h : Π a : α, P a) (b : β) : P (e.symm b) :=
begin
  -- this is a bit perverse, as `equiv_rw e.symm at b` is more natural,
  -- but this tests rewriting in the argument of a dependent function
  equiv_rw e at h,
  exact h _,
end

-- a poor example, rewriting in the base of a dependent pair
example {α β : Type} (P : α → Type) (h : Σ a, P a) (e : α ≃ β) : β :=
begin
  equiv_rw e at h,
  exact h.1
end

-- rewriting in the argument of a dependent function can't be done in one step
example {α β γ : Type} (e : α ≃ β) (P : α → Type*) (h : Π a : α, (P a) × (option α)) (b : β) :
  option β :=
begin
  equiv_rw e at h,
  have t := h b,
  equiv_rw e at t,
  exact t.2,
end

-- Demonstrate using `equiv_rw` to build new instances of `equiv_functor`
-- Observe that the next three declarations could easily be implemented by a tactic.

-- This has been automated in the `transport` branch,
-- so we won't attempt to write a deriver handler until we join with that.
def semigroup.map {α β : Type} (e : α ≃ β) : semigroup α → semigroup β :=
begin
  intro S,
  refine_struct { .. },
  -- transport data fields using `equiv_rw`
  { have mul := S.mul,
    equiv_rw e at mul,
    -- This `equiv_rw` performs the following steps:
    -- have e' := (equiv.arrow_congr' e (equiv.arrow_congr' e e)),
    -- have h := (e'.symm_apply_apply mul).symm,
    -- revert h,
    -- generalize : (e' mul) = mul',
    -- intro h,
    -- clear_dependent mul,
    -- rename mul' mul,
    exact mul,
  },
  -- transport axioms by simplifying, and applying the original axiom
  { intros, dsimp, simp, apply S.mul_assoc, }
end

example {α β : Type} (e : α ≃ β) (S : semigroup α) :
  (semigroup.map e S).mul =
    (equiv.arrow_congr' e (equiv.arrow_congr' e e)) has_mul.mul :=
rfl

example {α β : Type} (e : α ≃ β) (S : semigroup α) (x y : β) :
begin
  haveI := semigroup.map e S,
  exact x * y = e (e.symm x * e.symm y)
end :=
rfl

attribute [ext] semigroup

lemma semigroup.id_map (α : Type) : semigroup.map (equiv.refl α) = id :=
by { ext, refl, }

lemma semigroup.map_map {α β γ : Type} (e : α ≃ β) (f : β ≃ γ) :
  semigroup.map (e.trans f) = (semigroup.map f) ∘ (semigroup.map e) :=
by { ext, dsimp [semigroup.map], simp, }

-- TODO (after joining the `transport` branch) create a derive handler for this
instance : equiv_functor semigroup :=
{ map := λ α β e, semigroup.map e,
  map_refl' := semigroup.id_map,
  map_trans' := λ α β γ e f, semigroup.map_map e f, }

-- Verify that we can now use `equiv_rw` under `semigroup`:
example {α : Type} [I : semigroup α] {β : Type} (e : α ≃ β) : semigroup β :=
begin
  equiv_rw e at I,
  exact I,
end

-- Now we do `monoid`, to try out a structure with constants.

-- The constructions and proofs here are written as uniformly as possible.
-- This example is the blueprint for the `transport` tactic.

mk_simp_attribute transport_simps "simps useful inside `transport`"

attribute [transport_simps]
  eq_rec_constant
  cast_eq
  equiv.to_fun_as_coe
  equiv.arrow_congr'_apply
  equiv.symm_apply_apply
  equiv.apply_eq_iff_eq_symm_apply

def monoid.map {α β : Type} (e : α ≃ β) (S : monoid α) : monoid β :=
begin
  refine_struct { .. },
  { have mul := S.mul, equiv_rw e at mul, exact mul, },
  { try { unfold_projs },
    simp only with transport_simps,
    have mul_assoc := S.mul_assoc,
    equiv_rw e at mul_assoc,
    solve_by_elim, },
  { have one := S.one, equiv_rw e at one, exact one, },
  { try { unfold_projs },
    simp only with transport_simps,
    have one_mul := S.one_mul,
    equiv_rw e at one_mul,
    solve_by_elim, },
  { try { unfold_projs },
    simp only with transport_simps,
    have mul_one := S.mul_one,
    equiv_rw e at mul_one,
    solve_by_elim, },
  { have npow := S.npow, equiv_rw e at npow, exact npow, },
  { try { unfold_projs },
    simp only with transport_simps,
    have npow_zero' := S.npow_zero',
    equiv_rw e at npow_zero',
    solve_by_elim, },
  { try { unfold_projs },
    simp only with transport_simps,
    have npow_succ' := S.npow_succ',
    equiv_rw e at npow_succ',
    solve_by_elim, },
end

example {α β : Type} (e : α ≃ β) (S : monoid α) :
  (monoid.map e S).mul =
    (equiv.arrow_congr' e (equiv.arrow_congr' e e)) has_mul.mul :=
rfl

example {α β : Type} (e : α ≃ β) (S : monoid α) (x y : β) :
begin
  haveI := monoid.map e S,
  exact x * y = e (e.symm x * e.symm y)
end :=
rfl

example {α β : Type} (e : α ≃ β) (S : monoid α) :
begin
  haveI := monoid.map e S,
  exact (1 : β) = e (1 : α)
end :=
rfl

example
  {α : Type} {β : Type}
  (m : α → α → α)
  (e : α ≃ β) :
  β → β → β :=
begin
  equiv_rw e at m,
  exact m,
end

-- This used to fail because metavariables were getting stuck!
example
  {α : Type} {β : Type 2}
  (m : α → α → α)
  (e : α ≃ β) :
  β → β → β :=
begin
  equiv_rw e at m,
  exact m,
end


import .lptree .binary_tree
       galois.option

namespace binary_tree

def twice {A} (f : A -> A -> A)
  (x y : A × A) : A × A :=
  let (a, b) := x in let (p, q) := y in
     (f a b, f p q)

def untwice_tree {A} (f : A -> A -> A)
  : tree (A × A) -> tree A
| (tree.leaf (x, y)) := tree.node (f x y) (tree.leaf x) (tree.leaf y)
| (tree.node (x, y) l r) := tree.node (f x y) (untwice_tree l) (untwice_tree r)

lemma untwice_tree_height {A} (f : A → A → A)
  (x : tree (A × A))
  : (untwice_tree f x).height = x.height + 1
:= begin
induction x; induction item; dsimp [untwice_tree, tree.height],
{ rw nat.max_same, },
{ rw ih_1, rw ih_2, clear ih_1 ih_2 fst snd,
  f_equal, rw nat.max_add,
}
end

/-- Compute a list of left subtrees, starting with the furthest
    down
-/
def lptree_to_tree_helper
  : ∀ {A}, (A -> A -> A) -> lptree A -> list (tree A)
| A f lptree.nil := []
| A f (lptree.cons mx t') := (match mx with
    | some x := list.cons (tree.leaf x)
    | none := λ zs, zs
    end)
      (list.map (untwice_tree f) (lptree_to_tree_helper (twice f) t'))

def lptree_to_tree_helper_option
  : ∀ {A}, (A -> A -> A) -> lptree A -> list (option (tree A))
| A f lptree.nil := []
| A f (lptree.cons mx t') := list.cons
   (option.map tree.leaf mx)
      (list.map (option.map (untwice_tree f)) (lptree_to_tree_helper_option (twice f) t'))

def asc_heights : ℕ → list ℕ → ℕ
| n [] := n
| n (x :: xs) := asc_heights(max x n + 1) xs

def max_tree_list_height {A : Type} (x : tree A) (xs : list (tree A)) : ℕ
  := asc_heights x.height (xs.map tree.height)

lemma tree_height_untwice_tree {A} (f : A → A → A) :
  (tree.height ∘ untwice_tree f) = (nat.succ ∘ tree.height)
:= begin
apply funext, intros x; dsimp [function.comp],
rw untwice_tree_height,
end

lemma asc_heights_helper_mono {m n : ℕ} (H : m ≤ n)
  (xs : list ℕ)
  : asc_heights m xs ≤ asc_heights n xs
:= begin
revert m n,
induction xs; intros; dsimp [asc_heights], assumption,
apply ih_1, apply nat.add_le_add_right, apply nat.max_mono,
apply nat.le_refl, assumption,
end

lemma asc_heights_succ (n : ℕ) (xs : list ℕ)
  : asc_heights n.succ (xs.map nat.succ) ≤ (asc_heights n xs).succ
:= begin
revert n;
induction xs; intros; dsimp [asc_heights],
{ constructor, },
{ repeat { rw ← nat.add_one },
  rw nat.max_add, apply le_trans, apply ih_1,
  rw ← nat.add_one,
}
end

/-- Given a rightmost subtree, and a list of left subtrees
    starting from furthest toward the rightmost subtree and
    moving towards the root, assemble them into a single tree.
-/
def assemble_left_subtrees {A} (f : A -> A -> A)
  : tree A -> list (tree A) -> tree A
  | x [] := x
  | x (y :: ys) := assemble_left_subtrees (combine f y x) ys

/-- Convert a left-perfect tree to a binary tree with internal
    nodes, using the function `f` to produce internal nodes
    from the roots of the corresponding subtrees. Since lptrees
    may be empty, but trees may not, we return `none` exactly
    when the lptree is empty.
-/
def lptree_to_tree {A} (f : A -> A -> A)
  (t : lptree A) : option (tree A) :=
  match lptree_to_tree_helper f t with
  | [] := none
  | (x :: xs) := some (assemble_left_subtrees f x xs)
  end

def assemble_left_subtrees_option {A} (f : A → A → A) : list (option (tree A)) → option (tree A)
| [] := none
| (none :: xs) := assemble_left_subtrees_option xs
| (some x :: xs) := some (assemble_left_subtrees f x xs.filter_some)

def lptree_to_tree_option {A} (f : A -> A -> A)
  (t : lptree A) : option (tree A) :=
  assemble_left_subtrees_option f (lptree_to_tree_helper_option f t)

lemma lptree.nonzero_subtrees {A} (t : lptree A)
  (f : A -> A -> A)
  (H : lptree_to_tree_helper f t ≠ [])
  : option.Issome (lptree_to_tree f t)
  :=
begin
unfold lptree_to_tree,
revert H,
destruct (lptree_to_tree_helper f t); intros,
{ contradiction },
{ clear H, rw a_2, simp [lptree_to_tree._match_1], constructor }
end

lemma lptree.nonzero_tree {A} (t : lptree A)
  (f : A -> A -> A)
  (tnonzero : lptree.nonzero t)
  : option.Issome (lptree_to_tree f t) :=
begin
apply lptree.nonzero_subtrees,
induction tnonzero with A x t A ma t tnonzero IHtnonzero,
{ dsimp, simp [lptree_to_tree_helper], },
{ simp [lptree_to_tree_helper],
  cases ma; simp [lptree_to_tree_helper._match_1],
  { apply list.map_not_nil, apply IHtnonzero },
}
end

def merge_to_tree {A} (f : A -> A -> A)
  (xs : list A) : option (tree A)
  := lptree_to_tree f (list_to_lptree xs)

lemma list_to_tree_Some {A} (xs : list A)
  (f) (H : xs ≠ [])
  : option.Issome (merge_to_tree f xs)
  :=
begin
  apply lptree.nonzero_tree,
  apply list_to_lptree.nonzero,
  assumption
end

lemma lptree_to_tree_helper_nonempty_nonzero {A}
  (f : A -> A -> A)
  (t : lptree A)
  (H : lptree_to_tree_helper f t ≠ [])
  : lptree.nonzero t :=
begin
induction t,
  { contradiction },
  { cases a,
    { simp [lptree_to_tree_helper] at H, constructor,
     apply ih_1, intros contra, apply H,
     apply list.map_nil, apply contra },
    { constructor }
  }
end

lemma assemble_left_subtrees_height {A : Type}
  (f : A → A → A) (x : tree A) (xs : list (tree A))
  : (assemble_left_subtrees f x xs).height = max_tree_list_height x xs
:= begin
revert x,
unfold max_tree_list_height,
induction xs; intros;
  dsimp [tree.height, assemble_left_subtrees, asc_heights],
{ reflexivity },
{ rw ih_1, rw combine_height, }
end

lemma asc_heights_lemma1 (xs : list ℕ) (n : ℕ)
  : asc_heights n (list.map nat.succ xs)
  ≤ asc_heights n xs + 1
:= begin
apply le_trans, tactic.swap,
apply asc_heights_succ,
apply asc_heights_helper_mono,
constructor, constructor,
end

def opt_default {A} (default : A) : option A → A
| (some x) := x
| none := default

lemma asc_heights_filter_some1 {A} (n : ℕ) (xs : list (option (tree A))) :
 asc_heights n (list.map tree.height xs.filter_some) ≤
    asc_heights n
      (list.map (opt_default 0 ∘ option.map tree.height) xs)
:= begin
revert n,
induction xs; intros; dsimp [asc_heights, list.map, list.filter_some],
{ apply le_refl },
{ induction a; dsimp [list.filter_some],
  { apply le_trans, apply ih_1,
    apply asc_heights_helper_mono,
    apply le_trans, tactic.swap, apply nat.le_add_r,
    apply le_max_right, },
  { dsimp [asc_heights], apply le_trans,
    apply ih_1,
    apply asc_heights_helper_mono,
    apply nat.add_le_add_right,
    apply nat.max_mono,
    { apply le_refl },
    { apply le_refl }
  }
}
end

lemma asc_heights_filter_some {A} (n : ℕ) (xs : list (option (tree A))) :
 asc_heights n (list.map tree.height xs.filter_some) ≤
    asc_heights (n + 1)
      (list.map (opt_default 0 ∘ option.map tree.height) xs)
:= begin
apply le_trans, apply asc_heights_filter_some1,
apply asc_heights_helper_mono, constructor, constructor,
end

lemma assemble_left_subtrees_option_height {A : Type}
  (f : A → A → A) (xs : list (option (tree A)))
  : (match assemble_left_subtrees_option f xs with
    | none := true
    | some t := t.height ≤ asc_heights 0 (list.map (opt_default 0 ∘ option.map tree.height) xs)
    end : Prop)
:= begin
destruct (assemble_left_subtrees_option f xs),
{ intros Hnone, rw Hnone, dsimp, constructor, },
{ intros t Ht, rw Ht, dsimp,
  revert t, induction xs; intros; dsimp [list.map, asc_heights],
  { dsimp [assemble_left_subtrees_option] at Ht, contradiction, },
  { induction a,
    { dsimp [assemble_left_subtrees_option] at Ht,
      specialize (ih_1 _ Ht), apply le_trans, assumption,
      apply asc_heights_helper_mono, apply nat.zero_le,
      },
    { dsimp [assemble_left_subtrees_option] at Ht,
      injection Ht with Ht', clear Ht,
      subst t,
      rw assemble_left_subtrees_height,
      clear ih_1,
      unfold max_tree_list_height,
      apply le_trans, apply asc_heights_filter_some,
      apply asc_heights_helper_mono,
      dsimp [option.map, opt_default, option.bind, function.comp],
      rw nat.max_0_r,
    }
  }
}
end

lemma asc_heights_list_mono_lemma (n : ℕ) (xs : list (option ℕ)) :
  asc_heights n (xs.map (opt_default 0 ∘ option.map nat.succ))
≤ asc_heights n (xs.map (nat.succ ∘ opt_default 0))
:= begin
revert n,
induction xs; intros; dsimp [list.map, asc_heights],
{ apply nat.le_refl,  },
{ apply le_trans, apply ih_1,
  apply asc_heights_helper_mono,
  apply nat.add_le_add_right,
  apply nat.max_mono,
  { dsimp [function.comp], induction a;
      dsimp [option.map, option.bind, opt_default],
    apply nat.zero_le, apply nat.le_refl },
  { apply le_refl }
}
end

lemma asc_heights_succ_option (n : ℕ) (xs : list (option ℕ))
  : asc_heights n.succ (xs.map (opt_default 0 ∘ option.map nat.succ))
  ≤ (asc_heights n (xs.map (opt_default 0))).succ
:= begin
revert n;
induction xs; intros; dsimp [asc_heights],
{ constructor, },
{ repeat { rw nat.add_one },
  apply le_trans, apply ih_1,
  apply nat.succ_le_succ, apply asc_heights_helper_mono,
  repeat { rw ← nat.add_one }, rw ← nat.max_add,
  apply nat.max_mono,
  { induction a; dsimp [opt_default, function.comp, option.map, option.bind],
    apply nat.zero_le, apply le_refl,
  },
  { apply le_refl }
}
end

lemma stupid_lemma {A} (a : A)
  : ((opt_default 0 ∘ option.map tree.height) ((some ∘ tree.leaf) a))
  = 0 := rfl

lemma asc_heights_lemma {A : Type}
  (f : A → A → A) (t : lptree A)
  : asc_heights 0 (list.map (opt_default 0 ∘ option.map tree.height) (lptree_to_tree_helper_option f t))
  ≤ lptree.height t
:= begin
induction t; dsimp [lptree_to_tree_helper_option, lptree.height, asc_heights],
{ apply nat.zero_le, },
{ rw ← list.map_compose,
  rw function.comp.assoc
    (opt_default 0) (option.map tree.height) (option.map (untwice_tree f)),
  rw ← option.map_compose,
  rw tree_height_untwice_tree,
  rw option.map_compose (tree.height) (nat.succ),
  rw ← function.comp.assoc
    (opt_default 0) (option.map nat.succ) (option.map tree.height),
  rw list.map_compose,
  apply le_trans, apply asc_heights_list_mono_lemma,
  rw ← list.map_compose,
  rw function.comp.assoc
    (nat.succ) (opt_default 0) (option.map tree.height),
  rw list.map_compose,
  repeat { rw nat.add_one },
  apply le_trans,
  apply asc_heights_succ,
  apply nat.succ_le_succ,
  induction a; dsimp [option.map, option.bind
  , lptree_to_tree_helper_option, lptree.height
  , asc_heights],
  {
    apply ih_1,
  },
  { rw stupid_lemma,
    dsimp [max], rw (if_pos (le_refl 0)),
    apply ih_1,
  }
}
end

lemma lptree_to_tree_option_height
  {A : Type}
  (f : A → A → A) (lpt : lptree A)
  : (match lptree_to_tree_option f lpt with
    | none := true
    | some t := t.height ≤ lpt.height
    end : Prop)
:= begin
destruct (lptree_to_tree_option f lpt),
{ intros Hnone, rw Hnone, dsimp, constructor },
{ intros t Ht, rw Ht, dsimp,
  unfold lptree_to_tree_option at Ht,
  have H := assemble_left_subtrees_option_height
    f (lptree_to_tree_helper_option f lpt),
  rw Ht at H, dsimp at H,
  apply le_trans, assumption,
  apply asc_heights_lemma,
}
end

lemma lptree_to_tree_helper_option_equiv
  {A : Type}
  (f : A → A → A) (lpt : lptree A)
  : lptree_to_tree_helper f lpt
  = (lptree_to_tree_helper_option f lpt).filter_some
:= begin
induction lpt;
  dsimp [lptree_to_tree_helper, lptree_to_tree_helper_option, list.filter_some],
{ reflexivity },
{ induction a;
    dsimp [option.map, option.bind, lptree_to_tree_helper
      , lptree_to_tree_helper_option, list.filter_some],
    { rw list.map_filter_some, f_equal,
    apply ih_1, },
    { f_equal, rw list.map_filter_some, f_equal, apply ih_1 }
 }
end

lemma assemble_left_subtrees_option_filter_some
  {A : Type} (f : A → A → A)
  (xs : list (option (tree A)))
  : assemble_left_subtrees_option f xs = match xs.filter_some with
  | [] := none
  | (y :: ys) := some (assemble_left_subtrees f y ys)
  end
:= begin
induction xs; dsimp [list.filter_some, assemble_left_subtrees_option],
{ reflexivity },
{ rename a x, induction x; dsimp [list.filter_some, assemble_left_subtrees_option],
  { rw ih_1, },
  { reflexivity }
}
end

lemma lptree_to_tree_option_equiv
  {A : Type}
  (f : A → A → A) (lpt : lptree A)
  : lptree_to_tree_option f lpt = lptree_to_tree f lpt
:= begin
unfold lptree_to_tree_option lptree_to_tree,
rw assemble_left_subtrees_option_filter_some,
destruct (lptree_to_tree_helper f lpt),
{ intros Hnone, rw Hnone, dsimp [lptree_to_tree],
  rw lptree_to_tree_helper_option_equiv at Hnone,
  rw Hnone,
},
{ intros t ts Hts, rw Hts, dsimp [lptree_to_tree],
  rw lptree_to_tree_helper_option_equiv at Hts,
  rw Hts,
}
end

lemma lptree_to_tree_some_nonzero {A}
  (f : A -> A -> A)
  (t : lptree A) :
  ∀ (x : tree A) (H : lptree_to_tree f t = some x), lptree.nonzero t :=
begin
intros, apply (lptree_to_tree_helper_nonempty_nonzero f),
unfold lptree_to_tree at H,
intros contra,
rw contra at H,
simp [lptree_to_tree._match_1] at H,
contradiction
end

lemma assemble_left_subtrees_preserves_nodes
 {A} (f : A -> A -> A) (xs : list (tree A))
 (Hxs : list.Forall (internal_nodes_ok f) xs)
 : ∀ (x : tree A) (Hx : internal_nodes_ok f x),
   internal_nodes_ok f (assemble_left_subtrees f x xs)
 :=
 begin
 induction Hxs; intros,
 { simp [assemble_left_subtrees], assumption },
 { simp [assemble_left_subtrees],
   apply ih_1, apply internal_nodes_ok_combine,
   assumption, assumption }
 end

lemma assemble_left_subtrees_preserves_leaves
  {A} (f : A -> A -> A) (xs : list (tree A))
  : ∀ (x : tree A),
   (assemble_left_subtrees f x xs).leaves
   = left_subtrees_leaves f xs x :=
begin
induction xs; intros,
{ reflexivity },
{ simp [assemble_left_subtrees],
  rw ih_1,
  reflexivity
}
end

lemma congr_arg2_pair {A B C} (f : A -> B -> C)
  (a a' : A) (b b' : B)
  : (a, b) = (a', b') -> f a b = f a' b'
  :=
begin
intros H, injection H,
subst a,
subst b
end

lemma root_untwice_tree {A} (f : A -> A -> A) (t : tree (A × A))
  : forall (x y : A) (Hroot : root t = (x, y))
  , f x y = root (untwice_tree f t) :=
begin
induction t; intros,
{ simp [root] at Hroot,
  rw Hroot,
  simp [untwice_tree],
  reflexivity,
},
{ simp [root] at Hroot,
  rw Hroot,
  simp [untwice_tree],
  reflexivity
}
end

lemma root_untwice_tree' {A} (f : A -> A -> A) (l r : tree (A × A))
  : twice f (root l) (root r)
  = (root (untwice_tree f l), root (untwice_tree f r))
  :=
begin
  generalize Ql : (root l) = Pl,
  cases Pl,
  generalize Qr : (root r) = Pr,
  cases Pr,
  simp [twice],
  apply and.intro,
  all_goals { apply root_untwice_tree, assumption, },
end

lemma internal_nodes_ok_twice {A}
  (f : A -> A -> A) (x : tree (A × A))
  (H : internal_nodes_ok (twice f) x)
  : internal_nodes_ok f (untwice_tree f x)
:=
begin
induction x,
{ cases item, simp [untwice_tree],
    constructor, constructor, constructor, reflexivity
},
{ cases item, simp [untwice_tree], constructor,
  { apply ih_1, clear ih_1 ih_2,
    generalize Q : (tree.node (fst, snd) l r) = P,
    rw Q at H, revert fst snd l r Q,
    induction H; intros,
    { contradiction },
    { injection Q, subst l_1, assumption }
  },
  { apply ih_2, clear ih_1 ih_2,
    generalize Q : (tree.node (fst, snd) l r) = P,
    rw Q at H, revert fst snd l r Q,
    induction H; intros,
    { contradiction },
    { injection Q, subst r_1, assumption }
  },
  { clear ih_1 ih_2,
    generalize Q : (tree.node (fst, snd) l r) = P,
    rw Q at H, revert fst snd l r Q,
    induction H; intros,
    { contradiction },
    { subst x, injection Q with h, subst l_1, subst r_1,
      clear Q, generalize Y : (root l) = X,
      apply congr_arg2_pair, rw h,
      apply root_untwice_tree' }
  },
}
end

lemma internal_nodes_ok_lptree_to_tree_helper
  {A} (f : A -> A -> A) (t : lptree A)
  : list.Forall (internal_nodes_ok f)
    (lptree_to_tree_helper f t) :=
begin
induction t,
{ simp [lptree_to_tree_helper],
  constructor },
{ simp [lptree_to_tree_helper],
  cases a,
  { simp [lptree_to_tree_helper._match_1],
    specialize (ih_1 (twice f)),
    apply list.map_Forall,
    apply list.impl_Forall,
        { assumption },
        { intros, apply internal_nodes_ok_twice, apply a }
  },
  { simp [lptree_to_tree_helper._match_1],
    constructor,
      { constructor },
      { apply list.map_Forall,
        apply list.impl_Forall,
        { apply ih_1 },
        { intros, apply internal_nodes_ok_twice, assumption }
      }
  }
}
end

/-- If we convert an lptree to a tree, producing internal
    nodes with f, indeed all the internal nodes are the
    result of applying f to the roots of their subtrees.
-/
theorem lptree_nodes_spec {A} (t : lptree A)
  (f : A -> A -> A)
  : (match lptree_to_tree f t with
  | (some t') := internal_nodes_ok f t'
  | none := true
  end : Prop)
:=
begin
generalize Q : (lptree_to_tree f t) = P,
cases P,
{ dsimp, constructor },
{ dsimp,
  generalize W : (lptree_to_tree_helper f t) = Z,
  cases Z,
  { unfold lptree_to_tree at Q,
    rewrite W at Q,
    simp [lptree_to_tree._match_1] at Q,
    contradiction },
  { unfold lptree_to_tree at Q,
    rewrite W at Q,
    simp [lptree_to_tree._match_1] at Q,
    injection Q with Q', clear Q, subst a,
    have H := internal_nodes_ok_lptree_to_tree_helper f t,
    rw W at H,
    clear W,
    apply_in H list.Forall_invert,
    dsimp at H,
    induction H,
    apply assemble_left_subtrees_preserves_nodes;
    assumption
    }
}
end

lemma depair_app {A} (xs ys : list (A × A))
  : depair (xs ++ ys) = depair xs ++ depair ys
:=
begin
induction xs,
{ reflexivity },
{ cases a,
  simp [depair],
  rw ih_1 }
end

lemma depair_tree_leaves {A} (f : A -> A -> A)
  (t : tree (A × A))
  : depair t.leaves = (untwice_tree f t).leaves
:=
begin
induction t,
{ cases item, simp [tree.leaves, untwice_tree],
  simp [depair]
},
{ simp [tree.leaves],
  rw depair_app,
  rw [ih_1, ih_2],
  cases item with i1 i2,
  simp [untwice_tree],
  simp [tree.leaves] }
end

lemma depair_leaves {A} (f : A -> A -> A)
  (xs : list (tree (A × A)))
: depair (left_subtrees_leaves' xs) =
    left_subtrees_leaves' (list.map (untwice_tree f) xs)
:=
begin
induction xs,
{ reflexivity },
{ simp [left_subtrees_leaves'],
  rw depair_app,
  f_equal,
  apply depair_tree_leaves,
  assumption }
end

lemma lptree.leaves_helper_same' {A} (f) (t : lptree A)
 : t.leaves
 = left_subtrees_leaves' (lptree_to_tree_helper f t) :=
begin
induction t,
{ reflexivity },
{ simp [lptree.leaves],
  simp [lptree_to_tree_helper],
  cases a,
  { simp [lptree.leaves],
    simp [lptree_to_tree_helper],
    rw (ih_1 (twice f)),
    rw depair_leaves,
   },
  { simp [lptree.leaves],
    simp [lptree_to_tree_helper],
    simp [left_subtrees_leaves'],
    simp only [tree.leaves],
    f_equal,
    rw (ih_1 (twice f)),
    apply depair_leaves },
}
end

lemma lptree.leaves_helper_same {A} (f) (t : lptree A)
 : t.leaves
 = match lptree_to_tree_helper f t with
   | [] := []
   | x :: xs := left_subtrees_leaves f xs x
   end :=
begin
simp,
rw (lptree.leaves_helper_same' f),
generalize : (lptree_to_tree_helper f t) = xs,
intros,
cases xs,
{ reflexivity },
{ dsimp,
  symmetry,
  apply left_subtrees_leaves_same }
end

/-- If we compute the leaves of an lptree, it is the same
    as if we convert it to a binary tree and then compute
    the leaves
-/
lemma tree_lptree.leaves {A} (f) (t : lptree A)
  : t.leaves = tree_leaves_option (lptree_to_tree f t)
  :=
begin
generalize P : (lptree_to_tree f t) = Q,
cases Q,
{ simp [tree_leaves_option],

  cases (lptree.nonzero_dec t),
  apply lptree_not_nonzero_no_leaves,
  assumption,
  cases t,
  reflexivity,
  exfalso,
  have H' := lptree.nonzero_tree _ f a,
  rw P at H',
  apply (@option.not_Issome_none (tree A)),
  assumption
},
{ simp [tree_leaves_option],
  generalize W : (lptree_to_tree_helper f t) = Z,
  cases Z,
  { unfold lptree_to_tree at P,
    rewrite W at P,
    simp [lptree_to_tree._match_1] at P,
    contradiction },
  { unfold lptree_to_tree at P,
    rewrite W at P,
    simp [lptree_to_tree._match_1] at P,
    injection P, clear P,
    subst a,
    rw assemble_left_subtrees_preserves_leaves,
    rw (lptree.leaves_helper_same f),
    simp, rw W }
}
end

/-- If we take a list, convert it to an lptree, convert
    that to a binary tree, and compute the leaves,
    we get back the original list
-/
lemma lptree.leaves_ok {A} (f : A -> A -> A) (xs : list A)
  : xs = tree_leaves_option (merge_to_tree f xs) :=
begin
transitivity,
rw ← (lptree_leaves_list xs),
unfold merge_to_tree,
rw (tree_lptree.leaves f)
end

--#eval (lptree_to_tree nat.add (list_to_lptree [7,6,5,4,3,2,1]))

end binary_tree


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.zero
import Mathlib.PostPort

universes v u u' l

namespace Mathlib

/-!
# Kernels and cokernels

In a category with zero morphisms, the kernel of a morphism `f : X ⟶ Y` is
the equalizer of `f` and `0 : X ⟶ Y`. (Similarly the cokernel is the coequalizer.)

The basic definitions are
* `kernel : (X ⟶ Y) → C`
* `kernel.ι : kernel f ⟶ X`
* `kernel.condition : kernel.ι f ≫ f = 0` and
* `kernel.lift (k : W ⟶ X) (h : k ≫ f = 0) : W ⟶ kernel f` (as well as the dual versions)

## Main statements

Besides the definition and lifts, we prove
* `kernel.ι_zero_is_iso`: a kernel map of a zero morphism is an isomorphism
* `kernel.eq_zero_of_epi_kernel`: if `kernel.ι f` is an epimorphism, then `f = 0`
* `kernel.of_mono`: the kernel of a monomorphism is the zero object
* `kernel.lift_mono`: the lift of a monomorphism `k : W ⟶ X` such that `k ≫ f = 0`
  is still a monomorphism
* `kernel.is_limit_cone_zero_cone`: if our category has a zero object, then the map from the zero
  obect is a kernel map of any monomorphism
* `kernel.ι_of_zero`: `kernel.ι (0 : X ⟶ Y)` is an isomorphism

and the corresponding dual statements.

## Future work
* TODO: connect this with existing working in the group theory and ring theory libraries.

## Implementation notes
As with the other special shapes in the limits library, all the definitions here are given as
`abbreviation`s of the general statements for limits, so all the `simp` lemmas and theorems about
general limits can be used.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

namespace category_theory.limits

/-- A morphism `f` has a kernel if the functor `parallel_pair f 0` has a limit. -/
/-- A morphism `f` has a cokernel if the functor `parallel_pair f 0` has a colimit. -/
def has_kernel {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) :=
  has_limit (parallel_pair f 0)

def has_cokernel {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) :=
  has_colimit (parallel_pair f 0)

/-- A kernel fork is just a fork where the second morphism is a zero morphism. -/
def kernel_fork {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) :=
  fork f 0

@[simp] theorem kernel_fork.condition_assoc {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} (s : kernel_fork f) {X' : C} (f' : Y ⟶ X') : fork.ι s ≫ f ≫ f' = 0 ≫ f' := sorry

@[simp] theorem kernel_fork.app_one {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} (s : kernel_fork f) : nat_trans.app (cone.π s) walking_parallel_pair.one = 0 := sorry

/-- A morphism `ι` satisfying `ι ≫ f = 0` determines a kernel fork over `f`. -/
def kernel_fork.of_ι {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {Z : C} (ι : Z ⟶ X) (w : ι ≫ f = 0) : kernel_fork f :=
  fork.of_ι ι sorry

@[simp] theorem kernel_fork.ι_of_ι {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {P : C} (f : X ⟶ Y) (ι : P ⟶ X) (w : ι ≫ f = 0) : fork.ι (kernel_fork.of_ι ι w) = ι :=
  rfl

/-- Every kernel fork `s` is isomorphic (actually, equal) to `fork.of_ι (fork.ι s) _`. -/
def iso_of_ι {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} (s : fork f 0) : s ≅ fork.of_ι (fork.ι s) (iso_of_ι._proof_1 s) :=
  cones.ext (iso.refl (cone.X s)) sorry

/-- If `ι = ι'`, then `fork.of_ι ι _` and `fork.of_ι ι' _` are isomorphic. -/
def of_ι_congr {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {P : C} {ι : P ⟶ X} {ι' : P ⟶ X} {w : ι ≫ f = 0} (h : ι = ι') : kernel_fork.of_ι ι w ≅ kernel_fork.of_ι ι' (of_ι_congr._proof_1 h) :=
  cones.ext (iso.refl (cone.X (kernel_fork.of_ι ι w))) sorry

/-- If `F` is an equivalence, then applying `F` to a diagram indexing a (co)kernel of `f` yields
    the diagram indexing the (co)kernel of `F.map f`. -/
def comp_nat_iso {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {D : Type u'} [category D] [has_zero_morphisms D] (F : C ⥤ D) [is_equivalence F] : parallel_pair f 0 ⋙ F ≅ parallel_pair (functor.map F f) 0 :=
  nat_iso.of_components (fun (j : walking_parallel_pair) => sorry) sorry

/-- If `s` is a limit kernel fork and `k : W ⟶ X` satisfies ``k ≫ f = 0`, then there is some
    `l : W ⟶ s.X` such that `l ≫ fork.ι s = k`. -/
def kernel_fork.is_limit.lift' {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {s : kernel_fork f} (hs : is_limit s) {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : Subtype fun (l : W ⟶ cone.X s) => l ≫ fork.ι s = k :=
  { val := is_limit.lift hs (kernel_fork.of_ι k h), property := sorry }

/-- This is a slightly more convenient method to verify that a kernel fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content -/
def is_limit_aux {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} (t : kernel_fork f) (lift : (s : kernel_fork f) → cone.X s ⟶ cone.X t) (fac : ∀ (s : kernel_fork f), lift s ≫ fork.ι t = fork.ι s) (uniq : ∀ (s : kernel_fork f) (m : cone.X s ⟶ cone.X t), m ≫ fork.ι t = fork.ι s → m = lift s) : is_limit t :=
  is_limit.mk lift

/--
This is a more convenient formulation to show that a `kernel_fork` constructed using
`kernel_fork.of_ι` is a limit cone.
-/
def is_limit.of_ι {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {W : C} (g : W ⟶ X) (eq : g ≫ f = 0) (lift : {W' : C} → (g' : W' ⟶ X) → g' ≫ f = 0 → (W' ⟶ W)) (fac : ∀ {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0), lift g' eq' ≫ g = g') (uniq : ∀ {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0) (m : W' ⟶ W), m ≫ g = g' → m = lift g' eq') : is_limit (kernel_fork.of_ι g eq) :=
  is_limit_aux (kernel_fork.of_ι g eq) (fun (s : kernel_fork f) => lift (fork.ι s) (kernel_fork.condition s)) sorry sorry

/-- The kernel of a morphism, expressed as the equalizer with the 0 morphism. -/
def kernel {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] : C :=
  equalizer f 0

/-- The map from `kernel f` into the source of `f`. -/
def kernel.ι {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] : kernel f ⟶ X :=
  equalizer.ι f 0

@[simp] theorem equalizer_as_kernel {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] : equalizer.ι f 0 = kernel.ι f :=
  rfl

@[simp] theorem kernel.condition_assoc {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] {X' : C} (f' : Y ⟶ X') : kernel.ι f ≫ f ≫ f' = 0 ≫ f' := sorry

/-- Given any morphism `k : W ⟶ X` satisfying `k ≫ f = 0`, `k` factors through `kernel.ι f`
    via `kernel.lift : W ⟶ kernel f`. -/
def kernel.lift {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : W ⟶ kernel f :=
  limit.lift (parallel_pair f 0) (kernel_fork.of_ι k h)

@[simp] theorem kernel.lift_ι {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : kernel.lift f k h ≫ kernel.ι f = k :=
  limit.lift_π (kernel_fork.of_ι k h) walking_parallel_pair.zero

@[simp] theorem kernel.lift_zero {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] {W : C} {h : 0 ≫ f = 0} : kernel.lift f 0 h = 0 := sorry

protected instance kernel.lift_mono {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] {W : C} (k : W ⟶ X) (h : k ≫ f = 0) [mono k] : mono (kernel.lift f k h) := sorry

/-- Any morphism `k : W ⟶ X` satisfying `k ≫ f = 0` induces a morphism `l : W ⟶ kernel f` such that
    `l ≫ kernel.ι f = k`. -/
def kernel.lift' {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : Subtype fun (l : W ⟶ kernel f) => l ≫ kernel.ι f = k :=
  { val := kernel.lift f k h, property := kernel.lift_ι f k h }

/-- Every kernel of the zero morphism is an isomorphism -/
protected instance kernel.ι_zero_is_iso {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} : is_iso (kernel.ι 0) :=
  equalizer.ι_of_self 0

theorem eq_zero_of_epi_kernel {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] [epi (kernel.ι f)] : f = 0 := sorry

/-- The kernel of a zero morphism is isomorphic to the source. -/
def kernel_zero_iso_source {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} : kernel 0 ≅ X :=
  equalizer.iso_source_of_self 0

@[simp] theorem kernel_zero_iso_source_hom {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} : iso.hom kernel_zero_iso_source = kernel.ι 0 :=
  rfl

@[simp] theorem kernel_zero_iso_source_inv {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} : iso.inv kernel_zero_iso_source =
  kernel.lift 0 𝟙
    (eq.mpr
      (id
        (Eq.trans
          ((fun (a a_1 : X ⟶ Y) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ Y) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2) (𝟙 ≫ 0)
            0 comp_zero 0 0 (Eq.refl 0))
          (propext (eq_self_iff_true 0))))
      trivial) :=
  rfl

/-- If two morphisms are known to be equal, then their kernels are isomorphic. -/
def kernel_iso_of_eq {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} [has_kernel f] [has_kernel g] (h : f = g) : kernel f ≅ kernel g :=
  has_limit.iso_of_nat_iso (eq.mpr sorry (iso.refl (parallel_pair g 0)))

@[simp] theorem kernel_iso_of_eq_refl {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] {h : f = f} : kernel_iso_of_eq h = iso.refl (kernel f) := sorry

@[simp] theorem kernel_iso_of_eq_trans {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} {h : X ⟶ Y} [has_kernel f] [has_kernel g] [has_kernel h] (w₁ : f = g) (w₂ : g = h) : kernel_iso_of_eq w₁ ≪≫ kernel_iso_of_eq w₂ = kernel_iso_of_eq (Eq.trans w₁ w₂) := sorry

theorem kernel_not_epi_of_nonzero {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} [has_kernel f] (w : f ≠ 0) : ¬epi (kernel.ι f) :=
  fun (I : epi (kernel.ι f)) => w (eq_zero_of_epi_kernel f)

theorem kernel_not_iso_of_nonzero {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} [has_kernel f] (w : f ≠ 0) : is_iso (kernel.ι f) → False :=
  fun (I : is_iso (kernel.ι f)) => kernel_not_epi_of_nonzero w (category_theory.epi_of_strong_epi (kernel.ι f))

/--
When `g` is an isomorphism, the kernel of `f ≫ g` is isomorphic to the kernel of `f`.
-/
def kernel_comp_is_iso {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel (f ≫ g)] [has_kernel f] [is_iso g] : kernel (f ≫ g) ≅ kernel f :=
  iso.mk (kernel.lift f (kernel.ι (f ≫ g)) sorry) (kernel.lift (f ≫ g) (kernel.ι f) sorry)

@[simp] theorem kernel_comp_is_iso_hom_comp_kernel_ι {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel (f ≫ g)] [has_kernel f] [is_iso g] : iso.hom (kernel_comp_is_iso f g) ≫ kernel.ι f = kernel.ι (f ≫ g) := sorry

@[simp] theorem kernel_comp_is_iso_inv_comp_kernel_ι {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel (f ≫ g)] [has_kernel f] [is_iso g] : iso.inv (kernel_comp_is_iso f g) ≫ kernel.ι (f ≫ g) = kernel.ι f := sorry

/--
When `f` is an isomorphism, the kernel of `f ≫ g` is isomorphic to the kernel of `g`.
-/
def kernel_is_iso_comp {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel (f ≫ g)] [is_iso f] [has_kernel g] : kernel (f ≫ g) ≅ kernel g :=
  iso.mk (kernel.lift g (kernel.ι (f ≫ g) ≫ f) sorry) (kernel.lift (f ≫ g) (kernel.ι g ≫ inv f) sorry)

@[simp] theorem kernel_is_iso_comp_hom_comp_kernel_ι {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel (f ≫ g)] [is_iso f] [has_kernel g] : iso.hom (kernel_is_iso_comp f g) ≫ kernel.ι g = kernel.ι (f ≫ g) ≫ f := sorry

@[simp] theorem kernel_is_iso_comp_inv_comp_kernel_ι {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel (f ≫ g)] [is_iso f] [has_kernel g] : iso.inv (kernel_is_iso_comp f g) ≫ kernel.ι (f ≫ g) = kernel.ι g ≫ inv f := sorry

/-- The morphism from the zero object determines a cone on a kernel diagram -/
def kernel.zero_cone {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_zero_object C] : cone (parallel_pair f 0) :=
  cone.mk 0 (nat_trans.mk fun (j : walking_parallel_pair) => 0)

/-- The map from the zero object is a kernel of a monomorphism -/
def kernel.is_limit_cone_zero_cone {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_zero_object C] [mono f] : is_limit (kernel.zero_cone f) :=
  fork.is_limit.mk (kernel.zero_cone f) (fun (s : fork f 0) => 0) sorry sorry

/-- The kernel of a monomorphism is isomorphic to the zero object -/
def kernel.of_mono {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_zero_object C] [has_kernel f] [mono f] : kernel f ≅ 0 :=
  functor.map_iso (cones.forget (parallel_pair f 0))
    (is_limit.unique_up_to_iso (limit.is_limit (parallel_pair f 0)) (kernel.is_limit_cone_zero_cone f))

/-- The kernel morphism of a monomorphism is a zero morphism -/
theorem kernel.ι_of_mono {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_zero_object C] [has_kernel f] [mono f] : kernel.ι f = 0 :=
  zero_of_source_iso_zero (kernel.ι f) (kernel.of_mono f)

/-- If `i` is an isomorphism such that `l ≫ i.hom = f`, then any kernel of `f` is a kernel of `l`.-/
def is_kernel.of_comp_iso {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) {Z : C} (l : X ⟶ Z) (i : Z ≅ Y) (h : l ≫ iso.hom i = f) {s : kernel_fork f} (hs : is_limit s) : is_limit (kernel_fork.of_ι (fork.ι s) (is_kernel.of_comp_iso._proof_1 f l i h)) :=
  fork.is_limit.mk (kernel_fork.of_ι (fork.ι s) sorry)
    (fun (s_1 : fork l 0) => is_limit.lift hs (kernel_fork.of_ι (fork.ι s_1) sorry)) sorry sorry

/-- If `i` is an isomorphism such that `l ≫ i.hom = f`, then the kernel of `f` is a kernel of `l`.-/
def kernel.of_comp_iso {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] {Z : C} (l : X ⟶ Z) (i : Z ≅ Y) (h : l ≫ iso.hom i = f) : is_limit (kernel_fork.of_ι (kernel.ι f) (kernel.of_comp_iso._proof_1 f l i h)) :=
  is_kernel.of_comp_iso f l i h (limit.is_limit (parallel_pair f 0))

/-- If `s` is any limit kernel cone over `f` and if  `i` is an isomorphism such that
    `i.hom ≫ s.ι  = l`, then `l` is a kernel of `f`. -/
def is_kernel.iso_kernel {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) {Z : C} (l : Z ⟶ X) {s : kernel_fork f} (hs : is_limit s) (i : Z ≅ cone.X s) (h : iso.hom i ≫ fork.ι s = l) : is_limit (kernel_fork.of_ι l (is_kernel.iso_kernel._proof_1 f l i h)) :=
  is_limit.of_iso_limit hs (cones.ext (iso.symm i) sorry)

/-- If `i` is an isomorphism such that `i.hom ≫ kernel.ι f = l`, then `l` is a kernel of `f`. -/
def kernel.iso_kernel {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] {Z : C} (l : Z ⟶ X) (i : Z ≅ kernel f) (h : iso.hom i ≫ kernel.ι f = l) : is_limit (kernel_fork.of_ι l (kernel.iso_kernel._proof_1 f l i h)) :=
  is_kernel.iso_kernel f l (limit.is_limit (parallel_pair f 0)) i h

/-- The kernel morphism of a zero morphism is an isomorphism -/
def kernel.ι_of_zero {C : Type u} [category C] [has_zero_morphisms C] (X : C) (Y : C) : is_iso (kernel.ι 0) :=
  equalizer.ι_of_self 0

/-- A cokernel cofork is just a cofork where the second morphism is a zero morphism. -/
def cokernel_cofork {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) :=
  cofork f 0

@[simp] theorem cokernel_cofork.condition {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} (s : cokernel_cofork f) : f ≫ cofork.π s = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (f ≫ cofork.π s = 0)) (cofork.condition s)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 ≫ cofork.π s = 0)) zero_comp)) (Eq.refl 0))

@[simp] theorem cokernel_cofork.app_zero {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} (s : cokernel_cofork f) : nat_trans.app (cocone.ι s) walking_parallel_pair.zero = 0 := sorry

/-- A morphism `π` satisfying `f ≫ π = 0` determines a cokernel cofork on `f`. -/
def cokernel_cofork.of_π {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {Z : C} (π : Y ⟶ Z) (w : f ≫ π = 0) : cokernel_cofork f :=
  cofork.of_π π sorry

@[simp] theorem cokernel_cofork.π_of_π {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {P : C} (f : X ⟶ Y) (π : Y ⟶ P) (w : f ≫ π = 0) : cofork.π (cokernel_cofork.of_π π w) = π :=
  rfl

/-- Every cokernel cofork `s` is isomorphic (actually, equal) to `cofork.of_π (cofork.π s) _`. -/
def iso_of_π {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} (s : cofork f 0) : s ≅ cofork.of_π (cofork.π s) (iso_of_π._proof_1 s) :=
  cocones.ext (iso.refl (cocone.X s)) sorry

/-- If `π = π'`, then `cokernel_cofork.of_π π _` and `cokernel_cofork.of_π π' _` are isomorphic. -/
def of_π_congr {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {P : C} {π : Y ⟶ P} {π' : Y ⟶ P} {w : f ≫ π = 0} (h : π = π') : cokernel_cofork.of_π π w ≅ cokernel_cofork.of_π π' (of_π_congr._proof_1 h) :=
  cocones.ext (iso.refl (cocone.X (cokernel_cofork.of_π π w))) sorry

/-- If `s` is a colimit cokernel cofork, then every `k : Y ⟶ W` satisfying `f ≫ k = 0` induces
    `l : s.X ⟶ W` such that `cofork.π s ≫ l = k`. -/
def cokernel_cofork.is_colimit.desc' {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {s : cokernel_cofork f} (hs : is_colimit s) {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) : Subtype fun (l : cocone.X s ⟶ W) => cofork.π s ≫ l = k :=
  { val := is_colimit.desc hs (cokernel_cofork.of_π k h), property := sorry }

/--
This is a slightly more convenient method to verify that a cokernel cofork is a colimit cocone.
It only asks for a proof of facts that carry any mathematical content -/
def is_colimit_aux {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} (t : cokernel_cofork f) (desc : (s : cokernel_cofork f) → cocone.X t ⟶ cocone.X s) (fac : ∀ (s : cokernel_cofork f), cofork.π t ≫ desc s = cofork.π s) (uniq : ∀ (s : cokernel_cofork f) (m : cocone.X t ⟶ cocone.X s), cofork.π t ≫ m = cofork.π s → m = desc s) : is_colimit t :=
  is_colimit.mk desc

/--
This is a more convenient formulation to show that a `cokernel_cofork` constructed using
`cokernel_cofork.of_π` is a limit cone.
-/
def is_colimit.of_π {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {Z : C} (g : Y ⟶ Z) (eq : f ≫ g = 0) (desc : {Z' : C} → (g' : Y ⟶ Z') → f ≫ g' = 0 → (Z ⟶ Z')) (fac : ∀ {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0), g ≫ desc g' eq' = g') (uniq : ∀ {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0) (m : Z ⟶ Z'), g ≫ m = g' → m = desc g' eq') : is_colimit (cokernel_cofork.of_π g eq) :=
  is_colimit_aux (cokernel_cofork.of_π g eq)
    (fun (s : cokernel_cofork f) => desc (cofork.π s) (cokernel_cofork.condition s)) sorry sorry

/-- The cokernel of a morphism, expressed as the coequalizer with the 0 morphism. -/
def cokernel {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] : C :=
  coequalizer f 0

/-- The map from the target of `f` to `cokernel f`. -/
def cokernel.π {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] : Y ⟶ cokernel f :=
  coequalizer.π f 0

@[simp] theorem coequalizer_as_cokernel {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] : coequalizer.π f 0 = cokernel.π f :=
  rfl

@[simp] theorem cokernel.condition {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] : f ≫ cokernel.π f = 0 :=
  cokernel_cofork.condition (colimit.cocone (parallel_pair f 0))

/-- Given any morphism `k : Y ⟶ W` such that `f ≫ k = 0`, `k` factors through `cokernel.π f`
    via `cokernel.desc : cokernel f ⟶ W`. -/
def cokernel.desc {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) : cokernel f ⟶ W :=
  colimit.desc (parallel_pair f 0) (cokernel_cofork.of_π k h)

@[simp] theorem cokernel.π_desc {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) : cokernel.π f ≫ cokernel.desc f k h = k :=
  colimit.ι_desc (cokernel_cofork.of_π k h) walking_parallel_pair.one

@[simp] theorem cokernel.desc_zero {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] {W : C} {h : f ≫ 0 = 0} : cokernel.desc f 0 h = 0 := sorry

protected instance cokernel.desc_epi {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) [epi k] : epi (cokernel.desc f k h) :=
  epi.mk
    fun (Z : C) (g g' : W ⟶ Z) (w : cokernel.desc f k h ≫ g = cokernel.desc f k h ≫ g') =>
      iff.mp (cancel_epi k)
        (eq.mp
          ((fun (a a_1 : Y ⟶ Z) (e_1 : a = a_1) (ᾰ ᾰ_1 : Y ⟶ Z) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
            (cokernel.π f ≫ cokernel.desc f k h ≫ g) (k ≫ g) (cokernel.π_desc_assoc f k h g)
            (cokernel.π f ≫ cokernel.desc f k h ≫ g') (k ≫ g') (cokernel.π_desc_assoc f k h g'))
          (cokernel.π f ≫= w))

/-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = 0` induces `l : cokernel f ⟶ W` such that
    `cokernel.π f ≫ l = k`. -/
def cokernel.desc' {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) : Subtype fun (l : cokernel f ⟶ W) => cokernel.π f ≫ l = k :=
  { val := cokernel.desc f k h, property := cokernel.π_desc f k h }

/-- The cokernel of the zero morphism is an isomorphism -/
protected instance cokernel.π_zero_is_iso {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} : is_iso (cokernel.π 0) :=
  coequalizer.π_of_self 0

theorem eq_zero_of_mono_cokernel {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] [mono (cokernel.π f)] : f = 0 := sorry

/-- The cokernel of a zero morphism is isomorphic to the target. -/
def cokernel_zero_iso_target {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} : cokernel 0 ≅ Y :=
  coequalizer.iso_target_of_self 0

@[simp] theorem cokernel_zero_iso_target_hom {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} : iso.hom cokernel_zero_iso_target =
  cokernel.desc 0 𝟙
    (eq.mpr
      (id
        (Eq.trans
          ((fun (a a_1 : X ⟶ Y) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ Y) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2) (0 ≫ 𝟙)
            0 zero_comp 0 0 (Eq.refl 0))
          (propext (eq_self_iff_true 0))))
      trivial) :=
  rfl

@[simp] theorem cokernel_zero_iso_target_inv {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} : iso.inv cokernel_zero_iso_target = cokernel.π 0 :=
  rfl

/-- If two morphisms are known to be equal, then their cokernels are isomorphic. -/
def cokernel_iso_of_eq {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} [has_cokernel f] [has_cokernel g] (h : f = g) : cokernel f ≅ cokernel g :=
  has_colimit.iso_of_nat_iso (eq.mpr sorry (iso.refl (parallel_pair g 0)))

@[simp] theorem cokernel_iso_of_eq_refl {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] {h : f = f} : cokernel_iso_of_eq h = iso.refl (cokernel f) := sorry

@[simp] theorem cokernel_iso_of_eq_trans {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} {h : X ⟶ Y} [has_cokernel f] [has_cokernel g] [has_cokernel h] (w₁ : f = g) (w₂ : g = h) : cokernel_iso_of_eq w₁ ≪≫ cokernel_iso_of_eq w₂ = cokernel_iso_of_eq (Eq.trans w₁ w₂) := sorry

theorem cokernel_not_mono_of_nonzero {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} [has_cokernel f] (w : f ≠ 0) : ¬mono (cokernel.π f) :=
  fun (I : mono (cokernel.π f)) => w (eq_zero_of_mono_cokernel f)

theorem cokernel_not_iso_of_nonzero {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {f : X ⟶ Y} [has_cokernel f] (w : f ≠ 0) : is_iso (cokernel.π f) → False :=
  fun (I : is_iso (cokernel.π f)) => cokernel_not_mono_of_nonzero w (split_mono.mono (cokernel.π f))

/--
When `g` is an isomorphism, the cokernel of `f ≫ g` is isomorphic to the cokernel of `f`.
-/
def cokernel_comp_is_iso {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel (f ≫ g)] [has_cokernel f] [is_iso g] : cokernel (f ≫ g) ≅ cokernel f :=
  iso.mk (cokernel.desc (f ≫ g) (inv g ≫ cokernel.π f) sorry) (cokernel.desc f (g ≫ cokernel.π (f ≫ g)) sorry)

@[simp] theorem cokernel_π_comp_cokernel_comp_is_iso_hom {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel (f ≫ g)] [has_cokernel f] [is_iso g] : cokernel.π (f ≫ g) ≫ iso.hom (cokernel_comp_is_iso f g) = inv g ≫ cokernel.π f := sorry

@[simp] theorem cokernel_π_comp_cokernel_comp_is_iso_inv {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel (f ≫ g)] [has_cokernel f] [is_iso g] : cokernel.π f ≫ iso.inv (cokernel_comp_is_iso f g) = g ≫ cokernel.π (f ≫ g) := sorry

/--
When `f` is an isomorphism, the cokernel of `f ≫ g` is isomorphic to the cokernel of `g`.
-/
def cokernel_is_iso_comp {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel (f ≫ g)] [is_iso f] [has_cokernel g] : cokernel (f ≫ g) ≅ cokernel g :=
  iso.mk (cokernel.desc (f ≫ g) (cokernel.π g) sorry) (cokernel.desc g (cokernel.π (f ≫ g)) sorry)

@[simp] theorem cokernel_π_comp_cokernel_is_iso_comp_hom {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel (f ≫ g)] [is_iso f] [has_cokernel g] : cokernel.π (f ≫ g) ≫ iso.hom (cokernel_is_iso_comp f g) = cokernel.π g := sorry

@[simp] theorem cokernel_π_comp_cokernel_is_iso_comp_inv {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel (f ≫ g)] [is_iso f] [has_cokernel g] : cokernel.π g ≫ iso.inv (cokernel_is_iso_comp f g) = cokernel.π (f ≫ g) := sorry

/-- The morphism to the zero object determines a cocone on a cokernel diagram -/
def cokernel.zero_cocone {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_zero_object C] : cocone (parallel_pair f 0) :=
  cocone.mk 0 (nat_trans.mk fun (j : walking_parallel_pair) => 0)

/-- The morphism to the zero object is a cokernel of an epimorphism -/
def cokernel.is_colimit_cocone_zero_cocone {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_zero_object C] [epi f] : is_colimit (cokernel.zero_cocone f) :=
  cofork.is_colimit.mk (cokernel.zero_cocone f) (fun (s : cofork f 0) => 0) sorry sorry

/-- The cokernel of an epimorphism is isomorphic to the zero object -/
def cokernel.of_epi {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_zero_object C] [has_cokernel f] [epi f] : cokernel f ≅ 0 :=
  functor.map_iso (cocones.forget (parallel_pair f 0))
    (is_colimit.unique_up_to_iso (colimit.is_colimit (parallel_pair f 0)) (cokernel.is_colimit_cocone_zero_cocone f))

/-- The cokernel morphism of an epimorphism is a zero morphism -/
theorem cokernel.π_of_epi {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_zero_object C] [has_cokernel f] [epi f] : cokernel.π f = 0 :=
  zero_of_target_iso_zero (cokernel.π f) (cokernel.of_epi f)

/--
The cokernel of the image inclusion of a morphism `f` is isomorphic to the cokernel of `f`.

(This result requires that the factorisation through the image is an epimorphism.
This holds in any category with equalizers.)
-/
@[simp] theorem cokernel_image_ι_inv {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_image f] [has_cokernel (image.ι f)] [has_cokernel f] [epi (factor_thru_image f)] : iso.inv (cokernel_image_ι f) = cokernel.desc f (cokernel.π (image.ι f)) (cokernel_image_ι._proof_2 f) :=
  Eq.refl (iso.inv (cokernel_image_ι f))

/-- The cokernel of a zero morphism is an isomorphism -/
def cokernel.π_of_zero {C : Type u} [category C] [has_zero_morphisms C] (X : C) (Y : C) : is_iso (cokernel.π 0) :=
  coequalizer.π_of_self 0

/-- The kernel of the cokernel of an epimorphism is an isomorphism -/
protected instance kernel.of_cokernel_of_epi {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_zero_object C] [has_cokernel f] [has_kernel (cokernel.π f)] [epi f] : is_iso (kernel.ι (cokernel.π f)) :=
  equalizer.ι_of_eq (cokernel.π_of_epi f)

/-- The cokernel of the kernel of a monomorphism is an isomorphism -/
protected instance cokernel.of_kernel_of_mono {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_zero_object C] [has_kernel f] [has_cokernel (kernel.ι f)] [mono f] : is_iso (cokernel.π (kernel.ι f)) :=
  coequalizer.π_of_eq (kernel.ι_of_mono f)

/-- If `i` is an isomorphism such that `i.hom ≫ l = f`, then any cokernel of `f` is a cokernel of
    `l`. -/
def is_cokernel.of_iso_comp {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) {Z : C} (l : Z ⟶ Y) (i : X ≅ Z) (h : iso.hom i ≫ l = f) {s : cokernel_cofork f} (hs : is_colimit s) : is_colimit (cokernel_cofork.of_π (cofork.π s) (is_cokernel.of_iso_comp._proof_1 f l i h)) :=
  cofork.is_colimit.mk (cokernel_cofork.of_π (cofork.π s) sorry)
    (fun (s_1 : cofork l 0) => is_colimit.desc hs (cokernel_cofork.of_π (cofork.π s_1) sorry)) sorry sorry

/-- If `i` is an isomorphism such that `i.hom ≫ l = f`, then the cokernel of `f` is a cokernel of
    `l`. -/
def cokernel.of_iso_comp {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] {Z : C} (l : Z ⟶ Y) (i : X ≅ Z) (h : iso.hom i ≫ l = f) : is_colimit (cokernel_cofork.of_π (cokernel.π f) (cokernel.of_iso_comp._proof_1 f l i h)) :=
  is_cokernel.of_iso_comp f l i h (colimit.is_colimit (parallel_pair f 0))

/-- If `s` is any colimit cokernel cocone over `f` and `i` is an isomorphism such that
    `s.π ≫ i.hom = l`, then `l` is a cokernel of `f`. -/
def is_cokernel.cokernel_iso {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) {Z : C} (l : Y ⟶ Z) {s : cokernel_cofork f} (hs : is_colimit s) (i : cocone.X s ≅ Z) (h : cofork.π s ≫ iso.hom i = l) : is_colimit (cokernel_cofork.of_π l (is_cokernel.cokernel_iso._proof_1 f l i h)) :=
  is_colimit.of_iso_colimit hs (cocones.ext i sorry)

/-- If `i` is an isomorphism such that `cokernel.π f ≫ i.hom = l`, then `l` is a cokernel of `f`. -/
def cokernel.cokernel_iso {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] {Z : C} (l : Y ⟶ Z) (i : cokernel f ≅ Z) (h : cokernel.π f ≫ iso.hom i = l) : is_colimit (cokernel_cofork.of_π l (cokernel.cokernel_iso._proof_1 f l i h)) :=
  is_cokernel.cokernel_iso f l (colimit.is_colimit (parallel_pair f 0)) i h

end category_theory.limits

namespace category_theory.limits

/-- `has_kernels` represents the existence of kernels for every morphism. -/
class has_kernels (C : Type u) [category C] [has_zero_morphisms C]
where
  has_limit : ∀ {X Y : C} (f : X ⟶ Y), has_kernel f

/-- `has_cokernels` represents the existence of cokernels for every morphism. -/
class has_cokernels (C : Type u) [category C] [has_zero_morphisms C]
where
  has_colimit : ∀ {X Y : C} (f : X ⟶ Y), has_cokernel f

protected instance has_kernels_of_has_equalizers (C : Type u) [category C] [has_zero_morphisms C] [has_equalizers C] : has_kernels C :=
  has_kernels.mk fun {X Y : C} (f : X ⟶ Y) => limits.has_limit_of_has_limits_of_shape (parallel_pair f 0)

protected instance has_cokernels_of_has_coequalizers (C : Type u) [category C] [has_zero_morphisms C] [has_coequalizers C] : has_cokernels C :=
  has_cokernels.mk fun {X Y : C} (f : X ⟶ Y) => limits.has_colimit_of_has_colimits_of_shape (parallel_pair f 0)


/-
Copyright (c) 2020 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Floris van Doorn, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.instances.nnreal
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Square root of a real number

In this file we define

* `nnreal.sqrt` to be the square root of a nonnegative real number.
* `real.sqrt` to be the square root of a real number, defined to be zero on negative numbers.

Then we prove some basic properties of these functions.

## Implementation notes

We define `nnreal.sqrt` as the noncomputable inverse to the function `x ↦ x * x`. We use general
theory of inverses of strictly monotone functions to prove that `nnreal.sqrt x` exists. As a side
effect, `nnreal.sqrt` is a bundled `order_iso`, so for `nnreal` numbers we get continuity as well as
theorems like `sqrt x ≤ y ↔ x * x ≤ y` for free.

Then we define `real.sqrt x` to be `nnreal.sqrt (nnreal.of_real x)`. We also define a Cauchy
sequence `real.sqrt_aux (f : cau_seq ℚ abs)` which converges to `sqrt (mk f)` but do not prove (yet)
that this sequence actually converges to `sqrt (mk f)`.

## Tags

square root
-/

namespace nnreal

/-- Square root of a nonnegative real number. -/
def sqrt : nnreal ≃o nnreal :=
  order_iso.symm (strict_mono.order_iso_of_surjective (fun (x : nnreal) => x * x) sorry sorry)

theorem sqrt_eq_iff_sqr_eq {x : nnreal} {y : nnreal} : coe_fn sqrt x = y ↔ y * y = x :=
  iff.trans (equiv.apply_eq_iff_eq_symm_apply (rel_iso.to_equiv sqrt)) eq_comm

theorem sqrt_le_iff {x : nnreal} {y : nnreal} : coe_fn sqrt x ≤ y ↔ x ≤ y * y :=
  order_iso.to_galois_connection sqrt x y

theorem le_sqrt_iff {x : nnreal} {y : nnreal} : x ≤ coe_fn sqrt y ↔ x * x ≤ y :=
  iff.symm (order_iso.to_galois_connection (order_iso.symm sqrt) x y)

@[simp] theorem sqrt_eq_zero {x : nnreal} : coe_fn sqrt x = 0 ↔ x = 0 :=
  iff.trans sqrt_eq_iff_sqr_eq
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 * 0 = x ↔ x = 0)) (propext eq_comm)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (x = 0 * 0 ↔ x = 0)) (zero_mul 0))) (iff.refl (x = 0))))

@[simp] theorem sqrt_zero : coe_fn sqrt 0 = 0 :=
  iff.mpr sqrt_eq_zero rfl

@[simp] theorem sqrt_one : coe_fn sqrt 1 = 1 :=
  iff.mpr sqrt_eq_iff_sqr_eq (mul_one 1)

@[simp] theorem mul_sqrt_self (x : nnreal) : coe_fn sqrt x * coe_fn sqrt x = x :=
  order_iso.symm_apply_apply sqrt x

@[simp] theorem sqrt_mul_self (x : nnreal) : coe_fn sqrt (x * x) = x :=
  order_iso.apply_symm_apply sqrt x

theorem sqrt_mul (x : nnreal) (y : nnreal) : coe_fn sqrt (x * y) = coe_fn sqrt x * coe_fn sqrt y := sorry

/-- `nnreal.sqrt` as a `monoid_with_zero_hom`. -/
def sqrt_hom : monoid_with_zero_hom nnreal nnreal :=
  monoid_with_zero_hom.mk (⇑sqrt) sqrt_zero sqrt_one sqrt_mul

theorem sqrt_inv (x : nnreal) : coe_fn sqrt (x⁻¹) = (coe_fn sqrt x⁻¹) :=
  monoid_with_zero_hom.map_inv' sqrt_hom x

theorem sqrt_div (x : nnreal) (y : nnreal) : coe_fn sqrt (x / y) = coe_fn sqrt x / coe_fn sqrt y :=
  monoid_with_zero_hom.map_div sqrt_hom x y

theorem continuous_sqrt : continuous ⇑sqrt :=
  order_iso.continuous sqrt

end nnreal

namespace real

/-- An auxiliary sequence of rational numbers that converges to `real.sqrt (mk f)`.
Currently this sequence is not used in `mathlib`.  -/
def sqrt_aux (f : cau_seq ℚ abs) : ℕ → ℚ :=
  sorry

theorem sqrt_aux_nonneg (f : cau_seq ℚ abs) (i : ℕ) : 0 ≤ sqrt_aux f i := sorry

/- TODO(Mario): finish the proof
theorem sqrt_aux_converges (f : cau_seq ℚ abs) : ∃ h x, 0 ≤ x ∧ x * x = max 0 (mk f) ∧
  mk ⟨sqrt_aux f, h⟩ = x :=
begin
  rcases sqrt_exists (le_max_left 0 (mk f)) with ⟨x, x0, hx⟩,
  suffices : ∃ h, mk ⟨sqrt_aux f, h⟩ = x,
  { exact this.imp (λ h e, ⟨x, x0, hx, e⟩) },
  apply of_near,

  suffices : ∃ δ > 0, ∀ i, abs (↑(sqrt_aux f i) - x) < δ / 2 ^ i,
  { rcases this with ⟨δ, δ0, hδ⟩,
    intros,
     }
end -/

/-- The square root of a real number. This returns 0 for negative inputs. -/
def sqrt (x : ℝ) : ℝ :=
  ↑(coe_fn nnreal.sqrt (nnreal.of_real x))

/-quotient.lift_on x
  (λ f, mk ⟨sqrt_aux f, (sqrt_aux_converges f).fst⟩)
  (λ f g e, begin
    rcases sqrt_aux_converges f with ⟨hf, x, x0, xf, xs⟩,
    rcases sqrt_aux_converges g with ⟨hg, y, y0, yg, ys⟩,
    refine xs.trans (eq.trans _ ys.symm),
    rw [← @mul_self_inj_of_nonneg ℝ _ x y x0 y0, xf, yg],
    congr' 1, exact quotient.sound e
  end)-/

theorem continuous_sqrt : continuous sqrt :=
  continuous.comp nnreal.continuous_coe (continuous.comp (order_iso.continuous nnreal.sqrt) nnreal.continuous_of_real)

theorem sqrt_eq_zero_of_nonpos {x : ℝ} (h : x ≤ 0) : sqrt x = 0 := sorry

theorem sqrt_nonneg (x : ℝ) : 0 ≤ sqrt x :=
  nnreal.coe_nonneg (coe_fn nnreal.sqrt (nnreal.of_real x))

@[simp] theorem mul_self_sqrt {x : ℝ} (h : 0 ≤ x) : sqrt x * sqrt x = x := sorry

@[simp] theorem sqrt_mul_self {x : ℝ} (h : 0 ≤ x) : sqrt (x * x) = x :=
  iff.mp (mul_self_inj_of_nonneg (sqrt_nonneg (x * x)) h) (mul_self_sqrt (mul_self_nonneg x))

theorem sqrt_eq_iff_mul_self_eq {x : ℝ} {y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) : sqrt x = y ↔ y * y = x := sorry

@[simp] theorem sqr_sqrt {x : ℝ} (h : 0 ≤ x) : sqrt x ^ bit0 1 = x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (sqrt x ^ bit0 1 = x)) (pow_two (sqrt x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (sqrt x * sqrt x = x)) (mul_self_sqrt h))) (Eq.refl x))

@[simp] theorem sqrt_sqr {x : ℝ} (h : 0 ≤ x) : sqrt (x ^ bit0 1) = x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (sqrt (x ^ bit0 1) = x)) (pow_two x)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (sqrt (x * x) = x)) (sqrt_mul_self h))) (Eq.refl x))

theorem sqrt_eq_iff_sqr_eq {x : ℝ} {y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) : sqrt x = y ↔ y ^ bit0 1 = x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (sqrt x = y ↔ y ^ bit0 1 = x)) (pow_two y)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (sqrt x = y ↔ y * y = x)) (propext (sqrt_eq_iff_mul_self_eq hx hy))))
      (iff.refl (y * y = x)))

theorem sqrt_mul_self_eq_abs (x : ℝ) : sqrt (x * x) = abs x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (sqrt (x * x) = abs x)) (Eq.symm (abs_mul_abs_self x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (sqrt (abs x * abs x) = abs x)) (sqrt_mul_self (abs_nonneg x)))) (Eq.refl (abs x)))

theorem sqrt_sqr_eq_abs (x : ℝ) : sqrt (x ^ bit0 1) = abs x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (sqrt (x ^ bit0 1) = abs x)) (pow_two x)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (sqrt (x * x) = abs x)) (sqrt_mul_self_eq_abs x))) (Eq.refl (abs x)))

@[simp] theorem sqrt_zero : sqrt 0 = 0 := sorry

@[simp] theorem sqrt_one : sqrt 1 = 1 := sorry

@[simp] theorem sqrt_le {x : ℝ} {y : ℝ} (hy : 0 ≤ y) : sqrt x ≤ sqrt y ↔ x ≤ y := sorry

@[simp] theorem sqrt_lt {x : ℝ} {y : ℝ} (hx : 0 ≤ x) : sqrt x < sqrt y ↔ x < y :=
  lt_iff_lt_of_le_iff_le (sqrt_le hx)

theorem sqrt_le_sqrt {x : ℝ} {y : ℝ} (h : x ≤ y) : sqrt x ≤ sqrt y := sorry

theorem sqrt_le_left {x : ℝ} {y : ℝ} (hy : 0 ≤ y) : sqrt x ≤ y ↔ x ≤ y ^ bit0 1 := sorry

theorem sqrt_le_iff {x : ℝ} {y : ℝ} : sqrt x ≤ y ↔ 0 ≤ y ∧ x ≤ y ^ bit0 1 := sorry

/- note: if you want to conclude `x ≤ sqrt y`, then use `le_sqrt_of_sqr_le`.
   if you have `x > 0`, consider using `le_sqrt'` -/

theorem le_sqrt {x : ℝ} {y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) : x ≤ sqrt y ↔ x ^ bit0 1 ≤ y := sorry

theorem le_sqrt' {x : ℝ} {y : ℝ} (hx : 0 < x) : x ≤ sqrt y ↔ x ^ bit0 1 ≤ y := sorry

theorem le_sqrt_of_sqr_le {x : ℝ} {y : ℝ} (h : x ^ bit0 1 ≤ y) : x ≤ sqrt y :=
  or.dcases_on (lt_or_ge 0 x)
    (fun (hx : 0 < x) => eq.mpr (id (Eq._oldrec (Eq.refl (x ≤ sqrt y)) (propext (le_sqrt' hx)))) h)
    fun (hx : 0 ≥ x) => le_trans hx (sqrt_nonneg y)

@[simp] theorem sqrt_inj {x : ℝ} {y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) : sqrt x = sqrt y ↔ x = y := sorry

@[simp] theorem sqrt_eq_zero {x : ℝ} (h : 0 ≤ x) : sqrt x = 0 ↔ x = 0 := sorry

theorem sqrt_eq_zero' {x : ℝ} : sqrt x = 0 ↔ x ≤ 0 := sorry

@[simp] theorem sqrt_pos {x : ℝ} : 0 < sqrt x ↔ 0 < x := sorry

@[simp] theorem sqrt_mul {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : sqrt (x * y) = sqrt x * sqrt y := sorry

@[simp] theorem sqrt_mul' (x : ℝ) {y : ℝ} (hy : 0 ≤ y) : sqrt (x * y) = sqrt x * sqrt y := sorry

@[simp] theorem sqrt_inv (x : ℝ) : sqrt (x⁻¹) = (sqrt x⁻¹) := sorry

@[simp] theorem sqrt_div {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : sqrt (x / y) = sqrt x / sqrt y := sorry

end real

theorem filter.tendsto.sqrt {α : Type u_1} {f : α → ℝ} {l : filter α} {x : ℝ} (h : filter.tendsto f l (nhds x)) : filter.tendsto (fun (x : α) => real.sqrt (f x)) l (nhds (real.sqrt x)) :=
  filter.tendsto.comp (continuous.tendsto real.continuous_sqrt x) h

theorem continuous_within_at.sqrt {α : Type u_1} [topological_space α] {f : α → ℝ} {s : set α} {x : α} (h : continuous_within_at f s x) : continuous_within_at (fun (x : α) => real.sqrt (f x)) s x :=
  filter.tendsto.sqrt h

theorem continuous_at.sqrt {α : Type u_1} [topological_space α] {f : α → ℝ} {x : α} (h : continuous_at f x) : continuous_at (fun (x : α) => real.sqrt (f x)) x :=
  filter.tendsto.sqrt h

theorem continuous_on.sqrt {α : Type u_1} [topological_space α] {f : α → ℝ} {s : set α} (h : continuous_on f s) : continuous_on (fun (x : α) => real.sqrt (f x)) s :=
  fun (x : α) (hx : x ∈ s) => continuous_within_at.sqrt (h x hx)

theorem continuous.sqrt {α : Type u_1} [topological_space α] {f : α → ℝ} (h : continuous f) : continuous fun (x : α) => real.sqrt (f x) :=
  continuous.comp real.continuous_sqrt h


/- The lemma in this tag says that if we have a top space
and a basis with the property that the intersection of two
basis elements is in the basis, then to give a sheaf on B
is to give a "sheaf on a cofinal system of covers of B".
In the application to schemes, this means a presheaf with
the property that it satisfies the sheaf axiom for
finite covers of basic opens by basic opens, noting that
the intersection of two basis opens is a basic open.
-/

import tag009J

universe u
-- A "standard" basis -- I just mean intersection of two basic opens is basic open.
-- Makes the sheaf axiom easier, and is satisfied in the case of Spec of a ring.
-- Below is the statement of the sheaf axiom for a given open cover in this case.
definition sheaf_property_for_standard_basis
  {X : Type u} [T : topological_space X]
  {B : set (set X)}
  (HB : topological_space.is_topological_basis B)
  (FPTB : presheaf_of_types_on_basis HB)
  (Hstandard : ∀ {U V : set X}, B U → B V → B (U ∩ V))
  (U : set X)
  (BU : B U)
  (γ : Type u)
  (Ui : γ → set X)
  (BUi : ∀ i : γ, B (Ui i))
  (Hcover: (⋃ (i : γ), (Ui i)) = U) : Prop :=
  ∀ si : Π (i : γ), FPTB.F (BUi i),
  (∀ i j : γ, FPTB.res (BUi i) (Hstandard (BUi i) (BUi j) : B (Ui i ∩ Ui j)) (set.inter_subset_left _ _) (si i) =
              FPTB.res (BUi j) (Hstandard (BUi i) (BUi j) : B (Ui i ∩ Ui j)) (set.inter_subset_right _ _) (si j))
  → ∃! s : FPTB.F BU, ∀ i : γ, FPTB.res BU (BUi i) (Hcover ▸ (set.subset_Union Ui i)) s = si i

definition basis_is_compact
  {X : Type u} [T : topological_space X]
  {B : set (set X)}
  (HB : topological_space.is_topological_basis B) : Prop :=
  ∀ U : set X, B U →
    ∀ β : Type u, ∀ Ui : β → set X,
    (∀ i : β, B (Ui i)) →
    (⋃ (i : β), Ui i) = U →
    ∃ γ : Type u, ∃ Hfinite : fintype γ,
    ∃ f : γ → β,
    (⋃ (j : γ), Ui (f j)) = U

definition sheaf_for_standard_cofinal_system  {X : Type u} [T : topological_space X]
  {B : set (set X)}
  (HB : topological_space.is_topological_basis B)
  (FPTB : presheaf_of_types_on_basis HB)
  (Hstandard : ∀ U V : set X, B U → B V → B (U ∩ V))
  -- cofinal system is finite covers
  (HBcompact: basis_is_compact HB)
  :=
  (∀ U : set X, ∀ BU : B U,
  ∀ γ : Type u, fintype γ → -- note fintype here
  ∀ Ui : γ → set X,
  ∀ BUi :  ∀ i : γ, B (Ui i),
  ∀ Hcover: (⋃ (i : γ), (Ui i)) = U,
  sheaf_property_for_standard_basis HB FPTB Hstandard U BU γ Ui BUi Hcover)

theorem lemma_cofinal_systems_coverings_standard_case
  {X : Type u} [T : topological_space X]
  {B : set (set X)}
  (HB : topological_space.is_topological_basis B)
  (FPTB : presheaf_of_types_on_basis HB)
  (Hstandard : ∀ U V : set X, B U → B V → B (U ∩ V))
  -- cofinal system is finite covers
  (HBcompact: basis_is_compact HB)
  : sheaf_for_standard_cofinal_system HB FPTB Hstandard HBcompact →
-- that line above is shorthand for:
--  (∀ U : set X, ∀ BU : B U,
--  ∀ γ : Type u, fintype γ → -- note fintype here
--  ∀ Ui : γ → set X,
--  ∀ BUi :  ∀ i : γ, B (Ui i),
--  ∀ Hcover: (⋃ (i : γ), (Ui i)) = U,
--  sheaf_property_for_standard_basis HB FPTB Hstandard U BU γ Ui BUi Hcover)
--  →
  (∀ U : set X, ∀ BU : B U,
  ∀ γ : Type u,
  ∀ Ui : γ → set X,
  ∀ BUi :  ∀ i : γ, B (Ui i),
  ∀ Hcover: (⋃ (i : γ), (Ui i)) = U,
  sheaf_property_for_standard_basis HB FPTB Hstandard U BU γ Ui BUi Hcover)
  :=
begin
  intro Hfinite,
  intros U BU β Ui BUi Hcover,
  intros si Hsiglue,
  -- Hcover has a finite subcover
  cases HBcompact U BU β Ui BUi Hcover with γ Hγ,
  cases Hγ with HFinγ Hf,
  cases Hf with f Hfincover,
  have Huniques := Hfinite U BU γ HFinγ (Ui ∘ f) (λ j, BUi (f j)) Hfincover
    (λ i, si (f i)) (λ i j, Hsiglue (f i) (f j)),
  cases Huniques with s Hs,
  existsi s,
  split,
  { intro i,
    let Vj : γ → set X := λ j, Ui (f j) ∩ Ui i,
    have BVj : ∀ j : γ, B (Vj j) :=
      λ j, Hstandard (Ui (f j)) (Ui i) (BUi (f j)) (BUi i),
    have  HVcover : (⋃ (j : γ), Vj j) = Ui i,
    { apply set.ext,intro x,split,
      { intro HUn,
        cases HUn with Uk HUk,
        cases HUk with Ul HUl,
        cases Ul with j Hj,
        rw Hj at HUl,
        exact HUl.2
      },
      { intro Hx,
        have Hx2 : x ∈ U,
          rw ←Hcover,exact ⟨(Ui i),⟨i,rfl⟩,Hx⟩,
        rw ←Hfincover at Hx2,
        cases Hx2 with Vjj Hx3,
        cases Hx3 with Hx4 Vjjx,
        cases Hx4 with j Hj,
        existsi (Vj j),
        constructor,existsi j,refl,
        split,rw Hj at Vjjx,exact Vjjx,
        exact Hx
      }
    },
    --let x, show x = _,
    have HV := Hfinite (Ui i) (BUi i) γ HFinγ Vj BVj HVcover
      (λ j, FPTB.res BU (BVj j)
      (set.subset.trans (set.inter_subset_right _ _)
        (Hcover ▸ (set.subset_Union Ui i))) s) _,swap,
    { intros j1 j2,
      let Vj1 := Vj j1,
      let Vj2 := Vj j2,
      let Vj12 := Vj j1 ∩ Vj j2,
      have BVj1 := BVj j1,
      have BVj2 := BVj j2,
      have BVj12 := Hstandard _ _ BVj1 BVj2,
      show ((FPTB.res BVj1 BVj12 _) ∘ (FPTB.res BU BVj1 _)) s =
           ((FPTB.res BVj2 BVj12 _) ∘ (FPTB.res BU BVj2 _)) s,
      rw ←(FPTB.Hcomp U Vj1 Vj12 BU BVj1 BVj12 _ _),
      rw ←(FPTB.Hcomp U Vj2 Vj12 BU BVj2 BVj12 _ _),
    },
    -- it's "exact HV" -- a fact about Ui i
    cases HV with s2 Hs2,
    refine @eq.trans _ _ s2 _ _ _,
    { -- goal is that restriction of s to Ui i is s2
      apply Hs2.2,
      intro j, -- goal is that res from U to Ui i to Vj j.
      show ((FPTB.res _ _ _) ∘ (FPTB.res BU _ _)) s
        = FPTB.res BU _ _ s,
      rw ←(FPTB.Hcomp U (Ui i) (Vj j) BU _ _ _ _),
    },
    { -- goal is s2 = si i on Ui i
      apply eq.symm,
      apply Hs2.2,
      intro j,
      -- goal is that si i restricted to Vj j equals s restricted to Vj j
      -- Hs.1 is the fact that
      -- for all j, restriction of
      -- s to Ui (f j) is si (f j).
      -- now restrict to Vj j
      -- and deduce res of s to Vj j equals res of si (f j) to Vj j
      -- now Hsiglue says that on Vj j = Ui (f j) ∩ Ui i
      -- si (f j) and si i are equal.
      -- it says res si (f j) to Ui (f j) cap Ui i = res si i
      rw ←(Hsiglue), -- that was easy!
      -- goal now is that si (f j) = s on Ui (f j) cap Ui i
      have Htemp : si (f j) = _ := eq.symm (Hs.1 j),
      rw Htemp,
      show ((FPTB.res _ _ _) ∘ (FPTB.res BU _ _)) s = FPTB.res BU _ _ s,
      rw ←(FPTB.Hcomp U _ _ BU _ _ _ _),
    },
  },
  { intros s' Hs',
    apply Hs.2,
    intro i,
    exact Hs' (f i)
  }
end


--
example : 0 < 2 :=
  Nat.lt_trans Nat.zero_lt_one (Nat.lt_succ_self _)
            --^ $/lean/plainTermGoal
             --^ $/lean/plainTermGoal
              --^ $/lean/plainTermGoal
                             --^ $/lean/plainTermGoal
                                              --^ $/lean/plainTermGoal

example : OptionM Unit := do
  let y : Int ← none
  let x := Nat.zero
        --^ $/lean/plainTermGoal
  return ()

example (m n : Nat) : m < n :=
  Nat.lt_trans _ _
               --^ $/lean/plainTermGoal

example : True := sorry
                --^ $/lean/plainTermGoal

example : ∀ n, n < n + 42 :=
  fun n => Nat.lt_of_le_of_lt (Nat.le_add_right n 41) (Nat.lt_succ_self _)
--^ $/lean/plainTermGoal
    --^ $/lean/plainTermGoal

example : ∀ n, n < 1 + n := by
  intro n
  rw [Nat.add_comm]
    --^ $/lean/plainTermGoal
  exact Nat.lt_succ_self _
      --^ $/lean/plainTermGoal

#check fun (n m : Nat) => m
            --^ $/lean/plainTermGoal