/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

notation, basic datatypes and type classes
-/
import Mathlib.PrePort

universes u l v w u_1 u_2 u₁ u₂ u₃

namespace Mathlib

/- Reserving notation. We do this so that the precedence of all of the operators
can be seen in one place and to prevent core notation being accidentally overloaded later.  -/

/- Notation for logical operations and relations -/

/- types and type constructors -/

/- arithmetic operations -/

/- boolean operations -/

/- set operations -/

/- other symbols -/

/--
The kernel definitional equality test (t =?= s) has special support for id_delta applications.
It implements the following rules

   1)   (id_delta t) =?= t
   2)   t =?= (id_delta t)
   3)   (id_delta t) =?= s  IF (unfold_of t) =?= s
   4)   t =?= id_delta s    IF t =?= (unfold_of s)

This is mechanism for controlling the delta reduction (aka unfolding) used in the kernel.

We use id_delta applications to address performance problems when type checking
lemmas generated by the equation compiler.
-/
def id_delta {α : Sort u} (a : α) : α :=
  a

/-- Gadget for optional parameter support. -/
def opt_param (α : Sort u) (default : α) :=
  α

/-- Gadget for marking output parameters in type classes. -/
def out_param (α : Sort u) :=
  α

/-
  id_rhs is an auxiliary declaration used in the equation compiler to address performance
  issues when proving equational lemmas. The equation compiler uses it as a marker.
-/

def id_rhs (α : Sort u) (a : α) : α :=
  a

/-- An abbreviation for `punit.{0}`, its most common instantiation.
    This type should be preferred over `punit` where possible to avoid
    unnecessary universe parameters. -/
def unit :=
  PUnit

def unit.star : Unit :=
  PUnit.unit

/--
Gadget for defining thunks, thunk parameters have special treatment.
Example: given
      def f (s : string) (t : thunk nat) : nat
an application
     f "hello" 10
 is converted into
     f "hello" (λ _, 10)
-/
def thunk (α : Type u) :=
  Unit → α

inductive empty
where

/--
Logical not.

`not P`, with notation `¬ P`, is the `Prop` which is true if and only if `P` is false. It is
internally represented as `P → false`, so one way to prove a goal `⊢ ¬ P` is to use `intro h`,
which gives you a new hypothesis `h : P` and the goal `⊢ false`.

A hypothesis `h : ¬ P` can be used in term mode as a function, so if `w : P` then `h w : false`.

Related mathlib tactic: `contrapose`.
-/
def not (a : Prop) :=
  a → False

prefix:40 "¬" => Mathlib.not

/-
Initialize the quotient module, which effectively adds the following definitions:

constant quot {α : Sort u} (r : α → α → Prop) : Sort u

constant quot.mk {α : Sort u} (r : α → α → Prop) (a : α) : quot r

constant quot.lift {α : Sort u} {r : α → α → Prop} {β : Sort v} (f : α → β) :
  (∀ a b : α, r a b → eq (f a) (f b)) → quot r → β

constant quot.ind {α : Sort u} {r : α → α → Prop} {β : quot r → Prop} :
  (∀ a : α, β (quot.mk r a)) → ∀ q : quot r, β q

Also the reduction rule:

quot.lift f _ (quot.mk a) ~~> f a

-/

/--
Heterogeneous equality.

Its purpose is to write down equalities between terms whose types are not definitionally equal.
For example, given `x : vector α n` and `y : vector α (0+n)`, `x = y` doesn't typecheck but `x == y` does.

If you have a goal `⊢ x == y`,
your first instinct should be to ask (either yourself, or on [zulip](https://leanprover.zulipchat.com/))
if something has gone wrong already.
If you really do need to follow this route,
you may find the lemmas `eq_rec_heq` and `eq_mpr_heq` useful.
-/
/-- Similar to `prod`, but α and β can be propositions.
   We use this type internally to automatically generate the brec_on recursor. -/
/--
Logical and.

`and P Q`, with notation `P ∧ Q`, is the `Prop` which is true precisely when `P` and `Q` are
both true.

To prove a goal `⊢ P ∧ Q`, you can use the tactic `split`,
which gives two separate goals `⊢ P` and `⊢ Q`.

Given a hypothesis `h : P ∧ Q`, you can use the tactic `cases h with hP hQ`
to obtain two new hypotheses `hP : P` and `hQ : Q`. See also the `obtain` or `rcases` tactics in
mathlib.
-/
def and.elim_left {a : Prop} {b : Prop} (h : a ∧ b) : a :=
  and.left h

def and.elim_right {a : Prop} {b : Prop} (h : a ∧ b) : b :=
  and.right h

infixl:50 " = " => Mathlib.eq

/- eq basic support -/

def rfl {α : Sort u} {a : α} : a = a :=
  Eq.refl a

theorem eq.subst {α : Sort u} {P : α → Prop} {a : α} {b : α} (h₁ : a = b) (h₂ : P a) : P b :=
  Eq._oldrec h₂ h₁

infixr:75 " ▸ " => Mathlib.eq.subst

theorem eq.trans {α : Sort u} {a : α} {b : α} {c : α} (h₁ : a = b) (h₂ : b = c) : a = c :=
  h₂ ▸ h₁

theorem eq.symm {α : Sort u} {a : α} {b : α} (h : a = b) : b = a :=
  h ▸ rfl

infixl:50 " == " => Mathlib.heq

def heq.rfl {α : Sort u} {a : α} : a == a :=
  HEq.refl a

theorem eq_of_heq {α : Sort u} {a : α} {a' : α} (h : a == a') : a = a' :=
  (fun (this : ∀ (α' : Sort u) (a' : α'), a == a' → ∀ (h₂ : α = α'), eq.rec_on h₂ a = a') =>
      (fun (this : eq.rec_on (Eq.refl α) a = a') => this) (this α a' h (Eq.refl α)))
    fun (α' : Sort u) (a' : α') (h₁ : a == a') => heq.rec_on h₁ fun (h₂ : α = α) => rfl

/- The following four lemmas could not be automatically generated when the
   structures were declared, so we prove them manually here. -/

theorem prod.mk.inj {α : Type u} {β : Type v} {x₁ : α} {y₁ : β} {x₂ : α} {y₂ : β} : (x₁, y₁) = (x₂, y₂) → x₁ = x₂ ∧ y₁ = y₂ :=
  fun (h : (x₁, y₁) = (x₂, y₂)) => prod.no_confusion h fun (h₁ : x₁ = x₂) (h₂ : y₁ = y₂) => { left := h₁, right := h₂ }

theorem prod.mk.inj_arrow {α : Type u} {β : Type v} {x₁ : α} {y₁ : β} {x₂ : α} {y₂ : β} : (x₁, y₁) = (x₂, y₂) → {P : Sort w} → (x₁ = x₂ → y₁ = y₂ → P) → P :=
  fun (h₁ : (x₁, y₁) = (x₂, y₂)) (_x : Sort w) (h₂ : x₁ = x₂ → y₁ = y₂ → _x) => prod.no_confusion h₁ h₂

theorem pprod.mk.inj {α : Sort u} {β : Sort v} {x₁ : α} {y₁ : β} {x₂ : α} {y₂ : β} : { fst := x₁, snd := y₁ } = { fst := x₂, snd := y₂ } → x₁ = x₂ ∧ y₁ = y₂ :=
  fun (h : { fst := x₁, snd := y₁ } = { fst := x₂, snd := y₂ }) =>
    pprod.no_confusion h fun (h₁ : x₁ = x₂) (h₂ : y₁ = y₂) => { left := h₁, right := h₂ }

theorem pprod.mk.inj_arrow {α : Type u} {β : Type v} {x₁ : α} {y₁ : β} {x₂ : α} {y₂ : β} : (x₁, y₁) = (x₂, y₂) → {P : Sort w} → (x₁ = x₂ → y₁ = y₂ → P) → P :=
  fun (h₁ : (x₁, y₁) = (x₂, y₂)) (_x : Sort w) (h₂ : x₁ = x₂ → y₁ = y₂ → _x) => prod.no_confusion h₁ h₂

inductive sum (α : Type u) (β : Type v)
where
| inl : α → sum α β
| inr : β → sum α β

inductive psum (α : Sort u) (β : Sort v)
where
| inl : α → psum α β
| inr : β → psum α β

/--
Logical or.

`or P Q`, with notation `P ∨ Q`, is the proposition which is true if and only if `P` or `Q` is
true.

To prove a goal `⊢ P ∨ Q`, if you know which alternative you want to prove,
you can use the tactics `left` (which gives the goal `⊢ P`)
or `right` (which gives the goal `⊢ Q`).

Given a hypothesis `h : P ∨ Q` and goal `⊢ R`,
the tactic `cases h` will give you two copies of the goal `⊢ R`,
with the hypothesis `h : P` in the first, and the hypothesis `h : Q` in the second.
-/
def or.intro_left {a : Prop} (b : Prop) (ha : a) : a ∨ b :=
  Or.inl ha

def or.intro_right (a : Prop) {b : Prop} (hb : b) : a ∨ b :=
  Or.inr hb

structure sigma {α : Type u} (β : α → Type v)
where
  fst : α
  snd : β fst

structure psigma {α : Sort u} (β : α → Sort v)
where
  fst : α
  snd : β fst

/- Remark: subtype must take a Sort instead of Type because of the axiom strong_indefinite_description. -/

def decidable_pred {α : Sort u} (r : α → Prop) :=
  (a : α) → Decidable (r a)

def decidable_rel {α : Sort u} (r : α → α → Prop) :=
  (a b : α) → Decidable (r a b)

def decidable_eq (α : Sort u) :=
  DecidableRel Eq

infixr:67 " :: " => Mathlib.list.cons

structure unification_constraint
where
  α : Type u
  lhs : α
  rhs : α

infixl:50 " ≟ " => Mathlib.unification_constraint.mk

infixl:50 " =?= " => Mathlib.unification_constraint.mk

structure unification_hint
where
  pattern : unification_constraint
  constraints : List unification_constraint

/- Declare builtin and reserved notation -/

class has_inv (α : Type u)
where
  inv : α → α

class has_dvd (α : Type u)
where
  dvd : α → α → Prop

class has_andthen (α : Type u) (β : Type v) (σ : outParam (Type w))
where
  andthen : α → β → σ

class has_union (α : Type u)
where
  union : α → α → α

class has_inter (α : Type u)
where
  inter : α → α → α

class has_sdiff (α : Type u)
where
  sdiff : α → α → α

class has_equiv (α : Sort u)
where
  equiv : α → α → Prop

class has_subset (α : Type u)
where
  subset : α → α → Prop

/- Type classes has_emptyc and has_insert are
class has_ssubset (α : Type u)
where
  ssubset : α → α → Prop

   used to implement polymorphic notation for collections.
   Example: {a, b, c}. -/

class has_emptyc (α : Type u)
where
  emptyc : α

class has_insert (α : outParam (Type u)) (γ : Type v)
where
  insert : α → γ → γ

/- Type class used to implement the notation { a ∈ c | p a } -/

class has_singleton (α : outParam (Type u)) (β : Type v)
where
  singleton : α → β

class has_sep (α : outParam (Type u)) (γ : Type v)
where
  sep : (α → Prop) → γ → γ

/- Type class for set-like membership -/

class has_mem (α : outParam (Type u)) (γ : Type v)
where
  mem : α → γ → Prop

class has_pow (α : Type u) (β : Type v)
where
  pow : α → β → α

infixl:50 " ∈ " => Mathlib.has_mem.mem

infixl:65 " + " => Mathlib.has_add.add

infixl:70 " * " => Mathlib.has_mul.mul

infixl:65 " - " => Mathlib.has_sub.sub

infixl:70 " / " => Mathlib.has_div.div

infixl:50 " ∣ " => Mathlib.has_dvd.dvd

infixl:70 " % " => Mathlib.has_mod.mod

prefix:75 "-" => Mathlib.has_neg.neg

infixl:50 " <= " => Mathlib.has_le.le

infixl:50 " ≤ " => Mathlib.has_le.le

infixl:50 " < " => Mathlib.has_lt.lt

infixl:65 " ++ " => Mathlib.has_append.append

infixl:1 "; " => Mathlib.has_andthen.andthen

notation:1024 "∅" => Mathlib.has_emptyc.emptyc

infixl:65 " ∪ " => Mathlib.has_union.union

infixl:70 " ∩ " => Mathlib.has_inter.inter

infixl:50 " ⊆ " => Mathlib.has_subset.subset

infixl:50 " ⊂ " => Mathlib.has_ssubset.ssubset

infixl:70 " \ " => Mathlib.has_sdiff.sdiff

infixl:50 " ≈ " => Mathlib.has_equiv.equiv

infixr:80 " ^ " => Mathlib.has_pow.pow

def ge {α : Type u} [HasLessEq α] (a : α) (b : α) :=
  b ≤ a

def gt {α : Type u} [HasLess α] (a : α) (b : α) :=
  b < a

infixl:50 " >= " => Mathlib.ge

infixl:50 " ≥ " => Mathlib.ge

infixl:50 " > " => Mathlib.gt

def superset {α : Type u} [has_subset α] (a : α) (b : α) :=
  b ⊆ a

def ssuperset {α : Type u} [has_ssubset α] (a : α) (b : α) :=
  b ⊂ a

infixl:50 " ⊇ " => Mathlib.superset

infixl:50 " ⊃ " => Mathlib.ssuperset

def bit0 {α : Type u} [s : Add α] (a : α) : α :=
  a + a

def bit1 {α : Type u} [s₁ : HasOne α] [s₂ : Add α] (a : α) : α :=
  bit0 a + 1

class is_lawful_singleton (α : Type u) (β : Type v) [has_emptyc β] [has_insert α β] [has_singleton α β]
where
  insert_emptyc_eq : ∀ (x : α), insert x ∅ = has_singleton.singleton x

/- nat basic instances -/

namespace nat

protected def add : Nat → Nat → Nat :=
  Nat.add

end nat

protected instance nat.has_zero : HasZero Nat :=
  { zero := 0 }

protected instance nat.has_one : HasOne Nat :=
  { one := 1 }

protected instance nat.has_add : Add Nat :=
  { add := Nat.add }

def std.priority.default : Nat :=
  bit0 (bit0 (bit0 (bit1 (bit0 (bit1 (bit1 (bit1 (bit1 1))))))))

def std.priority.max : Nat :=
  bit1
    (bit1
      (bit1
        (bit1
          (bit1
            (bit1
              (bit1
                (bit1
                  (bit1
                    (bit1
                      (bit1
                        (bit1
                          (bit1
                            (bit1
                              (bit1
                                (bit1
                                  (bit1
                                    (bit1
                                      (bit1
                                        (bit1
                                          (bit1
                                            (bit1
                                              (bit1
                                                (bit1
                                                  (bit1
                                                    (bit1 (bit1 (bit1 (bit1 (bit1 (bit1 1))))))))))))))))))))))))))))))

namespace nat

end nat

protected def nat.prio : Nat :=
  std.priority.default + bit0 (bit0 (bit1 (bit0 (bit0 (bit1 1)))))

/-
  Global declarations of right binding strength

  If a module reassigns these, it will be incompatible with other modules that adhere to these
  conventions.

  When hovering over a symbol, use "C-c C-k" to see how to input it.
-/

def std.prec.max : Nat :=
  bit0 (bit0 (bit0 (bit0 (bit0 (bit0 (bit0 (bit0 (bit0 (bit0 1)))))))))

def std.prec.arrow : Nat :=
  bit1 (bit0 (bit0 (bit1 1)))

/-
The next def is "max + 10". It can be used e.g. for postfix operations that should
be stronger than application.
-/

def std.prec.max_plus : Nat :=
  std.prec.max + bit0 (bit1 (bit0 1))

postfix:0 "⁻¹" => Mathlib.has_inv.inv

infixr:35 " × " => Mathlib.prod

-- notation for n-ary tuples

/- sizeof -/

def sizeof {α : Sort u} [s : SizeOf α] : α → Nat :=
  has_sizeof.sizeof

/-
Declare sizeof instances and lemmas for types declared before has_sizeof.
From now on, the inductive compiler will automatically generate sizeof instances and lemmas.
-/

/- Every type `α` has a default has_sizeof instance that just returns 0 for every element of `α` -/

protected def default.sizeof (α : Sort u) : α → Nat :=
  sorry

protected instance default_has_sizeof (α : Sort u) : SizeOf α :=
  { sizeOf := default.sizeof α }

protected def nat.sizeof : Nat → Nat :=
  sorry

protected instance nat.has_sizeof : SizeOf Nat :=
  { sizeOf := nat.sizeof }

protected def prod.sizeof {α : Type u} {β : Type v} [SizeOf α] [SizeOf β] : α × β → Nat :=
  sorry

protected instance prod.has_sizeof (α : Type u) (β : Type v) [SizeOf α] [SizeOf β] : SizeOf (α × β) :=
  { sizeOf := prod.sizeof }

protected def sum.sizeof {α : Type u} {β : Type v} [SizeOf α] [SizeOf β] : sum α β → Nat :=
  sorry

protected instance sum.has_sizeof (α : Type u) (β : Type v) [SizeOf α] [SizeOf β] : SizeOf (sum α β) :=
  { sizeOf := sum.sizeof }

protected def psum.sizeof {α : Type u} {β : Type v} [SizeOf α] [SizeOf β] : psum α β → Nat :=
  sorry

protected instance psum.has_sizeof (α : Type u) (β : Type v) [SizeOf α] [SizeOf β] : SizeOf (psum α β) :=
  { sizeOf := psum.sizeof }

protected def sigma.sizeof {α : Type u} {β : α → Type v} [SizeOf α] [(a : α) → SizeOf (β a)] : sigma β → Nat :=
  sorry

protected instance sigma.has_sizeof (α : Type u) (β : α → Type v) [SizeOf α] [(a : α) → SizeOf (β a)] : SizeOf (sigma β) :=
  { sizeOf := sigma.sizeof }

protected def psigma.sizeof {α : Type u} {β : α → Type v} [SizeOf α] [(a : α) → SizeOf (β a)] : psigma β → Nat :=
  sorry

protected instance psigma.has_sizeof (α : Type u) (β : α → Type v) [SizeOf α] [(a : α) → SizeOf (β a)] : SizeOf (psigma β) :=
  { sizeOf := psigma.sizeof }

protected def punit.sizeof : PUnit → Nat :=
  sorry

protected instance punit.has_sizeof : SizeOf PUnit :=
  { sizeOf := punit.sizeof }

protected def bool.sizeof : Bool → Nat :=
  sorry

protected instance bool.has_sizeof : SizeOf Bool :=
  { sizeOf := bool.sizeof }

protected def option.sizeof {α : Type u} [SizeOf α] : Option α → Nat :=
  sorry

protected instance option.has_sizeof (α : Type u) [SizeOf α] : SizeOf (Option α) :=
  { sizeOf := option.sizeof }

protected def list.sizeof {α : Type u} [SizeOf α] : List α → Nat :=
  sorry

protected instance list.has_sizeof (α : Type u) [SizeOf α] : SizeOf (List α) :=
  { sizeOf := list.sizeof }

protected def subtype.sizeof {α : Type u} [SizeOf α] {p : α → Prop} : Subtype p → Nat :=
  sorry

protected instance subtype.has_sizeof {α : Type u} [SizeOf α] (p : α → Prop) : SizeOf (Subtype p) :=
  { sizeOf := subtype.sizeof }

theorem nat_add_zero (n : Nat) : n + 0 = n :=
  rfl

/- Combinator calculus -/

namespace combinator

def I {α : Type u₁} (a : α) : α :=
  a

def K {α : Type u₁} {β : Type u₂} (a : α) (b : β) : α :=
  a

end combinator

def combinator.S {α : Type u₁} {β : Type u₂} {γ : Type u₃} (x : α → β → γ) (y : α → β) (z : α) : γ :=
  x z (y z)

/-- Auxiliary datatype for #[ ... ] notation.
    #[1, 2, 3, 4] is notation for

    bin_tree.node
      (bin_tree.node (bin_tree.leaf 1) (bin_tree.leaf 2))
      (bin_tree.node (bin_tree.leaf 3) (bin_tree.leaf 4))

    We use this notation to input long sequences without exhausting the system stack space.
    Later, we define a coercion from `bin_tree` into `list`.
-/
inductive bin_tree (α : Type u)
where
| empty : bin_tree α
| leaf : α → bin_tree α
| node : bin_tree α → bin_tree α → bin_tree α

/- Basic unification hints -/

def add_succ_defeq_succ_add_hint (x : Nat) (y : Nat) (z : Nat) : unification_hint :=
  unification_hint.mk (x + Nat.succ y =?= Nat.succ z) [z =?= x + y]

/-- Like `by apply_instance`, but not dependent on the tactic framework. -/
def infer_instance {α : Sort u} [i : α] : α :=
  i


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johan Commelin, Andrew Yang
-/
import category_theory.limits.preserves.shapes.zero
import category_theory.monoidal.End
import category_theory.monoidal.discrete

/-!
# Shift

A `shift` on a category `C` indexed by a monoid `A` is nothing more than a monoidal functor
from `A` to `C ⥤ C`. A typical example to keep in mind might be the category of
complexes `⋯ → C_{n-1} → C_n → C_{n+1} → ⋯`. It has a shift indexed by `ℤ`, where we assign to
each `n : ℤ` the functor `C ⥤ C` that re-indexes the terms, so the degree `i` term of `shift n C`
would be the degree `i+n`-th term of `C`.

## Main definitions
* `has_shift`: A typeclass asserting the existence of a shift functor.
* `shift_equiv`: When the indexing monoid is a group, then the functor indexed by `n` and `-n` forms
  an self-equivalence of `C`.
* `shift_comm`: When the indexing monoid is commutative, then shifts commute as well.

## Implementation Notes

Many of the definitions in this file are marked as an `abbreviation` so that the simp lemmas in
`category_theory/monoidal/End` can apply.

-/
namespace category_theory

noncomputable theory

universes v u

variables (C : Type u) (A : Type*) [category.{v} C]

local attribute [instance] endofunctor_monoidal_category

section eq_to_hom

variables {A C}

variables [add_monoid A] (F : monoidal_functor (discrete A) (C ⥤ C))

 @[simp, reassoc] lemma eq_to_hom_μ_app {i j i' j' : A} (h₁ : i = i') (h₂ : j = j') (X : C) :
   eq_to_hom (by rw [h₁, h₂] : (F.obj ⟨i⟩ ⊗ F.obj ⟨j⟩).obj X =
       (F.obj ⟨i'⟩ ⊗ F.obj ⟨j'⟩).obj X) ≫ (F.μ ⟨i'⟩ ⟨j'⟩).app X =
     (F.μ ⟨i⟩ ⟨j⟩).app X ≫ eq_to_hom (by rw [h₁, h₂]) :=
 by { cases h₁, cases h₂, rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id] }

 @[simp, reassoc] lemma μ_inv_app_eq_to_hom {i j i' j' : A} (h₁ : i = i') (h₂ : j = j') (X : C) :
   inv ((F.μ ⟨i⟩ ⟨j⟩).app X) ≫ eq_to_hom (by rw [h₁, h₂]) =
     eq_to_hom (by rw [h₁, h₂]) ≫ inv ((F.μ ⟨i'⟩ ⟨j'⟩).app X) :=
 by { cases h₁, cases h₂, rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id] }

end eq_to_hom

variables {A C}

/-- A monoidal functor from a group `A` into `C ⥤ C` induces
a self-equivalence of `C` for each `n : A`. -/
@[simps functor inverse unit_iso_hom unit_iso_inv counit_iso_hom counit_iso_inv]
def add_neg_equiv [add_group A] (F : monoidal_functor (discrete A) (C ⥤ C)) (n : A) : C ≌ C :=
equiv_of_tensor_iso_unit F ⟨n⟩ ⟨(-n : A)⟩
  (discrete.eq_to_iso (add_neg_self n)) (discrete.eq_to_iso (neg_add_self n))
  (subsingleton.elim _ _)

section defs

variables (A C) [add_monoid A]

/-- A category has a shift indexed by an additive monoid `A`
if there is a monoidal functor from `A` to `C ⥤ C`. -/
class has_shift (C : Type u) (A : Type*) [category.{v} C] [add_monoid A] :=
(shift : monoidal_functor (discrete A) (C ⥤ C))

/-- A helper structure to construct the shift functor `(discrete A) ⥤ (C ⥤ C)`. -/
@[nolint has_inhabited_instance]
structure shift_mk_core :=
(F : A → (C ⥤ C))
(ε : 𝟭 C ≅ F 0)
(μ : Π n m : A, F n ⋙ F m ≅ F (n + m))
(associativity : ∀ (m₁ m₂ m₃ : A) (X : C),
  (F m₃).map ((μ m₁ m₂).hom.app X) ≫ (μ (m₁ + m₂) m₃).hom.app X ≫
    eq_to_hom (by { congr' 2, exact add_assoc _ _ _ }) =
    (μ m₂ m₃).hom.app ((F m₁).obj X) ≫ (μ m₁ (m₂ + m₃)).hom.app X . obviously)
(left_unitality : ∀ (n : A) (X : C),
  (F n).map (ε.hom.app X) ≫ (μ 0 n).hom.app X =
    eq_to_hom (by { dsimp, rw zero_add }) . obviously)
(right_unitality : ∀ (n : A) (X : C),
  ε.hom.app ((F n).obj X) ≫ (μ n 0).hom.app X =
    eq_to_hom (by { dsimp, rw add_zero }) . obviously)

section
local attribute [simp] eq_to_hom_map
local attribute [reducible] endofunctor_monoidal_category discrete.add_monoidal

/-- Constructs a `has_shift C A` instance from `shift_mk_core`. -/
@[simps]
def has_shift_mk (h : shift_mk_core C A) : has_shift C A :=
⟨{ ε := h.ε.hom,
   μ := λ m n, (h.μ m.as n.as).hom,
   μ_natural' := by { rintros ⟨X⟩ ⟨Y⟩ ⟨X'⟩ ⟨Y'⟩ ⟨⟨⟨rfl⟩⟩⟩ ⟨⟨⟨rfl⟩⟩⟩, ext,
     dsimp, simp, dsimp, simp },
   associativity' := by { introv, ext, dsimp, simpa using h.associativity _ _ _ _, },
   left_unitality' :=
    by { rintro ⟨X⟩, ext, dsimp, rw [category.id_comp, ← category.assoc, h.left_unitality], simp },
   right_unitality' :=
    by { rintro ⟨X⟩, ext, dsimp, rw [functor.map_id, category.comp_id,
      ← category.assoc, h.right_unitality], simp },
 ..(discrete.functor h.F) }⟩

end

variables [has_shift C A]

/-- The monoidal functor from `A` to `C ⥤ C` given a `has_shift` instance. -/
def shift_monoidal_functor : monoidal_functor (discrete A) (C ⥤ C) := has_shift.shift

variable {A}

/-- The shift autoequivalence, moving objects and morphisms 'up'. -/
abbreviation shift_functor (i : A) : C ⥤ C := (shift_monoidal_functor C A).obj ⟨i⟩

/-- Shifting by `i + j` is the same as shifting by `i` and then shifting by `j`. -/
abbreviation shift_functor_add (i j : A) :
  shift_functor C (i + j) ≅ shift_functor C i ⋙ shift_functor C j :=
((shift_monoidal_functor C A).μ_iso ⟨i⟩ ⟨j⟩).symm

variables (A)

/-- Shifting by zero is the identity functor. -/
abbreviation shift_functor_zero : shift_functor C (0 : A) ≅ 𝟭 C :=
(shift_monoidal_functor C A).ε_iso.symm

-- Any better notational suggestions?
notation X`⟦`n`⟧`:20 := (shift_functor _ n).obj X
notation f`⟦`n`⟧'`:80 := (shift_functor _ n).map f

end defs

section add_monoid

variables {C A} [add_monoid A] [has_shift C A] (X Y : C) (f : X ⟶ Y)

@[simp] lemma has_shift.shift_obj_obj (n : A) (X : C) : (has_shift.shift.obj ⟨n⟩).obj X = X⟦n⟧ :=
rfl

/-- Shifting by `i + j` is the same as shifting by `i` and then shifting by `j`. -/
abbreviation shift_add (i j : A) : X⟦i + j⟧ ≅ X⟦i⟧⟦j⟧ := (shift_functor_add C i j).app _

@[reassoc] lemma shift_add_hom_comp_eq_to_hom₁ (i i' j : A) (h : i = i') :
  (shift_add X i j).hom ≫ eq_to_hom (by rw h) = eq_to_hom (by rw h) ≫ (shift_add X i' j).hom :=
by { cases h, rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id] }

@[reassoc] lemma shift_add_hom_comp_eq_to_hom₂ (i j j' : A) (h : j = j') :
  (shift_add X i j).hom ≫ eq_to_hom (by rw h) = eq_to_hom (by rw h) ≫ (shift_add X i j').hom :=
by { cases h, rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id] }

@[reassoc] lemma shift_add_hom_comp_eq_to_hom₁₂ (i j i' j' : A) (h₁ : i = i') (h₂ : j = j') :
  (shift_add X i j).hom ≫ eq_to_hom (by rw [h₁, h₂]) =
    eq_to_hom (by rw [h₁, h₂]) ≫ (shift_add X i' j').hom :=
by { cases h₁, cases h₂, rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id] }

@[reassoc] lemma eq_to_hom_comp_shift_add_inv₁ (i i' j : A) (h : i = i') :
  eq_to_hom (by rw h) ≫ (shift_add X i' j).inv = (shift_add X i j).inv ≫ eq_to_hom (by rw h) :=
by rw [iso.comp_inv_eq, category.assoc, iso.eq_inv_comp, shift_add_hom_comp_eq_to_hom₁]

@[reassoc] lemma eq_to_hom_comp_shift_add_inv₂ (i j j' : A) (h : j = j') :
  eq_to_hom (by rw h) ≫ (shift_add X i j').inv = (shift_add X i j).inv ≫ eq_to_hom (by rw h) :=
by rw [iso.comp_inv_eq, category.assoc, iso.eq_inv_comp, shift_add_hom_comp_eq_to_hom₂]

@[reassoc] lemma eq_to_hom_comp_shift_add_inv₁₂ (i j i' j' : A) (h₁ : i = i') (h₂ : j = j') :
  eq_to_hom (by rw [h₁, h₂]) ≫ (shift_add X i' j').inv =
    (shift_add X i j).inv ≫ eq_to_hom (by rw [h₁, h₂]) :=
by rw [iso.comp_inv_eq, category.assoc, iso.eq_inv_comp, shift_add_hom_comp_eq_to_hom₁₂]

lemma shift_shift' (i j : A) :
  f⟦i⟧'⟦j⟧' = (shift_add X i j).inv ≫ f⟦i + j⟧' ≫ (shift_add Y i j).hom :=
by { symmetry, apply nat_iso.naturality_1 }

variables (A)

/-- Shifting by zero is the identity functor. -/
abbreviation shift_zero  :
  X⟦0⟧ ≅ X := (shift_functor_zero C A).app _

lemma shift_zero' :
  f⟦(0 : A)⟧' = (shift_zero A X).hom ≫ f ≫ (shift_zero A Y).inv :=
by { symmetry, apply nat_iso.naturality_2 }

end add_monoid

section add_group

variables (C) {A} [add_group A] [has_shift C A]
variables (X Y : C) (f : X ⟶ Y)

/-- Shifting by `i` is an equivalence. -/
instance (i : A) : is_equivalence (shift_functor C i) :=
begin
  change is_equivalence (add_neg_equiv (shift_monoidal_functor C A) i).functor,
  apply_instance,
end

@[simp] lemma shift_functor_inv (i : A) :
  (shift_functor C i).inv = shift_functor C (-i) :=
rfl

/-- Shifting by `i` and then shifting by `-i` is the identity. -/
abbreviation shift_functor_comp_shift_functor_neg (i : A) :
  shift_functor C i ⋙ shift_functor C (-i) ≅ 𝟭 C :=
unit_of_tensor_iso_unit (shift_monoidal_functor C A) ⟨i⟩ ⟨(-i : A)⟩
  (discrete.eq_to_iso (add_neg_self i))

/-- Shifting by `-i` and then shifting by `i` is the identity. -/
abbreviation shift_functor_neg_comp_shift_functor (i : A) :
  shift_functor C (-i) ⋙ shift_functor C i ≅ 𝟭 C :=
unit_of_tensor_iso_unit (shift_monoidal_functor C A) ⟨(-i : A)⟩ ⟨i⟩
  (discrete.eq_to_iso (neg_add_self i))

section

variables (C)

/-- Shifting by `n` is a faithful functor. -/
instance shift_functor_faithful (i : A) : faithful (shift_functor C i) :=
faithful.of_comp_iso (shift_functor_comp_shift_functor_neg C i)

/-- Shifting by `n` is a full functor. -/
instance shift_functor_full (i : A) : full (shift_functor C i) :=
begin
  haveI : full (shift_functor C i ⋙ shift_functor C (-i)) :=
    full.of_iso (shift_functor_comp_shift_functor_neg C i).symm,
  exact full.of_comp_faithful _ (shift_functor C (-i))
end

/-- Shifting by `n` is an essentially surjective functor. -/
instance shift_functor_ess_surj (i : A) : ess_surj (shift_functor C i) :=
{ mem_ess_image := λ Y, ⟨Y⟦-i⟧, ⟨(shift_functor_neg_comp_shift_functor C i).app Y⟩⟩ }

end

variables {C}

/-- Shifting by `i` and then shifting by `-i` is the identity. -/
abbreviation shift_shift_neg (i : A) : X⟦i⟧⟦-i⟧ ≅ X :=
(shift_functor_comp_shift_functor_neg C i).app _

/-- Shifting by `-i` and then shifting by `i` is the identity. -/
abbreviation shift_neg_shift (i : A) : X⟦-i⟧⟦i⟧ ≅ X :=
(shift_functor_neg_comp_shift_functor C i).app _

variables {X Y}

lemma shift_shift_neg' (i : A) :
  f⟦i⟧'⟦-i⟧' = (shift_shift_neg X i).hom ≫ f ≫ (shift_shift_neg Y i).inv :=
by { symmetry, apply nat_iso.naturality_2 }

lemma shift_neg_shift' (i : A) :
  f⟦-i⟧'⟦i⟧' = (shift_neg_shift X i).hom ≫ f ≫ (shift_neg_shift Y i).inv :=
by { symmetry, apply nat_iso.naturality_2 }

lemma shift_equiv_triangle (n : A) (X : C) :
  (shift_shift_neg X n).inv⟦n⟧' ≫ (shift_neg_shift (X⟦n⟧) n).hom = 𝟙 (X⟦n⟧) :=
(add_neg_equiv (shift_monoidal_functor C A) n).functor_unit_iso_comp X

section
local attribute [reducible] discrete.add_monoidal

lemma shift_shift_neg_hom_shift (n : A) (X : C) :
  (shift_shift_neg X n).hom ⟦n⟧' = (shift_neg_shift (X⟦n⟧) n).hom :=
begin
  -- This is just `simp, simp [eq_to_hom_map]`.
  simp only [iso.app_hom, unit_of_tensor_iso_unit_hom_app, eq_to_iso.hom, functor.map_comp,
    obj_μ_app, eq_to_iso.inv, obj_ε_inv_app, μ_naturalityₗ_assoc, category.assoc,
    μ_inv_hom_app_assoc, ε_inv_app_obj, μ_naturalityᵣ_assoc],
  simp only [eq_to_hom_map, eq_to_hom_app, eq_to_hom_trans],
end

end

lemma shift_shift_neg_inv_shift (n : A) (X : C) :
  (shift_shift_neg X n).inv ⟦n⟧' = (shift_neg_shift (X⟦n⟧) n).inv :=
by { ext, rw [← shift_shift_neg_hom_shift, ← functor.map_comp, iso.hom_inv_id, functor.map_id] }

@[simp]
lemma shift_shift_neg_shift_eq (n : A) (X : C) :
  (shift_functor C n).map_iso (shift_shift_neg X n) = shift_neg_shift (X⟦n⟧) n :=
category_theory.iso.ext $ shift_shift_neg_hom_shift _ _

variables (C)

/-- Shifting by `n` and shifting by `-n` forms an equivalence. -/
@[simps]
def shift_equiv (n : A) : C ≌ C :=
{ functor := shift_functor C n,
  inverse := shift_functor C (-n),
  ..(add_neg_equiv (shift_monoidal_functor C A) n) }

variable {C}

open category_theory.limits

variables [has_zero_morphisms C]

lemma shift_zero_eq_zero (X Y : C) (n : A) : (0 : X ⟶ Y)⟦n⟧' = (0 : X⟦n⟧ ⟶ Y⟦n⟧) :=
category_theory.functor.map_zero _ _ _

end add_group

section add_comm_monoid

variables {C A} [add_comm_monoid A] [has_shift C A]
variables (X Y : C) (f : X ⟶ Y)

/-- When shifts are indexed by an additive commutative monoid, then shifts commute. -/
def shift_comm (i j : A) : X⟦i⟧⟦j⟧ ≅ X⟦j⟧⟦i⟧ :=
(shift_add X i j).symm ≪≫ ((shift_monoidal_functor C A).to_functor.map_iso
  (discrete.eq_to_iso $ add_comm i j : (⟨i+j⟩ : discrete A) ≅ ⟨j+i⟩)).app X ≪≫ shift_add X j i

@[simp] lemma shift_comm_symm (i j : A) : (shift_comm X i j).symm = shift_comm X j i :=
begin
  ext, dsimp [shift_comm], simpa [eq_to_hom_map],
end

variables {X Y}

/-- When shifts are indexed by an additive commutative monoid, then shifts commute. -/
lemma shift_comm' (i j : A) :
  f⟦i⟧'⟦j⟧' = (shift_comm _ _ _).hom ≫ f⟦j⟧'⟦i⟧' ≫ (shift_comm _ _ _).hom :=
begin
  -- This is just `simp, simp [eq_to_hom_map]`.
  simp only [shift_comm, iso.trans_hom, iso.symm_hom, iso.app_inv, iso.symm_inv,
    monoidal_functor.μ_iso_hom, iso.app_hom, functor.map_iso_hom, eq_to_iso.hom, μ_naturality_assoc,
    nat_trans.naturality_assoc, nat_trans.naturality, functor.comp_map, category.assoc,
    μ_inv_hom_app_assoc],
  simp only [eq_to_hom_map, eq_to_hom_app, eq_to_hom_trans_assoc, eq_to_hom_refl, category.id_comp,
    μ_hom_inv_app_assoc],
end

@[reassoc] lemma shift_comm_hom_comp (i j : A) :
  (shift_comm X i j).hom ≫ f⟦j⟧'⟦i⟧' = f⟦i⟧'⟦j⟧' ≫ (shift_comm Y i j).hom :=
by rw [shift_comm', ← shift_comm_symm, iso.symm_hom, iso.inv_hom_id_assoc]

end add_comm_monoid

variables {D : Type*} [category D] [add_monoid A] [has_shift D A]
variables (F : C ⥤ D) [full F] [faithful F]

section
local attribute [reducible] discrete.add_monoidal

/-- Given a family of endomorphisms of `C` which are interwined by a fully faithful `F : C ⥤ D`
with shift functors on `D`, we can promote that family to shift functors on `C`. -/
def has_shift_of_fully_faithful
  (s : A → C ⥤ C) (i : ∀ i, s i ⋙ F ≅ F ⋙ shift_functor D i) : has_shift C A :=
has_shift_mk C A
{ F := s,
  ε := nat_iso_of_comp_fully_faithful F
    (calc 𝟭 C ⋙ F ≅ F                                   : functor.left_unitor _
      ... ≅ F ⋙ 𝟭 D                                     : (functor.right_unitor _).symm
      ... ≅ F ⋙ shift_functor D (0 : A)                 :
              iso_whisker_left F (shift_functor_zero D A).symm
      ... ≅ s 0 ⋙ F                                     : (i 0).symm),
  μ := λ a b, nat_iso_of_comp_fully_faithful F
    (calc (s a ⋙ s b) ⋙ F ≅ s a ⋙ s b ⋙ F             : functor.associator _ _ _
     ... ≅ s a ⋙ F ⋙ shift_functor D b                 : iso_whisker_left _ (i b)
     ... ≅ (s a ⋙ F) ⋙ shift_functor D b               : (functor.associator _ _ _).symm
     ... ≅ (F ⋙ shift_functor D a) ⋙ shift_functor D b : iso_whisker_right (i a) _
     ... ≅ F ⋙ shift_functor D a ⋙ shift_functor D b   : functor.associator _ _ _
     ... ≅ F ⋙ shift_functor D (a + b)                  :
             iso_whisker_left _ (shift_functor_add D a b).symm
     ... ≅ s (a + b) ⋙ F                                : (i (a + b)).symm),
  associativity := begin
    intros, apply F.map_injective, dsimp,
    simp only [category.comp_id, category.id_comp, category.assoc,
      category_theory.functor.map_comp, functor.image_preimage,
       eq_to_hom_map, iso.inv_hom_id_app_assoc],
    erw (i m₃).hom.naturality_assoc,
    congr' 1,
    dsimp,
    simp only [eq_to_iso.inv, eq_to_hom_app, eq_to_hom_map, obj_μ_app, μ_naturality_assoc,
      category.assoc, category_theory.functor.map_comp, functor.image_preimage],
    congr' 3,
    dsimp,
    simp only [←(shift_functor D m₃).map_comp_assoc, iso.inv_hom_id_app],
    erw [(shift_functor D m₃).map_id, category.id_comp],
    erw [((shift_monoidal_functor D A).μ_iso ⟨m₁ + m₂⟩ ⟨m₃⟩).inv_hom_id_app_assoc],
    congr' 1,
    have := dcongr_arg (λ a, (i a).inv.app X) (add_assoc m₁ m₂ m₃),
    dsimp at this,
    simp [this],
  end,
  left_unitality := begin
    intros, apply F.map_injective, dsimp,
    simp only [category.comp_id, category.id_comp, category.assoc, category_theory.functor.map_comp,
      eq_to_hom_app, eq_to_hom_map, functor.image_preimage],
    erw (i n).hom.naturality_assoc,
    dsimp,
    simp only [eq_to_iso.inv, eq_to_hom_app, category.assoc, category_theory.functor.map_comp,
      eq_to_hom_map, obj_ε_app, functor.image_preimage],
    simp only [←(shift_functor D n).map_comp_assoc, iso.inv_hom_id_app],
    dsimp,
    simp only [category.id_comp, μ_inv_hom_app_assoc, category_theory.functor.map_id],
    have := dcongr_arg (λ a, (i a).inv.app X) (zero_add n),
    dsimp at this,
    simp [this],
  end,
  right_unitality := begin
    intros, apply F.map_injective, dsimp,
    simp only [category.comp_id, category.id_comp, category.assoc,
      iso.inv_hom_id_app_assoc, eq_to_iso.inv, eq_to_hom_app, eq_to_hom_map,
      category_theory.functor.map_comp, functor.image_preimage,
      obj_zero_map_μ_app, ε_hom_inv_app_assoc],
    have := dcongr_arg (λ a, (i a).inv.app X) (add_zero n),
    dsimp at this,
    simp [this],
  end, }

end

/-- When we construct shifts on a subcategory from shifts on the ambient category,
the inclusion functor intertwines the shifts. -/
@[nolint unused_arguments] -- incorrectly reports that `[full F]` and `[faithful F]` are unused.
def has_shift_of_fully_faithful_comm
  (s : A → C ⥤ C) (i : ∀ i, s i ⋙ F ≅ F ⋙ shift_functor D i) (m : A) :
  begin
    haveI := has_shift_of_fully_faithful F s i,
    exact (shift_functor C m) ⋙ F ≅ F ⋙ shift_functor D m
  end :=
i m

end category_theory


import for_mathlib.endomorphisms.basic
import for_mathlib.derived.les_facts
import for_mathlib.additive_functor
import for_mathlib.exact_functor
import for_mathlib.homotopy_category_op
import for_mathlib.has_homology_aux
import for_mathlib.hom_single_iso2
import for_mathlib.nat_trans

noncomputable theory

universes v u

open category_theory category_theory.limits opposite
open bounded_homotopy_category

namespace homological_complex

variables {𝓐 : Type u} [category.{v} 𝓐] [abelian 𝓐]
variables {ι : Type*} {c : complex_shape ι}

def e (X : homological_complex (endomorphisms 𝓐) c) :
  End (((endomorphisms.forget 𝓐).map_homological_complex c).obj X) :=
{ f := λ i, (X.X i).e,
  comm' := λ i j hij, (X.d i j).comm }

def mk_end (X : homological_complex 𝓐 c) (f : X ⟶ X) :
  homological_complex (endomorphisms 𝓐) c :=
{ X := λ i, ⟨X.X i, f.f i⟩,
  d := λ i j, ⟨X.d i j, f.comm i j⟩,
  shape' := by { intros i j h, ext, apply X.shape i j h },
  d_comp_d' := by { intros, ext, apply X.d_comp_d } }

end homological_complex

namespace homotopy_category

variables {𝓐 : Type u} [category.{v} 𝓐] [abelian 𝓐]
variables {𝓑 : Type*} [category 𝓑] [abelian 𝓑]
variables (F : 𝓐 ⥤ 𝓑) [functor.additive F]

instance map_homotopy_category_is_bounded_above
  (X : homotopy_category 𝓐 $ complex_shape.up ℤ) [X.is_bounded_above] :
  ((F.map_homotopy_category _).obj X).is_bounded_above :=
begin
  obtain ⟨b, hb⟩ := is_bounded_above.cond X,
  exact ⟨⟨b, λ i hi, category_theory.functor.map_is_zero _ (hb i hi)⟩⟩,
 end

end homotopy_category

namespace bounded_homotopy_category

variables {𝓐 : Type u} [category.{v} 𝓐] [abelian 𝓐]
variables [has_coproducts_of_shape (ulift.{v} ℕ) 𝓐]
variables [has_products_of_shape (ulift.{v} ℕ) 𝓐]

variables (X : bounded_homotopy_category (endomorphisms 𝓐))

/-- `unEnd` is the "forget the endomorphism" map from the category whose objects are complexes
of pairs `(Aⁱ,eⁱ)` with morphisms defined up to homotopy, to the category whose objects are
complexes of objects `Aⁱ` with morphisms defined up to homotopy.  -/
def unEnd : bounded_homotopy_category 𝓐 :=
of $ ((endomorphisms.forget _).map_homotopy_category _).obj X.val

def e : End X.unEnd := (homotopy_category.quotient _ _).map $ X.val.as.e

end bounded_homotopy_category

namespace category_theory

section
variables {C : Type*} [category C] {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z)

lemma is_iso.comp_right_iff [is_iso g] : is_iso (f ≫ g) ↔ is_iso f :=
begin
  split; introI h,
  { have : is_iso ((f ≫ g) ≫ inv g), { apply_instance },
    simpa only [category.assoc, is_iso.hom_inv_id, category.comp_id] },
  { apply_instance }
end

lemma is_iso.comp_left_iff [is_iso f] : is_iso (f ≫ g) ↔ is_iso g :=
begin
  split; introI h,
  { have : is_iso (inv f ≫ (f ≫ g)), { apply_instance },
    simpa only [category.assoc, is_iso.inv_hom_id_assoc] },
  { apply_instance }
end

end

namespace endomorphisms

variables {𝓐 : Type u} [category.{v} 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
variables [has_coproducts_of_shape (ulift.{v} ℕ) 𝓐]
variables [has_products_of_shape (ulift.{v} ℕ) 𝓐]

def mk_bo_ho_ca' (X : cochain_complex 𝓐 ℤ)
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj X).is_bounded_above] (f : X ⟶ X) :
  bounded_homotopy_category (endomorphisms 𝓐) :=
{ val := { as :=
  { X := λ i, ⟨X.X i, f.f i⟩,
    d := λ i j, ⟨X.d i j, f.comm _ _⟩,
    shape' := λ i j h, by { ext, exact X.shape i j h, },
    d_comp_d' := λ i j k hij hjk, by { ext, apply homological_complex.d_comp_d } } },
  bdd := begin
    obtain ⟨a, ha⟩ := homotopy_category.is_bounded_above.cond ((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj X),
    refine ⟨⟨a, λ i hi, _⟩⟩,
    rw is_zero_iff_id_eq_zero, ext, dsimp, rw ← is_zero_iff_id_eq_zero,
    exact ha i hi,
  end }

def mk_bo_ho_ca (X : bounded_homotopy_category 𝓐) (f : X ⟶ X) :
  bounded_homotopy_category (endomorphisms 𝓐) :=
@mk_bo_ho_ca' _ _ _ _ _ _ X.val.as (by { cases X with X hX, cases X, exact hX }) f.out
.

lemma quot_out_single_map {X Y : 𝓐} (f : X ⟶ Y) (i : ℤ) :
  ((homotopy_category.single 𝓐 i).map f).out = (homological_complex.single 𝓐 _ i).map f :=
begin
  have h := homotopy_category.homotopy_out_map
    ((homological_complex.single 𝓐 (complex_shape.up ℤ) i).map f),
  ext k,
  erw h.comm k,
  suffices : (d_next k) h.hom + (prev_d k) h.hom = 0, { rw [this, zero_add] },
  obtain (hki|rfl) := ne_or_eq k i,
  { apply limits.is_zero.eq_of_src,
    show is_zero (ite (k = i) X _), rw [if_neg hki], apply is_zero_zero },
  { have hk1 : (complex_shape.up ℤ).rel (k-1) k := sub_add_cancel _ _,
    have hk2 : (complex_shape.up ℤ).rel k (k+1) := rfl,
    rw [prev_d_eq _ hk1, d_next_eq _ hk2],
    have aux1 : h.hom (k + 1) k = 0,
    { apply limits.is_zero.eq_of_src, show is_zero (ite _ X _), rw if_neg, apply is_zero_zero,
      linarith },
    have aux2 : h.hom k (k - 1) = 0,
    { apply limits.is_zero.eq_of_tgt, show is_zero (ite _ Y _), rw if_neg, apply is_zero_zero,
      linarith },
    rw [aux1, aux2, comp_zero, zero_comp, add_zero], }
end

def mk_bo_ha_ca'_single (X : 𝓐) (f : X ⟶ X) :
  mk_bo_ho_ca' ((homological_complex.single _ _ 0).obj X) (functor.map _ f) ≅ (single _ 0).obj ⟨X, f⟩ :=
bounded_homotopy_category.mk_iso
begin
  refine (homotopy_category.quotient _ _).map_iso _,
  refine homological_complex.hom.iso_of_components _ _,
  { intro i,
    refine endomorphisms.mk_iso _ _,
    { dsimp, split_ifs, { exact iso.refl _ },
      { refine (is_zero_zero _).iso _, apply endomorphisms.is_zero_X,
        exact is_zero_zero (endomorphisms 𝓐), } },
    { dsimp, split_ifs with hi,
      { subst i, dsimp, erw [iso.refl_hom], simp only [category.id_comp, category.comp_id],
        convert rfl, },
      { apply is_zero.eq_of_src, rw [if_neg hi], exact is_zero_zero _ } } },
  { rintro i j (rfl : _ = _),
    by_cases hi : i = 0,
    { apply is_zero.eq_of_tgt, dsimp, rw [if_neg], exact is_zero_zero _, linarith only [hi] },
    { apply is_zero.eq_of_src, dsimp, rw [is_zero_iff_id_eq_zero], ext, dsimp, rw [if_neg hi],
      apply (is_zero_zero _).eq_of_src } }
end

def mk_bo_ha_ca_single (X : 𝓐) (f : X ⟶ X) :
  mk_bo_ho_ca ((single _ 0).obj X) ((single _ 0).map f) ≅ (single _ 0).obj ⟨X, f⟩ :=
bounded_homotopy_category.mk_iso
begin
  dsimp only [mk_bo_ho_ca, single],
  refine (homotopy_category.quotient _ _).map_iso _,
  refine homological_complex.hom.iso_of_components _ _,
  { intro i,
    refine endomorphisms.mk_iso _ _,
    { dsimp, split_ifs, { exact iso.refl _ },
      { refine (is_zero_zero _).iso _, apply endomorphisms.is_zero_X,
        exact is_zero_zero (endomorphisms 𝓐), } },
    { dsimp, erw quot_out_single_map, dsimp, split_ifs with hi,
      { subst i, dsimp, erw [iso.refl_hom], simp only [category.id_comp, category.comp_id],
        convert rfl, },
      { apply is_zero.eq_of_src, rw [if_neg hi], exact is_zero_zero _ } } },
  { rintro i j (rfl : _ = _),
    by_cases hi : i = 0,
    { apply is_zero.eq_of_tgt, dsimp, rw [if_neg], exact is_zero_zero _, linarith only [hi] },
    { apply is_zero.eq_of_src, dsimp, rw [is_zero_iff_id_eq_zero], ext, dsimp, rw [if_neg hi],
      apply (is_zero_zero _).eq_of_src } }
end
.

instance {P Q : bounded_homotopy_category (endomorphisms 𝓐)} (f : P ⟶ Q)
  [homotopy_category.is_quasi_iso f] :
homotopy_category.is_quasi_iso (((endomorphisms.forget _).map_bounded_homotopy_category).map f) :=
(endomorphisms.forget 𝓐).map_quasi_iso_on_homotopy_category f

instance forget_preserves_is_quasi_iso {P Q : bounded_homotopy_category 𝓐} (f : P ⟶ Q)
  [hf : homotopy_category.is_quasi_iso f] :
  homotopy_category.is_quasi_iso ((bounded_homotopy_category.forget 𝓐).map f) := hf

instance forget_of_termwise_projective_is_termwise_projective
  {P : bounded_homotopy_category (endomorphisms 𝓐)} (k : ℤ)
   [hP : projective (P.val.as.X k)] :
  projective (((endomorphisms.forget 𝓐).map_bounded_homotopy_category.obj P).val.as.X k) :=
by { dsimp [of], apply_instance, }

def forget_mk_end (X : chain_complex 𝓐 ℕ) (f : X ⟶ X) :
  (endomorphisms.forget 𝓐).map_bounded_homotopy_category.obj
    (chain_complex.to_bounded_homotopy_category.obj (homological_complex.mk_end X f)) ≅
  chain_complex.to_bounded_homotopy_category.obj X :=
bounded_homotopy_category.mk_iso $ (homotopy_category.quotient _ _).map_iso $
homological_complex.hom.iso_of_components
(λ m,
match m with
| int.of_nat 0 := iso.refl _
| int.of_nat (i+1) := is_zero.iso (functor.map_is_zero _ $ is_zero_zero _) (is_zero_zero _)
| -[1+i] := iso.refl _
end)
begin
  rintros (i|(_|i)) j (rfl : _ = _),
  { apply (is_zero_zero _).eq_of_tgt, },
  { erw [iso.refl_hom, iso.refl_hom, category.id_comp, category.comp_id], refl },
  { erw [iso.refl_hom, iso.refl_hom, category.id_comp, category.comp_id], refl },
end

/-

Mathematical summary of the `Ext_is_zero_iff` proof according to kmb's
possibly flawed understanding:

The lemma will follow from the following things:

1) If X is a complex in the bounded homotopy category
and Y is an object, thought of as a `single`
complex, then Extⁱ(X,Y) is the homology of the complex
(Cᵢ) whose i'th term is Hom(Pⁱ,Y), where P is a projective
replacement of X. This applies to both the category 𝓐
and to the endomorphism category. The reason is
that Extⁱ(X,Y)=Hom(P,Y⟦i⟧).

2) For a cleverly chosen choice of Pⁱ (see `exists_K_projective_endomorphism_replacement`)
we have a short exact sequence of complexes
0 -> Hom_{endos}(Pⁱ,Y) -> Hom(Pⁱ,Y) -> Hom(Pⁱ,Y)->0
where the surjection is e(P) - e(Y), with e the endomorphism.
This can be checked to be surjective via an explicit construction;
the trick is that Pⁱ is going to be `free Q` for some object `Q : 𝓐`

-/

variables (Y : 𝓐) (g : Y ⟶ Y) (P : bounded_homotopy_category (endomorphisms 𝓐))

def C₁ (Y : endomorphisms 𝓐) (P : bounded_homotopy_category (endomorphisms 𝓐)) :=
((preadditive_yoneda.obj Y).map_homological_complex _).obj P.val.as.op

def C₂  (Y : 𝓐) (P : bounded_homotopy_category (endomorphisms 𝓐)) :=
((preadditive_yoneda.obj Y).map_homological_complex _).obj P.unEnd.val.as.op

def map₁ : C₁ ⟨Y,g⟩ P ⟶ C₂ Y P :=
{ f := λ i,
  { to_fun := endomorphisms.hom.f,
    map_zero' := rfl,
    map_add' := λ _ _, rfl },
  comm' := λ i j h, rfl }

open category_theory.preadditive

@[simps]
def map₂_left : C₂ Y P ⟶ C₂ Y P :=
((preadditive_yoneda.obj Y).map_homological_complex _).map
  (homological_complex.op_functor.map (quiver.hom.op P.val.as.e))

@[simps]
def map₂_right : C₂ Y P ⟶ C₂ Y P :=
(nat_trans.map_homological_complex (preadditive_yoneda.map g) _).app P.unEnd.val.as.op

def map₂ : C₂ Y P ⟶ C₂ Y P :=
map₂_left Y P - map₂_right Y g P

lemma map₁_mono (n : ℤ) : mono ((map₁ Y g P).f n) :=
begin
  rw [AddCommGroup.mono_iff_injective, injective_iff_map_eq_zero],
  intros φ hφ, ext, exact hφ
end

lemma map₂_epi {n : ℤ} (h : projective (P.val.as.X n)) : epi ((map₂ Y g P).f n) :=
begin
  -- this is Joel Riou's argument, reduce to `free` and do an explicit calculation
  let F : (endomorphisms 𝓐)ᵒᵖ ⥤ AddCommGroup :=
    (endomorphisms.forget 𝓐).op ⋙ (preadditive_yoneda.obj Y),
  let τ : F ⟶ F :=
  { app := λ Q, add_monoid_hom.mk' (λ ψ, Q.unop.e ≫ ψ - ψ ≫ g)
    begin
      intros a b,
      simp only [comp_add, add_comp, sub_eq_add_neg, neg_add, add_assoc],
      congr' 1, apply add_left_comm,
    end,
    naturality' := λ Q₁ Q₂ f, begin
      ext,
      simp only [functor.comp_map, functor.op_map, forget_map, comp_apply,
        add_monoid_hom.mk'_apply, map_sub],
      congr' 1,
      { dsimp, apply f.unop.comm_assoc, },
      { dsimp, rw category.assoc, },
    end, },
  suffices : ∀ (Q : endomorphisms 𝓐) (hQ : projective Q), epi (τ.app (op Q)),
  { exact this _ h, },
  suffices : ∀ (A : 𝓐) (hA : projective A), epi (τ.app (op (free A))),
  { intro Q,
    introI,
    haveI := this Q.X (infer_instance),
    let π := free.desc (𝟙 (Q.X)),
    haveI : epi π.f := begin
      refine @epi_of_epi _ _ _ _ _ (sigma.ι _ (ulift.up 0)) _ (id _),
      simp only [free.desc_f, category.id_comp, colimit.ι_desc, cofan.mk_ι_app, pow_zero,
        End.one_def],
      apply_instance,
    end,
    haveI : epi π := epi_of_epi_f _,
    let s := projective.factor_thru (𝟙 Q) π,
    have hs : s ≫ π = 𝟙 Q := projective.factor_thru_comp _ _,
    constructor,
    intros Z q₁ q₂ hq₀,
    have hq₁ := congr_arg (λ (q : _ ⟶ _), (F.map s.op) ≫ q) hq₀,
    simp only at hq₁,
    rw [τ.naturality_assoc, τ.naturality_assoc, cancel_epi (τ.app (op (free Q.X)))] at hq₁,
    simpa only [← F.map_comp_assoc, ← op_comp, hs, op_id, F.map_id, category.id_comp]
      using congr_arg (λ (q : _ ⟶ _), (F.map π.op) ≫ q) hq₁, },
  introsI A hA,
  rw AddCommGroup.epi_iff_surjective,
  intros φ,
  let ψ : (free A).X ⟶ Y,
  { refine sigma.desc _, rintro ⟨i⟩, refine nat.rec_on i 0 (λ j ψ, _),
    refine ((sigma.ι (λ (i : ulift ℕ), A) (ulift.up j)) ≫ φ) + (ψ ≫ g) },
  refine ⟨ψ, _⟩,
  ext ⟨⟨i⟩⟩,
  dsimp only [τ, add_monoid_hom.mk'_apply, free, unop_op, op_unop, ψ],
  rw [comp_sub, sub_eq_iff_eq_add],
  simp only [colimit.ι_desc_assoc, colimit.ι_desc, limits.cofan.mk_ι_app],
  refl,
end

lemma map₁₂_exact {n : ℤ} (h : projective (P.val.as.X n)) :
  exact ((map₁ Y g P).f n) ((map₂ Y g P).f n) :=
begin
  rw AddCommGroup.exact_iff', split,
  { rw [map₂, homological_complex.sub_f_apply, comp_sub],
    ext φ,
    simp only [map₁, map₂_left_f_apply, map₂_right_f_apply, add_monoid_hom.sub_apply, comp_apply,
      AddCommGroup.zero_apply],
    erw [endomorphisms.hom.comm], apply sub_self },
  intros φ hφ,
  refine ⟨⟨φ, _⟩, _⟩,
  { simpa only [add_monoid_hom.mem_ker, map₂, map₂_left_f_apply, map₂_right_f_apply,
      homological_complex.sub_f_apply, add_monoid_hom.sub_apply, sub_eq_zero] using hφ, },
  { refl },
end

lemma map₁₂_short_exact {n : ℤ} (h : projective (P.val.as.X n)) :
  short_exact ((map₁ Y g P).f n) ((map₂ Y g P).f n) :=
{ mono := map₁_mono _ _ _ _,
  epi := map₂_epi _ _ _ h,
  exact := map₁₂_exact _ _ _ h }

lemma homology_is_zero_iff_is_iso (h : ∀ n, projective (P.val.as.X n)) :
  (∀ i, is_zero ((homology_functor _ _ i).obj (C₁ ⟨Y, g⟩ P))) ↔
  (∀ j, is_iso ((homology_functor _ _ j).map (map₂ Y g P))) :=
begin
  have LES := homological_complex.six_term_exact_seq (map₁ Y g P) (map₂ Y g P)
    (λ n, map₁₂_short_exact _ _ _ (h n)),
  split,
  { intros H i,
    obtain ⟨i, rfl⟩ : ∃ j, j + 1 = i := ⟨i-1, sub_add_cancel _ _⟩,
    apply ((LES (i+1) i rfl)).is_iso_of_zero_of_zero,
    { refine (H (i+1)).eq_of_src _ _, },
    { refine (H i).eq_of_tgt _ _, }, },
  { intros H i,
    refine is_zero_of_exact_zero_zero' _ _ ((LES (i+1) i rfl).drop 2).pair _ _,
    { refine ((LES (i+1) i rfl).drop 1).pair.epi_iff_eq_zero.mp _,
      exact @is_iso.epi_of_iso _ _ _ _ _ (H _), },
    { refine ((LES (i+1) i rfl).drop 3).pair.mono_iff_eq_zero.mp _,
      exact @is_iso.mono_of_iso _ _ _ _ _ (H _), } }
end

@[reassoc]
lemma flip_obj_map_comm {C D E : Type*} [category C] [category D] [category E]
  (F : C ⥤ D ⥤ E) {c : C} {d : D} (f : c ⟶ c) (g : d ⟶ d) :
  (F.flip.obj d).map f ≫ (F.obj c).map g = (F.obj c).map g ≫ (F.flip.obj d).map f :=
(nat_trans.naturality _ _).symm

@[reassoc]
lemma flip_map_app_comm {C D E : Type*} [category C] [category D] [category E]
  (F : C ⥤ D ⥤ E) {c : C} {d : D} (f : c ⟶ c) (g : d ⟶ d) :
  (F.flip.map g).app c ≫ (F.map f).app d = (F.map f).app d ≫ (F.flip.map g).app c  :=
(nat_trans.naturality _ _).symm

lemma lift_unop_op {X Y : bounded_homotopy_category 𝓐}
  [homotopy_category.is_K_projective X.val] (g : X ⟶ Y) (f : Y ⟶ Y) :
  bounded_homotopy_category.lift g Y.π ≫
    bounded_homotopy_category.lift ((unop (op Y)).π ≫ f.op.unop) (unop (op Y)).π =
  lift (g ≫ f) Y.π ≫ eq_to_hom (by refl) :=
begin
  erw lift_comp_lift_comp,
  symmetry,
  apply category.comp_id,
end

lemma compatibility₁_aux {Y : 𝓐} {P₁ P₂ : bounded_homotopy_category 𝓐} (f : P₁ ⟶ P₂) :
  (homotopy_category.quotient AddCommGroup (complex_shape.up ℤ).symm).map
    (homological_complex.unop_functor.map
      (((preadditive_yoneda.obj Y).right_op.map_homological_complex (complex_shape.up ℤ)).map (quot.out f)).op) =
  (homotopy_category.quotient AddCommGroup (complex_shape.up ℤ).symm).map (
      -- show ((preadditive_yoneda.obj Y).map_homological_complex _).obj P₂.val.as.op ⟶
      --     ((preadditive_yoneda.obj Y).map_homological_complex _).obj P₁.val.as.op, from
    ((preadditive_yoneda.obj Y).map_homological_complex (complex_shape.up ℤ).symm).map $
      -- show homological_complex.op_functor.obj (op P₂.val.as) ⟶
      --      homological_complex.op_functor.obj (op P₁.val.as), from
           homological_complex.op_functor.map (f.out.op)) :=
rfl

lemma compatibility₁ {Y : 𝓐} {P₁ P₂ P₃ : bounded_homotopy_category 𝓐} (g : P₁ ⟶ P₃) (f : P₂ ⟶ P₃)
  (h : P₁.val.as ⟶ P₂.val.as)
  (H : (homotopy_category.quotient _ _).map h ≫ f = g)
  (i : ℤ) :
  (preadditive_yoneda.obj ((single 𝓐 i).obj Y)).map f.op ≫ (P₂.hom_single_iso Y i).hom ≫
    (homology_functor AddCommGroup _ i).map
      (((preadditive_yoneda.obj Y).map_homological_complex _).map
        (homological_complex.op_functor.map (quiver.hom.op h)))
      = (preadditive_yoneda.obj ((single 𝓐 i).obj Y)).map g.op ≫
        (P₁.hom_single_iso Y i).hom :=
begin
  rw hom_single_iso_naturality,
  slice_lhs 1 2 { rw hom_single_iso_naturality, },
  simp only [category.assoc],
  congr' 1,
  dsimp only [functor.comp_map, functor.op],
  simp only [quiver.hom.unop_op, ← functor.map_comp,
    homotopy_category.homology_functor_map_factors],
  congr' 1,
  simp only [functor.right_op_map, quiver.hom.unop_op, functor.map_comp, compatibility₁_aux],
  simp only [← functor.map_comp],
  apply homotopy_category.eq_of_homotopy,
  apply functor.map_homotopy,
  rw [← op_comp],
  apply homological_complex.op_functor_map_homotopy,
  apply homotopy_category.homotopy_of_eq,
  simp only [functor.map_comp, homotopy_category.quotient_map_out],
  exact H,
end

instance preadditive_yoneda_flip_additive :
  (preadditive_yoneda : 𝓐 ⥤ _).flip.additive := { }

variable (𝓐)

@[simps]
def congr_single_functor {p q : ℤ} (h : p = q) :
  single 𝓐 p ≅ single 𝓐 q := eq_to_iso (by subst h)

variable {𝓐}

@[reassoc]
lemma preadditive_yoneda_bifunctor_comm {C : Type*} [category C] [preadditive C]
  {X₁ X₂ : C} {Y₁ Y₂ : Cᵒᵖ} (f : X₁ ⟶ X₂) (g : Y₁ ⟶ Y₂) :
  (preadditive_yoneda.obj X₁).map g ≫ (preadditive_yoneda.map f).app Y₂ =
  ((preadditive_yoneda.map f).app Y₁) ≫ (preadditive_yoneda.obj X₂).map g:=
nat_trans.naturality _ _

lemma compatibility₂ {Y₁ Y₂ : 𝓐} (g : Y₁ ⟶ Y₂) {P₁ P₂ : bounded_homotopy_category 𝓐} (π : P₁ ⟶ P₂)
  (i : ℤ) :
  (preadditive_yoneda.map (((shift_single_iso 0 (-i)).app Y₁).hom ≫
    eq_to_hom (show (single 𝓐 (0 - -i)).obj Y₁ = (single 𝓐 i).obj Y₁,
    by { congr, linarith, }))).app (op P₂) ≫
    (preadditive_yoneda.obj ((single 𝓐 i).obj Y₁)).map π.op ≫
    (hom_single_iso P₁ Y₁ i).hom ≫
    (homology_functor _ _ i).map ((nat_trans.map_homological_complex
      (preadditive_yoneda.map g) _).app P₁.val.as.op) =
  (preadditive_yoneda.map ((shift_functor (bounded_homotopy_category 𝓐) (-i)).map ((single 𝓐 0).map g))).app (op P₂) ≫
    (preadditive_yoneda.map (((shift_single_iso 0 (-i)).app Y₂).hom ≫
    eq_to_hom (show (single 𝓐 (0 - -i)).obj Y₂ = (single 𝓐 i).obj Y₂,
    by { congr, linarith, }))).app (op P₂) ≫
    (preadditive_yoneda.obj ((single 𝓐 i).obj Y₂)).map π.op ≫
    (hom_single_iso P₁ Y₂ i).hom :=
begin
  let τiso := shift_single_iso 0 (-i) ≪≫ congr_single_functor 𝓐 (show 0 - -i = i, by linarith),
  let τ := (shift_single_iso 0 (-i) ≪≫ congr_single_functor 𝓐 (show 0 - -i = i, by linarith)).hom,
  have eq₁ : Π Y, eq_to_hom (show (single 𝓐 (0 - -i)).obj Y = (single 𝓐 i).obj Y,
    by { congr, linarith, }) = ((congr_single_functor _ (by linarith)).app Y).hom :=
    λ Y, by simp only [iso.app_hom, congr_single_functor_hom, eq_to_hom_app],
  have eq₂ : shift_single_iso 0 (-i) ≪≫
    congr_single_functor 𝓐 (show 0 - -i = i, by linarith) = τiso := rfl,
  have eq₃ : Π Y, (τiso.app Y).hom = τ.app Y := λ Y, rfl,
  simp only [eq₁, ← iso.trans_hom, ← nat_iso.trans_app, eq₂, eq₃],
  have eq₄ := preadditive_yoneda.congr_map (τ.naturality g),
  simp only [functor.map_comp] at eq₄,
  have eq₅ := nat_trans.congr_app eq₄ (op P₂),
  simp only [nat_trans.comp_app] at eq₅,
  slice_rhs 1 2 { erw eq₅, },
  simp only [category.assoc],
  congr' 1,
  rw ← preadditive_yoneda_bifunctor_comm_assoc,
  congr' 1,
  apply concrete_category.hom_ext,
  intro x,
  apply hom_single_iso_naturality_snd_var,
end

--attribute [reassoc] nat_trans.comp_app

lemma Ext_is_zero_iff (X : chain_complex 𝓐 ℕ) (Y : 𝓐)
  (f : X ⟶ X) (g : Y ⟶ Y) :
  (∀ i, is_zero (((Ext i).obj (op $ chain_complex.to_bounded_homotopy_category.obj
    (X.mk_end f))).obj $ (single _ 0).obj ⟨Y, g⟩)) ↔
  (∀ i, is_iso $ ((Ext i).map (chain_complex.to_bounded_homotopy_category.map f).op).app _ -
                 ((Ext i).obj (op _)).map ((single _ 0).map g)) :=
begin
  obtain ⟨P, _inst, fP, h1, h2⟩ := exists_K_projective_replacement
    (chain_complex.to_bounded_homotopy_category.obj (X.mk_end f)),
  let fP' := (bounded_homotopy_category.forget _).map
    (((endomorphisms.forget _).map_bounded_homotopy_category).map fP ≫ (forget_mk_end X f).hom),
  /- use that fP commutes with the given endomorphisms... -/
  have fP'_eq : fP' ≫ chain_complex.to_bounded_homotopy_category.map f =
    (homotopy_category.quotient _ _).map P.val.as.e ≫ fP',
  { dsimp only [chain_complex.to_bounded_homotopy_category_map, functor.comp_map],
    erw [← (homotopy_category.quotient _ _).map_comp],
    erw [← (homotopy_category.quotient _ _).map_comp],
    congr' 1,
    ext ((_|i)|i),
    { dsimp only [forget_mk_end, homological_complex.comp_f, endomorphisms.forget,
        functor.map_homological_complex_map_f, homological_complex.hom.iso_of_components_hom_f],
      erw [iso.refl_hom, category.comp_id],
      erw ((quot.out fP).f 0).comm, refl },
    { apply limits.is_zero.eq_of_tgt, exact is_zero_zero _ },
    { dsimp only [forget_mk_end, homological_complex.comp_f, endomorphisms.forget,
        functor.map_homological_complex_map_f, homological_complex.hom.iso_of_components_hom_f],
      erw [iso.refl_hom, category.comp_id],
      erw ((quot.out fP).f _).comm, refl }, },
  resetI,
  have foo : ∀ (h : ℤ → Prop), (∀ i, h i) ↔ (∀ i, h (-i)),
  { intro h, split,
    { intros h1 i, apply h1 (-i) },
    { intros h1 i, specialize h1 (-i), rwa neg_neg at h1, } },
  convert homology_is_zero_iff_is_iso Y g P h2,
  { apply propext,
    rw foo,
    apply forall_congr,
    intro i,
    let := Ext_iso (-i) P
      (chain_complex.to_bounded_homotopy_category.obj (homological_complex.mk_end X f))
      ((single (endomorphisms 𝓐) 0).obj {X := Y, e := g}) fP,
    rw iso.is_zero_iff this, clear this,
    delta C₁,
    apply iso.is_zero_iff,
    let := hom_single_iso P ⟨Y, g⟩ i,
    refine iso.trans _ this, clear this,
    let := (shift_single_iso 0 (-i) : single (endomorphisms 𝓐) 0 ⋙ _ ≅ _),
    change (preadditive_yoneda.flip.obj (op P)).obj _ ≅
      (preadditive_yoneda.flip.obj (op P)).obj _,
    apply (preadditive_yoneda.flip.obj (op P)).map_iso,
    convert iso.app this ⟨Y, g⟩, -- I ♥ you Lean, this just worked first time
    ring, },
  { apply propext,
    rw foo,
    apply forall_congr,
    intro i,
    let j : (((Ext (-i)).obj (op (chain_complex.to_bounded_homotopy_category.obj X))).obj ((single 𝓐 0).obj Y))
    ≅ ((homology_functor AddCommGroup (complex_shape.up ℤ).symm i).obj (C₂ Y P)),
    { -- need that post-composing with an iso sends quasi-isos to quasi-isos! More precisely:
      -- Above I sorried that if fP is a quasi-iso then so is
      -- ((endomorphisms.forget _).map_bounded_homotopy_category).map fP,
      -- however unfortunately we now need to post-compose with something
      -- which is close to, but not equal to, 𝟙.
      -- This should hopefully be straightforward
      haveI : homotopy_category.is_quasi_iso fP',
      { dsimp only [fP'], rw functor.map_comp, apply_instance, },
      refine iso.trans (Ext_iso (-i) _ _ ((single 𝓐 0).obj Y) fP') _,
--      delta C₂,
      refine iso.trans _ (hom_single_iso ((endomorphisms.forget 𝓐).map_bounded_homotopy_category.obj P) Y i),
      let := (shift_single_iso 0 (-i) : single 𝓐 0 ⋙ _ ≅ _),
      refine (preadditive_yoneda.flip.obj (op ((endomorphisms.forget 𝓐).map_bounded_homotopy_category.obj P))).map_iso _,
      let e := this.app Y,
      refine e ≪≫ eq_to_iso _,
      ring_nf, },
    -- Goal is `is_iso f : A ⟶ A` iff `is_iso f' : A' ⟶ A'` and we have an
    -- iso `j : A ⟶ A'` so it suffices to prove that the square
    -- (with `j` on two sides) commutes.
    suffices : j.hom ≫ ((homology_functor AddCommGroup (complex_shape.up ℤ).symm i).map (map₂ Y g P))
      = (((Ext (-i)).map (chain_complex.to_bounded_homotopy_category.map f).op).app ((single 𝓐 0).obj Y) -
      ((Ext (-i)).obj (op (chain_complex.to_bounded_homotopy_category.obj X))).map ((single 𝓐 0).map g)) ≫ j.hom,
    { rw [← is_iso_iff_is_iso_comp_left j.hom, this, is_iso_iff_is_iso_comp_right], },
    delta map₂,
    rw [functor.map_sub, comp_sub, sub_comp],
    refine congr_arg2 _ _ _,
    { dsimp only [j, iso.trans_hom, Ext_iso, Ext, Ext0, functor.map_iso_hom, functor.comp_map,
        whiskering_left_obj_map, whisker_left_app, functor.flip_obj_map, functor.flip_map_app,
        iso.op_hom], clear j,
      simp only [nat_trans.naturality, nat_trans.naturality_assoc],
      erw [nat_trans.naturality_assoc, ← functor.map_comp_assoc],
      simp only [← op_comp, category.assoc],
      congr' 1,
      dsimp only [bounded_homotopy_category.replacement_iso],
      rw lift_unop_op,
      apply compatibility₁,
      simp only [eq_to_hom_refl, category.comp_id],
      erw fP'_eq,
      apply lift_unique,
      erw category.assoc,
      erw bounded_homotopy_category.lift_lifts, },
    { dsimp only [j, iso.trans_hom, Ext_iso, Ext, Ext0, functor.map_iso_hom, functor.comp_map,
        whiskering_left_obj_map, whisker_left_app, functor.flip_obj_map, functor.flip_map_app,
        iso.op_hom, functor.comp_obj, whiskering_left_obj_obj, unop_op, op_unop], clear j,
      simp only [nat_trans.naturality, nat_trans.naturality_assoc,
        category.assoc, map₂_right],
      apply compatibility₂, } }
end

open_locale zero_object

def single_unEnd (X : endomorphisms 𝓐) : ((single _ 0).obj X).unEnd ≅ (single _ 0).obj X.X :=
{ hom := quot.mk _
  { f := λ i, show (ite (i = 0) X 0).X ⟶ ite (i = 0) X.X 0,
    from if hi : i = 0 then eq_to_hom (by { simp only [if_pos hi] })
      else 0,
    comm' := begin
      rintros i j _,
      change _ ≫ 0 = 0 ≫ _, simp, end },
  inv := quot.mk _ {
    f := λ i, show ite (i = 0) X.X 0 ⟶ (ite (i = 0) X 0).X,
    from if hi : i = 0 then eq_to_hom (by { simp only [if_pos hi] })
      else 0,
    comm' := begin
      rintros i j (rfl : _ = _),
      change _ ≫ 0 = 0 ≫ _, simp, end },
  hom_inv_id' := begin
    change quot.mk _ (_ ≫ _) = quot.mk _ _,
    apply congr_arg,
    ext i,
    simp only [homological_complex.comp_f, homological_complex.id_f],
    split_ifs,
    { simp },
    { rw [comp_zero, eq_comm, ← limits.is_zero.iff_id_eq_zero],
      change is_zero (ite (i = 0) X 0).X,
      rw if_neg h,
      apply is_zero_X,
      apply is_zero_zero,
    },
  end,
  inv_hom_id' := begin
    change quot.mk _ (_ ≫ _) = quot.mk _ _,
    apply congr_arg,
    ext i,
    simp only [homological_complex.comp_f, homological_complex.id_f],
    split_ifs,
    { simp },
    { rw [comp_zero, eq_comm, ← limits.is_zero.iff_id_eq_zero],
      change is_zero (ite (i = 0) X.X 0),
      rw if_neg h,
      apply is_zero_zero, },
  end }

lemma single_unEnd_e (X : endomorphisms 𝓐) :
  (single_unEnd X).hom ≫ (single _ 0).map X.e = ((single _ 0).obj X).e ≫ (single_unEnd X).hom :=
begin
  change quot.mk _ (_ ≫ _) = quot.mk _ _,
  apply congr_arg,
  ext i,
  change dite _ _ _ ≫ dite _ _ _ = _ ≫ dite _ _ _,
  split_ifs,
  { subst h,
    rw [eq_to_hom_trans_assoc, ← category.assoc],
    congr',
    simp,
    refl, },
  { simp, },
end

lemma single_e (X : endomorphisms 𝓐) :
  (single_unEnd X).hom ≫ (single _ 0).map X.e ≫ (single_unEnd X).inv = ((single _ 0).obj X).e :=
by rw [← category.assoc, iso.comp_inv_eq, single_unEnd_e]

open category_theory.preadditive

def embed_single (X : 𝓐) :
  (homological_complex.embed complex_shape.embedding.nat_down_int_up).obj
    ((homological_complex.single 𝓐 (complex_shape.down ℕ) 0).obj X) ≅
  (homological_complex.single 𝓐 (complex_shape.up ℤ) 0).obj X :=
homological_complex.hom.iso_of_components (by rintro ((_|i)|i); exact iso.refl _)
begin
  rintro (i|i) j (rfl : _ = _),
  { apply is_zero.eq_of_tgt, exact is_zero_zero _ },
  { apply is_zero.eq_of_src, exact is_zero_zero _ },
end

def to_bounded_homotopy_category_single (X : 𝓐) :
  chain_complex.to_bounded_homotopy_category.obj ((homological_complex.single _ _ 0).obj X) ≅
  (single _ 0).obj X :=
bounded_homotopy_category.mk_iso $ (homotopy_category.quotient _ _).map_iso $
embed_single X

lemma to_bounded_homotopy_category_single_naturality (X : 𝓐) (f : X ⟶ X) :
  (to_bounded_homotopy_category_single X).op.hom ≫
  (chain_complex.to_bounded_homotopy_category.map
       ((homological_complex.single 𝓐 (complex_shape.down ℕ) 0).map f)).op ≫
    (to_bounded_homotopy_category_single X).op.inv = ((single _ 0).map f).op :=
begin
  dsimp only [iso.op], simp only [← op_comp], congr' 1,
  dsimp only [to_bounded_homotopy_category_single, chain_complex.to_bounded_homotopy_category,
    bounded_homotopy_category.mk_iso, functor.comp_map, functor.map_iso, single,
    homotopy_category.single],
  erw [← functor.map_comp, ← functor.map_comp], congr' 1,
  ext ((_|i)|i),
  { simp only [category.assoc, homological_complex.comp_f, homological_complex.single_map_f,
      int.of_nat_eq_coe, zmod.nat_cast_self, eq_self_iff_true, eq_to_hom_refl, category.comp_id,
      category.id_comp, dite_eq_ite, if_true],
    dsimp only [embed_single,
      homological_complex.hom.iso_of_components_hom_f, iso.refl_hom,
      homological_complex.hom.iso_of_components_inv_f, iso.refl_inv],
    erw [category.comp_id, category.id_comp, homological_complex.embed_nat_obj_down_up_zero_f],
    dsimp only [homological_complex.single_map_f],
    simp only [eq_self_iff_true, eq_to_hom_refl, category.comp_id, category.id_comp, dite_eq_ite, if_true], },
  { apply is_zero.eq_of_src, apply is_zero_zero },
  { apply is_zero.eq_of_src, apply is_zero_zero },
end

def to_bounded_homotopy_category_mk_end_single (X : 𝓐) (f : X ⟶ X) :
  chain_complex.to_bounded_homotopy_category.obj
    (((homological_complex.single 𝓐 _ 0).obj X).mk_end
       ((homological_complex.single 𝓐 _ 0).map f)) ≅
  (single (endomorphisms 𝓐) 0).obj (⟨X,f⟩) :=
begin
  refine _ ≪≫ to_bounded_homotopy_category_single _,
  apply functor.map_iso,
  refine homological_complex.hom.iso_of_components _ _,
  { rintro (_|i); refine endomorphisms.mk_iso _ _,
    { exact iso.refl _ },
    { dsimp [homological_complex.mk_end],
      simp only [category.id_comp, category.comp_id, if_pos rfl], refl, },
    { apply (is_zero_zero _).iso, apply is_zero_X, apply is_zero_zero },
    { apply (is_zero_zero _).eq_of_src }, },
  { rintro _ i (rfl : _ = _), apply is_zero.eq_of_src, rw is_zero_iff_id_eq_zero, ext, }
end
.

lemma Ext'_is_zero_iff (X Y : 𝓐) (f : X ⟶ X) (g : Y ⟶ Y) :
  (∀ i, is_zero (((Ext' i).obj (op $ endomorphisms.mk X f)).obj $ endomorphisms.mk Y g)) ↔
  (∀ i, is_iso $ ((Ext' i).map f.op).app _ - ((Ext' i).obj _).map g) :=
begin
  convert (Ext_is_zero_iff ((homological_complex.single _ _ 0).obj X) Y (functor.map _ f) g)
    using 1,
  { apply propext, apply forall_congr, intro i,
    apply iso.is_zero_iff, dsimp only [Ext', functor.comp_obj, functor.flip_obj_obj],
    apply iso.app, apply functor.map_iso, dsimp only [functor.op_obj], apply iso.op,
    apply to_bounded_homotopy_category_mk_end_single },
  { apply propext, apply forall_congr, intro i,
    let e := ((Ext i).map_iso (to_bounded_homotopy_category_single X).op).app ((single _ 0).obj Y),
    rw [← is_iso.comp_left_iff e.hom, ← is_iso.comp_right_iff _ e.inv],
    simp only [comp_sub, sub_comp, iso.app_hom, iso.app_inv, category.assoc,
      functor.map_iso_hom, functor.map_iso_inv, ← nat_trans.comp_app, ← functor.map_comp,
      to_bounded_homotopy_category_single_naturality],
    clear e,
    dsimp only [Ext', functor.comp_obj, functor.comp_map],
    congr' 3,
    rw [nat_trans.naturality, ← nat_trans.comp_app_assoc, ← functor.map_comp, iso.hom_inv_id,
      functor.map_id, nat_trans.id_app, category.id_comp],
    refl },
end

end endomorphisms

end category_theory


import combinatorics.simple_graph.connectivity data.finset.basic

variables {V : Type*} {G : simple_graph V}

namespace finset
@[simp] lemma singleton_inter_nonempty [decidable_eq V] {a : V} {X : finset V} :
  ({a} ∩ X).nonempty ↔ a ∈ X :=
{ mp := not_not.mp ∘ mt singleton_inter_of_not_mem ∘ nonempty_iff_ne_empty.mp,
  mpr := eq.rec (singleton_nonempty a) ∘ eq.symm ∘ singleton_inter_of_mem }
end finset

namespace simple_graph
lemma reachable.step {x y : V} : G.adj x y → reachable G x y :=
λ h, ⟨walk.cons h walk.nil⟩
end simple_graph


import category_theory.preadditive.additive_functor
import algebra.category.Group.preadditive
import algebra.category.Group.limits

noncomputable theory

universes v u

open category_theory category_theory.category

namespace AddCommGroup

open category_theory.limits

variables

def pi' {I : Type v} (X : I → AddCommGroup.{u}) := (AddCommGroup.of (Π i, (X i).α))

@[simps]
def cone_pi {I : Type} (X : I → AddCommGroup.{u}) : fan X := fan.mk (pi' X) (λ i,
  { to_fun := λ x, x i,
    map_zero' := by tidy,
    map_add' := by tidy, })

lemma cone_pi_is_limit {I : Type} (X : I → AddCommGroup.{u}) : is_limit (cone_pi X) :=
mk_fan_limit _
  (λ s,
    { to_fun := λ x i, s.proj i x,
      map_zero' := by tidy,
      map_add' := by tidy}) (by tidy)
  (λ s m hm, begin
    ext x i,
    dsimp,
    simpa only [← hm],
  end)

def pi_iso_pi' {I : Type} (X : I → AddCommGroup.{u}) : ∏ X ≅ pi' X :=
is_limit.cone_point_unique_up_to_iso (limit.is_limit _) (cone_pi_is_limit X)

variables {I : Type v} {X Y Z : I → AddCommGroup.{u}} (f : Π i, X i ⟶ Y i) (g : Π i, Y i ⟶ Z i)

@[simps]
def pi'_map : pi' X ⟶ pi' Y :=
{ to_fun := λ x i, f i (x i),
  map_zero' := by tidy,
  map_add' := by tidy, }

@[simp, reassoc]
lemma pi'_map_comp : pi'_map (λ i, f i ≫ g i) = pi'_map f ≫ pi'_map g := rfl

@[simps]
def pi'_lift {I : Type} {X : AddCommGroup.{u}} {Y : I → AddCommGroup.{u}} (φ : Π i, X ⟶ Y i) :
  X ⟶ pi' Y :=
{ to_fun := λ x i, φ i x,
  map_zero' := by tidy,
  map_add' := by tidy, }

end AddCommGroup

namespace algebra

namespace homology

def concrete_exact {X₁ X₂ X₃ : AddCommGroup.{u}} (f₁ : X₁ ⟶ X₂) (f₂ : X₂ ⟶ X₃) : Prop :=
∀ (x₂ : X₂) (h : f₂ x₂ = 0), ∃ (x₁ : X₁), f₁ x₁ = x₂

def concrete_exact.lift {X₁ X₂ X₃ : AddCommGroup.{u}} {f₁ : X₁ ⟶ X₂} {f₂ : X₂ ⟶ X₃}
  (h : concrete_exact f₁ f₂) {x₂ : X₂} (zero : f₂ x₂ = 0) : X₁ :=
(h x₂ zero).some

@[simp]
lemma concrete_exact.lift_spec {X₁ X₂ X₃ : AddCommGroup.{u}} {f₁ : X₁ ⟶ X₂} {f₂ : X₂ ⟶ X₃}
  (h : concrete_exact f₁ f₂) {x₂ : X₂} (zero : f₂ x₂ = 0) :
  f₁ (h.lift zero) = x₂ := (h x₂ zero).some_spec

lemma concrete_exact.of_iso {X₁ Y₁ X₂ Y₂ X₃ Y₃ : AddCommGroup.{u}} {g₁ : Y₁ ⟶ Y₂} {g₂ : Y₂ ⟶ Y₃}
  (h : concrete_exact g₁ g₂) (f₁ : X₁ ⟶ X₂) (f₂ : X₂ ⟶ X₃) (e₁ : X₁ ≅ Y₁) (e₂ : X₂ ≅ Y₂)
  (e₃ : X₃ ≅ Y₃) (comm₁ : f₁ ≫ e₂.hom = e₁.hom ≫ g₁) (comm₂ : f₂ ≫ e₃.hom = e₂.hom ≫ g₂) :
  concrete_exact f₁ f₂ :=
begin
  intros x₂ hx₂,
  have hy₂ : g₂ (e₂.hom x₂) = 0,
  { rw [← comp_apply, ← comm₂, comp_apply, hx₂, map_zero], },
  obtain ⟨y₁, hy₁⟩ := h _ hy₂,
  refine ⟨e₁.inv y₁, _⟩,
  have comm₁' : e₁.inv ≫ f₁ = g₁ ≫ e₂.inv,
  { rw [← cancel_mono e₂.hom, ← cancel_epi e₁.hom, assoc, assoc, e₂.inv_hom_id, comp_id,
      e₁.hom_inv_id_assoc, comm₁], },
  rw [← comp_apply, comm₁', comp_apply, hy₁, ← comp_apply, e₂.hom_inv_id, id_apply],
end

lemma injective_iff {X₁ X₂ : AddCommGroup.{u}} (f : X₁ ⟶ X₂) :
  function.injective f ↔ ∀ (x₁ : X₁) (h : f x₁ = 0), x₁ = 0 :=
begin
  split,
  { intros h x₁ hx₁,
    apply h,
    rw [hx₁, map_zero], },
  { intros h x₁ x₂ hx,
    rw ← sub_eq_zero,
    apply h,
    rw [map_sub, hx, sub_self], },
end

lemma concrete_exact.pi' {I : Type v} {X₁ X₂ X₃ : I → AddCommGroup.{u}}
  (f₁ : Π i, X₁ i ⟶ X₂ i) (f₂ : Π i, X₂ i ⟶ X₃ i) (h : ∀ i, concrete_exact (f₁ i) (f₂ i)) :
  concrete_exact (AddCommGroup.pi'_map f₁) (AddCommGroup.pi'_map f₂) :=
begin
  intros x₂ hx₂,
  have h : ∀ (i : I), ∃ (x₁ : X₁ i), (f₁ i) x₁ = x₂ i := λ i, h i (x₂ i) (congr_fun hx₂ i),
  exact ⟨λ i, (h i).some, by { ext i, exact (h i).some_spec, }⟩,
end

variables (A : Type*) [category A] [preadditive A]

structure five_complex :=
(X₁ X₂ X₃ X₄ X₅ : A)
(f₁ : X₁ ⟶ X₂)
(f₂ : X₂ ⟶ X₃)
(f₃ : X₃ ⟶ X₄)
(f₄ : X₄ ⟶ X₅)
(h₁₂ : f₁ ≫ f₂ = 0)
(h₂₃ : f₂ ≫ f₃ = 0)
(h₃₄ : f₃ ≫ f₄ = 0)

namespace five_complex

variable {A}

@[ext]
structure hom (E E' : five_complex A) :=
(τ₁ : E.X₁ ⟶ E'.X₁)
(τ₂ : E.X₂ ⟶ E'.X₂)
(τ₃ : E.X₃ ⟶ E'.X₃)
(τ₄ : E.X₄ ⟶ E'.X₄)
(τ₅ : E.X₅ ⟶ E'.X₅)
(comm₁ : E.f₁ ≫ τ₂ = τ₁ ≫ E'.f₁)
(comm₂ : E.f₂ ≫ τ₃ = τ₂ ≫ E'.f₂)
(comm₃ : E.f₃ ≫ τ₄ = τ₃ ≫ E'.f₃)
(comm₄ : E.f₄ ≫ τ₅ = τ₄ ≫ E'.f₄)

@[simps]
instance : category (five_complex A) :=
{ hom := hom,
  id := λ E, hom.mk (𝟙 _) (𝟙 _) (𝟙 _) (𝟙 _) (𝟙 _) (by rw [id_comp,comp_id])
    (by rw [id_comp,comp_id]) (by rw [id_comp,comp_id]) (by rw [id_comp,comp_id]),
  comp := λ E E' E'' φ φ', hom.mk (φ.τ₁ ≫ φ'.τ₁) (φ.τ₂ ≫ φ'.τ₂) (φ.τ₃ ≫ φ'.τ₃)
    (φ.τ₄ ≫ φ'.τ₄) (φ.τ₅ ≫ φ'.τ₅) (by rw [assoc, reassoc_of (φ.comm₁), φ'.comm₁])
    (by rw [assoc, reassoc_of (φ.comm₂), φ'.comm₂])
    (by rw [assoc, reassoc_of (φ.comm₃), φ'.comm₃])
    (by rw [assoc, reassoc_of (φ.comm₄), φ'.comm₄]), }

variable (A)

@[simps]
def eval₁ : five_complex A ⥤ A :=
{ obj := λ E, E.X₁,
  map := λ E E' φ, φ.τ₁, }

@[simps]
def eval₂ : five_complex A ⥤ A :=
{ obj := λ E, E.X₂,
  map := λ E E' φ, φ.τ₂, }

@[simps]
def eval₃ : five_complex A ⥤ A :=
{ obj := λ E, E.X₃,
  map := λ E E' φ, φ.τ₃, }

@[simps]
def eval₄ : five_complex A ⥤ A :=
{ obj := λ E, E.X₄,
  map := λ E E' φ, φ.τ₄, }

@[simps]
def eval₅ : five_complex A ⥤ A :=
{ obj := λ E, E.X₅,
  map := λ E E' φ, φ.τ₅, }

lemma is_iso_of_isos {E E' : five_complex A} (φ : E ⟶ E') (h₁ : is_iso φ.τ₁)
  (h₂ : is_iso φ.τ₂) (h₃ : is_iso φ.τ₃) (h₄ : is_iso φ.τ₄) (h₅ : is_iso φ.τ₅) :
  is_iso φ :=
begin
  let ψ : E' ⟶ E :=
  { τ₁ := inv φ.τ₁,
    τ₂ := inv φ.τ₂,
    τ₃ := inv φ.τ₃,
    τ₄ := inv φ.τ₄,
    τ₅ := inv φ.τ₅,
    comm₁ := by { simp only [← cancel_mono (φ.τ₂), φ.comm₁, assoc, is_iso.inv_hom_id, comp_id,
      is_iso.inv_hom_id_assoc], },
    comm₂ := by { simp only [← cancel_mono (φ.τ₃), φ.comm₂, assoc, is_iso.inv_hom_id, comp_id,
      is_iso.inv_hom_id_assoc], },
    comm₃ := by { simp only [← cancel_mono (φ.τ₄), φ.comm₃, assoc, is_iso.inv_hom_id, comp_id,
      is_iso.inv_hom_id_assoc], },
    comm₄ := by { simp only [← cancel_mono (φ.τ₅), φ.comm₄, assoc, is_iso.inv_hom_id, comp_id,
      is_iso.inv_hom_id_assoc], }, },
  exact ⟨⟨ψ, ⟨by tidy, by tidy⟩⟩⟩,
end

variable {A}

structure exact (E : five_complex (AddCommGroup.{u})) : Prop :=
(ex₂ : concrete_exact E.f₁ E.f₂)
(ex₃ : concrete_exact E.f₂ E.f₃)
(ex₄ : concrete_exact E.f₃ E.f₄)

lemma concrete_comm₁ {E E' : five_complex (AddCommGroup.{u})} (φ : E ⟶ E')
  (x₁ : E.X₁) : φ.τ₂ (E.f₁ x₁) = E'.f₁ (φ.τ₁ x₁) :=
by simp only [← comp_apply, φ.comm₁]

lemma concrete_comm₂ {E E' : five_complex (AddCommGroup.{u})} (φ : E ⟶ E')
  (x₂ : E.X₂) : φ.τ₃ (E.f₂ x₂) = E'.f₂ (φ.τ₂ x₂) :=
by simp only [← comp_apply, φ.comm₂]

lemma concrete_comm₃ {E E' : five_complex (AddCommGroup.{u})} (φ : E ⟶ E')
  (x₃ : E.X₃) : φ.τ₄ (E.f₃ x₃) = E'.f₃ (φ.τ₃ x₃) :=
by simp only [← comp_apply, φ.comm₃]

lemma concrete_comm₄ {E E' : five_complex (AddCommGroup.{u})} (φ : E ⟶ E')
  (x₄ : E.X₄) : φ.τ₅ (E.f₄ x₄) = E'.f₄ (φ.τ₄ x₄) :=
by simp only [← comp_apply, φ.comm₄]

lemma exact.of_iso {E E' : five_complex AddCommGroup.{u}} (φ : E ⟶ E') (hφ : is_iso φ)
  (hE' : E'.exact) : E.exact :=
begin
  let e := as_iso φ,
  constructor,
  { exact concrete_exact.of_iso hE'.ex₂ E.f₁ E.f₂ ((eval₁ _).map_iso e)
      ((eval₂ _).map_iso e) ((eval₃ _).map_iso e) φ.comm₁ φ.comm₂, },
  { exact concrete_exact.of_iso hE'.ex₃ E.f₂ E.f₃ ((eval₂ _).map_iso e)
      ((eval₃ _).map_iso e) ((eval₄ _).map_iso e) φ.comm₂ φ.comm₃, },
  { exact concrete_exact.of_iso hE'.ex₄ E.f₃ E.f₄ ((eval₃ _).map_iso e)
      ((eval₄ _).map_iso e) ((eval₅ _).map_iso e) φ.comm₃ φ.comm₄, },
end

lemma five_lemma_injective {E E' : five_complex (AddCommGroup.{u})} (φ : E ⟶ E')
  (hE : E.exact) (hE' : E'.exact)
  (h₁ : function.surjective φ.τ₁)
  (h₂ : function.injective φ.τ₂)
  (h₄ : function.injective φ.τ₄) :
  function.injective φ.τ₃ :=
begin
  rw injective_iff at ⊢ h₄,
  intros x₃ hx₃,
  have eq₁ : E.f₃ x₃ = 0,
  { apply h₄,
    rw [concrete_comm₃, hx₃, map_zero], },
  let x₂ := hE.ex₃.lift eq₁,
  have hx₂ : E.f₂ x₂ = x₃ := hE.ex₃.lift_spec eq₁,
  let x₂' := φ.τ₂ x₂,
  have eq₂ : E'.f₂ x₂' = 0,
  { dsimp only [x₂'],
    rw [← concrete_comm₂, concrete_exact.lift_spec, hx₃], },
  let x₁' := hE'.ex₂.lift eq₂,
  obtain ⟨x₁, hx₁⟩ := h₁ x₁',
  have eq₃ : E.f₁ x₁ = x₂,
  { apply h₂,
    rw [concrete_comm₁, hx₁, concrete_exact.lift_spec], },
  rw [← hx₂, ← eq₃, ← comp_apply, E.h₁₂, AddCommGroup.zero_apply],
end

lemma five_lemma_surjective {E E' : five_complex (AddCommGroup.{u})} (φ : E ⟶ E')
  (hE : E.exact) (hE' : E'.exact)
  (h₂ : function.surjective φ.τ₂)
  (h₄ : function.surjective φ.τ₄)
  (h₅ : function.injective φ.τ₅) :
  function.surjective φ.τ₃ :=
begin
  intro x₃',
  obtain ⟨x₄, hx₄⟩ := h₄ (E'.f₃ x₃'),
  have eq₁ : E.f₄ x₄ = 0,
  { apply h₅,
    rw [concrete_comm₄, hx₄, ← comp_apply, E'.h₃₄, AddCommGroup.zero_apply, map_zero], },
  let x₃ := hE.ex₄.lift eq₁,
  have hx₃ : E.f₃ x₃ = x₄ := by simp only [concrete_exact.lift_spec],
  let δ := x₃' - φ.τ₃ x₃,
  have eq₂ : E'.f₃ δ = 0,
  { dsimp only [δ],
    simp only [map_sub, ← concrete_comm₃, hx₃, hx₄, sub_self], },
  let ε := hE'.ex₃.lift eq₂,
  have hε : E'.f₂ ε = δ := by simp only [concrete_exact.lift_spec],
  obtain ⟨x₂, hx₂⟩ := h₂ ε,
  refine ⟨x₃ + E.f₂ x₂, _⟩,
  rw [map_add, concrete_comm₂, hx₂, hε, add_sub_cancel'_right],
end

lemma five_lemma_bijective {E E' : five_complex (AddCommGroup.{u})} (φ : E ⟶ E')
  (hE : E.exact) (hE' : E'.exact)
  (h₁ : function.bijective φ.τ₁)
  (h₂ : function.bijective φ.τ₂)
  (h₄ : function.bijective φ.τ₄)
  (h₅ : function.bijective φ.τ₅) :
  function.bijective φ.τ₃ :=
⟨five_lemma_injective φ hE hE' h₁.2 h₂.1 h₄.1, five_lemma_surjective φ hE hE' h₂.2 h₄.2 h₅.1⟩

@[simps]
def pi {I : Type} (E : I → five_complex AddCommGroup.{u}) : five_complex AddCommGroup.{u} :=
{ X₁ := ∏ (λ i, (E i).X₁),
  X₂ := ∏ (λ i, (E i).X₂),
  X₃ := ∏ (λ i, (E i).X₃),
  X₄ := ∏ (λ i, (E i).X₄),
  X₅ := ∏ (λ i, (E i).X₅),
  f₁ := limits.pi.map (λ i, (E i).f₁),
  f₂ := limits.pi.map (λ i, (E i).f₂),
  f₃ := limits.pi.map (λ i, (E i).f₃),
  f₄ := limits.pi.map (λ i, (E i).f₄),
  h₁₂ := limits.limit.hom_ext begin
    rintro ⟨i⟩,
    simp only [assoc, limits.lim_map_π, discrete.nat_trans_app, limits.lim_map_π_assoc,
      limits.zero_comp, (E i).h₁₂, limits.comp_zero],
  end,
  h₂₃ := limits.limit.hom_ext begin
    rintro ⟨i⟩,
    simp only [assoc, limits.lim_map_π, discrete.nat_trans_app, limits.lim_map_π_assoc,
      limits.zero_comp, (E i).h₂₃, limits.comp_zero],
  end,
  h₃₄ := limits.limit.hom_ext begin
    rintro ⟨i⟩,
    simp only [assoc, limits.lim_map_π, discrete.nat_trans_app, limits.lim_map_π_assoc,
      limits.zero_comp, (E i).h₃₄, limits.comp_zero],
  end, }

@[simps]
def pi' {I : Type v} (E : I → five_complex AddCommGroup.{u}) :
  five_complex AddCommGroup.{max u v} :=
{ X₁ := AddCommGroup.pi'.{v u} (λ i, (E i).X₁),
  X₂ := AddCommGroup.pi'.{v u} (λ i, (E i).X₂),
  X₃ := AddCommGroup.pi'.{v u} (λ i, (E i).X₃),
  X₄ := AddCommGroup.pi'.{v u} (λ i, (E i).X₄),
  X₅ := AddCommGroup.pi'.{v u} (λ i, (E i).X₅),
  f₁ := AddCommGroup.pi'_map (λ i, (E i).f₁),
  f₂ := AddCommGroup.pi'_map (λ i, (E i).f₂),
  f₃ := AddCommGroup.pi'_map (λ i, (E i).f₃),
  f₄ := AddCommGroup.pi'_map (λ i, (E i).f₄),
  h₁₂ := by simpa only [← AddCommGroup.pi'_map_comp, (E _).h₁₂],
  h₂₃ := by simpa only [← AddCommGroup.pi'_map_comp, (E _).h₂₃],
  h₃₄ := by simpa only [← AddCommGroup.pi'_map_comp, (E _).h₃₄], }

lemma pi'_exact {I : Type v} (E : I → five_complex AddCommGroup.{u})
  (h : ∀ i, (E i).exact) : (pi' E).exact :=
⟨concrete_exact.pi' _ _ (λ i, (h i).ex₂),
  concrete_exact.pi' _ _ (λ i, (h i).ex₃),
  concrete_exact.pi' _ _ (λ i, (h i).ex₄)⟩

@[simps]
def pi'_lift {I : Type} {E : five_complex AddCommGroup.{u}}
  {E' : I → five_complex AddCommGroup.{u}} (φ : Π i, E ⟶ E' i) :
  E ⟶ pi' E' :=
{ τ₁ := AddCommGroup.pi'_lift (λ i, (φ i).τ₁),
  τ₂ := AddCommGroup.pi'_lift (λ i, (φ i).τ₂),
  τ₃ := AddCommGroup.pi'_lift (λ i, (φ i).τ₃),
  τ₄ := AddCommGroup.pi'_lift (λ i, (φ i).τ₄),
  τ₅ := AddCommGroup.pi'_lift (λ i, (φ i).τ₅),
  comm₁ := begin
    ext x i,
    simp only [comp_apply, AddCommGroup.pi'_lift_apply, pi'_f₁, AddCommGroup.pi'_map_apply],
    simp only [← comp_apply, (φ i).comm₁],
  end,
  comm₂ := begin
    ext x i,
    simp only [comp_apply, AddCommGroup.pi'_lift_apply, pi'_f₂, AddCommGroup.pi'_map_apply],
    simp only [← comp_apply, (φ i).comm₂],
  end,
  comm₃ := begin
    ext x i,
    simp only [comp_apply, AddCommGroup.pi'_lift_apply, pi'_f₃, AddCommGroup.pi'_map_apply],
    simp only [← comp_apply, (φ i).comm₃],
  end,
  comm₄ := begin
    ext x i,
    simp only [comp_apply, AddCommGroup.pi'_lift_apply, pi'_f₄, AddCommGroup.pi'_map_apply],
    simp only [← comp_apply, (φ i).comm₄],
  end, }

end five_complex

end homology

end algebra

namespace category_theory

namespace functor

open algebra.homology

@[simps]
def map_five_complex {C D : Type*} [category C] [category D] [preadditive C]
  [preadditive D] (F : C ⥤ D) [F.additive] :
  five_complex C ⥤ five_complex D :=
{ obj := λ E,
  { X₁ := F.obj E.X₁,
    X₂ := F.obj E.X₂,
    X₃ := F.obj E.X₃,
    X₄ := F.obj E.X₄,
    X₅ := F.obj E.X₅,
    f₁ := F.map E.f₁,
    f₂ := F.map E.f₂,
    f₃ := F.map E.f₃,
    f₄ := F.map E.f₄,
    h₁₂ := by { rw [← F.map_comp, E.h₁₂, F.map_zero], },
    h₂₃ := by { rw [← F.map_comp, E.h₂₃, F.map_zero], },
    h₃₄ := by { rw [← F.map_comp, E.h₃₄, F.map_zero], }, },
  map := λ E E' φ,
  { τ₁ := F.map φ.τ₁,
    τ₂ := F.map φ.τ₂,
    τ₃ := F.map φ.τ₃,
    τ₄ := F.map φ.τ₄,
    τ₅ := F.map φ.τ₅,
    comm₁ := by simp only [← F.map_comp, φ.comm₁],
    comm₂ := by simp only [← F.map_comp, φ.comm₂],
    comm₃ := by simp only [← F.map_comp, φ.comm₃],
    comm₄ := by simp only [← F.map_comp, φ.comm₄], }, }

end functor

end category_theory