/-= Chapter 7: Inductive types =-/

/- Enumerated types -/
namespace enumerated_types

inductive Weekday where
| sunday : Weekday
| monday : Weekday
| tuesday : Weekday
| wednesday : Weekday
| thursday : Weekday
| friday : Weekday
| saturday : Weekday

#check Weekday.sunday
#check Weekday.monday

section
open Weekday

#check sunday
#check monday
end

namespace omit_type

inductive Weekday where
| sunday
| monday
| tuesday
| wednesday
| thursday
| friday
| saturday

end omit_type

section
open Weekday
def numberOfDay (d : Weekday) : Nat :=
  match d with
  | sunday => 1
  | monday => 2
  | tuesday => 3
  | wednesday => 4
  | thursday => 5
  | friday => 6
  | saturday => 7
end

#eval numberOfDay Weekday.sunday
#eval numberOfDay Weekday.monday
#eval numberOfDay Weekday.tuesday

section pretty_print

set_option pp.all true
#print numberOfDay
#print numberOfDay.match_1
#print Weekday.casesOn
#check @Weekday.rec
#print Weekday.rec

end pretty_print

namespace repr

inductive Weekday where
| sunday
| monday
| tuesday
| wednesday
| thursday
| friday
| saturday
deriving Repr

open Weekday

#eval tuesday

end repr

namespace add_to_namespace

inductive Weekday where
| sunday
| monday
| tuesday
| wednesday
| thursday
| friday
| saturday
deriving Repr

namespace Weekday

def next (d : Weekday) : Weekday :=
  match d with
  | sunday => monday
  | monday => tuesday
  | tuesday => wednesday
  | wednesday => thursday
  | thursday => friday
  | friday => saturday
  | saturday => sunday

def previous (d : Weekday) : Weekday :=
  match d with
  | sunday => saturday
  | monday => sunday
  | tuesday => monday
  | wednesday => tuesday
  | thursday => wednesday
  | friday => thursday
  | saturday => friday

#eval next (next tuesday)
#eval next (previous tuesday)

example : next (previous tuesday) = tuesday :=
  rfl

def next_previous (d : Weekday) : next (previous d) = d :=
  match d with
  | sunday => rfl
  | monday => rfl
  | tuesday => rfl
  | wednesday => rfl
  | thursday => rfl
  | friday => rfl
  | saturday => rfl

namespace tactic_version

def next_previous (d : Weekday) : next (previous d) = d := by
  cases d <;> rfl

end tactic_version

end Weekday

end add_to_namespace

namespace bool

inductive Bool where
| false
| true

namespace Bool

def and (p q : Bool) : Bool :=
  match p with
  | true => q
  | false => false

def or (p q : Bool) : Bool :=
  match p with
  | true => true
  | false => q

def not (p : Bool) : Bool :=
  match p with
  | true => false
  | false => true

example (p : Bool) : not (not p) = p := by
  match p with
  | true => rfl
  | false => rfl

example (p q : Bool) : and p q = and q p := by
  match p, q with
  | true, true => rfl
  | true, false => rfl
  | false, true => rfl
  | false, false => rfl

end Bool

end bool

end enumerated_types

/- Constructors with arguments -/
namespace constructors_with_arguments

namespace prod_and_sum

inductive Prod (α : Type u) (β : Type v)
| mk : α → β → Prod α β

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

def fst {α : Type u} {β : Type v} (p : Prod α β) : α :=
  match p with
  | Prod.mk a b => a

def snd {α : Type u} {β : Type v} (p : Prod α β) : β :=
  match p with
  | Prod.mk a b => b

end prod_and_sum

#check Prod.casesOn

def prod_example (p : Bool × Nat) : Nat :=
  Prod.casesOn (motive := λ _ => Nat) p (λ b n => cond b (2 * n) (2 * n + 1))

#eval prod_example (true, 3)
#eval prod_example (false, 3)

def sum_example (s : Sum Nat Nat) : Nat :=
  Sum.casesOn (motive := λ _ => Nat) s (λ n => 2 * n) (λ n => 2 * n + 1)

#eval sum_example (Sum.inl 3)
#eval sum_example (Sum.inr 3)

namespace named_arguments

inductive Prod (α : Type u) (β : Type v)
| mk (fst : α) (snd : β) : Prod α β

inductive Sum (α : Type u) (β : Type v)
| inl (a : α) : Sum α β
| inr (b : β) : Sum α β

end named_arguments

namespace structures

structure Prod (α : Type u) (β : Type v) where
  mk :: (fst : α) (snd : β)

structure Color where
  (red : Nat) (green : Nat) (blue : Nat)
  deriving Repr

def yellow := Color.mk 255 255 0

#eval Color.red yellow
#eval yellow

namespace fields

structure Color where
  red : Nat
  green : Nat
  blue : Nat
  deriving Repr

end fields

structure Semigroup where
  carrier : Type u
  mul : carrier → carrier → carrier
  mul_assoc : ∀ a b c, mul (mul a b) c = mul a (mul b c)

end structures

namespace more_std_examples

inductive Sigma {α : Type u} (β : α → Type v) where
| mk : (a : α) → β a → Sigma β

inductive Option (α : Type u) where
| none : Option α
| some : α → Option α

inductive Inhabited (α : Type u) where
| mk : α → Inhabited α

end more_std_examples

-- Exercises
-- develop a notion of composition of partial functions
def compose
    {α : Type u} {β : Type v} {γ : Type w}
    (f : β → Option γ) (g : α → Option β) (x : α) : Option γ :=
  match g x with
  | some (y : β) => f y
  | none => none

-- show that it behaves as expected
def partial_id {α : Type u} : α → Option α := some
def partial_none {α : Type u} : α → Option α := λ _ => none

example : compose partial_id partial_none 3 = none := rfl
example : compose partial_none partial_id 3 = none := rfl
example : compose partial_id partial_id 3 = some 3 := rfl

-- show that Bool and Nat are inhabited
example : Inhabited Bool := Inhabited.mk false
example : Inhabited Nat := Inhabited.mk 0

-- the product of two inhabited types is inhabited
theorem prod_inhabited
    {α : Type u} {β : Type v} (ia : Inhabited α) (ib : Inhabited β)
    : Inhabited (α × β) :=
  match ia, ib with
  | Inhabited.mk a, Inhabited.mk b => Inhabited.mk (a, b)

-- the type of functions to an inhabited type is inhabited
theorem fn_inhabited
    {α : Type u} {β : Type v} (ib : Inhabited β)
    : Inhabited (α → β) :=
  let (Inhabited.mk b) := ib
  Inhabited.mk (λ _ => b)

end constructors_with_arguments

/- Inductively defined propositions -/
namespace inductively_defined_propositions

inductive False : Prop where

inductive True : Prop where
| intro : True

inductive And (a b : Prop) : Prop where
| intro : a → b → And a b

inductive Or (a b : Prop) : Prop where
| inl : a → Or a b
| inr : b → Or a b

inductive Exists {α : Type u} (q : α → Prop) : Prop where
| intro : ∀ (a : α), q a → Exists q

inductive Subtype {α : Type u} (p : α → Prop) where
| mk : (x : α) → p x → Subtype p

end inductively_defined_propositions

/- Defining the natural numbers -/
namespace defining_the_natural_numbers

namespace my_nat

inductive Nat where
| zero : Nat
| succ : Nat → Nat
deriving Repr

#check @Nat.rec
#check @Nat.recOn

namespace Nat

def add (m n : Nat) : Nat :=
  match n with
  | Nat.zero => m
  | Nat.succ n => Nat.succ (add m n)

#eval add (succ (succ zero)) (succ zero)

instance : Add Nat where
  add := add

theorem add_zero (m : Nat) : m + zero = m := rfl
theorem add_succ (m n : Nat) : m + succ n = succ (m + n) := rfl

end Nat

end my_nat

open Nat

theorem zero_add (n : Nat) : 0 + n = n :=
  Nat.recOn (motive := λ x => 0 + x = x)
    n
    (show 0 + 0 = 0 from rfl)
    (fun (n : Nat) (ih : 0 + n = n) =>
      show 0 + succ n = succ n from
      calc
        _ = 0 + succ n   := rfl
        _ = succ (0 + n) := rfl
        _ = succ n       := by rw [ih])

theorem zero_add_tactics (n : Nat) : 0 + n = n :=
  Nat.recOn (motive := λ x => 0 + x = x)
    n
    rfl
    (λ n ih => by simp [add_succ, ih])

theorem add_assoc (m n k : Nat) : (m + n) + k = m + (n + k) := by
  apply Nat.recOn (motive := λ k => (m + n) + k = m + (n + k)) k
  · show (m + n) + 0 = m + (n + 0)
    rfl
  · intro k (ih : (m + n) + k = m + (n + k))
    show (m + n) + succ k = m + (n + succ k)
    calc
      _ = (m + n) + succ k   := rfl
      _ = succ ((m + n) + k) := rfl
      _ = succ (m + (n + k)) := by rw [ih]
      _ = m + succ (n + k)   := rfl
      _ = m + (n + succ k)   := rfl

theorem add_assoc_short (m n k : Nat) : (m + n) + k = m + (n + k) := by
  apply Nat.recOn (motive := λ k => (m + n) + k = m + (n + k)) k
  · rfl
  · intro k ih
    simp [Nat.add_succ, ih]

theorem succ_add (n m : Nat) : succ n + m = succ (n + m) := by
  apply Nat.recOn (motive := λ x => succ n + x = succ (n + x))
  · show succ n + 0 = succ (n + 0)
    rfl
  · intro m (ih : succ n + m = succ (n + m))
    show succ n + succ m = succ (n + succ m)
    calc
      _ = succ n + succ m     := rfl
      _ = succ (succ n + m)   := rfl
      _ = succ (succ (n + m)) := by rw [ih]
      _ = succ (n + succ m)   := rfl

theorem add_comm (m n : Nat) : m + n = n + m := by
  apply Nat.recOn (motive := λ x => m + x = x + m) n
  · show m + 0 = 0 + m
    rw [Nat.zero_add, Nat.add_zero]
  · intro n (ih : m + n = n + m)
    show m + succ n = succ n + m
    calc
      _ = m + succ n   := rfl
      _ = succ (m + n) := rfl
      _ = succ (n + m) := by rw [ih]
      _ = succ n + m   := by rw [succ_add]

theorem succ_add_short (n m : Nat) : succ n + m = succ (n + m) := by
  apply Nat.recOn (motive := λ x => succ n + x = succ (n + x))
  · simp
  · intro m ih
    simp only [add_succ, ih]

theorem add_comm_short (m n : Nat) : m + n = n + m := by
  apply Nat.recOn (motive := λ x => m + x = x + m) n
  · simp
  · intro n ih
    simp only [add_succ, succ_add, ih]

end defining_the_natural_numbers

/- Other recursive data types -/
namespace other_recursive_data_types

inductive List (α : Type u) where
| nil : List α
| cons : α → List α → List α

namespace List

def append (as bs : List α) : List α :=
  match as with
  | nil => bs
  | cons a as => cons a (append as bs)

theorem nil_append (as : List α) : append nil as = as := rfl

theorem cons_append
    (a : α) (as bs : List α) : append (cons a as) bs = cons a (append as bs) :=
  rfl

theorem append_nil (as : List α) : append as nil = as := by
  apply List.recOn (motive := λ xs => append xs nil = xs) as
  · show append nil nil = nil
    rfl
  · intro a as (ih : append as nil = as)
    show append (cons a as) nil = cons a as
    calc
      _ = append (cons a as) nil := rfl
      _ = cons a (append as nil) := rfl
      _ = cons a as              := by rw [ih]

theorem append_assoc
    (as bs cs : List α)
    : append (append as bs) cs = append as (append bs cs) := by
  apply List.recOn
      (motive := λ xs => append (append xs bs) cs = append xs (append bs cs))
      as
  · show append (append nil bs) cs = append nil (append bs cs)
    rfl
  · intro a as (ih : append (append as bs) cs = append as (append bs cs))
    show append (append (cons a as) bs) cs = append (cons a as) (append bs cs)
    calc
      _ = append (append (cons a as) bs) cs := rfl
      _ = append (cons a (append as bs)) cs := rfl
      _ = cons a (append (append as bs) cs) := rfl
      _ = cons a (append as (append bs cs)) := by rw [ih]
      _ = append (cons a as) (append bs cs) := rfl

def length (as : List α) : Nat :=
  match as with
  | nil => 0
  | cons _ as => Nat.succ (length as)

example : length (nil : List Nat) = 0 := rfl
example : length (cons 42 nil) = 1 := rfl

theorem length_append
    (as bs : List α) : length (append as bs) = length as + length bs := by
  apply List.recOn
      (motive := λ xs => length (append xs bs) = length xs + length bs)
      as
  · show length (append nil bs) = length nil + length bs
    calc
      _ = length (append nil bs) := rfl
      _ = length bs              := rfl
      _ = 0 + length bs          := by rw [Nat.zero_add]
      _ = length nil + length bs := rfl
  · intro a as (ih : length (append as bs) = length as + length bs)
    show length (append (cons a as) bs) = length (cons a as) + length bs
    calc
      _ = length (append (cons a as) bs)   := rfl
      _ = length (cons a (append as bs))   := rfl
      _ = Nat.succ (length (append as bs)) := rfl
      _ = Nat.succ (length as + length bs) := by rw [ih]
      _ = Nat.succ (length as) + length bs := by rw [←Nat.succ_add]
      _ = length (cons a as) + length bs   := rfl

end List

inductive BinaryTree where
| leaf : BinaryTree
| node : BinaryTree → BinaryTree → BinaryTree

inductive CBTree where
| leaf : CBTree
| sup : (Nat → CBTree) → CBTree

namespace CBTree

def succ (t : CBTree) : CBTree :=
  sup (λ _ => t)

def toCBTree : Nat → CBTree
| 0 => leaf
| n+1 => succ (toCBTree n)

def omega : CBTree :=
  sup toCBTree

end CBTree

end other_recursive_data_types

/- Tactics for inductive types -/
namespace tactics_for_inductive_types

example (p : Nat → Prop) (hz : p 0) (hs : ∀ n, p (Nat.succ n)) : ∀ n, p n := by
  intro n
  cases n
  · exact hz -- goal is p 0
  · apply hs -- goal is a : ℕ ⊢ p (succ a)

open Nat

example (n : Nat) (h : n ≠ 0) : succ (pred n) = n := by
  cases n with
  | zero =>
    -- goal: h : 0 ≠ 0 ⊢ succ (pred 0) = 0
    apply absurd rfl h
  | succ m =>
    -- second goal: h : succ m ≠ 0 ⊢ succ (pred (succ m)) = succ m
    rfl

namespace cases_data

def f (n : Nat) : Nat := by
  cases n; exact 3; exact 7

example : f 0 = 3 := rfl
example : f 5 = 7 := rfl

end cases_data

namespace cases_tuple

def Tuple (α : Type) (n : Nat) :=
  { as : List α // as.length = n }

def f {n : Nat} (t : Tuple α n) : Nat := by
  cases n; exact 3; exact 7

def myTuple : Tuple Nat 3 :=
  ⟨[0, 1, 2], rfl⟩

example : f myTuple = 7 :=
  rfl

end cases_tuple

namespace cases_multi

inductive Foo where
| bar₁ : Nat → Nat → Foo
| bar₂ : Nat → Nat → Nat → Foo

def silly (x : Foo) : Nat := by
  cases x with
  | bar₁ a b => exact b
  | bar₂ c d e => exact e

end cases_multi

namespace cases_multi_swap

inductive Foo where
| bar₁ : Nat → Nat → Foo
| bar₂ : Nat → Nat → Nat → Foo

def silly (x : Foo) : Nat := by
  cases x with
  | bar₂ c d e => exact e
  | bar₁ a b => exact b

end cases_multi_swap

namespace case_tactic

inductive Foo where
| bar₁ : Nat → Nat → Foo
| bar₂ : Nat → Nat → Nat → Foo

def silly (x : Foo) : Nat := by
  cases x
  case bar₂ c d e => exact e
  case bar₁ a b => exact b

end case_tactic

namespace case_tactic_swap

inductive Foo where
| bar₁ : Nat → Nat → Foo
| bar₂ : Nat → Nat → Nat → Foo

def silly (x : Foo) : Nat := by
  cases x
  case bar₁ a b => exact b
  case bar₂ c d e => exact e

end case_tactic_swap

example
    (p : Nat → Prop) (hz : p 0) (hs : ∀ n, p (succ n)) (m k : Nat)
    : p (m + 3 * k) := by
  cases m + 3 * k
  exact hz -- goal is p 0
  apply hs -- goal is a : ℕ ⊢ p (succ a)

example
    (p : Nat → Prop) (hz : p 0) (hs : ∀ n, p (succ n)) (m k : Nat)
    : p (m + 3 * k) := by
  generalize m + 3 * k = n
  cases n
  exact hz
  apply hs

example (p : Prop) (m n : Nat) (h₁ : m < n → p) (h₂ : m ≥ n → p) : p := by
  cases Nat.lt_or_ge m n
  case inl hlt => exact h₁ hlt
  case inr hge => exact h₂ hge

example (p : Prop) (m n : Nat) (h₁ : m < n → p) (h₂ : m ≥ n → p) : p := by
  have h : m < n ∨ m ≥ n := Nat.lt_or_ge m n
  cases h
  case inl hlt => exact h₁ hlt
  case inr hge => exact h₂ hge

#check Nat.sub_self

example (m n : Nat) : m - n = 0 ∨ m ≠ n := by
  cases Decidable.em (m = n) with
  | inl heq => rw [heq]; apply Or.inl; exact Nat.sub_self n
  | inr hne => apply Or.inr; exact hne

theorem zero_add (n : Nat) : 0 + n = n := by
  induction n with
  | zero => rfl
  | succ n ih => rw [Nat.add_succ, ih]

theorem zero_add_case (n : Nat) : 0 + n = n := by
  induction n
  case zero => rfl
  case succ n ih => rw [Nat.add_succ, ih]

namespace induction_examples

theorem zero_add (n : Nat) : 0 + n = n := by
  induction n <;> simp [*]

theorem succ_add (m n : Nat) : succ m + n = succ (m + n) := by
  induction n <;> simp[*, add_zero, add_succ]

theorem add_comm (m n : Nat) : m + n = n + m := by
  induction n <;> simp [*, add_succ, succ_add]

theorem add_assoc (m n k : Nat) : (m + n) + k = m + (n + k) := by
  induction k <;> simp [*, add_zero, add_succ]

end induction_examples

#check @Nat.mod.inductionOn

example (x : Nat) {y : Nat} (h : y > 0) : x % y < y := by
  induction x, y using Nat.mod.inductionOn with
  | ind x y h₁ ih =>
    rw [Nat.mod_eq_sub_mod h₁.2]
    exact ih h
  | base x y h₁ =>
    have : ¬ 0 < y ∨ ¬ y ≤ x := Iff.mp (Decidable.not_and_iff_or_not ..) h₁
    cases this with
    | inl h₁ => exact absurd h h₁
    | inr h₁ =>
      have hgt : y > x := Nat.gt_of_not_le h₁
      rw [← Nat.mod_eq_of_lt hgt] at hgt
      assumption

example :
    (λ (x : Nat × Nat) (y : Nat × Nat) => x.1 + y.2) =
    (λ (x : Nat × Nat) (z : Nat × Nat) => z.2 + x.1) := by
  funext (a, b) (c, d)
  show a + d = d + a
  rw [Nat.add_comm]

example (m n k : Nat) (h : succ (succ m) = succ (succ n)) : n + k = m + k := by
  injection h with h'
  injection h' with h''
  rw [h'']

example (m n : Nat) (h : succ m = 0) : n = n + 7 := by
  injection h

example (m n : Nat) (h : succ m = 0) : n = n + 7 := by
  contradiction

example (h : 7 = 4) : False := by
  contradiction

end tactics_for_inductive_types

/- Inductive families -/
namespace inductive_families

inductive Vector (α : Type u) : Nat → Type u where
| nil : Vector α 0
| cons : α → {n : Nat} → Vector α n → Vector α (n + 1)

inductive Eq {α : Sort u} (a : α) : α → Prop where
| refl {} : Eq a a

#check @Eq.rec

theorem subst
    {α : Type u} {a b : α} {p : α → Prop} (h₁ : Eq a b) (h₂ : p a) : p b :=
  match h₁ with
  | Eq.refl _ => h₂

section
set_option pp.all true
#print subst
#print subst.match_1
#print Eq.casesOn
end

theorem symm {α : Type u} {a b : α} (h : Eq a b) : Eq b a :=
  match h with
  | Eq.refl _ => Eq.refl _

theorem trans {α : Type u} {a b c : α} (h₁ : Eq a b) (h₂ : Eq b c) : Eq a c := by
  cases h₂ with
  | refl => exact h₁

theorem congr
    {α β : Type u} {a b : α} (f : α → β) (h : Eq a b) : Eq (f a) (f b) := by
  cases h with
  | refl => exact Eq.refl (f a)

end inductive_families

/- Mutual and nested inductive types -/
namespace mutual_and_nested_inductive_types

mutual
  inductive Even : Nat → Prop where
  | even_zero : Even 0
  | even_succ : {n : Nat} → Odd n → Even (n + 1)

  inductive Odd : Nat → Prop where
  | odd_succ : {n : Nat} → Even n → Odd (n + 1)
end

mutual
  inductive Tree (α : Type u) where
  | node : α → TreeList α → Tree α

  inductive TreeList (α : Type u) where
  | nil : TreeList α
  | cons : Tree α → TreeList α → TreeList α
end

inductive BetterTree (α : Type u) where
| mk : α → List (BetterTree α) → BetterTree α

end mutual_and_nested_inductive_types

/- Exercises -/
namespace exercises

namespace ex_1

open Nat

def mul (n m : Nat) : Nat :=
  match n with
  | 0 => 0
  | n+1 => m + (mul n m)

theorem zero_mul {n : Nat} : mul 0 n = 0 := rfl

theorem mul_zero {n : Nat} : mul n 0 = 0 := by
  induction n
  case zero =>
    show mul 0 0 = 0
    rfl
  case succ n ih =>
    have : mul n 0 = 0 := ih
    show mul (succ n) 0 = 0
    calc
      _ = mul (succ n) 0 := rfl
      _ = 0 + mul n 0    := rfl
      _ = mul n 0        := by rw [Nat.zero_add]
      _ = 0              := by rw [ih]

theorem succ_mul {n m : Nat} : mul (succ n) m = m + mul n m := rfl

theorem mul_succ {n m : Nat} : mul m (succ n) = m + mul m n := by
  induction m
  case zero =>
    show mul 0 (succ n) = 0 + mul 0 n
    simp only [zero_mul, Nat.zero_add]
  case succ m ih =>
    have : mul m (succ n) = m + mul m n := ih
    show mul (succ m) (succ n) = succ m + mul (succ m) n
    calc
      _ = mul (succ m) (succ n)   := rfl
      _ = succ n + mul m (succ n) := by rw [succ_mul]
      _ = succ n + (m + mul m n)  := by rw [ih]
      _ = (succ n + m) + mul m n  := by rw [Nat.add_assoc]
      _ = succ (n + m) + mul m n  := by rw [Nat.succ_add]
      _ = (n + succ m) + mul m n  := by rw [Nat.add_succ]
      _ = (succ m + n) + mul m n  := by rw [Nat.add_comm n]
      _ = succ m + (n + mul m n)  := by rw [Nat.add_assoc]
      _ = succ m + mul (succ m) n := by rw [succ_mul]

theorem mul_comm {n m : Nat} : mul n m = mul m n := by
  induction n
  case zero =>
    show mul 0 m = mul m 0
    simp only [zero_mul, mul_zero]
  case succ n ih =>
    have : mul n m = mul m n := ih
    show mul (succ n) m = mul m (succ n)
    calc
      _ = mul (succ n) m := rfl
      _ = m + mul n m    := by rw [succ_mul]
      _ = m + mul m n    := by rw [ih]
      _ = mul m (succ n) := by rw [mul_succ]

theorem right_distrib {n m k : Nat} : mul (n + m) k = mul n k + mul m k := by
  induction n
  case zero =>
    show mul (0 + m) k = mul 0 k + mul m k
    calc
      _ = mul (0 + m) k     := rfl
      _ = mul m k           := by rw [Nat.zero_add]
      _ = 0 + mul m k       := by rw [Nat.zero_add]
      _ = mul 0 k + mul m k := by rw [zero_mul]
  case succ n ih =>
    have : mul (n + m) k = mul n k + mul m k := ih
    show mul (succ n + m) k = mul (succ n) k + mul m k
    calc
      _ = mul (succ n + m) k       := rfl
      _ = mul (succ (n + m)) k     := by rw [Nat.succ_add]
      _ = k + mul (n + m) k        := by rw [succ_mul]
      _ = k + (mul n k + mul m k)  := by rw [ih]
      _ = (k + mul n k) + mul m k  := by rw [Nat.add_assoc]
      _ = mul (succ n) k + mul m k := by rw [succ_mul]

theorem mul_assoc {n m k : Nat} : mul (mul n m) k = mul n (mul m k) := by
  induction n
  case zero =>
    show mul (mul 0 m) k = mul 0 (mul m k)
    calc
      _ = mul (mul 0 m) k := rfl
      _ = mul 0 k := by rw [zero_mul]
      _ = 0 := by rw [zero_mul]
      _ = mul 0 (mul m k) := by rw [zero_mul]
  case succ n ih =>
    have : mul (mul n m) k = mul n (mul m k) := ih
    show mul (mul (succ n) m) k = mul (succ n) (mul m k)
    calc
      _ = mul (mul (succ n) m) k    := rfl
      _ = mul (m + mul n m) k       := by rw [succ_mul]
      _ = mul m k + mul (mul n m) k := by rw [right_distrib]
      _ = mul m k + mul n (mul m k) := by rw [ih]
      _ = mul (succ n) (mul m k)    := by rw [succ_mul]

theorem one_mul {m : Nat} : mul 1 m = m := by
  calc
    _ = mul 1 m        := rfl
    _ = mul (succ 0) m := rfl
    _ = m + mul 0 m    := by rw [succ_mul]
    _ = m + 0          := by rw [zero_mul]
    _ = m              := by rw [Nat.add_zero]

def pred (n : Nat) : Nat :=
  match n with
  | 0 => 0
  | n+1 => n

theorem pred_succ {n : Nat} : pred (succ n) = n := by
  cases n
  case zero =>
    show pred (succ 0) = 0
    rfl
  case succ n =>
    show pred (succ (succ n)) = succ n
    rfl

def sub (n m : Nat) : Nat :=
  match n with
  | 0 => 0
  | n+1 => match m with
    | 0 => n+1
    | m+1 => sub n m

theorem zero_sub {n : Nat} : sub 0 n = 0 := rfl

theorem sub_zero {n : Nat} : sub n 0 = n := by
  cases n
  case zero =>
    show sub 0 0 = 0
    rfl
  case succ n =>
    show sub (succ n) 0 = succ n
    rfl

theorem sub_same {n : Nat} : sub n n = 0 := by
  induction n
  case zero =>
    show sub 0 0 = 0
    rfl
  case succ n ih =>
    have : sub n n = 0 := ih
    show sub (succ n) (succ n) = 0
    calc
      _ = sub (succ n) (succ n) := rfl
      _ = sub n n               := rfl
      _ = 0                     := by rw [ih]

def pow (n m : Nat) : Nat :=
  match m with
  | 0 => 1
  | m+1 => mul n (pow n m)

theorem pow_zero {n : Nat} : pow n 0 = 1 := rfl

theorem pow_succ {n m : Nat} : pow n (succ m) = mul n (pow n m) := rfl

theorem zero_pow {m : Nat} : pow 0 (succ m) = 0 := rfl

theorem pow_add {n m k : Nat} : pow n (m + k) = mul (pow n m) (pow n k) := by
  induction m
  case zero =>
    show pow n (0 + k) = mul (pow n 0) (pow n k)
    calc
      _ = pow n (0 + k)           := rfl
      _ = pow n k                 := by rw [Nat.zero_add]
      _ = mul 1 (pow n k)         := by rw [one_mul]
      _ = mul (pow n 0) (pow n k) := by rw [pow_zero]
  case succ m ih =>
    have : pow n (m + k) = mul (pow n m) (pow n k) := ih
    show pow n (succ m + k) = mul (pow n (succ m)) (pow n k)
    calc
      _ = pow n (succ m + k)              := rfl
      _ = pow n (succ (m + k))            := by rw [Nat.succ_add]
      _ = mul n (pow n (m + k))           := by rw [pow_succ]
      _ = mul n (mul (pow n m) (pow n k)) := by rw [ih]
      _ = mul (mul n (pow n m)) (pow n k) := by rw [mul_assoc]
      _ = mul (pow n (succ m)) (pow n k)  := by rw [pow_succ]

theorem pow_pow {n m k : Nat} : pow (pow n m) k = pow n (mul m k) := by
  induction k
  case zero =>
    show pow (pow n m) 0 = pow n (mul m 0)
    calc
      _ = pow (pow n m) 0 := rfl
      _ = 1               := by rw [pow_zero]
      _ = pow n 0         := by rw [pow_zero]
      _ = pow n (mul m 0) := by rw [mul_zero]
  case succ k ih =>
    have : pow (pow n m) k = pow n (mul m k) := ih
    show pow (pow n m) (succ k) = pow n (mul m (succ k))
    calc
      _ = pow (pow n m) (succ k)          := rfl
      _ = mul (pow n m) (pow (pow n m) k) := by rw [pow_succ]
      _ = mul (pow n m) (pow n (mul m k)) := by rw [ih]
      _ = pow n (m + mul m k)             := by rw [pow_add]
      _ = pow n (mul m (succ k))          := by rw [mul_succ]

end ex_1

namespace ex_2

def length (xs : List α) : Nat :=
  match xs with
  | [] => 0
  | x :: xs => 1 + length xs

def reverse_helper (xs : List α) (acc : List α) : List α :=
  match xs with
  | [] => acc
  | x :: xs => reverse_helper xs (x :: acc)

def reverse (xs : List α) : List α :=
  reverse_helper xs []

theorem length_nil : length ([] : List α) = 0 := rfl

theorem length_cons
    {x : α} {xs : List α} : length (x :: xs) = 1 + length xs := rfl

theorem reverse_nil : reverse ([] : List α) = [] := rfl

theorem reverse_helper_append
    {xs : List α} : ∀ ys, reverse_helper xs ys = reverse xs ++ ys := by
  induction xs
  case nil =>
    show ∀ ys, reverse_helper [] ys = reverse [] ++ ys
    intro ys
    calc
      _ = reverse_helper [] ys := rfl
      _ = ys := rfl
      _ = [] ++ ys := by rw [List.nil_append]
      _ = reverse [] ++ ys := by rw [reverse_nil]
  case cons x xs ih =>
    have : ∀ ys, reverse_helper xs ys = reverse xs ++ ys := ih
    show ∀ ys, reverse_helper (x :: xs) ys = reverse (x :: xs) ++ ys
    intro ys
    calc
      _ = reverse_helper (x :: xs) ys       := rfl
      _ = reverse_helper xs (x :: ys)       := rfl
      _ = reverse xs ++ x :: ys             := by rw [ih]
      _ = reverse xs ++ x :: ([] ++ ys)     := by rw [List.nil_append]
      _ = reverse xs ++ ((x :: []) ++ ys)   := by rw [List.cons_append]
      _ = (reverse xs ++ (x :: [])) ++ ys   := by rw [List.append_assoc]
      _ = reverse_helper xs (x :: []) ++ ys := by rw [ih]
      _ = reverse_helper (x :: xs) [] ++ ys := rfl
      _ = reverse (x :: xs) ++ ys           := rfl

theorem reverse_cons_append
    {x : α} {xs ys : List α}
    : reverse (x :: xs) ++ ys = reverse xs ++ x :: ys := by
  calc
    _ = reverse (x :: xs) ++ ys           := rfl
    _ = reverse_helper (x :: xs) [] ++ ys := rfl
    _ = reverse_helper xs (x :: []) ++ ys := rfl
    _ = (reverse xs ++ (x :: [])) ++ ys   := by rw [reverse_helper_append]
    _ = reverse xs ++ ((x :: []) ++ ys)   := by rw [List.append_assoc]
    _ = reverse xs ++ (x :: ([] ++ ys))   := by rw [List.cons_append]
    _ = reverse xs ++ (x :: ys)           := by rw [List.nil_append]

theorem reverse_singleton {x : α} : reverse [x] = [x] := by
  calc
    _ = reverse [x]             := rfl
    _ = reverse (x :: [])       := rfl
    _ = reverse (x :: []) ++ [] := by rw [List.append_nil]
    _ = reverse [] ++ (x :: []) := by rw [reverse_cons_append]
    _ = [] ++ (x :: [])         := by rw [reverse_nil]
    _ = x :: []                 := by rw [List.nil_append]
    _ = [x]                     := rfl

theorem length_append
    {xs ys : List α} : length (xs ++ ys) = length xs + length ys := by
  induction xs
  case nil =>
    show length ([] ++ ys) = length [] + length ys
    calc
      _ = length ([] ++ ys)     := rfl
      _ = length ys             := by rw [List.nil_append]
      _ = 0 + length ys         := by rw [Nat.zero_add]
      _ = length [] + length ys := by rw [length_nil]
  case cons x xs ih =>
    have : length (xs ++ ys) = length xs + length ys := ih
    show length (x :: xs ++ ys) = length (x :: xs) + length ys
    calc
      _ = length (x :: xs ++ ys)       := rfl
      _ = length (x :: (xs ++ ys))     := by rw [List.cons_append]
      _ = 1 + length (xs ++ ys)        := by rw [length_cons]
      _ = 1 + (length xs + length ys)  := by rw [ih]
      _ = (1 + length xs) + length ys  := by rw [Nat.add_assoc]
      _ = length (x :: xs) + length ys := by rw [length_cons]

theorem length_reverse {xs : List α} : length (reverse xs) = length xs := by
  induction xs
  case nil =>
    show length (reverse []) = length []
    calc
      _ = length (reverse []) := rfl
      _ = length [] := by rw [reverse_nil]
  case cons x xs ih =>
    have : length (reverse xs) = length xs := ih
    show length (reverse (x :: xs)) = length (x :: xs)
    calc
      _ = length (reverse (x :: xs))       := rfl
      _ = length (reverse (x :: xs) ++ []) := by rw [List.append_nil]
      _ = length (reverse xs ++ (x :: [])) := by rw [reverse_cons_append]
      _ = length (reverse xs) + length [x] := by rw [length_append]
      _ = length [x] + length (reverse xs) := by rw [Nat.add_comm]
      _ = length [x] + length xs           := by rw [ih]
      _ = 1 + length xs                    := rfl
      _ = length (x :: xs)                 := by rw [length_cons]

theorem reverse_append
    {xs ys : List α} : reverse (xs ++ ys) = reverse ys ++ reverse xs := by
  induction xs
  case nil =>
    show reverse ([] ++ ys) = reverse ys ++ reverse []
    calc
      _ = reverse ([] ++ ys)       := rfl
      _ = reverse ys               := by rw [List.nil_append]
      _ = reverse ys ++ []         := by rw [List.append_nil]
      _ = reverse ys ++ reverse [] := by rw [reverse_nil]
  case cons x xs ih =>
    have : reverse (xs ++ ys) = reverse ys ++ reverse xs := ih
    show reverse ((x :: xs) ++ ys) = reverse ys ++ reverse (x :: xs)
    calc
      _ = reverse ((x :: xs) ++ ys)               := rfl
      _ = reverse (x :: (xs ++ ys))               := by rw [List.cons_append]
      _ = reverse (x :: (xs ++ ys)) ++ []         := by rw [List.append_nil]
      _ = reverse (xs ++ ys) ++ (x :: [])         := by rw [reverse_cons_append]
      _ = (reverse ys ++ reverse xs) ++ (x :: []) := by rw [ih]
      _ = reverse ys ++ (reverse xs ++ (x :: [])) := by rw [List.append_assoc]
      _ = reverse ys ++ (reverse (x :: xs) ++ []) := by rw [reverse_cons_append]
      _ = reverse ys ++ reverse (x :: xs)         := by rw [List.append_nil]

theorem reverse_reverse {xs : List α} : reverse (reverse xs) = xs := by
  induction xs
  case nil =>
    show reverse (reverse []) = []
    calc
      _ = reverse (reverse []) := rfl
      _ = reverse []           := rfl
      _ = []                   := rfl
  case cons x xs ih =>
    have : reverse (reverse xs) = xs := ih
    show reverse (reverse (x :: xs)) = x :: xs
    calc
      _ = reverse (reverse (x :: xs))               := rfl
      _ = reverse (reverse (x :: xs) ++ [])         := by rw [List.append_nil]
      _ = reverse (reverse xs ++ (x :: []))         := by rw [reverse_cons_append]
      _ = reverse (x :: []) ++ reverse (reverse xs) := by rw [reverse_append]
      _ = reverse (x :: []) ++ xs                   := by rw [ih]
      _ = (x :: []) ++ xs                           := by rw [reverse_singleton]
      _ = x :: ([] ++ xs)                           := by rw [List.cons_append]
      _ = x :: xs                                   := by rw [List.nil_append]

end ex_2

namespace ex_3

inductive Term (V : Type u) where
| const (n : Nat)
| var (v : V)
| plus (s t : Term V) : Term V
| times (s t : Term V) : Term V

namespace Term

def eval {V : Type u} (varValue : V → Nat) (t : Term V) : Nat :=
  match t with
  | const n => n
  | var v => varValue v
  | plus s t => eval varValue s + eval varValue t
  | times s t => eval varValue s * eval varValue t

def simpleTerm : Term String := times (plus (var "x") (const 3)) (var "y")

def simpleVars (s : String) : Nat :=
  match s with
  | "x" => 1
  | "y" => 2
  | _ => 0

example : eval simpleVars simpleTerm = 8 := rfl

end Term

end ex_3

namespace ex_4

inductive BinOp where
| And | Or | Implies | Iff

inductive Formula (V : Type u) where
| const (b : Bool)
| var (v : V)
| not (p : Formula V)
| binOp (op : BinOp) (p q : Formula V)

open BinOp
open Formula

def and {V : Type u} (p q : Formula V) : Formula V := binOp And p q
def or {V : Type u} (p q : Formula V) : Formula V := binOp Or p q
def implies {V : Type u} (p q : Formula V) : Formula V := binOp Implies p q
def iff {V : Type u} (p q : Formula V) : Formula V := binOp Iff p q

def eval {V : Type u} (vars : V → Bool) (formula : Formula V) : Bool :=
  match formula with
  | const b => b
  | var v => vars v
  | Formula.not p => !(eval vars p)
  | binOp op p q =>
    let boolOp :=
      match op with
      | BinOp.And => (· && ·)
      | BinOp.Or => (· || ·)
      | BinOp.Implies => λ p q => p && !q
      | BinOp.Iff => (· == ·)
    boolOp (eval vars p) (eval vars q)

example : eval (λ _ : String => false) (const true) = true := rfl
example : eval (λ v => v == "x") (var "x") = true := rfl
example : eval (λ v => v == "x") (var "y") = false := rfl
example : eval (λ v => v == "x") (not (var "x")) = false := rfl

example
  : eval (λ v => v == "x" || v == "y") (and (var "x") (var "y")) = true
  := rfl

example
  : eval (λ v => v == "x" || v != "y") (and (var "x") (var "y")) = false
  := rfl

example
  : eval (λ v => v != "x" || v == "y") (and (var "x") (var "y")) = false
  := rfl

def node_count {V : Type u} (formula : Formula V) : Nat :=
  let children_node_count := match formula with
  | const _ => 0
  | var _ => 0
  | Formula.not p => node_count p
  | binOp _ p q => node_count p + node_count q
  1 + children_node_count

example : node_count (var "x") = 1 := rfl
example : node_count (or (const false) (var "y")) = 3 := rfl

def formula_vars {V : Type u} (formula : Formula V) : List V :=
  match formula with
  | const _ => []
  | var v => [v]
  | Formula.not p => formula_vars p
  | binOp _ p q => formula_vars p ++ formula_vars q

def and_assoc : Formula String :=
  let p := var "p"
  let q := var "q"
  let r := var "r"
  iff (and (and p q) r) (and p (and q r))

example : (formula_vars and_assoc).contains "p" = true := rfl
example : (formula_vars and_assoc).contains "q" = true := rfl
example : (formula_vars and_assoc).contains "r" = true := rfl
example : (formula_vars and_assoc).contains "s" = false := rfl
example : (formula_vars and_assoc).contains "t" = false := rfl

def substitute
    {V : Type u} [BEq V] (into : Formula V) (v : V) (formula : Formula V)
    : Formula V :=
  match into with
  | const c => const c
  | var w => if v == w then formula else var w
  | Formula.not p => not (substitute p v formula)
  | binOp op p q => binOp op (substitute p v formula) (substitute q v formula)

def lem : Formula String := or (var "p") (not (var "p"))
def qr : Formula String := and (var "q") (var "r")
example : substitute lem "p" qr = or qr (not qr) := rfl

end ex_4

end exercises


example (P Q : Prop) : Q → (P ∨ Q) :=
begin
intro q,
right,
exact q,
end


import RealsQuasiMorphisms.Basic
import Mathlib.Algebra.Order.Field.Defs
import RealsQuasiMorphisms.Algebra
import Mathlib.Algebra.Order.Ring.Cone

variable {G : Type _} [OrderedAddCommGroup G]

namespace AlmostHom

/-- An almost-homomorphism `f : G → ℤ` is non-negative if the image (under `f`) of `G ≥ 0` is bounded below. -/
protected def nonneg (f : AlmostHom G) : Prop := ∃ a : ℤ , ∀ x : G, x ≥ 0 → f x ≥ a
/-- An almost-homomorphism `f : G → ℤ` is non-positive if the image (under `f`) of `G ≥ 0` is bounded above (unused). -/
protected def nonpos (f : AlmostHom G) : Prop := ∃ b : ℤ , ∀ x : G, x ≥ 0 → f x ≤ b
/-- `f ≤ g` is equivalent to stating `g - f` is non-negative. -/
protected def le (f g : AlmostHom G) : Prop := AlmostHom.nonneg (g - f)

-- why exactly this is needed is well beyond me
private lemma add_reduces_to_fun (f g : AlmostHom G) : toFun (f + g) = toFun f + toFun g := by rfl
private lemma neg_reduces_to_fun (f : AlmostHom G) : toFun (-f) = - toFun f:= by rfl
private lemma sub_reduces_to_fun (f g : AlmostHom G) : toFun (f - g) = toFun f - toFun g := by rfl

/-- `AlmostHom.le` as defined  gives us a preorder on `AlmostHom G`. -/
instance : Preorder (AlmostHom G) where
  le := AlmostHom.le
  le_refl f := by
                simp only [AlmostHom.le, AlmostHom.nonneg, sub_self]
                use -1; intro x _
                show -1 ≤ 0; simp only [Left.neg_nonpos_iff]
  le_trans p q r:= by
                    intro hpq hqr
                    let ⟨a, hpq⟩ := hpq; let ⟨b, hqr⟩ := hqr
                    use a+b; intro x hx
                    simp only [sub_reduces_to_fun, Pi.sub_apply, ge_iff_le] at hpq hqr ⊢
                    let h := add_le_add (hpq x hx) (hqr x hx)
                    rw [sub_add_sub_cancel'] at h
                    apply h

/- Adding a bounded function to any other can only change the image of
any element by at most some bound. Thus any lower bound is preserved
up to a shift in the bound. -/
private lemma bounded_plus_nonneg_nonneg' (f : AlmostHom G)
        ⦃g : AlmostHom G⦄ (h : ∃ bound : ℕ, Bounded g bound)
    : f.nonneg → (f + g).nonneg := by
  intro hf
  let ⟨bound, hb⟩ := h
  rw [Bounded] at hb
  let ⟨a, ha⟩ := hf
  use a - bound; intro x hx
  have hb : -bound ≤ g.toFun x := by
    simp only [←Int.ofNat_le, Int.coe_natAbs, abs_le] at hb
    exact (hb x).left
  exact add_le_add (ha x hx) hb

/-- If `f` is a non-negative almost-homomorphism and `g` is bounded, then `f + g` is non-negative. -/
protected theorem bounded_plus_nonneg_nonneg {f : AlmostHom G} (g : boundedAlmostHoms G)
    : f.nonneg → (f + g).nonneg := by
  exact AlmostHom.bounded_plus_nonneg_nonneg' f g.property

/-- The almost-homomorphism 0 is non-negative. -/
protected lemma zero_nonneg : (0 : AlmostHom G).nonneg := by
  use -1; intro x _
  show -1 ≤ 0; simp only [Left.neg_nonpos_iff]

/-- If `f` and `g` are non-negative almost-homomorphisms then `f + g` is also non-negative. -/
protected lemma add_nonneg {f g : AlmostHom G} : f.nonneg → g.nonneg → (f + g).nonneg := by
  intro hf hg
  let ⟨a, ha⟩ := hf; let ⟨b, hb⟩ := hg
  use a + b; intro x hx
  exact add_le_add (ha x hx) (hb x hx)

-- this might exist somewhere already
private lemma neg_natAbs_le (a : ℤ) : -a.natAbs ≤ a := by
  simp only [←Int.ofNat_le, Int.coe_natAbs]
  exact neg_abs_le_self a

private lemma neg_le_natAbs (a : ℤ) : -a ≤ a.natAbs := by
  simp only [←Int.ofNat_le, Int.coe_natAbs]
  exact neg_le_abs_self a

-- this really need not be split up like this
private lemma nonneg_and_neg_nonneg_bounded' {f : AlmostHom G}
    : f.nonneg → (-f).nonneg → (∃ bound : ℕ, Bounded f bound) := by
  intro hf hf'
  let ⟨a, ha⟩ := hf; let ⟨b, hb⟩ := hf'
  let ⟨bound, hf⟩ := f.almostAdditive
  let y := f 0
  let nb := a.natAbs + b.natAbs + bound + y.natAbs
  use nb
  rw [Bounded]
  intro x
  by_cases hx:(x ≥ 0)
  · have h' : f x ≤ -b := by
      rw [le_neg]
      exact hb x hx
    let h'' := ha x hx
    simp only [←Int.ofNat_le, Int.coe_natAbs, abs_le]
    apply And.intro
    · have hga : a.natAbs ≤ nb := by
        simp only [add_assoc, le_add_iff_nonneg_right, zero_le]
      have hga : -nb ≤ -(↑a.natAbs : ℤ) := by
        simp only [←Int.ofNat_le] at hga
        simp only [neg_le_neg, hga]
      linarith [neg_natAbs_le a]
    · have hgb : Int.natAbs b ≤ Int.natAbs b + Int.natAbs a + bound + Int.natAbs (toFun f 0) := by
        simp only [add_assoc, le_add_iff_nonneg_right, zero_le]
      simp only [←Int.ofNat_le] at hgb
      have nbe : ↑(Int.natAbs b + Int.natAbs a + bound + Int.natAbs (toFun f 0)) = (↑nb : ℤ)  := by
        simp only [add_comm, Nat.cast_add, Int.coe_natAbs]
      linarith [neg_natAbs_le b]
  · sorry

/-- If `f` is an almost-homomorphism such that both `f` and `-f` are non-negative, then `f` is bounded. -/
protected lemma nonneg_and_neg_nonneg_bounded {f : AlmostHom G}
    : f.nonneg → (-f).nonneg → f ∈ boundedAlmostHoms G := by
  intro hf hf'
  let ⟨bound, hb⟩ := nonneg_and_neg_nonneg_bounded' (f := f) hf hf'
  use bound
  exact hb

/- This is a somewhat non-trivial result and not proven yet. -/
/-- If `f` is an almost-homomorphism, then at least one of `f` and `-f` must be non-negative. -/
protected lemma nonneg_total (f : AlmostHom G) : f.nonneg ∨ (-f).nonneg := by
  sorry

end AlmostHom

namespace QuasiHom

/-- A quasi-morphism `f` is non-negative if any representative almost-homomorphism is non-negative.

This is well-defined by `bounded_plus_nonneg_nonneg`. -/
protected def nonneg (f : QuasiHom G) : Prop := Quot.liftOn f AlmostHom.nonneg (λ f g h ↦ by
  rw [QuotientAddGroup.leftRel_apply] at h
  let x : boundedAlmostHoms G := ⟨-f + g, h⟩
  have h₁ : g = f + x := by
    simp only [add_neg_cancel_left]
  have h₂ : f = g + -x := by
    simp only [neg_add_rev, neg_neg, add_neg_cancel_left]
  apply propext
  apply Iff.intro
  · intro hf
    rw [h₁]
    apply AlmostHom.bounded_plus_nonneg_nonneg x hf
  · intro hg
    rw [h₂]
    apply AlmostHom.bounded_plus_nonneg_nonneg (-x) hg
  )

/-- The quasi-morphism 0 is non-negative. -/
protected lemma zero_nonneg : QuasiHom.nonneg (0 : QuasiHom G) := by
  apply AlmostHom.zero_nonneg

/-- The sum of two non-negative quasi-morphisms is non-negative. -/
protected lemma add_nonneg {f g : QuasiHom G} : f.nonneg → g.nonneg → (f + g).nonneg := by
  apply QuotientAddGroup.induction_on f
  apply QuotientAddGroup.induction_on g
  intro f g hf hg
  apply AlmostHom.add_nonneg hf hg

/-- If `f` and `-f` are both non-negative quasi-morphisms, then `f` must be `0`. -/
protected lemma nonneg_antisymm {f : QuasiHom G} : f.nonneg → (-f).nonneg → f = 0 := by
  apply QuotientAddGroup.induction_on f
  intro f hf hf'
  rw [QuotientAddGroup.eq_zero_iff]
  exact AlmostHom.nonneg_and_neg_nonneg_bounded hf hf'

/- This depends on the corresponding result for almost-homomorphisms, which is not yet proved. -/
/-- If `f` is a quasi-morphism, then at least one of `f` and `-f` must be non-negative. -/
protected lemma nonneg_total (f : QuasiHom G) : f.nonneg ∨ (-f).nonneg := by
  apply QuotientAddGroup.induction_on f
  intro f
  exact AlmostHom.nonneg_total f

/- The lemma used for `nonneg_total` is not yet proved. -/
/-- The set of non-negative quasi-morphisms, as a 'total positive cone' (the
convenient way to construct ordered additive groups). -/
noncomputable def GP : AddCommGroup.TotalPositiveCone (QuasiHom G) where
  nonneg := QuasiHom.nonneg
  zero_nonneg := QuasiHom.zero_nonneg
  add_nonneg := QuasiHom.add_nonneg
  nonneg_antisymm := QuasiHom.nonneg_antisymm
  nonneg_total := by simp only [QuasiHom.nonneg_total, forall_const]
  nonnegDecidable := (Classical.dec ·.nonneg)

-- instance : LinearOrder (QuasiHom G) where
--   le := sorry
--   le_refl := sorry
--   le_trans := sorry
--   le_antisymm := sorry
--   le_total := sorry
--   decidable_le := sorry -- how to even do this??
--   decidable_eq := sorry -- again, HOW to do this??

-- instance : LinearOrderedField (QuasiHom ℤ) where
--   add_le_add_left := sorry
--   zero_le_one := sorry
--   mul_pos := sorry
--   mul_comm := sorry
--   mul_inv_cancel := sorry
--   inv_zero := sorry
--   le_total := sorry -- this one is already proved in LinearOrder right??
--   decidable_le := sorry -- this one is already proved in LinearOrder right??

end QuasiHom


import .arith_expr

open nat_var
open nat_expr

-- variables

def X := Δ 0
def Y := Δ 1
def Z := Δ 2
def W := Δ 0  -- W and X are the same variable

-- an interpretation

def init : nat_var → nat
| v := nat.zero

-- test interpretation override

example : init X = 0 := rfl
example : init Y = 0 := rfl
example : init Z = 0 := rfl

-- "assignment operation"
-- {X = 0, Y = 0, Z = 0}
def st_1 := override init X 2
-- {X = 2, Y = 0, Z = 0}

example : st_1 X = 2 := rfl
example : st_1 Y = 0 := rfl
example : st_1 Z = 0 := rfl

-- "assignment operation"
-- {X = 2, Y = 0, Z = 0}
def st_2 := override (st_1) Z 5
-- {X = 2, Y = 0, Z = 5}

example : st_2 X = 2 := rfl
example : st_2 Y = 0 := rfl
example : st_2 Z = 5 := rfl

-- example expressions

def e1 := [0] -- overloaded []: literal
def e2 := e1 + e1
def e3 := e2++
def e4 := [X] + [Y] + [Z]   -- []: "var" expression

-- test evaluation

example : eval e3 init = 1 := rfl
example : eval e4 st_2 = 7 := rfl


import category_theory.category.Quiv
import category_theory.over
import algebra.category.CommRing
import mutation
/-!
# Cluster algebras

This file defines the upper cluster algebra and the cluter algebras associated with a seed.

Let `N` be a ℤ-module equipped with a skew-symmetric form. A finite multiset
on `N` is called a seed in `N`. Let `K` be a field of fractions of the group algeba of
the dual module of `N`. For each seed `s`, we define `upper_cluster_algebra s` and
`cluster_algebra s` as a subring of `K`.

# Main definitions

* `mutation_paths`: a category whose objects are the seeds in `N` and morphisms are the formal
  compositions of seed mutatons.
* `mutation_functor : paths (multiset N) ⥤ CommRingᵒᵖ`: a functor that maps seed mutations to
  mutations.
* `upper_cluster_algebra s`: the subring of `K` consisting of elements that are always
  Laurent polynomials when the image of `mutation_functor` of any compositions of seed mutations
  starting from `s` is applied.
* `cluster_monomials s`: the set of elements in `K` that become monomials when
  when the image of `mutation_functor` of some compositions of seed mutations starting from `s`
  is applied.
* `cluster_algebra s`: the subring of `K` generated by `cluster_monomials s`.

## Future work

Prove that `cluster_monomials s` is contained in `upper_cluster_algebra s`. This is
called the Laurent phenomenon of cluster algebras.

-/

noncomputable theory

open category_theory opposite

local attribute [class] is_integral_domain

section

variables
(N : Type*) [add_comm_group N] [skew_symmetric_form N] [is_integral_domain (ring_of_function N)]
(K : Type*) [field K] [algebra (ring_of_function N) K] [is_fraction_ring (ring_of_function N) K]

instance : algebra (ring_of_function N) ↥(CommRing.of K) := by {dsimp, apply_instance}
instance : is_fraction_ring (ring_of_function N) ↥(CommRing.of K) := by {dsimp, apply_instance}
instance : field ↥(CommRing.of K) := by {dsimp, apply_instance}

def laurent_subring : subring K := (algebra_map (ring_of_function N) K).range

private def z
{N : Type*} [add_comm_group N] [skew_symmetric_form N]
{K : Type*} [field K] [algebra (ring_of_function N) K]
[is_fraction_ring (ring_of_function N) K] (m : module.dual ℤ N) :=
algebra_map (ring_of_function N) K (finsupp.single m 1)

def seeds : quiver (multiset N) :=
{ hom := seed_mutation }

local attribute [instance] seeds

def mutation_paths : category (paths (multiset N)) :=
(paths.category_paths (multiset N))

local attribute [instance] mutation_paths

def mutation_prefunctor : prefunctor (multiset N) CommRingᵒᵖ :=
{ obj := λ s,  op (CommRing.of K),
  map := λ s s' μ, quiver.hom.op (ring_equiv.to_ring_hom (μ.field_equiv K))}

@[simp] lemma mutation_prefunctor.obj_eq_ring (s : multiset N) :
(mutation_prefunctor N K).obj s = op (CommRing.of K) := by refl

def mutation_functor : paths (multiset N) ⥤ CommRingᵒᵖ :=
{ obj := λ s, (mutation_prefunctor N K).obj s,
  map := λ s s' γ, compose_path ((mutation_prefunctor N K).map_path γ),
  map_id' := λ γ, by refl,
  map_comp' := by {rintros, simp} }

@[simp] lemma mutation_functor.obj_eq_ring (γ : paths (multiset N)) :
(mutation_functor N K).obj γ = op (CommRing.of K) := by refl

end

section
variables
{N : Type*} [add_comm_group N] [skew_symmetric_form N] [is_integral_domain (ring_of_function N)]
{K : Type*} [field K] [algebra (ring_of_function N) K] [is_fraction_ring (ring_of_function N) K]

local attribute [instance] seeds
local attribute [instance] mutation_paths

variables (s : multiset N)
include s

def field_hom_of_under_mutation_path (γ : @under _ (mutation_paths N) s) : K →+* K :=
let g := quiver.hom.unop ((under.post (mutation_functor N K)).obj γ).hom in by simpa using g

def upper_cluster_algebra := ⨅ γ, (laurent_subring N K).map (field_hom_of_under_mutation_path s γ)

def vector.is_monomial_at := { m : module.dual ℤ N | ∀ v ∈ s, m v ≥ 0 }

def is_monomial_at := { f : K | ∃ m : module.dual ℤ N, f = z m ∧ vector.is_monomial_at s m }

def cluster_monomials : set K :=
⋃ γ, field_hom_of_under_mutation_path s γ '' is_monomial_at (γ.right)

def cluster_algebra : subring K := subring.closure (cluster_monomials s)

def laurent_phenomenon : Prop := (cluster_algebra s : subring K) ≤ upper_cluster_algebra s

end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.braided
import Mathlib.category_theory.functor_category
import Mathlib.category_theory.const
import Mathlib.PostPort

universes u₁ u₂ v₁ v₂

namespace Mathlib

/-!
# Monoidal structure on `C ⥤ D` when `D` is monoidal.

When `C` is any category, and `D` is a monoidal category,
there is a natural "pointwise" monoidal structure on `C ⥤ D`.

The initial intended application is tensor product of presheaves.
-/

namespace category_theory.monoidal

namespace functor_category

/--
(An auxiliary definition for `functor_category_monoidal`.)
Tensor product of functors `C ⥤ D`, when `D` is monoidal.
 -/
def tensor_obj {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] (F : C ⥤ D) (G : C ⥤ D) : C ⥤ D :=
  functor.mk (fun (X : C) => functor.obj F X ⊗ functor.obj G X)
    fun (X Y : C) (f : X ⟶ Y) => functor.map F f ⊗ functor.map G f

/--
(An auxiliary definition for `functor_category_monoidal`.)
Tensor product of natural transformations into `D`, when `D` is monoidal.
-/
def tensor_hom {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {F : C ⥤ D} {G : C ⥤ D} {F' : C ⥤ D} {G' : C ⥤ D} (α : F ⟶ G) (β : F' ⟶ G') : tensor_obj F F' ⟶ tensor_obj G G' :=
  nat_trans.mk fun (X : C) => nat_trans.app α X ⊗ nat_trans.app β X

end functor_category

/--
When `C` is any category, and `D` is a monoidal category,
the functor category `C ⥤ D` has a natural pointwise monoidal structure,
where `(F ⊗ G).obj X = F.obj X ⊗ G.obj X`.
-/
protected instance functor_category_monoidal {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] : monoidal_category (C ⥤ D) :=
  monoidal_category.mk (fun (F G : C ⥤ D) => functor_category.tensor_obj F G)
    (fun (F G F' G' : C ⥤ D) (α : F ⟶ G) (β : F' ⟶ G') => functor_category.tensor_hom α β)
    (functor.obj (functor.const C) 𝟙_) (fun (F G H : C ⥤ D) => nat_iso.of_components (fun (X : C) => α_) sorry)
    (fun (F : C ⥤ D) => nat_iso.of_components (fun (X : C) => λ_) sorry)
    fun (F : C ⥤ D) => nat_iso.of_components (fun (X : C) => ρ_) sorry

@[simp] theorem tensor_unit_obj {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {X : C} : functor.obj 𝟙_ X = 𝟙_ :=
  rfl

@[simp] theorem tensor_unit_map {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {X : C} {Y : C} {f : X ⟶ Y} : functor.map 𝟙_ f = 𝟙 :=
  rfl

@[simp] theorem tensor_obj_obj {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {F : C ⥤ D} {G : C ⥤ D} {X : C} : functor.obj (F ⊗ G) X = functor.obj F X ⊗ functor.obj G X :=
  rfl

@[simp] theorem tensor_obj_map {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {F : C ⥤ D} {G : C ⥤ D} {X : C} {Y : C} {f : X ⟶ Y} : functor.map (F ⊗ G) f = functor.map F f ⊗ functor.map G f :=
  rfl

@[simp] theorem tensor_hom_app {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {F : C ⥤ D} {G : C ⥤ D} {F' : C ⥤ D} {G' : C ⥤ D} {α : F ⟶ G} {β : F' ⟶ G'} {X : C} : nat_trans.app (α ⊗ β) X = nat_trans.app α X ⊗ nat_trans.app β X :=
  rfl

@[simp] theorem left_unitor_hom_app {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {F : C ⥤ D} {X : C} : nat_trans.app (iso.hom λ_) X = iso.hom λ_ :=
  rfl

@[simp] theorem left_unitor_inv_app {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {F : C ⥤ D} {X : C} : nat_trans.app (iso.inv λ_) X = iso.inv λ_ :=
  rfl

@[simp] theorem right_unitor_hom_app {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {F : C ⥤ D} {X : C} : nat_trans.app (iso.hom ρ_) X = iso.hom ρ_ :=
  rfl

@[simp] theorem right_unitor_inv_app {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {F : C ⥤ D} {X : C} : nat_trans.app (iso.inv ρ_) X = iso.inv ρ_ :=
  rfl

@[simp] theorem associator_hom_app {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {F : C ⥤ D} {G : C ⥤ D} {H : C ⥤ D} {X : C} : nat_trans.app (iso.hom α_) X = iso.hom α_ :=
  rfl

@[simp] theorem associator_inv_app {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] {F : C ⥤ D} {G : C ⥤ D} {H : C ⥤ D} {X : C} : nat_trans.app (iso.inv α_) X = iso.inv α_ :=
  rfl

/--
When `C` is any category, and `D` is a braided monoidal category,
the natural pointwise monoidal structure on the functor category `C ⥤ D`
is also braided.
-/
protected instance functor_category_braided {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] [braided_category D] : braided_category (C ⥤ D) :=
  braided_category.mk fun (F G : C ⥤ D) => nat_iso.of_components (fun (X : C) => β_) sorry

/--
When `C` is any category, and `D` is a symmetric monoidal category,
the natural pointwise monoidal structure on the functor category `C ⥤ D`
is also symmetric.
-/
protected instance functor_category_symmetric {C : Type u₁} [category C] {D : Type u₂} [category D] [monoidal_category D] [symmetric_category D] : symmetric_category (C ⥤ D) :=
  symmetric_category.mk


import for_mathlib.algebra.homology.mapping_cone
import algebra.homology.additive
import for_mathlib.category_theory.triangulated.pretriangulated_misc
import for_mathlib.category_theory.triangulated.shift_triangle
import for_mathlib.category_theory.preadditive.misc

open category_theory category_theory.pretriangulated category_theory.triangulated
  category_theory.limits category_theory.category

noncomputable theory

section

variables {C ι : Type*} [category C] [preadditive C] {c : complex_shape ι}

def homotopy_category.lift {K L : homological_complex C c}
  (φ : (homotopy_category.quotient _ _).obj K ⟶ (homotopy_category.quotient _ _).obj L) :
  K ⟶ L := quot.out φ

instance [has_zero_object C] : has_zero_object (homotopy_category C c) :=
by { change has_zero_object (category_theory.quotient _), apply_instance, }

instance : preadditive (homotopy_category C c) :=
begin
  apply quotient.preadditive,
  { rintros X Y f₁ g₁ f₂ g₂ ⟨h₁⟩ ⟨h₂⟩,
    refine ⟨homotopy.add h₁ h₂⟩, },
  { rintros X Y f g ⟨h⟩,
    exact ⟨homotopy.equiv_sub_zero.symm
      (by simpa only [neg_sub_neg] using homotopy.equiv_sub_zero h.symm)⟩, },
end

instance homotopy_category.quotient_additive :
  (homotopy_category.quotient C c).additive := quotient.functor_additive _ _ _

lemma is_zero_of_homotopy_id_zero [has_zero_object C] (X : homological_complex C c)
  (h : homotopy (𝟙 X) 0) :
  is_zero ((homotopy_category.quotient C c).obj X) :=
begin
  have eq := homotopy_category.eq_of_homotopy _ _ h,
  simp only [category_theory.functor.map_id] at eq,
  simp only [is_zero.iff_id_eq_zero, eq, functor.map_zero],
end

end

variables {C : Type*} [category C] [preadditive C] [has_zero_object C]
  [has_binary_biproducts C]
  {K L : cochain_complex C ℤ} (φ : K ⟶ L)

namespace cochain_complex

@[simps mor₁ mor₂ mor₃]
def mapping_cone.triangle : triangle (cochain_complex C ℤ) :=
triangle.mk φ (mapping_cone.inr φ) (mapping_cone.δ φ)

section
variables {K₁ K₂ L₁ L₂ : cochain_complex C ℤ}
  [∀ p, has_binary_biproduct (K₁.X (p+1-(0 : ℤ))) (L₁.X p)]
  [∀ p, has_binary_biproduct (K₂.X (p+1-(0 : ℤ))) (L₂.X p)]
  (f₁ : K₁ ⟶ L₁) (f₂ : K₂ ⟶ L₂) (τ₁ : K₁ ⟶ K₂) (τ₂ : L₁ ⟶ L₂) (comm : f₁ ≫ τ₂ = τ₁ ≫ f₂)

@[simps]
def mapping_cone.triangle_map : mapping_cone.triangle f₁ ⟶ mapping_cone.triangle f₂ :=
{ hom₁ := τ₁,
  hom₂ := τ₂,
  hom₃ := mapping_cone.map _ _ _ _ comm,
  comm₁' := comm,
  comm₂' := mapping_cone.inr_comp_map _ _ _ _ comm,
  comm₃' := (mapping_cone.map_comp_δ _ _ _ _ comm).symm, }

@[simps]
def mapping_cone.triangle_map_iso {D : Type*} [category D] [preadditive D] [has_zero_object D]
  [has_binary_biproducts D]
  (Φ : C ⥤ D) [Φ.additive]:
  (functor.map_triangle (Φ.map_homological_complex (complex_shape.up ℤ))).obj
    (mapping_cone.triangle φ) ≅ mapping_cone.triangle ((Φ.map_homological_complex _).map φ) :=
begin
  refine triangle.mk_iso _ _ (iso.refl _) (iso.refl _) (mapping_cone.map_iso φ Φ) _ _ _,
  { tidy, },
  { ext n,
    rw mapping_cone.to_ext_iff _ _ (n+1) rfl,
    dsimp,
    simp only [assoc, mapping_cone.lift_fst_f, hom_complex.cocycle.map_coe,
      hom_complex.cochain.map_v, id_comp, mapping_cone.inr_fst,
      mapping_cone.lift_snd_f, mapping_cone.inr_snd, ← Φ.map_comp, Φ.map_zero, Φ.map_id],
    tauto, },
  { ext n,
    dsimp [mapping_cone.δ, mapping_cone.triangle],
    simp only [assoc, hom_complex.cochain.right_shift_v _ 1 0
        (zero_add 1).symm n n (add_zero n).symm _ rfl,
      shift_functor_obj_X_iso, hom_complex.cochain.neg_v, homological_complex.X_iso_of_eq_refl,
      preadditive.neg_comp, functor.map_neg, functor.map_comp, assoc, preadditive.comp_neg,
      mapping_cone.lift_fst_f_assoc, hom_complex.cocycle.map_coe,
      hom_complex.cochain.map_v, neg_inj],
    dsimp [iso.refl],
    erw [Φ.map_id, id_comp, comp_id, comp_id], },
end

end

end cochain_complex

open cochain_complex

namespace homotopy_category

def mapping_cone_triangle' : triangle (homotopy_category C (complex_shape.up ℤ)) :=
triangle.mk ((homotopy_category.quotient _ _).map φ) (mapping_cone.ι' φ) (mapping_cone.δ' φ)

variable (C)

def distinguished_triangles : set (triangle (homotopy_category C (complex_shape.up ℤ))) :=
λ T, ∃ (K L : cochain_complex C ℤ) (φ : K ⟶ L),
  nonempty (T ≅ mapping_cone_triangle' φ)

variable {C}

lemma mapping_cone_triangle'_distinguished :
  mapping_cone_triangle' φ ∈ distinguished_triangles C :=
⟨_, _, φ, nonempty.intro (iso.refl _)⟩

instance shift_functor_additive (n : ℤ) :
  (category_theory.shift_functor (homotopy_category C (complex_shape.up ℤ)) n).additive := { }

lemma isomorphic_distinguished
  (T₁ : triangle (homotopy_category C (complex_shape.up ℤ)))
  (h₁ : T₁ ∈ distinguished_triangles C)
  (T₂ : triangle (homotopy_category C (complex_shape.up ℤ)))
  (e : T₂ ≅ T₁) : T₂ ∈ distinguished_triangles C :=
begin
  obtain ⟨K, L, φ, ⟨e'⟩⟩ := h₁,
  exact ⟨K, L, φ, ⟨e ≪≫ e'⟩⟩,
end

lemma contractible_distinguished
  (X : homotopy_category C (complex_shape.up ℤ)) :
  contractible_triangle X ∈ distinguished_triangles C :=
begin
  cases X,
  refine ⟨_, _, 𝟙 X, ⟨_⟩⟩,
  have h : is_zero ((homotopy_category.quotient _ _).obj (mapping_cone (𝟙 X))),
  { refine is_zero_of_homotopy_id_zero _ _,
    exact mapping_cone.desc_homotopy _ _ _ 0 (mapping_cone.inl (𝟙 X)) (by simp) (by simp), },
  exact triangle.mk_iso _ _ (iso.refl _) (iso.refl _) (is_zero.iso_zero h).symm
    (by tidy) (is_zero.eq_of_tgt h _ _) (by simp only [is_zero.eq_of_src h
      ((mapping_cone_triangle' (𝟙 X)).mor₃) 0, contractible_triangle_mor₃, zero_comp, comp_zero]),
end

lemma distinguished_cocone_triangle
  (X Y : homotopy_category C (complex_shape.up ℤ)) (f : X ⟶ Y) :
  ∃ (Z : homotopy_category C (complex_shape.up ℤ)) (g : Y ⟶ Z)
    (h : Z ⟶ X⟦(1 : ℤ)⟧), triangle.mk f g h ∈ distinguished_triangles C :=
begin
  cases X,
  cases Y,
  obtain ⟨φ, rfl⟩ := quotient.functor_map_surjective _ _ f,
  exact ⟨_ ,_ ,_ , mapping_cone_triangle'_distinguished φ⟩,
end

open cochain_complex.hom_complex

lemma complete_distinguished_triangle_morphism'
  {K₁ L₁ K₂ L₂ : cochain_complex C ℤ} (φ₁ : K₁ ⟶ L₁) (φ₂ : K₂ ⟶ L₂)
  (a : K₁ ⟶ K₂) (b : L₁ ⟶ L₂) (hab : homotopy (φ₁ ≫ b) (a ≫ φ₂)) :
  ∃ (c : mapping_cone φ₁ ⟶ mapping_cone φ₂),
    nonempty (homotopy (mapping_cone.inr φ₁ ≫ c) (b ≫ mapping_cone.inr φ₂)) ∧
      nonempty (homotopy (mapping_cone.δ φ₁ ≫ a⟦1⟧') (c ≫ mapping_cone.δ φ₂)) :=
begin
  obtain ⟨z, hz⟩ := (equiv_homotopy _ _) hab, clear hab,
  refine ⟨_, _, _⟩,
  refine mapping_cone.desc _
    (z.comp (cochain.of_hom (mapping_cone.inr φ₂)) (add_zero _).symm +
      (cochain.of_hom a).comp (mapping_cone.inl φ₂) (zero_add _).symm)
    (b ≫ mapping_cone.inr φ₂) _,
  { simp only [δ_comp_of_second_is_zero_cochain _ _ _ (neg_add_self 1),
      cocycle.δ_cochain_of_hom, cochain.comp_zero, zero_add, ← assoc,
      cochain.of_hom_comp (φ₁ ≫ b), hz, cochain.add_comp, δ_add, ← cochain.of_hom_comp],
    simp only [add_zero, add_left_neg, δ_comp_of_first_is_zero_cochain, mapping_cone.δ_inl,
      cochain.of_hom_comp, cocycle.δ_cochain_of_hom, cochain.zero_comp, smul_zero, assoc], },
  { exact nonempty.intro (homotopy.of_eq (by simp)), },
  { refine nonempty.intro (homotopy.of_eq ((cocycle.equiv_hom _ _).injective _)),
    ext1,
    simp only [mapping_cone.δ, cochain.of_hom_comp, cocycle.equiv_hom_apply, cocycle.of_hom_coe,
      cocycle.cochain_of_hom_hom_of_eq_coe, cocycle.right_shift_coe,
      mapping_cone.δ_as_cocycle_coe],
    ext1,
    simp only [cochain.comp_zero_cochain, cochain.of_hom_v,
      cochain.right_shift_v _ 1 0 (zero_add 1).symm p p (add_zero p).symm _ rfl,
      shift_functor_obj_X_iso, assoc, cochain.neg_v,
      homological_complex.X_iso_of_eq_refl, preadditive.neg_comp, preadditive.comp_neg, neg_inj],
    dsimp [iso.refl],
    simp only [comp_id, id_comp, mapping_cone.from_ext_iff _ _ _ rfl],
    split,
    { simp only [zero_add, assoc, mapping_cone.inl_desc_v_assoc, cochain.add_v,
        cochain.comp_zero_cochain, cochain.of_hom_v, cochain.zero_cochain_comp,
        preadditive.add_comp, mapping_cone.inr_fst, comp_zero, mapping_cone.inl_fst, comp_id,
        mapping_cone.inl_fst_assoc], },
    { simp only [mapping_cone.inr_fst_assoc, mapping_cone.inr_fst, zero_comp, comp_zero,
        assoc, mapping_cone.inr_desc_f_assoc, homological_complex.comp_f], }, },
end

lemma complete_distinguished_triangle_morphism
  (T₁ T₂ : triangle (homotopy_category C (complex_shape.up ℤ)))
  (h₁ : T₁ ∈ distinguished_triangles C) (h₂ : T₂ ∈ distinguished_triangles C)
  (a : T₁.obj₁ ⟶ T₂.obj₁) (b : T₁.obj₂ ⟶ T₂.obj₂)
  (comm₁ : T₁.mor₁ ≫ b = a ≫ T₂.mor₁) :
  ∃ (c : T₁.obj₃ ⟶ T₂.obj₃), T₁.mor₂ ≫ c = b ≫ T₂.mor₂ ∧
    T₁.mor₃ ≫ a⟦(1 : ℤ)⟧' = c ≫ T₂.mor₃ :=
begin
  obtain ⟨K₁, L₁, φ₁, ⟨e₁⟩⟩ := h₁,
  obtain ⟨K₂, L₂, φ₂, ⟨e₂⟩⟩ := h₂,
  obtain ⟨c, ⟨h₁⟩, ⟨h₂⟩⟩ := complete_distinguished_triangle_morphism' φ₁ φ₂
    (quot.out (e₁.inv.hom₁ ≫ a ≫ e₂.hom.hom₁)) (quot.out (e₁.inv.hom₂ ≫ b ≫ e₂.hom.hom₂))
    (homotopy_of_eq _ _ begin
      simp only [functor.map_comp, quotient_map_out, category.assoc],
      erw [reassoc_of e₁.inv.comm₁, reassoc_of comm₁, e₂.hom.comm₁],
      refl,
    end),
  replace h₁ := eq_of_homotopy _ _ h₁,
  replace h₂ := eq_of_homotopy _ _ h₂,
  refine ⟨e₁.hom.hom₃ ≫ (homotopy_category.quotient _ _).map c ≫ e₂.inv.hom₃, _, _⟩,
  { simp only [functor.map_comp, quotient_map_out, category.assoc] at h₁,
    erw [reassoc_of e₁.hom.comm₂, reassoc_of h₁, e₂.inv.comm₂],
    simp only [triangle.hom_inv_id_hom₂_assoc], },
  { erw [functor.map_comp, quotient_map_shift] at h₂,
    simp only [quotient_map_out, functor.map_comp] at h₂,
    simp only [category.assoc, ← e₂.inv.comm₃],
    erw [← reassoc_of h₂, ← reassoc_of e₁.hom.comm₃],
    simp only [← functor.map_comp, triangle.hom_inv_id_hom₁, category.comp_id,
      triangle.hom_inv_id_hom₁_assoc], },
end

@[simps]
def rotate_distinguished_triangle_homotopy_equiv {K L : cochain_complex C ℤ} (φ : K ⟶ L) :
  homotopy_equiv (K⟦(1 : ℤ)⟧) (mapping_cone (mapping_cone.inr φ)) :=
{ hom := mapping_cone.lift _
    (-cocycle.left_shift (cocycle.of_hom φ) 1 1 (zero_add 1).symm)
    (-(mapping_cone.inl φ).left_shift 1 0 (neg_add_self 1).symm)
    begin
      simp only [δ_neg, mapping_cone.δ_inl, cochain.δ_left_shift
        (mapping_cone.inl φ) 1 _ 0 _ (neg_add_self 1).symm (zero_add 1).symm,
        ε_1, neg_smul, neg_neg, one_smul],
      ext1 p q hpq,
      simp only [cochain.add_v,
        cochain.left_shift_v _ 1 1 (zero_add 1).symm p _ hpq _ hpq,
        cochain.comp_zero_cochain, shift_functor_obj_X_iso, add_zero,
        mul_one, sub_self, mul_zero, euclidean_domain.zero_div, ε_1, neg_smul,
        homological_complex.X_iso_of_eq_refl, cochain.of_hom_comp, cochain.of_hom_v,
        one_zsmul, add_subgroup.coe_neg, cocycle.left_shift_coe, cocycle.of_hom_coe,
        cochain.neg_v, preadditive.neg_comp, cochain.zero_v, neg_neg, assoc,
        neg_add_self],
    end,
  inv := mapping_cone.desc _ 0 (mapping_cone.δ φ)
    (by simp only [δ_zero, mapping_cone.inr_δ, cochain.of_hom_zero]),
  homotopy_hom_inv_id := homotopy.of_eq begin
    ext n : 2,
    simp only [homological_complex.comp_f, homological_complex.id_f,
      mapping_cone.lift_desc_f _ _ _ _ _ _ _ _ _ rfl,
      mapping_cone.δ, mapping_cone.δ_as_cocycle, zero_add, add_subgroup.coe_neg,
      cochain.neg_v, cochain.zero_v, preadditive.neg_comp, comp_zero,
      cocycle.hom_of_f, cocycle.right_shift_coe,
      cochain.left_shift_v _ _ _ (neg_add_self 1).symm n n (by linarith) _ rfl,
      cochain.right_shift_v _ _ _ (zero_add 1).symm n n (by linarith) _ rfl,
      zero_add, mul_zero, sub_self, euclidean_domain.zero_div, ε_0, one_zsmul,
      preadditive.comp_neg, assoc, mapping_cone.inl_fst_assoc, iso.hom_inv_id, neg_neg],
  end,
  homotopy_inv_hom_id := (equiv_homotopy _ _).symm begin
    refine ⟨-(mapping_cone.snd (mapping_cone.inr φ)).comp ((mapping_cone.snd φ).comp
      (mapping_cone.inl (mapping_cone.inr φ)) (zero_add (-1)).symm) (zero_add (-1)).symm, _⟩,
    rw mapping_cone.cochain_ext _ _ (neg_add_self 1).symm,
    split,
    { simp only [cochain.of_hom_comp, ← cochain.comp_assoc_of_second_is_zero_cochain,
        mapping_cone.inl_desc, cochain.zero_comp,
        δ_comp_of_first_is_zero_cochain _ _ _ (neg_add_self 1),
        mapping_cone.δ_inl, cochain.comp_add, ← cochain.comp_assoc_of_third_is_zero_cochain,
        mapping_cone.inl_comp_snd, cochain.zero_comp, zero_add, cochain.comp_id,
        δ_comp_of_first_is_zero_cochain _ _ _ (zero_add 1), ε_0, one_smul, ε_neg, ε_1,
        neg_smul, cochain.comp_neg, cochain.add_comp, neg_zero, neg_neg,
        ← cochain.comp_assoc _ _ _ (neg_add_self 1).symm (add_neg_self 1).symm
        (show (-1 : ℤ) = -1+1+(-1), by linarith), mapping_cone.δ_snd, cochain.neg_comp,
        mapping_cone.inl_comp_fst, cochain.id_comp,
        mapping_cone.inr_comp_snd, δ_neg, add_left_neg], },
    { ext1,
      simp only [assoc, add_left_neg, eq_self_iff_true, neg_neg, cochain.of_hom_comp,
        cochain.comp_zero_cochain, cochain.of_hom_v, mapping_cone.inr_desc_f_assoc, δ_neg,
        δ_comp_of_first_is_zero_cochain, mapping_cone.δ_inl, mapping_cone.δ_snd, one_smul,
        cochain.neg_comp, cochain.comp_assoc_of_second_is_zero_cochain, zsmul_neg', neg_smul,
        cochain.comp_add, cochain.comp_neg, cochain.comp_zsmul, neg_add_rev, cochain.comp_id,
        cochain.add_v, cochain.zsmul_v, mapping_cone.inr_snd_assoc, cochain.neg_v, ε_neg, ε_1,
        mapping_cone.δ, mapping_cone.δ_as_cocycle, cocycle.hom_of_f,
        cocycle.right_shift_coe, add_subgroup.coe_neg,
        cochain.right_shift_v _ _ _ (zero_add 1).symm p p (by linarith) _ rfl,
        shift_functor_obj_X_iso, homological_complex.X_iso_of_eq_refl,
        mapping_cone.lift_f _ _ _ _ _ _ rfl, preadditive.comp_add,
        cochain.left_shift_v _ _ _ (neg_add_self 1).symm _ _ _ _ rfl, mul_zero,
        zero_add, one_mul, sub_self, euclidean_domain.zero_div, ε_0, cocycle.left_shift,
        cocycle.of_hom_coe, preadditive.comp_neg, preadditive.neg_comp, add_subgroup.coe_mk,
        cochain.left_shift_v _ _ _ (zero_add 1).symm _ _ _ _ rfl, add_zero,
        cochain.comp_v _ _ (add_neg_self (1 : ℤ)).symm p _ p rfl (by linarith),
        cochain.comp_v _ _ (zero_add (-1)).symm (p+1) (p+1) p (by linarith) (by linarith),
        mapping_cone.inr_fst_assoc, zero_comp, zero_add, neg_zero,
        iso.inv_hom_id_assoc, reassoc_of (eq_sub_of_add_eq (mapping_cone.id φ p _ rfl)),
        preadditive.sub_comp, id_comp],
      abel, },
  end, }

lemma rotate_distinguished_triangle₁ (T : triangle (homotopy_category C (complex_shape.up ℤ)))
  (hT : T ∈ distinguished_triangles C) : T.rotate ∈ distinguished_triangles C :=
begin
  obtain ⟨K, L, φ, ⟨e⟩⟩:= hT,
  suffices : (mapping_cone_triangle' φ).rotate ∈ distinguished_triangles C,
  { exact isomorphic_distinguished _ this _ ((rotate _).map_iso e), },
  refine ⟨_,_, mapping_cone.inr φ, ⟨triangle.mk_iso _ _ (iso.refl _) (iso.refl _)
    (iso_of_homotopy_equiv (rotate_distinguished_triangle_homotopy_equiv φ))
    (by tidy) (eq_of_homotopy _ _ _) (eq_of_homotopy _ _ (homotopy.of_eq _))⟩⟩,
  { rw id_comp,
    symmetry,
    equiv_rw equiv_homotopy  _ _,
    refine ⟨(mapping_cone.snd φ).comp (mapping_cone.inl (mapping_cone.inr φ)) (zero_add _).symm,
      _⟩,
    simp only [δ_comp_of_first_is_zero_cochain _ _ _ (neg_add_self 1),
      mapping_cone.δ_inl, cochain.of_hom_comp, mapping_cone.δ_snd,
      subtype.val_eq_coe, mapping_cone.cochain_ext _ _ (neg_add_self 1).symm,
      cochain.comp_add],
    split,
    { simp only [← cochain.comp_assoc_of_first_is_zero_cochain,
        ← cochain.comp_assoc_of_second_is_zero_cochain,
        ← cochain.comp_assoc_of_third_is_zero_cochain, cochain.comp_zsmul,
        mapping_cone.inl_comp_snd, cochain.zero_comp, zero_add, cochain.neg_comp,
        cochain.comp_neg, smul_neg, ε_neg, ε_1, neg_smul, neg_neg, one_smul,
        ← cochain.comp_assoc _ _ _ (neg_add_self 1).symm (add_neg_self 1).symm
        (show (-1 : ℤ) =-1+1+(-1), by linarith), mapping_cone.inl_comp_fst,
        cochain.id_comp],
      rw mapping_cone.cochain_ext' _ _ (neg_add_self 1).symm,
      split,
      { dsimp only [rotate_distinguished_triangle_homotopy_equiv],
        simp only [cochain.add_comp, cochain.comp_assoc_of_first_is_zero_cochain,
          cochain.comp_assoc_of_second_is_zero_cochain, mapping_cone.inr_comp_fst,
          mapping_cone.inl_comp_fst, cochain.comp_id, cochain.comp_zero,
          mapping_cone.lift_fst, add_subgroup.coe_neg, cocycle.left_shift_coe,
          cocycle.of_hom_coe, cochain.comp_neg, mapping_cone.δ, mapping_cone.δ_as_cocycle,
          cocycle.cochain_of_hom_hom_of_eq_coe, cocycle.right_shift_coe, add_subgroup.coe_neg],
        ext n,
        dsimp [mapping_cone_triangle'],
        simp only [cochain.zero_v, cochain.add_v, cochain.of_hom_v, cochain.neg_v,
          cochain.comp_v _ _ (neg_add_self 1).symm n (n-1) n (by linarith) (by linarith),
          cochain.comp_v _ _ (zero_add 1).symm (n-1) (n-1) n (by linarith) (by linarith),
          cochain.right_shift_v _ _ _ (zero_add 1).symm (n-1) (n-1) (by linarith) n (by linarith),
          cochain.left_shift_v _ _ _ (zero_add 1).symm (n-1) n (by linarith) n (by linarith),
          add_zero, neg_neg, shift_functor_obj_X_iso, preadditive.neg_comp, mul_one, sub_self,
          mul_zero, euclidean_domain.zero_div, ε_1, neg_smul, one_zsmul, preadditive.comp_neg,
          preadditive.neg_comp_assoc, assoc, homological_complex.X_iso_of_eq_inv_hom,
          homological_complex.X_iso_of_eq_refl, iso.refl_hom, comp_id,
          mapping_cone.inl_fst_assoc, add_right_neg], },
      { dsimp only [rotate_distinguished_triangle_homotopy_equiv],
        simp only [cochain.add_comp, cochain.comp_assoc_of_first_is_zero_cochain,
          cochain.comp_assoc_of_third_is_zero_cochain, mapping_cone.lift_snd,
          mapping_cone.inl_comp_snd, cochain.comp_zero, zero_add,
          mapping_cone.inr_comp_snd, cochain.comp_id, mapping_cone.δ,
          cocycle.cochain_of_hom_hom_of_eq_coe, cocycle.right_shift_coe,
          mapping_cone.δ_as_cocycle_coe, cochain.comp_neg],
        ext1 p q hpq,
        simp only [cochain.neg_v, cochain.comp_zero_cochain,
          cochain.left_shift_v _ _ _ (neg_add_self 1).symm q q (by linarith) p (by linarith),
          cochain.right_shift_v _ _ _ (zero_add 1).symm q q (by linarith) p (by linarith),
          zero_add, neg_neg, shift_functor_obj_X_iso, preadditive.neg_comp, mul_zero, sub_self,
          euclidean_domain.zero_div, ε_0, one_zsmul, preadditive.neg_comp_assoc, assoc,
          homological_complex.X_iso_of_eq_inv_hom, homological_complex.X_iso_of_eq_refl,
          iso.refl_hom, comp_id, preadditive.comp_neg, mapping_cone.inl_fst_assoc],
        dsimp only [mapping_cone_triangle'],
        erw [iso.inv_hom_id_assoc], }, },
    { simp only [← cochain.comp_assoc_of_first_is_zero_cochain, mapping_cone.inr_comp_snd,
        cochain.id_comp, cochain.comp_zsmul, mapping_cone.δ,
        ← cochain.comp_assoc_of_third_is_zero_cochain, cochain.comp_neg,
        mapping_cone.inr_comp_fst, cochain.zero_comp, neg_zero, smul_zero, add_zero,
        mapping_cone.δ_as_cocycle, self_eq_add_right, cocycle.right_shift_coe,
        cocycle.cochain_of_hom_hom_of_eq_coe],
      ext1 n,
      simp only [add_subgroup.coe_neg, cochain.comp_assoc_of_third_is_zero_cochain,
        cochain.comp_zero_cochain, cochain.of_hom_v, cochain.zero_v,
        cochain.right_shift_v _ _ _ (zero_add 1).symm n n (by linarith) _ rfl, assoc,
        cochain.neg_v, preadditive.neg_comp, preadditive.comp_neg,
        mapping_cone.inr_fst_assoc, zero_comp, neg_zero], }, },
  { ext n,
    dsimp only [rotate_distinguished_triangle_homotopy_equiv],
    simp only [category_theory.functor.map_id, preadditive.neg_comp,
      homological_complex.neg_f_apply, homological_complex.comp_f,
      cocycle.hom_of_f, cocycle.right_shift_coe, mapping_cone.δ_as_cocycle_coe,
      shift_functor_map_f', mapping_cone.δ,
      cochain.right_shift_v _ _ _ (zero_add 1).symm n n (by linarith) _ rfl,
      shift_functor_obj_X_iso, cochain.neg_v, homological_complex.X_iso_of_eq_refl,
      preadditive.comp_neg, neg_inj,
      mapping_cone.lift_fst_f_assoc, add_subgroup.coe_neg,
      cocycle.left_shift_coe, cocycle.of_hom_coe, cochain.neg_v,
      cochain.left_shift_v _ _ _ (zero_add 1).symm _ _ rfl _ rfl,
      mul_one, sub_self, mul_zero, euclidean_domain.zero_div, add_zero, ε_1,
      homological_complex.X_iso_of_eq_refl, cochain.of_hom_v, neg_smul, one_zsmul, neg_neg],
    erw [iso.refl_hom, iso.refl_inv, id_comp, comp_id], },
end

@[simps]
def triangle_shift (T : triangle (homotopy_category C (complex_shape.up ℤ))) (n : ℤ) :
  triangle (homotopy_category C (complex_shape.up ℤ)) :=
triangle.mk (ε n • T.mor₁⟦n⟧') (ε n • T.mor₂⟦n⟧') (ε n • T.mor₃⟦n⟧' ≫ (shift_comm T.obj₁ 1 n).hom)

instance cochain_complex_shift_functor_additive (n : ℤ) :
  (category_theory.shift_functor (cochain_complex C ℤ) n).additive := { }

instance has_comm_shift :
  (homotopy_category.quotient C (complex_shape.up ℤ)).has_comm_shift ℤ :=
quotient.functor_comm_shift _

def induced_triangle (T : triangle (cochain_complex C ℤ)) :
  triangle (homotopy_category C (complex_shape.up ℤ)) :=
(homotopy_category.quotient _ _).map_triangle.obj T

def mapping_cone_induced_triangle_iso :
  induced_triangle (mapping_cone.triangle φ) ≅ mapping_cone_triangle' φ :=
triangle.mk_iso _ _ (iso.refl _) (iso.refl _) (iso.refl _) (by tidy) (by tidy) begin
  simp only [iso.refl_hom, category_theory.functor.map_id, comp_id, id_comp],
  apply eq_of_homotopy,
  apply homotopy.of_eq,
  apply comp_id,
end

@[simps]
def shift_mapping_cone_iso {K L : cochain_complex C ℤ} (φ : K ⟶ L) (n : ℤ) :
  (mapping_cone φ)⟦n⟧ ≅ mapping_cone (φ⟦n⟧') :=
{ hom := mapping_cone.lift _
      (ε ((n*(n+1))/2) • cocycle.right_shift (cocycle.left_shift
        (mapping_cone.fst φ) n (n+1) (by linarith)) n 1 (by linarith))
      (ε ((n*(n+1))/2) • ((mapping_cone.snd φ).left_shift n n
        (zero_add n).symm).right_shift n 0 (zero_add n).symm) begin
    simp only [δ_zsmul, cochain.δ_right_shift _ n _ 0 1 (zero_add n).symm (add_comm n 1),
      cochain.δ_left_shift _ n 1 n (n+1) (zero_add n).symm (add_comm n 1), cochain.zsmul_comp,
      cochain.right_shift_smul, smul_smul, mul_ε_self, mul_one, mapping_cone.δ_snd,
      add_subgroup.coe_zsmul, cocycle.right_shift_coe, cocycle.left_shift_coe],
    ext1 p q hpq,
    simp only [cochain.add_v, cochain.zsmul_v, cochain.comp_zero_cochain, cochain.neg_v,
      cochain.right_shift_v _ n 1 (add_comm n 1) p q hpq (q+n) (by linarith),
      cochain.left_shift_v _ n (n+1) (add_comm n 1) p (q+n) (by linarith) _ rfl, assoc,
      shift_functor_obj_X_iso, homological_complex.X_iso_of_eq_refl, cochain.of_hom_v,
      shift_functor_map_f', preadditive.zsmul_comp, smul_smul, preadditive.neg_comp,
      preadditive.comp_neg, smul_neg, cochain.zero_v, neg_add_eq_zero],
    dsimp [iso.refl],
    simp only [id_comp, comp_id],
  end,
  inv := mapping_cone.desc _
      (ε ((n*(n+1))/2) • ((mapping_cone.inl φ).left_shift n (n-1) (by linarith)).right_shift n (-1) (by linarith))
      ((mapping_cone.inr φ)⟦n⟧') begin
    simp only [δ_zsmul, cochain.of_hom_comp, cochain.δ_right_shift _ _ _ _ _ _ (zero_add n).symm,
      cochain.δ_left_shift _ _ _ _ _ _ (zero_add n).symm, mapping_cone.δ_inl,
      cochain.right_shift_smul, smul_smul, mul_ε_self, mul_one],
    ext1 p,
    simp only [cochain.zsmul_v, cochain.comp_zero_cochain, cochain.of_hom_v, shift_functor_map_f',
      cochain.right_shift_v _ n 0 (zero_add n).symm p p (add_zero p).symm _ rfl,
      cochain.left_shift_v _ n n (zero_add n).symm p _ rfl _ rfl, smul_smul, ε_add, ε_mul_self,
      preadditive.zsmul_comp, shift_functor_obj_X_iso, homological_complex.X_iso_of_eq_refl,
      mul_succ_div_two],
    dsimp [iso.refl],
    erw [id_comp, comp_id],
    rw [mul_assoc, ← mul_assoc (ε n)],
    simp only [mul_ε_self, one_mul, one_smul],
  end,
  hom_inv_id' := begin
    ext p : 2,
    simp only [homological_complex.comp_f, homological_complex.id_f, assoc,
      preadditive.comp_zsmul, preadditive.zsmul_comp, cochain.zsmul_v,
      mapping_cone.lift_desc_f _ _ _ _ _ _ _ _ _ rfl, shift_functor_map_f',
      add_subgroup.coe_zsmul, cocycle.right_shift_coe, cocycle.left_shift_coe,
      cochain.right_shift_v _ n (-1) (show n-1=(-1)+n, by linarith) (p+1) p (by linarith) (p+n) (by linarith),
      cochain.left_shift_v _ n (n-1) (show n-1=(-1)+n, by linarith) (p+1) (p+n) (by linarith) _ rfl,
      cochain.right_shift_v _ n 1 (add_comm n 1) p _ rfl (p+1+n) (by linarith),
      cochain.left_shift_v _ n (n+1) (add_comm n 1) p (p+1+n) (by linarith) _ rfl,
      cochain.right_shift_v _ n 0 (zero_add n).symm p p (add_zero p).symm _ rfl,
      cochain.left_shift_v _ n n (zero_add n).symm p _ rfl _ rfl,
      iso.inv_hom_id_assoc, shift_functor_obj_X_iso, homological_complex.X_iso_of_eq_refl, smul_smul],
    dsimp [iso.refl],
    erw [id_comp, id_comp, id_comp, comp_id, ← mapping_cone.id φ (p+n) (p+1+n) (by linarith)],
    simp only [ε_add, ε_even _ (even_mul_pred n), ε_even _ (even_mul_succ n), one_mul],
    congr' 1,
    { conv_lhs { congr, rw mul_assoc, congr, skip, congr, skip, rw mul_comm, },
      conv_lhs { congr, congr, skip, rw ← mul_assoc, },
      simpa only [mul_ε_self, one_mul, one_smul], },
    { simp only [mul_succ_div_two, ε_mul_self, ε_add],
      conv_lhs { congr, rw [mul_assoc, ← mul_assoc (ε n)], },
      simp only [mul_ε_self, one_mul, one_smul], },
  end,
  inv_hom_id' := begin
    ext p : 2,
    simp only [homological_complex.comp_f, homological_complex.id_f, assoc],
    rw mapping_cone.to_ext_iff _ _ _ rfl,
    split,
    { simp only [assoc, mapping_cone.lift_fst_f, add_subgroup.coe_zsmul,
        cocycle.right_shift_coe, cocycle.left_shift_coe, cochain.zsmul_v,
        linear.comp_smul, id_comp,
        cochain.right_shift_v _ n 1 (add_comm n 1) p _ rfl (p+1+n) (by linarith),
        cochain.left_shift_v _ n (n+1) (add_comm n 1) p (p+1+n) (by linarith) _ rfl,
        preadditive.zsmul_comp, preadditive.comp_zsmul],
      rw mapping_cone.from_ext_iff _ _ _ rfl,
      split,
      { simp only [linear.comp_smul, mapping_cone.inl_desc_v_assoc, cochain.zsmul_v,
          linear.smul_comp, mapping_cone.inl_fst,
          cochain.right_shift_v _ n (-1) (show n-1 = -1+n, by linarith) (p+1) p (by linarith) (p+n) (by linarith),
          cochain.left_shift_v _ n (n-1) (show n-1 = -1+n, by linarith) (p+1) (p+n) (by linarith) _ rfl,
          shift_functor_obj_X_iso, ε_add, homological_complex.X_iso_of_eq_refl, assoc,
          iso.inv_hom_id_assoc, mapping_cone.inl_fst_assoc, iso.hom_inv_id, smul_smul,
          ε_even _ (even_mul_succ n), ε_even _ (even_mul_pred n), one_mul],
        conv_lhs { congr, congr, skip, rw mul_comm, },
        conv_lhs { congr, rw mul_assoc, congr, skip, rw ← mul_assoc, },
        simp only [mul_ε_self, one_mul, one_smul], },
      { simp only [preadditive.comp_zsmul, mapping_cone.inr_desc_f_assoc,
          shift_functor_obj_X_iso, ε_add, shift_functor_map_f',
          homological_complex.X_iso_of_eq_refl, mapping_cone.inr_fst],
        dsimp [iso.refl],
        erw [id_comp, comp_id],
        simp only [mapping_cone.inr_fst, smul_zero], }, },
    { simp only [assoc, mapping_cone.lift_snd_f, cochain.zsmul_v, linear.comp_smul, id_comp,
        cochain.right_shift_v _ _ _ (zero_add n).symm p p (add_zero p).symm _ rfl,
        cochain.left_shift_v _ _ _ (zero_add n).symm _ _ rfl _ rfl,
        preadditive.zsmul_comp, preadditive.comp_zsmul],
      rw mapping_cone.from_ext_iff _ _ _ rfl,
      split,
      { simp only [preadditive.comp_zsmul, mapping_cone.inl_desc_v_assoc, assoc,
          mapping_cone.inl_snd, cochain.zsmul_v, preadditive.zsmul_comp, smul_zero,
          cochain.right_shift_v _ n (-1) (show n-1 = -1+n, by linarith) (p+1) p (by linarith) (p+n) (by linarith),
          cochain.left_shift_v _ n (n-1) (show n-1 = -1+n, by linarith) (p+1) (p+n) (by linarith) _ rfl,
          iso.inv_hom_id_assoc, mapping_cone.inl_snd_assoc, zero_comp, comp_zero], },
      { simp only [assoc, preadditive.comp_zsmul, preadditive.zsmul_comp,
          mapping_cone.inr_desc_f_assoc, shift_functor_map_f', shift_functor_obj_X_iso,
          homological_complex.X_iso_of_eq_refl, smul_smul],
        dsimp only [iso.refl],
        erw [id_comp, comp_id],
        simp only [mapping_cone.inr_snd, ε_add, ε_mul_self, mul_succ_div_two, mul_assoc],
        conv_lhs { congr, congr, skip, rw ← mul_assoc, },
        simpa only [mul_ε_self, one_mul, one_smul], }, },
  end, }

def shift_mapping_cone_triangle_iso {K L : cochain_complex C ℤ} (φ : K ⟶ L) (n : ℤ) :
  (triangle.shift_functor _ n).obj (mapping_cone.triangle φ) ≅ mapping_cone.triangle (φ⟦n⟧') :=
begin
  refine triangle.mk_iso _ _ (iso.refl _) (preadditive.mul_iso ((-1)^n) (iso.refl _))
    (shift_mapping_cone_iso φ n) _ _ _,
  { dsimp [triangle.shift_functor],
    simp only [comp_id, id_comp, preadditive.comp_zsmul, smul_smul,
      ← units.coe_mul, ← mul_zpow, neg_mul, mul_neg, one_mul, neg_neg,
      one_zpow, units.coe_one, one_zsmul], },
  { ext p : 2,
    dsimp [triangle.shift_functor],
    simp only [preadditive.zsmul_comp, preadditive.comp_zsmul, id_comp,
      mapping_cone.lift_f _ _ _ _ _ _ rfl, preadditive.comp_add, cochain.zsmul_v,
      add_subgroup.coe_zsmul, cocycle.right_shift_coe, cocycle.left_shift_coe,
      cochain.right_shift_v _ n 1 (add_comm n 1) _ _ rfl _ rfl,
      cochain.left_shift_v _ n (n+1) (add_comm n 1) _ _ rfl _ rfl,
      cochain.right_shift_v _ _ _ (zero_add n).symm p p (add_zero p).symm _ rfl,
      cochain.left_shift_v _ _ _(zero_add n).symm _ _ rfl _ rfl, smul_smul,
      shift_functor_obj_X_iso, homological_complex.X_iso_of_eq_refl, assoc],
    dsimp [iso.refl],
    erw [id_comp, id_comp],
    simp only [mapping_cone.inr_fst_assoc, zero_comp, smul_zero, zero_add,
      mapping_cone.inr_snd_assoc, id_comp],
    congr' 1,
    convert one_mul _,
    nth_rewrite 0 mul_comm,
    simp only [mul_succ_div_two, ε_add, mul_assoc],
    conv_lhs { congr, skip, rw [← mul_assoc, mul_ε_self, one_mul], },
    rw [ε_mul_self, mul_ε_self], },
  { ext p : 2,
    dsimp [triangle.shift_functor, mapping_cone.triangle],
    simp only [preadditive.zsmul_comp, mapping_cone.lift_f (φ⟦n⟧') _ _ _ p _ rfl,
      mapping_cone.δ, cocycle.hom_of_f, shift_functor_add_comm_hom_app_f,
      cocycle.right_shift_coe, mapping_cone.δ_as_cocycle_coe, assoc,
      cocycle.left_shift_coe, preadditive.add_comp,
      cochain.right_shift_v _ _ _ (zero_add 1).symm (p+n) (p+n) (by linarith) _ rfl,
      shift_functor_obj_X_iso,
      cochain.right_shift_v _ _ _ (zero_add 1).symm p p (by linarith) _ rfl,
      cochain.neg_v, mapping_cone.inr_fst_assoc, mapping_cone.inl_fst_assoc,
      preadditive.neg_comp, preadditive.comp_neg, zero_comp, comp_zero, add_zero,
      smul_neg, neg_inj],
    dsimp,
    simp only [preadditive.zsmul_comp, smul_smul,
      cochain.right_shift_v _ _ _ (add_comm n 1) p _ rfl (p+1+n) (by linarith),
      cochain.left_shift_v _ _ _ (add_comm n 1) p (p+1+n) (by linarith) _ rfl],
    dsimp,
    simp only [homological_complex.X_iso_of_eq_refl],
    dsimp [iso.refl],
    erw [id_comp, comp_id, comp_id, comp_id, id_comp, cochain.v_comp_X_iso_of_eq_hom],
    congr' 1,
    nth_rewrite 0 mul_comm,
    simpa only [mul_succ_div_two, ε_add, ε_even _ (even_mul_succ n), one_mul, ← mul_assoc,
      mul_ε_self], },
end

lemma shift_distinguished_triangles (T : triangle (homotopy_category C (complex_shape.up ℤ)))
  (hT : T ∈ distinguished_triangles C) (n : ℤ) :
  (triangle.shift_functor _ n).obj T ∈ distinguished_triangles C :=
begin
  obtain ⟨K, L, φ, ⟨e⟩⟩:= hT,
  suffices : (triangle.shift_functor _ n).obj (mapping_cone_triangle' φ)
    ∈ distinguished_triangles C,
  { exact isomorphic_distinguished _ this _ (functor.map_iso _ e), },
  exact ⟨K⟦n⟧, L⟦n⟧, φ⟦n⟧',
    ⟨(triangle.shift_functor (homotopy_category C (complex_shape.up ℤ)) n).map_iso
    (mapping_cone_induced_triangle_iso φ).symm ≪≫
    ((triangle.shift_functor_comm
      ((homotopy_category.quotient C (complex_shape.up ℤ))) n).app _).symm ≪≫
    (homotopy_category.quotient _ _).map_triangle.map_iso (shift_mapping_cone_triangle_iso φ n) ≪≫
    (mapping_cone_induced_triangle_iso _)⟩⟩,
end

lemma rotate_distinguished_triangle (T : triangle (homotopy_category C (complex_shape.up ℤ))) :
  T ∈ distinguished_triangles C ↔ T.rotate ∈ distinguished_triangles C :=
begin
  split,
  { exact rotate_distinguished_triangle₁ T, },
  { intro h,
    replace h := rotate_distinguished_triangle₁ _ (rotate_distinguished_triangle₁ _ h),
    replace h := shift_distinguished_triangles _ h (-1),
    refine isomorphic_distinguished _ h _ _,
    exact (triangle.shift_functor_zero _).symm.app T ≪≫
      (triangle.shift_functor_iso_of_eq _ (by linarith)).app T ≪≫
      (triangle.shift_functor_add _ 1 (-1)).app T ≪≫
      (triangle.shift_functor _ (-1)).map_iso ((triangle.shift_functor_one_iso _).app T), },
end

instance : pretriangulated (homotopy_category C (complex_shape.up ℤ)) :=
{ distinguished_triangles := distinguished_triangles C,
  isomorphic_distinguished := isomorphic_distinguished,
  contractible_distinguished := contractible_distinguished,
  distinguished_cocone_triangle := distinguished_cocone_triangle,
  rotate_distinguished_triangle := rotate_distinguished_triangle,
  complete_distinguished_triangle_morphism :=
    complete_distinguished_triangle_morphism, }

lemma triangle_distinguished_iff (T : triangle (homotopy_category C (complex_shape.up ℤ))) :
  (T ∈ dist_triang (homotopy_category C (complex_shape.up ℤ)))
  ↔ ∃ (K L : cochain_complex C ℤ) (φ : K ⟶ L),
    nonempty (T ≅
      (homotopy_category.quotient _ _).map_triangle.obj (mapping_cone.triangle φ)) :=
begin
  split,
  { rintros ⟨K, L, φ, ⟨e⟩⟩,
    exact ⟨K, L, φ, ⟨e ≪≫ (mapping_cone_induced_triangle_iso φ).symm⟩⟩, },
  { rintro ⟨K, L, φ, ⟨e⟩⟩,
    exact ⟨K, L, φ, ⟨e ≪≫ (mapping_cone_induced_triangle_iso φ)⟩⟩, },
end

lemma triangle_distinguished_iff' (T : triangle (homotopy_category C (complex_shape.up ℤ))) :
  (T ∈ dist_triang (homotopy_category C (complex_shape.up ℤ))) ↔
  ∃ (K L : cochain_complex C ℤ) (φ : K ⟶ L), nonempty (T ≅
      (homotopy_category.quotient _ _).map_triangle.obj (mapping_cone.triangle φ).rotate) :=
begin
  split,
  { intro hT,
    replace hT := inv_rot_of_dist_triangle _ _ hT,
    rw triangle_distinguished_iff at hT,
    obtain ⟨K, L, φ, ⟨e⟩⟩ := hT,
    exact ⟨K, L, φ, ⟨(triangle_rotation _).counit_iso.symm.app T ≪≫
      (pretriangulated.rotate _).map_iso e ≪≫
      (homotopy_category.quotient _ _).map_triangle_rotate.app _⟩⟩, },
  { rintro ⟨K, L, φ, ⟨e⟩⟩,
    suffices : T.inv_rotate ∈ dist_triang _,
    { exact pretriangulated.isomorphic_distinguished _ (rot_of_dist_triangle _ _ this) _
        ((triangle_rotation _).counit_iso.symm.app T), },
    refine ⟨K, L, φ, ⟨(pretriangulated.inv_rotate _).map_iso e ≪≫ (inv_rotate _).map_iso
        (((homotopy_category.quotient _ _).map_triangle_rotate).symm.app _ ≪≫
        (rotate _).map_iso (mapping_cone_induced_triangle_iso φ)) ≪≫
      (triangle_rotation _).unit_iso.symm.app _⟩⟩, },
end

end homotopy_category


theorem USAJMO_Problems_Problem_1 :
  forall f: pnat -> pnat,
  (forall (a b: pnat), f(a*a + b*b) = f(a)* f(b) /\ f(a*a) = f(a)*f(a))
  -> forall n, f n = 1
:= sorry


/-
Copyright (c) 2020 Scott Morrison, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.limits.shapes.products
import category_theory.limits.preserves.basic

/-!
# Preserving products

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

Constructions to relate the notions of preserving products and reflecting products
to concrete fans.

In particular, we show that `pi_comparison G f` is an isomorphism iff `G` preserves
the limit of `f`.
-/

noncomputable theory

universes w v₁ v₂ u₁ u₂

open category_theory category_theory.category category_theory.limits

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

namespace category_theory.limits

variables {J : Type w} (f : J → C)

/--
The map of a fan is a limit iff the fan consisting of the mapped morphisms is a limit. This
essentially lets us commute `fan.mk` with `functor.map_cone`.
-/
def is_limit_map_cone_fan_mk_equiv {P : C} (g : Π j, P ⟶ f j) :
  is_limit (G.map_cone (fan.mk P g)) ≃
  is_limit (fan.mk _ (λ j, G.map (g j)) : fan (λ j, G.obj (f j))) :=
begin
  refine (is_limit.postcompose_hom_equiv _ _).symm.trans (is_limit.equiv_iso_limit _),
  refine discrete.nat_iso (λ j, iso.refl (G.obj (f j.as))),
  refine cones.ext (iso.refl _) (λ j, by { discrete_cases, dsimp, simp }),
end

/-- The property of preserving products expressed in terms of fans. -/
def is_limit_fan_mk_obj_of_is_limit [preserves_limit (discrete.functor f) G]
  {P : C} (g : Π j, P ⟶ f j) (t : is_limit (fan.mk _ g)) :
  is_limit (fan.mk (G.obj P) (λ j, G.map (g j)) : fan (λ j, G.obj (f j))) :=
is_limit_map_cone_fan_mk_equiv _ _ _ (preserves_limit.preserves t)

/-- The property of reflecting products expressed in terms of fans. -/
def is_limit_of_is_limit_fan_mk_obj [reflects_limit (discrete.functor f) G]
  {P : C} (g : Π j, P ⟶ f j) (t : is_limit (fan.mk _ (λ j, G.map (g j)) : fan (λ j, G.obj (f j)))) :
  is_limit (fan.mk P g) :=
reflects_limit.reflects ((is_limit_map_cone_fan_mk_equiv _ _ _).symm t)

section

variables [has_product f]

/--
If `G` preserves products and `C` has them, then the fan constructed of the mapped projection of a
product is a limit.
-/
def is_limit_of_has_product_of_preserves_limit [preserves_limit (discrete.functor f) G] :
  is_limit (fan.mk _ (λ (j : J), G.map (pi.π f j)) : fan (λ j, G.obj (f j))) :=
is_limit_fan_mk_obj_of_is_limit G f _ (product_is_product _)

variables [has_product (λ (j : J), G.obj (f j))]

/-- If `pi_comparison G f` is an isomorphism, then `G` preserves the limit of `f`. -/
def preserves_product.of_iso_comparison [i : is_iso (pi_comparison G f)] :
  preserves_limit (discrete.functor f) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (product_is_product f),
  apply (is_limit_map_cone_fan_mk_equiv _ _ _).symm _,
  apply is_limit.of_point_iso (limit.is_limit (discrete.functor (λ (j : J), G.obj (f j)))),
  apply i,
end

variable [preserves_limit (discrete.functor f) G]

/--
If `G` preserves limits, we have an isomorphism from the image of a product to the product of the
images.
-/
def preserves_product.iso : G.obj (∏ f) ≅ ∏ (λ j, G.obj (f j)) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_product_of_preserves_limit G f)
  (limit.is_limit _)

@[simp]
lemma preserves_product.iso_hom : (preserves_product.iso G f).hom = pi_comparison G f :=
rfl

instance : is_iso (pi_comparison G f) :=
begin
  rw ← preserves_product.iso_hom,
  apply_instance,
end

end

/--
The map of a cofan is a colimit iff the cofan consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cofan.mk` with `functor.map_cocone`.
-/
def is_colimit_map_cocone_cofan_mk_equiv {P : C} (g : Π j, f j ⟶ P) :
  is_colimit (G.map_cocone (cofan.mk P g)) ≃
  is_colimit (cofan.mk _ (λ j, G.map (g j)) : cofan (λ j, G.obj (f j))) :=
begin
  refine (is_colimit.precompose_hom_equiv _ _).symm.trans (is_colimit.equiv_iso_colimit _),
  refine discrete.nat_iso (λ j, iso.refl (G.obj (f j.as))),
  refine cocones.ext (iso.refl _) (λ j, by { discrete_cases, dsimp, simp }),
end

/-- The property of preserving coproducts expressed in terms of cofans. -/
def is_colimit_cofan_mk_obj_of_is_colimit [preserves_colimit (discrete.functor f) G]
  {P : C} (g : Π j, f j ⟶ P) (t : is_colimit (cofan.mk _ g)) :
  is_colimit (cofan.mk (G.obj P) (λ j, G.map (g j)) : cofan (λ j, G.obj (f j))) :=
is_colimit_map_cocone_cofan_mk_equiv _ _ _ (preserves_colimit.preserves t)

/-- The property of reflecting coproducts expressed in terms of cofans. -/
def is_colimit_of_is_colimit_cofan_mk_obj [reflects_colimit (discrete.functor f) G]
  {P : C} (g : Π j, f j ⟶ P)
  (t : is_colimit (cofan.mk _ (λ j, G.map (g j)) : cofan (λ j, G.obj (f j)))) :
  is_colimit (cofan.mk P g) :=
reflects_colimit.reflects ((is_colimit_map_cocone_cofan_mk_equiv _ _ _).symm t)

section

variables [has_coproduct f]

/--
If `G` preserves coproducts and `C` has them,
then the cofan constructed of the mapped inclusion of a coproduct is a colimit.
-/
def is_colimit_of_has_coproduct_of_preserves_colimit [preserves_colimit (discrete.functor f) G] :
  is_colimit (cofan.mk _ (λ (j : J), G.map (sigma.ι f j)) : cofan (λ j, G.obj (f j))) :=
is_colimit_cofan_mk_obj_of_is_colimit G f _ (coproduct_is_coproduct _)

variables [has_coproduct (λ (j : J), G.obj (f j))]

/-- If `sigma_comparison G f` is an isomorphism, then `G` preserves the colimit of `f`. -/
def preserves_coproduct.of_iso_comparison [i : is_iso (sigma_comparison G f)] :
  preserves_colimit (discrete.functor f) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (coproduct_is_coproduct f),
  apply (is_colimit_map_cocone_cofan_mk_equiv _ _ _).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (discrete.functor (λ (j : J), G.obj (f j)))),
  apply i,
end

variable [preserves_colimit (discrete.functor f) G]

/--
If `G` preserves colimits,
we have an isomorphism from the image of a coproduct to the coproduct of the images.
-/
def preserves_coproduct.iso : G.obj (∐ f) ≅ ∐ (λ j, G.obj (f j)) :=
is_colimit.cocone_point_unique_up_to_iso
  (is_colimit_of_has_coproduct_of_preserves_colimit G f)
  (colimit.is_colimit _)

@[simp]
lemma preserves_coproduct.inv_hom : (preserves_coproduct.iso G f).inv = sigma_comparison G f :=
rfl

instance : is_iso (sigma_comparison G f) :=
begin
  rw ← preserves_coproduct.inv_hom,
  apply_instance,
end

end

end category_theory.limits