/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.subtype
import Mathlib.data.prod
import Mathlib.PostPort

universes u_1 u_2 u v w l

namespace Mathlib

/-!
# Basic definitions about `≤` and `<`

## Definitions

### Predicates on functions

- `monotone f`: a function between two types equipped with `≤` is monotone
  if `a ≤ b` implies `f a ≤ f b`.
- `strict_mono f` : a function between two types equipped with `<` is strictly monotone
  if `a < b` implies `f a < f b`.
- `order_dual α` : a type tag reversing the meaning of all inequalities.

### Transfering orders

- `order.preimage`, `preorder.lift`: transfer a (pre)order on `β` to an order on `α`
  using a function `f : α → β`.
- `partial_order.lift`, `linear_order.lift`: transfer a partial (resp., linear) order on `β` to a
  partial (resp., linear) order on `α` using an injective function `f`.

### Extra classes

- `no_top_order`, `no_bot_order`: an order without a maximal/minimal element.
- `densely_ordered`: an order with no gaps, i.e. for any two elements `a<b` there exists
  `c`, `a<c<b`.

## Main theorems

- `monotone_of_monotone_nat`: if `f : ℕ → α` and `f n ≤ f (n + 1)` for all `n`, then
  `f` is monotone;
- `strict_mono.nat`: if `f : ℕ → α` and `f n < f (n + 1)` for all `n`, then f is strictly monotone.

## TODO

- expand module docs
- automatic construction of dual definitions / theorems

## See also
- `algebra.order` for basic lemmas about orders, and projection notation for orders

## Tags

preorder, order, partial order, linear order, monotone, strictly monotone
-/

theorem preorder.ext {α : Type u_1} {A : preorder α} {B : preorder α}
    (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B :=
  sorry

theorem partial_order.ext {α : Type u_1} {A : partial_order α} {B : partial_order α}
    (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B :=
  sorry

theorem linear_order.ext {α : Type u_1} {A : linear_order α} {B : linear_order α}
    (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B :=
  sorry

/-- Given a relation `R` on `β` and a function `f : α → β`,
  the preimage relation on `α` is defined by `x ≤ y ↔ f x ≤ f y`.
  It is the unique relation on `α` making `f` a `rel_embedding`
  (assuming `f` is injective). -/
@[simp] def order.preimage {α : Sort u_1} {β : Sort u_2} (f : α → β) (s : β → β → Prop) (x : α)
    (y : α) :=
  s (f x) (f y)

infixl:80 " ⁻¹'o " => Mathlib.order.preimage

/-- The preimage of a decidable order is decidable. -/
protected instance order.preimage.decidable {α : Sort u_1} {β : Sort u_2} (f : α → β)
    (s : β → β → Prop) [H : DecidableRel s] : DecidableRel (f ⁻¹'o s) :=
  fun (x y : α) => H (f x) (f y)

/-- A function between preorders is monotone if
  `a ≤ b` implies `f a ≤ f b`. -/
def monotone {α : Type u} {β : Type v} [preorder α] [preorder β] (f : α → β) :=
  ∀ {a b : α}, a ≤ b → f a ≤ f b

theorem monotone_id {α : Type u} [preorder α] : monotone id := fun (x y : α) (h : x ≤ y) => h

theorem monotone_const {α : Type u} {β : Type v} [preorder α] [preorder β] {b : β} :
    monotone fun (a : α) => b :=
  fun (x y : α) (h : x ≤ y) => le_refl b

protected theorem monotone.comp {α : Type u} {β : Type v} {γ : Type w} [preorder α] [preorder β]
    [preorder γ] {g : β → γ} {f : α → β} (m_g : monotone g) (m_f : monotone f) : monotone (g ∘ f) :=
  fun (a b : α) (h : a ≤ b) => m_g (m_f h)

protected theorem monotone.iterate {α : Type u} [preorder α] {f : α → α} (hf : monotone f) (n : ℕ) :
    monotone (nat.iterate f n) :=
  nat.rec_on n monotone_id fun (n : ℕ) (ihn : monotone (nat.iterate f n)) => monotone.comp ihn hf

theorem monotone_of_monotone_nat {α : Type u} [preorder α] {f : ℕ → α}
    (hf : ∀ (n : ℕ), f n ≤ f (n + 1)) : monotone f :=
  sorry

theorem monotone.reflect_lt {α : Type u_1} {β : Type u_2} [linear_order α] [preorder β] {f : α → β}
    (hf : monotone f) {x : α} {x' : α} (h : f x < f x') : x < x' :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x < x')) (Eq.symm (propext not_le))))
    (id fun (h' : x' ≤ x) => not_le_of_lt h (hf h'))

/-- If `f` is a monotone function from `ℕ` to a preorder such that `y` lies between `f x` and
  `f (x + 1)`, then `y` doesn't lie in the range of `f`. -/
theorem monotone.ne_of_lt_of_lt_nat {α : Type u_1} [preorder α] {f : ℕ → α} (hf : monotone f)
    (x : ℕ) (x' : ℕ) {y : α} (h1 : f x < y) (h2 : y < f (x + 1)) : f x' ≠ y :=
  sorry

/-- If `f` is a monotone function from `ℤ` to a preorder such that `y` lies between `f x` and
  `f (x + 1)`, then `y` doesn't lie in the range of `f`. -/
theorem monotone.ne_of_lt_of_lt_int {α : Type u_1} [preorder α] {f : ℤ → α} (hf : monotone f)
    (x : ℤ) (x' : ℤ) {y : α} (h1 : f x < y) (h2 : y < f (x + 1)) : f x' ≠ y :=
  sorry

/-- A function `f` is strictly monotone if `a < b` implies `f a < f b`. -/
def strict_mono {α : Type u} {β : Type v} [HasLess α] [HasLess β] (f : α → β) :=
  ∀ {a b : α}, a < b → f a < f b

theorem strict_mono_id {α : Type u} [HasLess α] : strict_mono id := fun (a b : α) => id

/-- A function `f` is strictly monotone increasing on `t` if `x < y` for `x,y ∈ t` implies
`f x < f y`. -/
def strict_mono_incr_on {α : Type u} {β : Type v} [HasLess α] [HasLess β] (f : α → β) (t : set α) :=
  ∀ {x : α}, x ∈ t → ∀ {y : α}, y ∈ t → x < y → f x < f y

/-- A function `f` is strictly monotone decreasing on `t` if `x < y` for `x,y ∈ t` implies
`f y < f x`. -/
def strict_mono_decr_on {α : Type u} {β : Type v} [HasLess α] [HasLess β] (f : α → β) (t : set α) :=
  ∀ {x : α}, x ∈ t → ∀ {y : α}, y ∈ t → x < y → f y < f x

/-- Type tag for a set with dual order: `≤` means `≥` and `<` means `>`. -/
def order_dual (α : Type u_1) := α

namespace order_dual

protected instance nonempty (α : Type u_1) [h : Nonempty α] : Nonempty (order_dual α) := h

protected instance subsingleton (α : Type u_1) [h : subsingleton α] : subsingleton (order_dual α) :=
  h

protected instance has_le (α : Type u_1) [HasLessEq α] : HasLessEq (order_dual α) :=
  { LessEq := fun (x y : α) => y ≤ x }

protected instance has_lt (α : Type u_1) [HasLess α] : HasLess (order_dual α) :=
  { Less := fun (x y : α) => y < x }

-- `dual_le` and `dual_lt` should not be simp lemmas:

-- they cause a loop since `α` and `order_dual α` are definitionally equal

theorem dual_le {α : Type u} [HasLessEq α] {a : α} {b : α} : a ≤ b ↔ b ≤ a := iff.rfl

theorem dual_lt {α : Type u} [HasLess α] {a : α} {b : α} : a < b ↔ b < a := iff.rfl

theorem dual_compares {α : Type u} [HasLess α] {a : α} {b : α} {o : ordering} :
    ordering.compares o a b ↔ ordering.compares o b a :=
  ordering.cases_on o iff.rfl eq_comm iff.rfl

protected instance preorder (α : Type u_1) [preorder α] : preorder (order_dual α) :=
  preorder.mk LessEq Less sorry sorry

protected instance partial_order (α : Type u_1) [partial_order α] : partial_order (order_dual α) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

protected instance linear_order (α : Type u_1) [linear_order α] : linear_order (order_dual α) :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry
    ((fun (this : DecidableRel fun (a b : α) => b ≤ a) => this)
      fun (a b : α) => has_le.le.decidable b a)
    Mathlib.decidable_eq_of_decidable_le
    ((fun (this : DecidableRel fun (a b : α) => b < a) => this)
      fun (a b : α) => has_lt.lt.decidable b a)

protected instance inhabited {α : Type u} [Inhabited α] : Inhabited (order_dual α) := id

theorem preorder.dual_dual (α : Type u_1) [H : preorder α] :
    order_dual.preorder (order_dual α) = H :=
  preorder.ext fun (_x _x_1 : order_dual (order_dual α)) => iff.rfl

theorem partial_order.dual_dual (α : Type u_1) [H : partial_order α] :
    order_dual.partial_order (order_dual α) = H :=
  partial_order.ext fun (_x _x_1 : order_dual (order_dual α)) => iff.rfl

theorem linear_order.dual_dual (α : Type u_1) [H : linear_order α] :
    order_dual.linear_order (order_dual α) = H :=
  linear_order.ext fun (_x _x_1 : order_dual (order_dual α)) => iff.rfl

theorem cmp_le_flip {α : Type u_1} [HasLessEq α] [DecidableRel LessEq] (x : α) (y : α) :
    cmp_le x y = cmp_le y x :=
  rfl

end order_dual

namespace strict_mono_incr_on

protected theorem dual {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} {s : set α}
    (H : strict_mono_incr_on f s) : strict_mono_incr_on f s :=
  fun (x : order_dual α) (hx : x ∈ s) (y : order_dual α) (hy : y ∈ s) => H hy hx

protected theorem dual_right {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β}
    {s : set α} (H : strict_mono_incr_on f s) : strict_mono_decr_on f s :=
  H

theorem le_iff_le {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} {s : set α}
    {x : α} {y : α} (H : strict_mono_incr_on f s) (hx : x ∈ s) (hy : y ∈ s) : f x ≤ f y ↔ x ≤ y :=
  sorry

theorem lt_iff_lt {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} {s : set α}
    {x : α} {y : α} (H : strict_mono_incr_on f s) (hx : x ∈ s) (hy : y ∈ s) : f x < f y ↔ x < y :=
  sorry

protected theorem compares {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β}
    {s : set α} {x : α} {y : α} (H : strict_mono_incr_on f s) (hx : x ∈ s) (hy : y ∈ s)
    {o : ordering} : ordering.compares o (f x) (f y) ↔ ordering.compares o x y :=
  sorry

end strict_mono_incr_on

namespace strict_mono_decr_on

protected theorem dual {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} {s : set α}
    (H : strict_mono_decr_on f s) : strict_mono_decr_on f s :=
  fun (x : order_dual α) (hx : x ∈ s) (y : order_dual α) (hy : y ∈ s) => H hy hx

protected theorem dual_right {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β}
    {s : set α} (H : strict_mono_decr_on f s) : strict_mono_incr_on f s :=
  H

theorem le_iff_le {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} {s : set α}
    {x : α} {y : α} (H : strict_mono_decr_on f s) (hx : x ∈ s) (hy : y ∈ s) : f x ≤ f y ↔ y ≤ x :=
  strict_mono_incr_on.le_iff_le (strict_mono_decr_on.dual_right H) hy hx

theorem lt_iff_lt {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β} {s : set α}
    {x : α} {y : α} (H : strict_mono_decr_on f s) (hx : x ∈ s) (hy : y ∈ s) : f x < f y ↔ y < x :=
  strict_mono_incr_on.lt_iff_lt (strict_mono_decr_on.dual_right H) hy hx

protected theorem compares {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β}
    {s : set α} {x : α} {y : α} (H : strict_mono_decr_on f s) (hx : x ∈ s) (hy : y ∈ s)
    {o : ordering} : ordering.compares o (f x) (f y) ↔ ordering.compares o y x :=
  iff.trans order_dual.dual_compares
    (strict_mono_incr_on.compares (strict_mono_decr_on.dual_right H) hy hx)

end strict_mono_decr_on

namespace strict_mono

protected theorem strict_mono_incr_on {α : Type u} {β : Type v} [HasLess α] [HasLess β] {f : α → β}
    (hf : strict_mono f) (s : set α) : strict_mono_incr_on f s :=
  fun (x : α) (hx : x ∈ s) (y : α) (hy : y ∈ s) (hxy : x < y) => hf hxy

theorem comp {α : Type u} {β : Type v} {γ : Type w} [HasLess α] [HasLess β] [HasLess γ] {g : β → γ}
    {f : α → β} (hg : strict_mono g) (hf : strict_mono f) : strict_mono (g ∘ f) :=
  fun (a b : α) (h : a < b) => hg (hf h)

protected theorem iterate {α : Type u} [HasLess α] {f : α → α} (hf : strict_mono f) (n : ℕ) :
    strict_mono (nat.iterate f n) :=
  nat.rec_on n strict_mono_id fun (n : ℕ) (ihn : strict_mono (nat.iterate f n)) => comp ihn hf

theorem id_le {φ : ℕ → ℕ} (h : strict_mono φ) (n : ℕ) : n ≤ φ n :=
  nat.rec_on n (nat.zero_le (φ 0))
    fun (n : ℕ) (hn : n ≤ φ n) => nat.succ_le_of_lt (lt_of_le_of_lt hn (h (nat.lt_succ_self n)))

protected theorem ite' {α : Type u} {β : Type v} [preorder α] [HasLess β] {f : α → β} {g : α → β}
    (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop} [decidable_pred p]
    (hp : ∀ {x y : α}, x < y → p y → p x) (hfg : ∀ {x y : α}, p x → ¬p y → x < y → f x < g y) :
    strict_mono fun (x : α) => ite (p x) (f x) (g x) :=
  sorry

protected theorem ite {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β} {g : α → β}
    (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop} [decidable_pred p]
    (hp : ∀ {x y : α}, x < y → p y → p x) (hfg : ∀ (x : α), f x ≤ g x) :
    strict_mono fun (x : α) => ite (p x) (f x) (g x) :=
  strict_mono.ite' hf hg hp
    fun (x y : α) (hx : p x) (hy : ¬p y) (h : x < y) => has_lt.lt.trans_le (hf h) (hfg y)

theorem lt_iff_lt {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β}
    (H : strict_mono f) {a : α} {b : α} : f a < f b ↔ a < b :=
  strict_mono_incr_on.lt_iff_lt (strict_mono.strict_mono_incr_on H set.univ) trivial trivial

protected theorem compares {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β}
    (H : strict_mono f) {a : α} {b : α} {o : ordering} :
    ordering.compares o (f a) (f b) ↔ ordering.compares o a b :=
  strict_mono_incr_on.compares (strict_mono.strict_mono_incr_on H set.univ) trivial trivial

theorem injective {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β}
    (H : strict_mono f) : function.injective f :=
  fun (x y : α) (h : f x = f y) =>
    (fun (this : ordering.compares ordering.eq x y) => this) (iff.mp (strict_mono.compares H) h)

theorem le_iff_le {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β}
    (H : strict_mono f) {a : α} {b : α} : f a ≤ f b ↔ a ≤ b :=
  strict_mono_incr_on.le_iff_le (strict_mono.strict_mono_incr_on H set.univ) trivial trivial

theorem top_preimage_top {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β}
    (H : strict_mono f) {a : α} (h_top : ∀ (p : β), p ≤ f a) (x : α) : x ≤ a :=
  iff.mp (le_iff_le H) (h_top (f x))

theorem bot_preimage_bot {α : Type u} {β : Type v} [linear_order α] [preorder β] {f : α → β}
    (H : strict_mono f) {a : α} (h_bot : ∀ (p : β), f a ≤ p) (x : α) : a ≤ x :=
  iff.mp (le_iff_le H) (h_bot (f x))

protected theorem nat {β : Type u_1} [preorder β] {f : ℕ → β} (h : ∀ (n : ℕ), f n < f (n + 1)) :
    strict_mono f :=
  sorry

-- `preorder α` isn't strong enough: if the preorder on α is an equivalence relation,

-- then `strict_mono f` is vacuously true.

theorem monotone {α : Type u} {β : Type v} [partial_order α] [preorder β] {f : α → β}
    (H : strict_mono f) : monotone f :=
  fun (a b : α) (h : a ≤ b) =>
    Or._oldrec (le_of_lt ∘ H)
      (fun (h_1 : a = b) => Eq._oldrec (fun (h : a ≤ a) => le_refl (f a)) h_1 h) (lt_or_eq_of_le h)

end strict_mono

theorem injective_of_lt_imp_ne {α : Type u} {β : Type v} [linear_order α] {f : α → β}
    (h : ∀ (x y : α), x < y → f x ≠ f y) : function.injective f :=
  sorry

theorem strict_mono_of_monotone_of_injective {α : Type u} {β : Type v} [partial_order α]
    [partial_order β] {f : α → β} (h₁ : monotone f) (h₂ : function.injective f) : strict_mono f :=
  sorry

theorem monotone.strict_mono_iff_injective {α : Type u} {β : Type v} [linear_order α]
    [partial_order β] {f : α → β} (h : monotone f) : strict_mono f ↔ function.injective f :=
  { mp := fun (h : strict_mono f) => strict_mono.injective h,
    mpr := strict_mono_of_monotone_of_injective h }

theorem strict_mono_of_le_iff_le {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β}
    (h : ∀ (x y : α), x ≤ y ↔ f x ≤ f y) : strict_mono f :=
  sorry

/-! ### Order instances on the function space -/

protected instance pi.preorder {ι : Type u} {α : ι → Type v} [(i : ι) → preorder (α i)] :
    preorder ((i : ι) → α i) :=
  preorder.mk (fun (x y : (i : ι) → α i) => ∀ (i : ι), x i ≤ y i)
    (fun (a b : (i : ι) → α i) => (∀ (i : ι), a i ≤ b i) ∧ ¬∀ (i : ι), b i ≤ a i) sorry sorry

theorem pi.le_def {ι : Type u} {α : ι → Type v} [(i : ι) → preorder (α i)] {x : (i : ι) → α i}
    {y : (i : ι) → α i} : x ≤ y ↔ ∀ (i : ι), x i ≤ y i :=
  iff.rfl

theorem le_update_iff {ι : Type u} {α : ι → Type v} [(i : ι) → preorder (α i)] [DecidableEq ι]
    {x : (i : ι) → α i} {y : (i : ι) → α i} {i : ι} {a : α i} :
    x ≤ function.update y i a ↔ x i ≤ a ∧ ∀ (j : ι), j ≠ i → x j ≤ y j :=
  function.forall_update_iff y fun (j : ι) (z : α j) => x j ≤ z

theorem update_le_iff {ι : Type u} {α : ι → Type v} [(i : ι) → preorder (α i)] [DecidableEq ι]
    {x : (i : ι) → α i} {y : (i : ι) → α i} {i : ι} {a : α i} :
    function.update x i a ≤ y ↔ a ≤ y i ∧ ∀ (j : ι), j ≠ i → x j ≤ y j :=
  function.forall_update_iff x fun (j : ι) (z : α j) => z ≤ y j

protected instance pi.partial_order {ι : Type u} {α : ι → Type v} [(i : ι) → partial_order (α i)] :
    partial_order ((i : ι) → α i) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

theorem comp_le_comp_left_of_monotone {α : Type u} {β : Type v} {γ : Type w} [preorder α]
    [preorder β] {f : β → α} {g : γ → β} {h : γ → β} (m_f : monotone f) (le_gh : g ≤ h) :
    f ∘ g ≤ f ∘ h :=
  fun (x : γ) => m_f (le_gh x)

protected theorem monotone.order_dual {α : Type u} {γ : Type w} [preorder α] [preorder γ]
    {f : α → γ} (hf : monotone f) : monotone f :=
  fun (x y : order_dual α) (hxy : x ≤ y) => hf hxy

theorem monotone_lam {α : Type u} {β : Type v} {γ : Type w} [preorder α] [preorder γ]
    {f : α → β → γ} (m : ∀ (b : β), monotone fun (a : α) => f a b) : monotone f :=
  fun (a a' : α) (h : a ≤ a') (b : β) => m b h

theorem monotone_app {α : Type u} {β : Type v} {γ : Type w} [preorder α] [preorder γ]
    (f : β → α → γ) (b : β) (m : monotone fun (a : α) (b : β) => f b a) : monotone (f b) :=
  fun (a a' : α) (h : a ≤ a') => m h b

theorem strict_mono.order_dual {α : Type u} {β : Type v} [HasLess α] [HasLess β] {f : α → β}
    (hf : strict_mono f) : strict_mono f :=
  fun (x y : order_dual α) (hxy : x < y) => hf hxy

/-- Transfer a `preorder` on `β` to a `preorder` on `α` using a function `f : α → β`. -/
def preorder.lift {α : Type u_1} {β : Type u_2} [preorder β] (f : α → β) : preorder α :=
  preorder.mk (fun (x y : α) => f x ≤ f y) (fun (x y : α) => f x < f y) sorry sorry

/-- Transfer a `partial_order` on `β` to a `partial_order` on `α` using an injective
function `f : α → β`. -/
def partial_order.lift {α : Type u_1} {β : Type u_2} [partial_order β] (f : α → β)
    (inj : function.injective f) : partial_order α :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

/-- Transfer a `linear_order` on `β` to a `linear_order` on `α` using an injective
function `f : α → β`. -/
def linear_order.lift {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β)
    (inj : function.injective f) : linear_order α :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry
    (fun (x y : α) => infer_instance)
    (fun (x y : α) => decidable_of_iff (f x = f y) (function.injective.eq_iff inj))
    fun (x y : α) => infer_instance

protected instance subtype.preorder {α : Type u_1} [preorder α] (p : α → Prop) :
    preorder (Subtype p) :=
  preorder.lift subtype.val

@[simp] theorem subtype.mk_le_mk {α : Type u_1} [preorder α] {p : α → Prop} {x : α} {y : α}
    {hx : p x} {hy : p y} : { val := x, property := hx } ≤ { val := y, property := hy } ↔ x ≤ y :=
  iff.rfl

@[simp] theorem subtype.mk_lt_mk {α : Type u_1} [preorder α] {p : α → Prop} {x : α} {y : α}
    {hx : p x} {hy : p y} : { val := x, property := hx } < { val := y, property := hy } ↔ x < y :=
  iff.rfl

@[simp] theorem subtype.coe_le_coe {α : Type u_1} [preorder α] {p : α → Prop} {x : Subtype p}
    {y : Subtype p} : ↑x ≤ ↑y ↔ x ≤ y :=
  iff.rfl

@[simp] theorem subtype.coe_lt_coe {α : Type u_1} [preorder α] {p : α → Prop} {x : Subtype p}
    {y : Subtype p} : ↑x < ↑y ↔ x < y :=
  iff.rfl

protected instance subtype.partial_order {α : Type u_1} [partial_order α] (p : α → Prop) :
    partial_order (Subtype p) :=
  partial_order.lift subtype.val subtype.val_injective

protected instance subtype.linear_order {α : Type u_1} [linear_order α] (p : α → Prop) :
    linear_order (Subtype p) :=
  linear_order.lift subtype.val subtype.val_injective

theorem subtype.mono_coe {α : Type u} [preorder α] (t : set α) : monotone coe :=
  fun (x y : Subtype t) => id

theorem subtype.strict_mono_coe {α : Type u} [preorder α] (t : set α) : strict_mono coe :=
  fun (x y : Subtype t) => id

protected instance prod.has_le (α : Type u) (β : Type v) [HasLessEq α] [HasLessEq β] :
    HasLessEq (α × β) :=
  { LessEq := fun (p q : α × β) => prod.fst p ≤ prod.fst q ∧ prod.snd p ≤ prod.snd q }

protected instance prod.preorder (α : Type u) (β : Type v) [preorder α] [preorder β] :
    preorder (α × β) :=
  preorder.mk LessEq (fun (a b : α × β) => a ≤ b ∧ ¬b ≤ a) sorry sorry

/-- The pointwise partial order on a product.
    (The lexicographic ordering is defined in order/lexicographic.lean, and the instances are
    available via the type synonym `lex α β = α × β`.) -/
protected instance prod.partial_order (α : Type u) (β : Type v) [partial_order α]
    [partial_order β] : partial_order (α × β) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

/-!
### Additional order classes
-/

/-- order without a top element; somtimes called cofinal -/
class no_top_order (α : Type u) [preorder α] where
  no_top : ∀ (a : α), ∃ (a' : α), a < a'

theorem no_top {α : Type u} [preorder α] [no_top_order α] (a : α) : ∃ (a' : α), a < a' :=
  no_top_order.no_top

protected instance nonempty_gt {α : Type u} [preorder α] [no_top_order α] (a : α) :
    Nonempty (Subtype fun (x : α) => a < x) :=
  iff.mpr nonempty_subtype (no_top a)

/-- order without a bottom element; somtimes called coinitial or dense -/
class no_bot_order (α : Type u) [preorder α] where
  no_bot : ∀ (a : α), ∃ (a' : α), a' < a

theorem no_bot {α : Type u} [preorder α] [no_bot_order α] (a : α) : ∃ (a' : α), a' < a :=
  no_bot_order.no_bot

protected instance order_dual.no_top_order (α : Type u) [preorder α] [no_bot_order α] :
    no_top_order (order_dual α) :=
  no_top_order.mk fun (a : order_dual α) => no_bot a

protected instance order_dual.no_bot_order (α : Type u) [preorder α] [no_top_order α] :
    no_bot_order (order_dual α) :=
  no_bot_order.mk fun (a : order_dual α) => no_top a

protected instance nonempty_lt {α : Type u} [preorder α] [no_bot_order α] (a : α) :
    Nonempty (Subtype fun (x : α) => x < a) :=
  iff.mpr nonempty_subtype (no_bot a)

/-- An order is dense if there is an element between any pair of distinct elements. -/
class densely_ordered (α : Type u) [preorder α] where
  dense : ∀ (a₁ a₂ : α), a₁ < a₂ → ∃ (a : α), a₁ < a ∧ a < a₂

theorem exists_between {α : Type u} [preorder α] [densely_ordered α] {a₁ : α} {a₂ : α} :
    a₁ < a₂ → ∃ (a : α), a₁ < a ∧ a < a₂ :=
  densely_ordered.dense

protected instance order_dual.densely_ordered (α : Type u) [preorder α] [densely_ordered α] :
    densely_ordered (order_dual α) :=
  densely_ordered.mk
    fun (a₁ a₂ : order_dual α) (ha : a₁ < a₂) =>
      Exists.imp (fun (a : α) => and.symm) (exists_between ha)

theorem le_of_forall_le_of_dense {α : Type u} [linear_order α] [densely_ordered α] {a₁ : α} {a₂ : α}
    (h : ∀ (a₃ : α), a₃ > a₂ → a₁ ≤ a₃) : a₁ ≤ a₂ :=
  sorry

theorem eq_of_le_of_forall_le_of_dense {α : Type u} [linear_order α] [densely_ordered α] {a₁ : α}
    {a₂ : α} (h₁ : a₂ ≤ a₁) (h₂ : ∀ (a₃ : α), a₃ > a₂ → a₁ ≤ a₃) : a₁ = a₂ :=
  le_antisymm (le_of_forall_le_of_dense h₂) h₁

theorem le_of_forall_ge_of_dense {α : Type u} [linear_order α] [densely_ordered α] {a₁ : α} {a₂ : α}
    (h : ∀ (a₃ : α), a₃ < a₁ → a₃ ≤ a₂) : a₁ ≤ a₂ :=
  sorry

theorem eq_of_le_of_forall_ge_of_dense {α : Type u} [linear_order α] [densely_ordered α] {a₁ : α}
    {a₂ : α} (h₁ : a₂ ≤ a₁) (h₂ : ∀ (a₃ : α), a₃ < a₁ → a₃ ≤ a₂) : a₁ = a₂ :=
  le_antisymm (le_of_forall_ge_of_dense h₂) h₁

theorem dense_or_discrete {α : Type u} [linear_order α] (a₁ : α) (a₂ : α) :
    (∃ (a : α), a₁ < a ∧ a < a₂) ∨ (∀ (a : α), a > a₁ → a₂ ≤ a) ∧ ∀ (a : α), a < a₂ → a ≤ a₁ :=
  sorry

/-- Type synonym to create an instance of `linear_order` from a
`partial_order` and `[is_total α (≤)]` -/
def as_linear_order (α : Type u) := α

protected instance as_linear_order.inhabited {α : Type u_1} [Inhabited α] :
    Inhabited (as_linear_order α) :=
  { default := Inhabited.default }

protected instance as_linear_order.linear_order {α : Type u_1} [partial_order α]
    [is_total α LessEq] : linear_order (as_linear_order α) :=
  linear_order.mk partial_order.le partial_order.lt partial_order.le_refl partial_order.le_trans
    partial_order.le_antisymm sorry (classical.dec_rel LessEq) Mathlib.decidable_eq_of_decidable_le
    Mathlib.decidable_lt_of_decidable_le

end Mathlib


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Scott Morrison
-/
import algebra.homology.quasi_iso
import category_theory.preadditive.injective_resolution
import category_theory.abelian.homology
import algebra.homology.homotopy_category

/-!
# Main result

When the underlying category is abelian:
* `category_theory.InjectiveResolution.desc`: Given `I : InjectiveResolution X` and
  `J : InjectiveResolution Y`, any morphism `X ⟶ Y` admits a descent to a chain map
  `J.cocomplex ⟶ I.cocomplex`. It is a descent in the sense that `I.ι` intertwines the descent and
  the original morphism, see `category_theory.InjectiveResolution.desc_commutes`.
* `category_theory.InjectiveResolution.desc_homotopy`: Any two such descents are homotopic.
* `category_theory.InjectiveResolution.homotopy_equiv`: Any two injective resolutions of the same
  object are homotopy equivalent.
* `category_theory.injective_resolutions`: If every object admits an injective resolution, we can
  construct a functor `injective_resolutions C : C ⥤ homotopy_category C`.

* `category_theory.exact_f_d`: `f` and `injective.d f` are exact.
* `category_theory.InjectiveResolution.of`: Hence, starting from a monomorphism `X ⟶ J`, where `J`
  is injective, we can apply `injective.d` repeatedly to obtain an injective resolution of `X`.
-/

noncomputable theory

open category_theory
open category_theory.limits

universes v u

namespace category_theory
variables {C : Type u} [category.{v} C]

open injective

namespace InjectiveResolution
section
variables [has_zero_morphisms C] [has_zero_object C] [has_equalizers C] [has_images C]
/-- Auxiliary construction for `desc`. -/
def desc_f_zero {Y Z : C} (f : Z ⟶ Y) (I : InjectiveResolution Y) (J : InjectiveResolution Z) :
  J.cocomplex.X 0 ⟶ I.cocomplex.X 0 :=
factor_thru (f ≫ I.ι.f 0) (J.ι.f 0)

end

section abelian
variables [abelian C]
/-- Auxiliary construction for `desc`. -/
def desc_f_one {Y Z : C}
  (f : Z ⟶ Y) (I : InjectiveResolution Y) (J : InjectiveResolution Z) :
  J.cocomplex.X 1 ⟶ I.cocomplex.X 1 :=
exact.desc (desc_f_zero f I J ≫ I.cocomplex.d 0 1) (J.ι.f 0) (J.cocomplex.d 0 1)
  (abelian.exact.op _ _ J.exact₀) (by simp [←category.assoc, desc_f_zero])

@[simp] lemma desc_f_one_zero_comm {Y Z : C}
  (f : Z ⟶ Y) (I : InjectiveResolution Y) (J : InjectiveResolution Z) :
  J.cocomplex.d 0 1 ≫ desc_f_one f I J = desc_f_zero f I J ≫ I.cocomplex.d 0 1 :=
by simp [desc_f_zero, desc_f_one]

/-- Auxiliary construction for `desc`. -/
def desc_f_succ {Y Z : C}
  (I : InjectiveResolution Y) (J : InjectiveResolution Z)
  (n : ℕ) (g : J.cocomplex.X n ⟶ I.cocomplex.X n) (g' : J.cocomplex.X (n+1) ⟶ I.cocomplex.X (n+1))
  (w : J.cocomplex.d n (n+1) ≫ g' = g ≫ I.cocomplex.d n (n+1)) :
  Σ' g'' : J.cocomplex.X (n+2) ⟶ I.cocomplex.X (n+2),
    J.cocomplex.d (n+1) (n+2) ≫ g'' = g' ≫ I.cocomplex.d (n+1) (n+2) :=
⟨@exact.desc C _ _ _ _ _ _ _ _ _
  (g' ≫ I.cocomplex.d (n+1) (n+2))
  (J.cocomplex.d n (n+1))
  (J.cocomplex.d (n+1) (n+2)) (abelian.exact.op _ _ (J.exact _))
  (by simp [←category.assoc, w]), (by simp)⟩

/-- A morphism in `C` descends to a chain map between injective resolutions. -/
def desc {Y Z : C}
  (f : Z ⟶ Y) (I : InjectiveResolution Y) (J : InjectiveResolution Z) :
  J.cocomplex ⟶ I.cocomplex :=
cochain_complex.mk_hom _ _ (desc_f_zero f _ _) (desc_f_one f _ _)
  (desc_f_one_zero_comm f I J).symm
  (λ n ⟨g, g', w⟩, ⟨(desc_f_succ I J n g g' w.symm).1, (desc_f_succ I J n g g' w.symm).2.symm⟩)

/-- The resolution maps intertwine the descent of a morphism and that morphism. -/
@[simp, reassoc]
lemma desc_commutes {Y Z : C}
  (f : Z ⟶ Y) (I : InjectiveResolution Y) (J : InjectiveResolution Z) :
  J.ι ≫ desc f I J = (cochain_complex.single₀ C).map f ≫ I.ι :=
begin
  ext n,
  rcases n with (_|_|n);
  { dsimp [desc, desc_f_one, desc_f_zero], simp, },
end

-- Now that we've checked this property of the descent,
-- we can seal away the actual definition.
attribute [irreducible] desc

/-- An auxiliary definition for `desc_homotopy_zero`. -/
def desc_homotopy_zero_zero {Y Z : C} {I : InjectiveResolution Y} {J : InjectiveResolution Z}
  (f : I.cocomplex ⟶ J.cocomplex)
  (comm : I.ι ≫ f = 0) : I.cocomplex.X 1 ⟶ J.cocomplex.X 0 :=
exact.desc (f.f 0) (I.ι.f 0) (I.cocomplex.d 0 1) (abelian.exact.op _ _ I.exact₀)
  (congr_fun (congr_arg homological_complex.hom.f comm) 0)

/-- An auxiliary definition for `desc_homotopy_zero`. -/
def desc_homotopy_zero_one {Y Z : C} {I : InjectiveResolution Y} {J : InjectiveResolution Z}
  (f : I.cocomplex ⟶ J.cocomplex)
  (comm : I.ι ≫ f = (0 : _ ⟶ J.cocomplex)) : I.cocomplex.X 2 ⟶ J.cocomplex.X 1 :=
exact.desc (f.f 1 - desc_homotopy_zero_zero f comm ≫ J.cocomplex.d 0 1)
  (I.cocomplex.d 0 1) (I.cocomplex.d 1 2) (abelian.exact.op _ _ (I.exact _))
  (by simp [desc_homotopy_zero_zero, ←category.assoc])

/-- An auxiliary definition for `desc_homotopy_zero`. -/
def desc_homotopy_zero_succ {Y Z : C} {I : InjectiveResolution Y} {J : InjectiveResolution Z}
  (f : I.cocomplex ⟶ J.cocomplex) (n : ℕ)
  (g : I.cocomplex.X (n + 1) ⟶ J.cocomplex.X n)
  (g' : I.cocomplex.X (n + 2) ⟶ J.cocomplex.X (n + 1))
  (w : f.f (n + 1) = I.cocomplex.d (n+1) (n+2) ≫ g' + g ≫ J.cocomplex.d n (n+1)) :
  I.cocomplex.X (n + 3) ⟶ J.cocomplex.X (n + 2) :=
exact.desc (f.f (n+2) - g' ≫ J.cocomplex.d _ _) (I.cocomplex.d (n+1) (n+2))
  (I.cocomplex.d (n+2) (n+3)) (abelian.exact.op _ _ (I.exact _))
  (by simp [preadditive.comp_sub, ←category.assoc, preadditive.sub_comp,
        show I.cocomplex.d (n+1) (n+2) ≫ g' = f.f (n + 1) - g ≫ J.cocomplex.d n (n+1),
        by {rw w, simp only [add_sub_cancel] } ])

/-- Any descent of the zero morphism is homotopic to zero. -/
def desc_homotopy_zero {Y Z : C} {I : InjectiveResolution Y} {J : InjectiveResolution Z}
  (f : I.cocomplex ⟶ J.cocomplex)
  (comm : I.ι ≫ f = 0) :
  homotopy f 0 :=
homotopy.mk_coinductive _ (desc_homotopy_zero_zero f comm) (by simp [desc_homotopy_zero_zero])
  (desc_homotopy_zero_one f comm) (by simp [desc_homotopy_zero_one])
  (λ n ⟨g, g', w⟩, ⟨desc_homotopy_zero_succ f n g g' (by simp only [w, add_comm]),
    by simp [desc_homotopy_zero_succ, w]⟩)

/-- Two descents of the same morphism are homotopic. -/
def desc_homotopy {Y Z : C} (f : Y ⟶ Z) {I : InjectiveResolution Y} {J : InjectiveResolution Z}
  (g h : I.cocomplex ⟶ J.cocomplex)
  (g_comm : I.ι ≫ g = (cochain_complex.single₀ C).map f ≫ J.ι)
  (h_comm : I.ι ≫ h = (cochain_complex.single₀ C).map f ≫ J.ι) :
  homotopy g h :=
homotopy.equiv_sub_zero.inv_fun (desc_homotopy_zero _ (by simp [g_comm, h_comm]))

/-- The descent of the identity morphism is homotopic to the identity cochain map. -/
def desc_id_homotopy (X : C) (I : InjectiveResolution X) :
  homotopy (desc (𝟙 X) I I) (𝟙 I.cocomplex) :=
by apply desc_homotopy (𝟙 X); simp

/-- The descent of a composition is homotopic to the composition of the descents. -/
def desc_comp_homotopy {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z)
  (I : InjectiveResolution X) (J : InjectiveResolution Y) (K : InjectiveResolution Z) :
  homotopy (desc (f ≫ g) K I) (desc f J I ≫ desc g K J)  :=
by apply desc_homotopy (f ≫ g); simp

-- We don't care about the actual definitions of these homotopies.
attribute [irreducible] desc_homotopy_zero desc_homotopy desc_id_homotopy desc_comp_homotopy

/-- Any two injective resolutions are homotopy equivalent. -/
def homotopy_equiv {X : C} (I J : InjectiveResolution X) :
  homotopy_equiv I.cocomplex J.cocomplex :=
{ hom := desc (𝟙 X) J I,
  inv := desc (𝟙 X) I J,
  homotopy_hom_inv_id := (desc_comp_homotopy (𝟙 X) (𝟙 X) I J I).symm.trans $
    by simpa [category.id_comp] using desc_id_homotopy _ _,
  homotopy_inv_hom_id := (desc_comp_homotopy (𝟙 X) (𝟙 X) J I J).symm.trans $
    by simpa [category.id_comp] using desc_id_homotopy _ _ }

@[simp, reassoc] lemma homotopy_equiv_hom_ι {X : C} (I J : InjectiveResolution X) :
  I.ι ≫ (homotopy_equiv I J).hom = J.ι :=
by simp [homotopy_equiv]

@[simp, reassoc] lemma homotopy_equiv_inv_ι {X : C} (I J : InjectiveResolution X) :
  J.ι ≫ (homotopy_equiv I J).inv = I.ι :=
by simp [homotopy_equiv]

end abelian

end InjectiveResolution

section
variables [abelian C]

/-- An arbitrarily chosen injective resolution of an object. -/
abbreviation injective_resolution (Z : C) [has_injective_resolution Z] : cochain_complex C ℕ :=
(has_injective_resolution.out Z).some.cocomplex

/-- The cochain map from cochain complex consisting of `Z` supported in degree `0`
back to the arbitrarily chosen injective resolution `injective_resolution Z`. -/
abbreviation injective_resolution.ι (Z : C) [has_injective_resolution Z] :
  (cochain_complex.single₀ C).obj Z ⟶ injective_resolution Z :=
(has_injective_resolution.out Z).some.ι

/-- The descent of a morphism to a cochain map between the arbitrarily chosen injective resolutions.
-/
abbreviation injective_resolution.desc {X Y : C} (f : X ⟶ Y)
  [has_injective_resolution X] [has_injective_resolution Y] :
  injective_resolution X ⟶ injective_resolution Y :=
InjectiveResolution.desc f _ _

variables (C) [has_injective_resolutions C]

/--
Taking injective resolutions is functorial,
if considered with target the homotopy category
(`ℕ`-indexed cochain complexes and chain maps up to homotopy).
-/
def injective_resolutions : C ⥤ homotopy_category C (complex_shape.up ℕ) :=
{ obj := λ X, (homotopy_category.quotient _ _).obj (injective_resolution X),
  map := λ X Y f, (homotopy_category.quotient _ _).map (injective_resolution.desc f),
  map_id' := λ X, begin
    rw ←(homotopy_category.quotient _ _).map_id,
    apply homotopy_category.eq_of_homotopy,
    apply InjectiveResolution.desc_id_homotopy,
  end,
  map_comp' := λ X Y Z f g, begin
    rw ←(homotopy_category.quotient _ _).map_comp,
    apply homotopy_category.eq_of_homotopy,
    apply InjectiveResolution.desc_comp_homotopy,
  end, }

end

section

variables [abelian C] [enough_injectives C]

lemma exact_f_d {X Y : C} (f : X ⟶ Y) : exact f (d f) :=
(abelian.exact_iff _ _).2 $
  ⟨by simp, zero_of_comp_mono (ι _) $ by rw [category.assoc, kernel.condition]⟩

end

namespace InjectiveResolution
/-!
Our goal is to define `InjectiveResolution.of Z : InjectiveResolution Z`.
The `0`-th object in this resolution will just be `injective.under Z`,
i.e. an arbitrarily chosen injective object with a map from `Z`.
After that, we build the `n+1`-st object as `injective.syzygies`
applied to the previously constructed morphism,
and the map from the `n`-th object as `injective.d`.
-/

variables [abelian C] [enough_injectives C]

/-- Auxiliary definition for `InjectiveResolution.of`. -/
@[simps]
def of_cocomplex (Z : C) : cochain_complex C ℕ :=
cochain_complex.mk'
  (injective.under Z) (injective.syzygies (injective.ι Z)) (injective.d (injective.ι Z))
  (λ ⟨X, Y, f⟩, ⟨injective.syzygies f, injective.d f, (exact_f_d f).w⟩)

/--
In any abelian category with enough injectives,
`InjectiveResolution.of Z` constructs an injective resolution of the object `Z`.
-/
@[irreducible] def of (Z : C) : InjectiveResolution Z :=
{ cocomplex := of_cocomplex Z,
  ι := cochain_complex.mk_hom _ _ (injective.ι Z) 0
    (by { simp only [of_cocomplex_d, eq_self_iff_true, eq_to_hom_refl, category.comp_id,
      dite_eq_ite, if_true, comp_zero],
      exact (exact_f_d (injective.ι Z)).w, } ) (λ n _, ⟨0, by ext⟩),
  injective := by { rintros (_|_|_|n); { apply injective.injective_under, } },
  exact₀ := by simpa using exact_f_d (injective.ι Z),
  exact := by { rintros (_|n); { simp, apply exact_f_d } },
  mono := injective.ι_mono Z }

@[priority 100]
instance (Z : C) : has_injective_resolution Z :=
{ out := ⟨of Z⟩ }

@[priority 100]
instance : has_injective_resolutions C :=
{ out := λ _, infer_instance }

end InjectiveResolution
end category_theory
namespace homological_complex.hom

variables {C : Type u} [category.{v} C] [abelian C]

/-- If `X` is a cochain complex of injective objects and we have a quasi-isomorphism
`f : Y[0] ⟶ X`, then `X` is an injective resolution of `Y.` -/
def homological_complex.hom.from_single₀_InjectiveResolution (X : cochain_complex C ℕ) (Y : C)
  (f : (cochain_complex.single₀ C).obj Y ⟶ X) [quasi_iso f]
  (H : ∀ n, injective (X.X n)) :
  InjectiveResolution Y :=
{ cocomplex := X,
  ι := f,
  injective := H,
  exact₀ := f.from_single₀_exact_f_d_at_zero,
  exact := f.from_single₀_exact_at_succ,
  mono := f.from_single₀_mono_at_zero }

end homological_complex.hom


/- Implement constraints as described in Heule 2008 -/

import Eternity2.Puzzle.TileSet
import Eternity2.Puzzle.CardConstraint

namespace Eternity2.Encoding

open Std LeanSAT Encode EncCNF Notation

structure TileSetVariables (ts : TileSet size (Tile <| Color.WithBorder s)) where
  piece_vars : Fin (size * size) → SquareIndex size → Var
  diamond_vars : DiamondIndex size → Color.WithBorder s → Var
  sign_vars : Fin (size * size) → Var

namespace TileSetVariables

instance [Inhabited (Color.WithBorder s)] {ts : TileSet size (Tile (Color.WithBorder s))} : Inhabited <| TileSetVariables ts where
  default := {
    piece_vars := λ _ _ => 0
    diamond_vars := λ _ _ => 0
    sign_vars := λ _ => 0
  }

variable (tsv : TileSetVariables ts)

def pieceVarList :=
  List.fins _ |>.bind fun p =>
  List.fins _ |>.bind fun r =>
  List.fins _ |>.map fun c =>
  tsv.piece_vars p ⟨r,c⟩

def diamondVarList :=
  DiamondIndex.all _ |>.bind fun d =>
  Color.allColors |>.map fun i =>
  tsv.diamond_vars d i

def signVarList := List.fins _ |>.map (tsv.sign_vars)

def borderDiamondVarList :=
  DiamondIndex.border _ |>.bind fun d =>
  Color.allColors |>.map fun i =>
  tsv.diamond_vars d i

def frameDiamondVarList :=
  DiamondIndex.frame _ |>.bind fun d =>
  Color.allColors |>.map fun i =>
  tsv.diamond_vars d i

private def cornerTiles (tsv : TileSetVariables ts) :=
  List.fins _ |>.filterMap (fun i =>
    let i' : Fin ts.tiles.length := ⟨i.val, by rw [ts.h_ts]; exact i.isLt⟩
    let tile := ts.tiles[i']
    if tile.isCorner then some (tile,i) else none)
private def sideTiles (tsv : TileSetVariables ts) :=
  List.fins _ |>.filterMap (fun i =>
    let i' : Fin ts.tiles.length := ⟨i.val, by rw [ts.h_ts]; exact i.isLt⟩
    let tile := ts.tiles[i']
    if tile.isSide then some (tile,i) else none)
private def centerTiles (tsv : TileSetVariables ts) :=
  List.fins _ |>.filterMap (fun i =>
    let i' : Fin ts.tiles.length := ⟨i.val, by rw [ts.h_ts]; exact i.isLt⟩
    let tile := ts.tiles[i']
    if tile.isCenter then some (tile,i) else none)

end TileSetVariables

def mkVars (ts : TileSet size (Tile <| Color.WithBorder s))
  : EncCNF (TileSetVariables ts) := do
  match ts.tiles.isDistinct with
  | false => throw s!"some tiles not unique; currently unsupported"
  | true =>
  let map := s.toMap
  let pvs ← mkVarBlock "x" [size*size, size*size]
  let dvs ← mkVarBlock "y" [2 * (size * size.succ), s.size]
  let svs ← mkVarBlock "z" [size*size]
  return ⟨(pvs[·][·.toFin]), (fun di c =>
    match map.find? c with
    | some i => dvs[di.toFin][i]
    | none => panic! s!"{c}"), (svs[·])⟩

variable {ts : TileSet size (Tile <| Color.WithBorder s)} (tsv : TileSetVariables ts)

def pieceConstraints : EncCNF Unit :=
  EncCNF.newCtx "pieceConstraints" do

  let squaresAndTiles :=
    [ (0, SquareIndex.corners  size |>.map (·.1), tsv.cornerTiles |>.map (·.2))
    , (1, SquareIndex.sides    size |>.map (·.1), tsv.sideTiles   |>.map (·.2))
    , (2, SquareIndex.center   size |>.map (·.1), tsv.centerTiles |>.map (·.2))]

  for (_,squares,tiles) in squaresAndTiles do
    /- Each square has a tile -/
    for q in squares do
      addClause ⟨tiles |>.map (tsv.piece_vars · q)⟩

    /- Each tile has a square -/
    for p in tiles do
      addClause ⟨squares |>.map (tsv.piece_vars p ·)⟩

  /- Eliminate mismatched square/tile types -/
  for ((x,squares,_),(y,_,tiles)) in
    List.product squaresAndTiles squaresAndTiles do
    if x ≠ y then
      for p in tiles do
        for q in squares do
          addClause (¬tsv.piece_vars p q)

/-- Constrain each diamond has exactly one color (of the right type) -/
def diamondConstraints : EncCNF Unit :=
  EncCNF.newCtx "diamondConstraints" do
  /- Frame (always frameColor) -/
  for d in DiamondIndex.frame size do
    addClause (tsv.diamond_vars d .frame)
    for c in Color.allColors do
      if not c.isFrame then
        addClause (¬tsv.diamond_vars d c)

  /- Border -/
  for d in DiamondIndex.border size do
    addClause ⟨Color.borderColors.map (tsv.diamond_vars d ·)⟩

    atMostOne <| Color.borderColors.map (tsv.diamond_vars d ·)

    for c in Color.allColors do
      if not c.isBorder then
        addClause (¬tsv.diamond_vars d c)

  for d in DiamondIndex.center size do
    addClause ⟨Color.centerColors.map (tsv.diamond_vars d ·)⟩

    atMostOne <| Color.centerColors.map (tsv.diamond_vars d ·)

    for c in Color.allColors do
      if not c.isCenter then
        addClause (¬tsv.diamond_vars d c)

/- Piece classification for essential constraints -/
private inductive PieceClass (color : Type u)
| corner            (u r      : color)
| side              (u r d    : color)
| fourSame          (urdl     : color)
| threeSame         (urd l    : color)
| twoNeighborPairs  (ur dl    : color)
| twoOppositePairs  (ud rl    : color)
| oneNeighborPair   (ur d l   : color)
| oneOppositePair   (ud r l   : color)
| allDiff           (u r d l  : color)
deriving Repr

instance [Repr c] : ToString (PieceClass c) where
  toString x := (repr x).pretty

instance (s) : Inhabited (PieceClass (Color.WithBorder s)) :=
  ⟨.corner default default⟩

private def classify (t : Tile (Color.WithBorder s))
  : PieceClass (Color.WithBorder s) :=
  match t.classify with
  | none => panic! s!"Encountered invalid piece during solving:\n{t.toString}"
  | some (.corner x y) => .corner x y
  | some (.side x y z) => .side x y z
  | some (.center w x y z) =>
  /- so much casework-/
  if w = x && x = y && y = z then
    .fourSame w
  else if w = x && x = y then
    .threeSame w z
  else if x = y && y = z then
    .threeSame x w
  else if y = z && z = w then
    .threeSame y x
  else if z = w && w = x then
    .threeSame z y
  else if w = x && y = z then
    .twoNeighborPairs w y
  else if x = y && z = w then
    .twoNeighborPairs x z
  else if w = y && x = z then
    .twoOppositePairs w x
  else if w = x then
    .oneNeighborPair w y z
  else if x = y then
    .oneNeighborPair x z w
  else if y = z then
    .oneNeighborPair y w x
  else if z = w then
    .oneNeighborPair z x y
  else if w = y then
    .oneOppositePair w x z
  else if x = z then
    .oneOppositePair x y w
  else
    .allDiff w x y z

def essentialConstraints (onlyEdge : Bool) : EncCNF Unit :=
  EncCNF.newCtx "essentialConstraints" do
  for _h : i in List.fins _ do
    match (
      let i' : Fin ts.tiles.length := ⟨i.val, by rw [ts.h_ts]; exact i.isLt⟩
      classify ts.tiles[i']
    ) with
    | .corner u r =>
        for (q,ds) in SquareIndex.corners size do
          /- if i placed at q, then diamond1 colored u ∧ diamond2 colored r -/
          addClause (¬tsv.piece_vars i q ∨ tsv.diamond_vars (ds 0) u)
          addClause (¬tsv.piece_vars i q ∨ tsv.diamond_vars (ds 1) r)
    | .side u r d =>
        for (q,ds) in SquareIndex.sides size do
          /- if i placed at q, then diamond1 colored u ∧ diamond2 colored r ∧ diamond3 colored d -/
          addClause (¬ tsv.piece_vars i q ∨ tsv.diamond_vars (ds 0) u)
          addClause (¬ tsv.piece_vars i q ∨ tsv.diamond_vars (ds 1) r)
          addClause (¬ tsv.piece_vars i q ∨ tsv.diamond_vars (ds 2) d)
    | .fourSame urdl =>
      if !onlyEdge then
        for (q,ds) in SquareIndex.center size do
          /- if i placed at q, then all diamonds colored urdl -/
          for rot in [0,1,2,3] do
            addClause (¬tsv.piece_vars i q ∨ tsv.diamond_vars (ds rot) urdl)
    | .threeSame urd l =>
      if !onlyEdge then
        for (q,ds) in SquareIndex.center size do
          /- if i placed at q, then one diamond must be l -/
          addClause (¬tsv.piece_vars i q ∨ tsv.diamond_vars (ds 0) l ∨
            tsv.diamond_vars (ds 1) l ∨ tsv.diamond_vars (ds 2) l ∨ tsv.diamond_vars (ds 3) l)
          /- and one of each opposite pair must be urd -/
          for rot in [0,1] do
            addClause (¬tsv.piece_vars i q
              ∨ tsv.diamond_vars (ds rot) urd ∨ tsv.diamond_vars (ds (rot+2)) urd)
          /- and one of each adjacent pair must be urd -/
          for rot in [0,1,2,3] do
            addClause (¬tsv.piece_vars i q
              ∨ tsv.diamond_vars (ds rot) urd ∨ tsv.diamond_vars (ds (rot+1)) urd)
    | .twoNeighborPairs ur dl =>
      if !onlyEdge then
        for (q,ds) in SquareIndex.center size do
          /- if i placed at q, then one of each opposite pair must be ur -/
          for rot in [0,1] do
            addClause (¬tsv.piece_vars i q
              ∨ tsv.diamond_vars (ds rot) ur ∨ tsv.diamond_vars (ds (rot+2)) ur)
          /- and one of each opposite pair must be dl -/
          for rot in [0,1] do
            addClause (¬tsv.piece_vars i q
              ∨ tsv.diamond_vars (ds rot) dl ∨ tsv.diamond_vars (ds (rot+2)) dl)
    | .twoOppositePairs ud rl =>
      if !onlyEdge then
        for (q,ds) in SquareIndex.center size do
          /- if i placed at q, then one of each adjacent pair must be ud -/
          for rot in [0,1,2,3] do
            addClause (¬tsv.piece_vars i q
              ∨ tsv.diamond_vars (ds rot) ud ∨ tsv.diamond_vars (ds (rot+1)) ud)
          /- and one of each adjacent pair must be rl -/
          for rot in [0,1,2,3] do
            addClause (¬tsv.piece_vars i q
              ∨ tsv.diamond_vars (ds rot) rl ∨ tsv.diamond_vars (ds (rot+1)) rl)
    | .oneNeighborPair ur d l =>
      if !onlyEdge then
        for (q,ds) in SquareIndex.center size do
          /- if i placed at q, then one of each opposite pair must be ur -/
          for rot in [0,1] do
            addClause (¬tsv.piece_vars i q
              ∨ tsv.diamond_vars (ds rot) ur ∨ tsv.diamond_vars (ds (rot+2)) ur)
          /- and if the adjacent pair is rot, rot+1, then rot+2 must be d and rot+3 must be l -/
          for rot in [0,1,2,3] do
            addClause (¬tsv.piece_vars i q
              ∨ ¬tsv.diamond_vars (ds rot) ur ∨ ¬tsv.diamond_vars (ds (rot+1)) ur
              ∨ tsv.diamond_vars (ds (rot+2)) d)
            addClause (¬tsv.piece_vars i q
              ∨ ¬tsv.diamond_vars (ds rot) ur ∨ ¬tsv.diamond_vars (ds (rot+1)) ur
              ∨ tsv.diamond_vars (ds (rot+3)) l)
    | .oneOppositePair ud r l =>
      if !onlyEdge then
        for (q,ds) in SquareIndex.center size do
          /- if i placed at q, then one of each adjacent pair must be ud -/
          for rot in [0,1,2,3] do
            addClause (¬tsv.piece_vars i q
              ∨ tsv.diamond_vars (ds rot) ud ∨ tsv.diamond_vars (ds (rot+1)) ud)
          /- and (if rot is r, rot+2 is l) and (if rot is l, rot+2 is r) -/
          for rot in [0,1,2,3] do
            addClause (¬tsv.piece_vars i q
              ∨ ¬tsv.diamond_vars (ds rot) r ∨ tsv.diamond_vars (ds (rot+2)) l)
            addClause (¬tsv.piece_vars i q
              ∨ ¬tsv.diamond_vars (ds rot) l ∨ tsv.diamond_vars (ds (rot+2)) r)
          /- one of the diamonds must be one of the colours -/
          addClause (¬tsv.piece_vars i q
            ∨ tsv.diamond_vars (ds 0) r ∨ tsv.diamond_vars (ds 1) r
            ∨ tsv.diamond_vars (ds 2) r ∨ tsv.diamond_vars (ds 3) r)
          addClause (¬tsv.piece_vars i q
            ∨ tsv.diamond_vars (ds 0) l ∨ tsv.diamond_vars (ds 1) l
            ∨ tsv.diamond_vars (ds 2) l ∨ tsv.diamond_vars (ds 3) l)
    | .allDiff u r d l =>
      if !onlyEdge then
        for (q,ds) in SquareIndex.center size do
          /- if i placed at q, then if rot is [u,r,d,l] then rot+1 is [r,d,l,u] -/
          for rot in [0,1,2,3] do
            addClause (¬tsv.piece_vars i q
              ∨ ¬tsv.diamond_vars (ds rot) u ∨ tsv.diamond_vars (ds (rot+1)) r)
            addClause (¬tsv.piece_vars i q
              ∨ ¬tsv.diamond_vars (ds rot) r ∨ tsv.diamond_vars (ds (rot+1)) d)
            addClause (¬tsv.piece_vars i q
              ∨ ¬tsv.diamond_vars (ds rot) d ∨ tsv.diamond_vars (ds (rot+1)) l)
            addClause (¬tsv.piece_vars i q
              ∨ ¬tsv.diamond_vars (ds rot) l ∨ tsv.diamond_vars (ds (rot+1)) u)
          /- one of the diamonds must be each of the colours -/
          for c in [u,r,d,l] do
            addClause (¬tsv.piece_vars i q
              ∨ tsv.diamond_vars (ds 0) c ∨ tsv.diamond_vars (ds 1) c
              ∨ tsv.diamond_vars (ds 2) c ∨ tsv.diamond_vars (ds 3) c)

def compactEncoding (onlyEdge : Bool := false)
  : EncCNF Unit := do
    pieceConstraints tsv
    diamondConstraints tsv
    essentialConstraints tsv onlyEdge

/-- A piece can be placed in atMostOne spot -/
def pieceExplicitConstraints : EncCNF Unit := do
  for (_,p) in tsv.cornerTiles do
    SquareIndex.corners size
    |>.map (tsv.piece_vars p ·.1)
    |> atMostOne
  for (_,p) in tsv.sideTiles do
    SquareIndex.sides size
    |>.map (tsv.piece_vars p ·.1)
    |> atMostOne
  for (_,p) in tsv.centerTiles do
    SquareIndex.center size
    |>.map (tsv.piece_vars p ·.1)
    |> atMostOne

def forbiddenColors : EncCNF Unit := do
  for (t,p) in tsv.centerTiles do
    let forbiddenColors := Color.centerColors.filter (!t.colors.contains ·)
    for (q,ds) in SquareIndex.center size do
      /- If tile p is placed at q, then each bordering diamond cannot be
          among the forbidden colors -/
      for c in forbiddenColors do
        for i in List.fins 4 do
          addClause (¬tsv.piece_vars p q ∨ ¬tsv.diamond_vars (ds i) c)

/- Constrain board to be the i'th corner configuration -/
def fixCorners (num : Fin 24) : EncCNF Unit := do
  if h:size > 0 then
    let corners := ts.tiles.enum'.filter (fun (_, t) => t.isCorner)
    match corners with
    | [a,b,c,d] =>
      let (a,b,c,d) :=
        let (num, x₁) := (num / 4, num % 4)
        let (num, x₂) := (num / 3, num % 3)
        let       x₃  :=           num % 2
        let take := fun {α} [Inhabited α] (L : List α) i =>
          let (A,B) := L.splitAt i
          (B.head!, A ++ B.tail!)
        have : Inhabited _ := ⟨a⟩
        let L := [a,b,c,d]
        let (a, L) := take L x₁
        let (b, L) := take L x₂
        let (c, L) := take L x₃
        let d := L.head!
        (a,b,c,d)
      addClause <| tsv.piece_vars (ts.h_ts ▸ a.1) ⟨⟨0,h⟩,        ⟨0,h⟩⟩
      addClause <| tsv.piece_vars (ts.h_ts ▸ b.1) ⟨⟨0,h⟩,        Fin.last _ h⟩
      addClause <| tsv.piece_vars (ts.h_ts ▸ c.1) ⟨Fin.last _ h, ⟨0,h⟩⟩
      addClause <| tsv.piece_vars (ts.h_ts ▸ d.1) ⟨Fin.last _ h, Fin.last _ h⟩
    | _ =>
      panic! s!"Tileset had {corners.length} corners"

/-- Given a list of tiles, encode that for each
border- or center-color, the `c`-colored triangles
must be half `+` and half `-`.
-/
def colorCardConstraints
  : EncCard Unit := do
  for color in Color.borderColors ++ Color.centerColors do
    let cVars :=
      List.fins (size*size) |>.bind (fun idx =>
        let t := ts.tiles[ts.h_ts.symm ▸ idx]
        let var := tsv.sign_vars idx
        t.colors.filter (· = color) |>.map (fun _ => var))
    let pos := cVars.map (.pos)
    assert! (pos.length % 2 = 0) -- handshake lemma :)
    EncCard.addClause <| .ofLits pos (pos.length / 2)

def signCardConstraints
  : EncCard Unit := do
  if size % 2 == 0 then
    /- Half the corners should be pos -/
    let corner_vars := List.fins (size*size)
      |>.filter (fun idx => ts.tiles[ts.h_ts.symm ▸ idx].isCorner)
      |>.map (.pos <| tsv.sign_vars ·)
    assert! corner_vars.length == 4
    EncCard.addClause <| .ofLits corner_vars 2
    /- Half the side pieces should be pos -/
    let side_vars := List.fins (size*size)
      |>.filter (fun idx => ts.tiles[ts.h_ts.symm ▸ idx].isSide)
      |>.map (.pos <| tsv.sign_vars ·)
    assert! side_vars.length == 4*(size-2)
    EncCard.addClause <| .ofLits side_vars (2*(size-2))
    /- Half the center pieces should be pos -/
    let center_vars := List.fins (size*size)
      |>.filter (fun idx => ts.tiles[ts.h_ts.symm ▸ idx].isCenter)
      |>.map (.pos <| tsv.sign_vars ·)
    assert! center_vars.length == (size-2)*(size-2)
    EncCard.addClause <| .ofLits center_vars ((size-2) * (size-2) / 2)
  else
    /- All the corners should be pos -/
    let corner_vars := List.fins (size*size)
      |>.filter (fun idx => ts.tiles[ts.h_ts.symm ▸ idx].isCorner)
      |>.map (.pos <| tsv.sign_vars ·)
    assert! corner_vars.length == 4
    EncCard.addClause <| .ofLits corner_vars 4
    /- Half - 2 of the side pieces should be pos -/
    let side_vars := List.fins (size*size)
      |>.filter (fun idx => ts.tiles[ts.h_ts.symm ▸ idx].isSide)
      |>.map (.pos <| tsv.sign_vars ·)
    assert! side_vars.length == 4*(size-2)
    EncCard.addClause <| .ofLits side_vars (2*(size-3))
    /- Half (round up) the center pieces should be pos -/
    let center_vars := List.fins (size*size)
      |>.filter (fun idx => ts.tiles[ts.h_ts.symm ▸ idx].isCenter)
      |>.map (.pos <| tsv.sign_vars ·)
    assert! center_vars.length == (size-2)*(size-2)
    EncCard.addClause <| .ofLits center_vars (((size-2) * (size-2) + 1) / 2)

def associatePolarities : EncCNF Unit := do
  -- For each piece & location, positive location -> positive piece, negative location -> negative piece
  for p in List.fins _ do
    for q in SquareIndex.all size do
      if q.isPos then
        -- positive location
        addClause (¬tsv.piece_vars p q ∨ tsv.sign_vars p)
      else
        -- negative location
        addClause (¬tsv.piece_vars p q ∨ ¬tsv.sign_vars p)


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.number_theory.pell
import Mathlib.data.pfun
import Mathlib.data.fin2
import Mathlib.PostPort

universes u u_1 u_2 u_3

namespace Mathlib

namespace int

theorem eq_nat_abs_iff_mul (x : ℤ) (n : ℕ) : nat_abs x = n ↔ (x - ↑n) * (x + ↑n) = 0 := sorry

end int

/-- Alternate definition of `vector` based on `fin2`. -/
def vector3 (α : Type u) (n : ℕ) :=
  fin2 n → α

namespace vector3

/-- The empty vector -/
def nil {α : Type u_1} : vector3 α 0 :=
  sorry

/-- The vector cons operation -/
def cons {α : Type u_1} {n : ℕ} (a : α) (v : vector3 α n) : vector3 α (Nat.succ n) :=
  fun (i : fin2 (Nat.succ n)) => fin2.cases' a v i

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

/- We do not want to make the following notation global, because then these expressions will be
overloaded, and only the expected type will be able to disambiguate the meaning. Worse: Lean will
try to insert a coercion from `vector3 α _` to `list α`, if a list is expected. -/

@[simp] theorem cons_fz {α : Type u_1} {n : ℕ} (a : α) (v : vector3 α n) : cons a v fin2.fz = a :=
  rfl

@[simp] theorem cons_fs {α : Type u_1} {n : ℕ} (a : α) (v : vector3 α n) (i : fin2 n) : cons a v (fin2.fs i) = v i :=
  rfl

/-- Get the `i`th element of a vector -/
def nth {α : Type u_1} {n : ℕ} (i : fin2 n) (v : vector3 α n) : α :=
  v i

/-- Construct a vector from a function on `fin2`. -/
def of_fn {α : Type u_1} {n : ℕ} (f : fin2 n → α) : vector3 α n :=
  f

/-- Get the head of a nonempty vector. -/
def head {α : Type u_1} {n : ℕ} (v : vector3 α (Nat.succ n)) : α :=
  v fin2.fz

/-- Get the tail of a nonempty vector. -/
def tail {α : Type u_1} {n : ℕ} (v : vector3 α (Nat.succ n)) : vector3 α n :=
  fun (i : fin2 n) => v (fin2.fs i)

theorem eq_nil {α : Type u_1} (v : vector3 α 0) : v = nil := sorry

theorem cons_head_tail {α : Type u_1} {n : ℕ} (v : vector3 α (Nat.succ n)) : head v :: tail v = v :=
  funext fun (i : fin2 (Nat.succ n)) => fin2.cases' rfl (fun (_x : fin2 n) => rfl) i

def nil_elim {α : Type u_1} {C : vector3 α 0 → Sort u} (H : C nil) (v : vector3 α 0) : C v :=
  eq.mpr sorry H

def cons_elim {α : Type u_1} {n : ℕ} {C : vector3 α (Nat.succ n) → Sort u} (H : (a : α) → (t : vector3 α n) → C (a :: t)) (v : vector3 α (Nat.succ n)) : C v :=
  eq.mpr sorry (H (head v) (tail v))

@[simp] theorem cons_elim_cons {α : Type u_1} {n : ℕ} {C : vector3 α (Nat.succ n) → Sort u_2} {H : (a : α) → (t : vector3 α n) → C (a :: t)} {a : α} {t : vector3 α n} : cons_elim H (a :: t) = H a t :=
  rfl

protected def rec_on {α : Type u_1} {C : {n : ℕ} → vector3 α n → Sort u} {n : ℕ} (v : vector3 α n) (H0 : C nil) (Hs : {n : ℕ} → (a : α) → (w : vector3 α n) → C w → C (a :: w)) : C v :=
  nat.rec_on n (fun (v : vector3 α 0) => nil_elim H0 v)
    (fun (n : ℕ) (IH : (_a : vector3 α n) → C _a) (v : vector3 α (Nat.succ n)) =>
      cons_elim (fun (a : α) (t : vector3 α n) => Hs a t (IH t)) v)
    v

@[simp] theorem rec_on_nil {α : Type u_1} {C : {n : ℕ} → vector3 α n → Sort u_2} {H0 : C nil} {Hs : {n : ℕ} → (a : α) → (w : vector3 α n) → C w → C (a :: w)} : vector3.rec_on nil H0 Hs = H0 :=
  rfl

@[simp] theorem rec_on_cons {α : Type u_1} {C : {n : ℕ} → vector3 α n → Sort u_2} {H0 : C nil} {Hs : {n : ℕ} → (a : α) → (w : vector3 α n) → C w → C (a :: w)} {n : ℕ} {a : α} {v : vector3 α n} : vector3.rec_on (a :: v) H0 Hs = Hs a v (vector3.rec_on v H0 Hs) :=
  rfl

/-- Append two vectors -/
def append {α : Type u_1} {m : ℕ} (v : vector3 α m) {n : ℕ} (w : vector3 α n) : vector3 α (n + m) :=
  nat.rec_on m (fun (_x : vector3 α 0) => w)
    (fun (m : ℕ) (IH : vector3 α m → vector3 α (n + m)) (v : vector3 α (Nat.succ m)) =>
      cons_elim (fun (a : α) (t : vector3 α m) => fin2.cases' a (IH t)) v)
    v

@[simp] theorem append_nil {α : Type u_1} {n : ℕ} (w : vector3 α n) : append nil w = w :=
  rfl

@[simp] theorem append_cons {α : Type u_1} (a : α) {m : ℕ} (v : vector3 α m) {n : ℕ} (w : vector3 α n) : append (a :: v) w = a :: append v w :=
  rfl

@[simp] theorem append_left {α : Type u_1} {m : ℕ} (i : fin2 m) (v : vector3 α m) {n : ℕ} (w : vector3 α n) : append v w (fin2.left n i) = v i := sorry

@[simp] theorem append_add {α : Type u_1} {m : ℕ} (v : vector3 α m) {n : ℕ} (w : vector3 α n) (i : fin2 n) : append v w (fin2.add i m) = w i := sorry

/-- Insert `a` into `v` at index `i`. -/
def insert {α : Type u_1} (a : α) {n : ℕ} (v : vector3 α n) (i : fin2 (Nat.succ n)) : vector3 α (Nat.succ n) :=
  fun (j : fin2 (Nat.succ n)) => cons a v (fin2.insert_perm i j)

@[simp] theorem insert_fz {α : Type u_1} (a : α) {n : ℕ} (v : vector3 α n) : insert a v fin2.fz = a :: v := sorry

@[simp] theorem insert_fs {α : Type u_1} (a : α) {n : ℕ} (b : α) (v : vector3 α n) (i : fin2 (Nat.succ n)) : insert a (b :: v) (fin2.fs i) = b :: insert a v i := sorry

theorem append_insert {α : Type u_1} (a : α) {k : ℕ} (t : vector3 α k) {n : ℕ} (v : vector3 α n) (i : fin2 (Nat.succ n)) (e : Nat.succ n + k = Nat.succ (n + k)) : insert a (append t v) (eq.rec_on e (fin2.add i k)) = eq.rec_on e (append t (insert a v i)) := sorry

end vector3

/-- "Curried" exists, i.e. ∃ x1 ... xn, f [x1, ..., xn] -/
def vector_ex {α : Type u_1} (k : ℕ) : (vector3 α k → Prop) → Prop :=
  sorry

/-- "Curried" forall, i.e. ∀ x1 ... xn, f [x1, ..., xn] -/
def vector_all {α : Type u_1} (k : ℕ) : (vector3 α k → Prop) → Prop :=
  sorry

theorem exists_vector_zero {α : Type u_1} (f : vector3 α 0 → Prop) : Exists f ↔ f vector3.nil := sorry

theorem exists_vector_succ {α : Type u_1} {n : ℕ} (f : vector3 α (Nat.succ n) → Prop) : Exists f ↔ ∃ (x : α), ∃ (v : vector3 α n), f (x :: v) := sorry

theorem vector_ex_iff_exists {α : Type u_1} {n : ℕ} (f : vector3 α n → Prop) : vector_ex n f ↔ Exists f := sorry

theorem vector_all_iff_forall {α : Type u_1} {n : ℕ} (f : vector3 α n → Prop) : vector_all n f ↔ ∀ (v : vector3 α n), f v := sorry

/-- `vector_allp p v` is equivalent to `∀ i, p (v i)`, but unfolds directly to a conjunction,
  i.e. `vector_allp p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
def vector_allp {α : Type u_1} (p : α → Prop) {n : ℕ} (v : vector3 α n) :=
  vector3.rec_on v True
    fun (n : ℕ) (a : α) (v : vector3 α n) (IH : Prop) =>
      vector3.rec_on v (p a) fun (n : ℕ) (b : α) (v' : vector3 α n) (_x : Prop) => p a ∧ IH

@[simp] theorem vector_allp_nil {α : Type u_1} (p : α → Prop) : vector_allp p vector3.nil = True :=
  rfl

@[simp] theorem vector_allp_singleton {α : Type u_1} (p : α → Prop) (x : α) : vector_allp p (x :: vector3.nil) = p x :=
  rfl

@[simp] theorem vector_allp_cons {α : Type u_1} (p : α → Prop) {n : ℕ} (x : α) (v : vector3 α n) : vector_allp p (x :: v) ↔ p x ∧ vector_allp p v :=
  vector3.rec_on v (iff.symm (and_true (vector_allp p (x :: vector3.nil))))
    fun (n : ℕ) (a : α) (v : vector3 α n) (IH : vector_allp p (x :: v) ↔ p x ∧ vector_allp p v) => iff.rfl

theorem vector_allp_iff_forall {α : Type u_1} (p : α → Prop) {n : ℕ} (v : vector3 α n) : vector_allp p v ↔ ∀ (i : fin2 n), p (v i) := sorry

theorem vector_allp.imp {α : Type u_1} {p : α → Prop} {q : α → Prop} (h : ∀ (x : α), p x → q x) {n : ℕ} {v : vector3 α n} (al : vector_allp p v) : vector_allp q v :=
  iff.mpr (vector_allp_iff_forall q v) fun (i : fin2 n) => h (v i) (iff.mp (vector_allp_iff_forall p v) al i)

/-- `list_all p l` is equivalent to `∀ a ∈ l, p a`, but unfolds directly to a conjunction,
  i.e. `list_all p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
@[simp] def list_all {α : Type u_1} (p : α → Prop) : List α → Prop :=
  sorry

@[simp] theorem list_all_cons {α : Type u_1} (p : α → Prop) (x : α) (l : List α) : list_all p (x :: l) ↔ p x ∧ list_all p l :=
  list.cases_on l (idRhs (list_all p [x] ↔ list_all p [x] ∧ True) (iff.symm (and_true (list_all p [x]))))
    fun (l_hd : α) (l_tl : List α) => idRhs (list_all p (x :: l_hd :: l_tl) ↔ list_all p (x :: l_hd :: l_tl)) iff.rfl

theorem list_all_iff_forall {α : Type u_1} (p : α → Prop) (l : List α) : list_all p l ↔ ∀ (x : α), x ∈ l → p x := sorry

theorem list_all.imp {α : Type u_1} {p : α → Prop} {q : α → Prop} (h : ∀ (x : α), p x → q x) {l : List α} : list_all p l → list_all q l := sorry

@[simp] theorem list_all_map {α : Type u_1} {β : Type u_2} {p : β → Prop} (f : α → β) {l : List α} : list_all p (list.map f l) ↔ list_all (p ∘ f) l := sorry

theorem list_all_congr {α : Type u_1} {p : α → Prop} {q : α → Prop} (h : ∀ (x : α), p x ↔ q x) {l : List α} : list_all p l ↔ list_all q l :=
  { mp := list_all.imp fun (x : α) => iff.mp (h x), mpr := list_all.imp fun (x : α) => iff.mpr (h x) }

protected instance decidable_list_all {α : Type u_1} (p : α → Prop) [decidable_pred p] (l : List α) : Decidable (list_all p l) :=
  decidable_of_decidable_of_iff (list.decidable_ball (fun (x : α) => p x) l) sorry

/- poly -/

/-- A predicate asserting that a function is a multivariate integer polynomial.
  (We are being a bit lazy here by allowing many representations for multiplication,
  rather than only allowing monomials and addition, but the definition is equivalent
  and this is easier to use.) -/
inductive is_poly {α : Sort u_1} : ((α → ℕ) → ℤ) → Prop
where
| proj : ∀ (i : α), is_poly fun (x : α → ℕ) => ↑(x i)
| const : ∀ (n : ℤ), is_poly fun (x : α → ℕ) => n
| sub : ∀ {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly fun (x : α → ℕ) => f x - g x
| mul : ∀ {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly fun (x : α → ℕ) => f x * g x

/-- The type of multivariate integer polynomials -/
def poly (α : Type u) :=
  Subtype fun (f : (α → ℕ) → ℤ) => is_poly f

namespace poly

protected instance has_coe_to_fun {α : Type u} : has_coe_to_fun (poly α) :=
  has_coe_to_fun.mk (fun (f : poly α) => (α → ℕ) → ℤ) fun (f : poly α) => subtype.val f

/-- The underlying function of a `poly` is a polynomial -/
theorem isp {α : Type u} (f : poly α) : is_poly ⇑f :=
  subtype.property f

/-- Extensionality for `poly α` -/
theorem ext {α : Type u} {f : poly α} {g : poly α} (e : ∀ (x : α → ℕ), coe_fn f x = coe_fn g x) : f = g :=
  subtype.eq (funext e)

/-- Construct a `poly` given an extensionally equivalent `poly`. -/
def subst {α : Type u} (f : poly α) (g : (α → ℕ) → ℤ) (e : ∀ (x : α → ℕ), coe_fn f x = g x) : poly α :=
  { val := g, property := sorry }

@[simp] theorem subst_eval {α : Type u} (f : poly α) (g : (α → ℕ) → ℤ) (e : ∀ (x : α → ℕ), coe_fn f x = g x) (x : α → ℕ) : coe_fn (subst f g e) x = g x :=
  rfl

/-- The `i`th projection function, `x_i`. -/
def proj {α : Type u} (i : α) : poly α :=
  { val := fun (x : α → ℕ) => ↑(x i), property := is_poly.proj i }

@[simp] theorem proj_eval {α : Type u} (i : α) (x : α → ℕ) : coe_fn (proj i) x = ↑(x i) :=
  rfl

/-- The constant function with value `n : ℤ`. -/
def const {α : Type u} (n : ℤ) : poly α :=
  { val := fun (x : α → ℕ) => n, property := is_poly.const n }

@[simp] theorem const_eval {α : Type u} (n : ℤ) (x : α → ℕ) : coe_fn (const n) x = n :=
  rfl

/-- The zero polynomial -/
def zero {α : Type u} : poly α :=
  const 0

protected instance has_zero {α : Type u} : HasZero (poly α) :=
  { zero := zero }

@[simp] theorem zero_eval {α : Type u} (x : α → ℕ) : coe_fn 0 x = 0 :=
  rfl

/-- The zero polynomial -/
def one {α : Type u} : poly α :=
  const 1

protected instance has_one {α : Type u} : HasOne (poly α) :=
  { one := one }

@[simp] theorem one_eval {α : Type u} (x : α → ℕ) : coe_fn 1 x = 1 :=
  rfl

/-- Subtraction of polynomials -/
def sub {α : Type u} : poly α → poly α → poly α :=
  sorry

protected instance has_sub {α : Type u} : Sub (poly α) :=
  { sub := sub }

@[simp] theorem sub_eval {α : Type u} (f : poly α) (g : poly α) (x : α → ℕ) : coe_fn (f - g) x = coe_fn f x - coe_fn g x := sorry

/-- Negation of a polynomial -/
def neg {α : Type u} (f : poly α) : poly α :=
  0 - f

protected instance has_neg {α : Type u} : Neg (poly α) :=
  { neg := neg }

@[simp] theorem neg_eval {α : Type u} (f : poly α) (x : α → ℕ) : coe_fn (-f) x = -coe_fn f x := sorry

/-- Addition of polynomials -/
def add {α : Type u} : poly α → poly α → poly α :=
  sorry

protected instance has_add {α : Type u} : Add (poly α) :=
  { add := add }

@[simp] theorem add_eval {α : Type u} (f : poly α) (g : poly α) (x : α → ℕ) : coe_fn (f + g) x = coe_fn f x + coe_fn g x := sorry

/-- Multiplication of polynomials -/
def mul {α : Type u} : poly α → poly α → poly α :=
  sorry

protected instance has_mul {α : Type u} : Mul (poly α) :=
  { mul := mul }

@[simp] theorem mul_eval {α : Type u} (f : poly α) (g : poly α) (x : α → ℕ) : coe_fn (f * g) x = coe_fn f x * coe_fn g x := sorry

protected instance comm_ring {α : Type u} : comm_ring (poly α) :=
  comm_ring.mk Add.add sorry 0 sorry sorry Neg.neg Sub.sub sorry sorry Mul.mul sorry 1 sorry sorry sorry sorry sorry

theorem induction {α : Type u} {C : poly α → Prop} (H1 : ∀ (i : α), C (proj i)) (H2 : ∀ (n : ℤ), C (const n)) (H3 : ∀ (f g : poly α), C f → C g → C (f - g)) (H4 : ∀ (f g : poly α), C f → C g → C (f * g)) (f : poly α) : C f := sorry

/-- The sum of squares of a list of polynomials. This is relevant for
  Diophantine equations, because it means that a list of equations
  can be encoded as a single equation: `x = 0 ∧ y = 0 ∧ z = 0` is
  equivalent to `x^2 + y^2 + z^2 = 0`. -/
def sumsq {α : Type u} : List (poly α) → poly α :=
  sorry

theorem sumsq_nonneg {α : Type u} (x : α → ℕ) (l : List (poly α)) : 0 ≤ coe_fn (sumsq l) x := sorry

theorem sumsq_eq_zero {α : Type u} (x : α → ℕ) (l : List (poly α)) : coe_fn (sumsq l) x = 0 ↔ list_all (fun (a : poly α) => coe_fn a x = 0) l := sorry

/-- Map the index set of variables, replacing `x_i` with `x_(f i)`. -/
def remap {α : Type u_1} {β : Type u_2} (f : α → β) (g : poly α) : poly β :=
  { val := fun (v : β → ℕ) => coe_fn g (v ∘ f), property := sorry }

@[simp] theorem remap_eval {α : Type u_1} {β : Type u_2} (f : α → β) (g : poly α) (v : β → ℕ) : coe_fn (remap f g) v = coe_fn g (v ∘ f) :=
  rfl

end poly

namespace sum

/-- combine two functions into a function on the disjoint union -/
def join {α : Type u_1} {β : Type u_2} {γ : Sort u_3} (f : α → γ) (g : β → γ) : α ⊕ β → γ :=
  sum.rec f g

end sum

namespace option

/-- Functions from `option` can be combined similarly to `vector.cons` -/
def cons {α : Type u_1} {β : Sort u_2} (a : β) (v : α → β) : Option α → β :=
  Option.rec a v

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

@[simp] theorem cons_head_tail {α : Type u_1} {β : Sort u_2} (v : Option α → β) : v none :: v ∘ some = v := sorry

end option

/- dioph -/

/-- A set `S ⊆ ℕ^α` is diophantine if there exists a polynomial on
  `α ⊕ β` such that `v ∈ S` iff there exists `t : ℕ^β` with `p (v, t) = 0`. -/
def dioph {α : Type u} (S : set (α → ℕ)) :=
  Exists fun {β : Type u} => ∃ (p : poly (α ⊕ β)), ∀ (v : α → ℕ), S v ↔ ∃ (t : β → ℕ), coe_fn p (sum.join v t) = 0

namespace dioph

theorem ext {α : Type u} {S : set (α → ℕ)} {S' : set (α → ℕ)} (d : dioph S) (H : ∀ (v : α → ℕ), S v ↔ S' v) : dioph S' :=
  Eq._oldrec d ((fun (this : S = S') => this) (set.ext H))

theorem of_no_dummies {α : Type u} (S : set (α → ℕ)) (p : poly α) (h : ∀ (v : α → ℕ), S v ↔ coe_fn p v = 0) : dioph S := sorry

theorem inject_dummies_lem {α : Type u} {β : Type u} {γ : Type u} (f : β → γ) (g : γ → Option β) (inv : ∀ (x : β), g (f x) = some x) (p : poly (α ⊕ β)) (v : α → ℕ) : (∃ (t : β → ℕ), coe_fn p (sum.join v t) = 0) ↔
  ∃ (t : γ → ℕ), coe_fn (poly.remap (sum.join sum.inl (sum.inr ∘ f)) p) (sum.join v t) = 0 := sorry

theorem inject_dummies {α : Type u} {β : Type u} {γ : Type u} {S : set (α → ℕ)} (f : β → γ) (g : γ → Option β) (inv : ∀ (x : β), g (f x) = some x) (p : poly (α ⊕ β)) (h : ∀ (v : α → ℕ), S v ↔ ∃ (t : β → ℕ), coe_fn p (sum.join v t) = 0) : ∃ (q : poly (α ⊕ γ)), ∀ (v : α → ℕ), S v ↔ ∃ (t : γ → ℕ), coe_fn q (sum.join v t) = 0 :=
  Exists.intro (poly.remap (sum.join sum.inl (sum.inr ∘ f)) p)
    fun (v : α → ℕ) => iff.trans (h v) (inject_dummies_lem f g inv p v)

theorem reindex_dioph {α : Type u} {β : Type u} {S : set (α → ℕ)} (d : dioph S) (f : α → β) : dioph fun (v : β → ℕ) => S (v ∘ f) := sorry

theorem dioph_list_all {α : Type u} (l : List (set (α → ℕ))) (d : list_all dioph l) : dioph fun (v : α → ℕ) => list_all (fun (S : set (α → ℕ)) => S v) l := sorry

theorem and_dioph {α : Type u} {S : set (α → ℕ)} {S' : set (α → ℕ)} (d : dioph S) (d' : dioph S') : dioph fun (v : α → ℕ) => S v ∧ S' v :=
  dioph_list_all [S, S'] { left := d, right := d' }

theorem or_dioph {α : Type u} {S : set (α → ℕ)} {S' : set (α → ℕ)} (d : dioph S) (d' : dioph S') : dioph fun (v : α → ℕ) => S v ∨ S' v := sorry

/-- A partial function is Diophantine if its graph is Diophantine. -/
def dioph_pfun {α : Type u} (f : (α → ℕ) →. ℕ) :=
  dioph fun (v : Option α → ℕ) => pfun.graph f (v ∘ some, v none)

/-- A function is Diophantine if its graph is Diophantine. -/
def dioph_fn {α : Type u} (f : (α → ℕ) → ℕ) :=
  dioph fun (v : Option α → ℕ) => f (v ∘ some) = v none

theorem reindex_dioph_fn {α : Type u} {β : Type u} {f : (α → ℕ) → ℕ} (d : dioph_fn f) (g : α → β) : dioph_fn fun (v : β → ℕ) => f (v ∘ g) :=
  reindex_dioph d (Functor.map g)

theorem ex_dioph {α : Type u} {β : Type u} {S : set (α ⊕ β → ℕ)} : dioph S → dioph fun (v : α → ℕ) => ∃ (x : β → ℕ), S (sum.join v x) := sorry

theorem ex1_dioph {α : Type u} {S : set (Option α → ℕ)} : dioph S → dioph fun (v : α → ℕ) => ∃ (x : ℕ), S (x :: v) := sorry

theorem dom_dioph {α : Type u} {f : (α → ℕ) →. ℕ} (d : dioph_pfun f) : dioph (pfun.dom f) :=
  cast (congr_arg dioph (set.ext fun (v : α → ℕ) => iff.symm (pfun.dom_iff_graph f v))) (ex1_dioph d)

theorem dioph_fn_iff_pfun {α : Type u} (f : (α → ℕ) → ℕ) : dioph_fn f = dioph_pfun ↑f :=
  congr_arg dioph (set.ext fun (v : Option α → ℕ) => iff.symm pfun.lift_graph)

theorem abs_poly_dioph {α : Type u} (p : poly α) : dioph_fn fun (v : α → ℕ) => int.nat_abs (coe_fn p v) :=
  of_no_dummies (fun (v : Option α → ℕ) => (fun (v : α → ℕ) => int.nat_abs (coe_fn p v)) (v ∘ some) = v none)
    ((poly.remap some p - poly.proj none) * (poly.remap some p + poly.proj none))
    fun (v : Option α → ℕ) => int.eq_nat_abs_iff_mul (coe_fn p (v ∘ some)) (v none)

theorem proj_dioph {α : Type u} (i : α) : dioph_fn fun (v : α → ℕ) => v i :=
  abs_poly_dioph (poly.proj i)

theorem dioph_pfun_comp1 {α : Type u} {S : set (Option α → ℕ)} (d : dioph S) {f : (α → ℕ) →. ℕ} (df : dioph_pfun f) : dioph fun (v : α → ℕ) => ∃ (h : pfun.dom f v), S (pfun.fn f v h :: v) := sorry

theorem dioph_fn_comp1 {α : Type u} {S : set (Option α → ℕ)} (d : dioph S) {f : (α → ℕ) → ℕ} (df : dioph_fn f) : dioph fun (v : α → ℕ) => S (f v :: v) := sorry

theorem dioph_fn_vec_comp1 {n : ℕ} {S : set (vector3 ℕ (Nat.succ n))} (d : dioph S) {f : vector3 ℕ n → ℕ} (df : dioph_fn f) : dioph fun (v : vector3 ℕ n) => S (f v :: v) := sorry

theorem vec_ex1_dioph (n : ℕ) {S : set (vector3 ℕ (Nat.succ n))} (d : dioph S) : dioph fun (v : vector3 ℕ n) => ∃ (x : ℕ), S (x :: v) := sorry

theorem dioph_fn_vec {n : ℕ} (f : vector3 ℕ n → ℕ) : dioph_fn f ↔ dioph fun (v : vector3 ℕ (Nat.succ n)) => f (v ∘ fin2.fs) = v fin2.fz :=
  { mp := fun (h : dioph_fn f) => reindex_dioph h (fin2.fz :: fin2.fs),
    mpr :=
      fun (h : dioph fun (v : vector3 ℕ (Nat.succ n)) => f (v ∘ fin2.fs) = v fin2.fz) => reindex_dioph h (none :: some) }

theorem dioph_pfun_vec {n : ℕ} (f : vector3 ℕ n →. ℕ) : dioph_pfun f ↔ dioph fun (v : vector3 ℕ (Nat.succ n)) => pfun.graph f (v ∘ fin2.fs, v fin2.fz) := sorry

theorem dioph_fn_compn {α : Type} {n : ℕ} {S : set (α ⊕ fin2 n → ℕ)} (d : dioph S) {f : vector3 ((α → ℕ) → ℕ) n} (df : vector_allp dioph_fn f) : dioph fun (v : α → ℕ) => S (sum.join v fun (i : fin2 n) => f i v) := sorry

theorem dioph_comp {α : Type} {n : ℕ} {S : set (vector3 ℕ n)} (d : dioph S) (f : vector3 ((α → ℕ) → ℕ) n) (df : vector_allp dioph_fn f) : dioph fun (v : α → ℕ) => S fun (i : fin2 n) => f i v :=
  dioph_fn_compn (reindex_dioph d sum.inr) df

theorem dioph_fn_comp {α : Type} {n : ℕ} {f : vector3 ℕ n → ℕ} (df : dioph_fn f) (g : vector3 ((α → ℕ) → ℕ) n) (dg : vector_allp dioph_fn g) : dioph_fn fun (v : α → ℕ) => f fun (i : fin2 n) => g i v := sorry

theorem proj_dioph_of_nat {n : ℕ} (m : ℕ) [fin2.is_lt m n] : dioph_fn fun (v : vector3 ℕ n) => v (fin2.of_nat' m) :=
  proj_dioph (fin2.of_nat' m)

theorem const_dioph {α : Type} (n : ℕ) : dioph_fn (function.const (α → ℕ) n) :=
  abs_poly_dioph (poly.const ↑n)

theorem dioph_comp2 {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) {S : ℕ → ℕ → Prop} (d : dioph fun (v : vector3 ℕ (bit0 1)) => S (v (fin2.of_nat' 0)) (v (fin2.of_nat' 1))) : dioph fun (v : α → ℕ) => S (f v) (g v) :=
  dioph_comp d (f :: g :: vector3.nil) { left := df, right := dg }

theorem dioph_fn_comp2 {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) {h : ℕ → ℕ → ℕ} (d : dioph_fn fun (v : vector3 ℕ (bit0 1)) => h (v (fin2.of_nat' 0)) (v (fin2.of_nat' 1))) : dioph_fn fun (v : α → ℕ) => h (f v) (g v) :=
  dioph_fn_comp d (f :: g :: vector3.nil) { left := df, right := dg }

theorem eq_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph fun (v : α → ℕ) => f v = g v := sorry

theorem add_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v + g v :=
  dioph_fn_comp2 df dg (abs_poly_dioph (poly.proj (fin2.of_nat' 0) + poly.proj (fin2.of_nat' 1)))

theorem mul_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v * g v :=
  dioph_fn_comp2 df dg (abs_poly_dioph (poly.proj (fin2.of_nat' 0) * poly.proj (fin2.of_nat' 1)))

theorem le_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph fun (v : α → ℕ) => f v ≤ g v := sorry

theorem lt_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph fun (v : α → ℕ) => f v < g v :=
  le_dioph (add_dioph df (const_dioph 1)) dg

theorem ne_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph fun (v : α → ℕ) => f v ≠ g v :=
  ext (or_dioph (lt_dioph df dg) (lt_dioph dg df)) fun (v : α → ℕ) => iff.symm ne_iff_lt_or_gt

theorem sub_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v - g v := sorry

theorem dvd_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph fun (v : α → ℕ) => f v ∣ g v := sorry

theorem mod_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v % g v := sorry

theorem modeq_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) {h : (α → ℕ) → ℕ} (dh : dioph_fn h) : dioph fun (v : α → ℕ) => nat.modeq (h v) (f v) (g v) :=
  eq_dioph (mod_dioph df dh) (mod_dioph dg dh)

theorem div_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v / g v := sorry

theorem pell_dioph : dioph
  fun (v : vector3 ℕ (bit0 (bit0 1))) =>
    ∃ (h : 1 < v (fin2.of_nat' 0)),
      pell.xn h (v (fin2.of_nat' 1)) = v (fin2.of_nat' (bit0 1)) ∧
        pell.yn h (v (fin2.of_nat' 1)) = v (fin2.of_nat' (bit1 1)) := sorry

theorem xn_dioph : dioph_pfun
  fun (v : vector3 ℕ (bit0 1)) =>
    roption.mk (1 < v (fin2.of_nat' 0)) fun (h : 1 < v (fin2.of_nat' 0)) => pell.xn h (v (fin2.of_nat' 1)) := sorry

theorem pow_dioph {α : Type} {f : (α → ℕ) → ℕ} {g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g) : dioph_fn fun (v : α → ℕ) => f v ^ g v := sorry


import Lean
open Lean

instance : BEq (Option ModuleIdx) := inferInstanceAs (BEq (Option Nat))

/- A function for extracting the name and the type out of a `ConstantInfo` term.
It is desgined to work only for theorems, but can be extended to work for definitions too (may cause issues). -/
def Lean.ConstantInfo.extractNameType : ConstantInfo → Option (Name × Expr)
  | .thmInfo ⟨⟨nm, _, typ⟩, _, _⟩ => some ⟨nm, typ⟩
--  | .defnInfo ⟨⟨nm, _, typ⟩, _, _, _, _⟩ => some ⟨nm, typ⟩
  | _ => none

/- Gets all the theorem names and docstrings in the current file -/
def getFileThmInfo : MetaM (List $ Name × Option String) := do

  let env ← getEnv -- getting the current environment
  let mainModuleIdx := env.getModuleIdx? env.mainModule -- the index of the main module (i.e., the current file)

  -- extracting the names and types of the theorems in the current file
  let cnsts : List (Name × Expr) := env.constants |>.toList |>.filterMap
    (λ ⟨nm, ci⟩ => liftOption $ do
      guard $ env.getModuleIdxFor? nm == mainModuleIdx -- ensuring that the constant is in the current file
      ci.extractNameType) -- extracting the name and the type pf the theorem using the function defined above

  -- fetching the docstrings for each of the theorems in the current file
  (liftM : IO _ → MetaM _) $
    cnsts.mapM (λ ⟨nm, typ⟩ => do
      return ⟨nm, ← findDocString? env nm⟩ )

section Testing

/-- Addition of two on the left is equal to addition of two on the right. -/
theorem add_two_comm : ∀ n : Nat, n + 2 = 2 + n := sorry

/-- Fermat's Last theorem, stated in the special case of `n = 3`. -/
theorem flt3 : a^3 + b^3 = c^3 → a * b * c = 0 := sorry

#eval getFileThmInfo

end Testing


import category_theory.functor.category
import category_theory.products.basic

open category_theory

namespace category_theory

namespace nat_trans

@[simps]
def unflip {C D E : Type*} [category C] [category D] [category E]
  {F G : C ⥤ D ⥤ E} (φ : F.flip ⟶ G.flip) : F ⟶ G :=
{ app := λ c,
  { app := λ d, (φ.app d).app c,
    naturality' := λ d₁ d₂ g, nat_trans.congr_app (φ.naturality g) c, },
  naturality' := λ c₁ c₂ f, begin
    ext d,
    exact (φ.app d).naturality f,
  end}

lemma unflip_id {C D E : Type*} [category C] [category D] [category E]
  {F : C ⥤ D ⥤ E} : nat_trans.unflip (𝟙 F.flip) = 𝟙 F := rfl

lemma unflip_comp {C D E : Type*} [category C] [category D] [category E]
  {F G H : C ⥤ D ⥤ E} (φ₁ : F.flip ⟶ G.flip) (φ₂ : G.flip ⟶ H.flip) :
  nat_trans.unflip (φ₁ ≫ φ₂) = nat_trans.unflip φ₁ ≫ nat_trans.unflip φ₂ := rfl

end nat_trans

namespace nat_iso

def unflip {C D E : Type*} [category C] [category D] [category E]
  {F G : C ⥤ D ⥤ E} (e : F.flip ≅ G.flip) : F ≅ G :=
{ hom := nat_trans.unflip e.hom,
  inv := nat_trans.unflip e.inv,
  hom_inv_id' := by rw [← nat_trans.unflip_comp, e.hom_inv_id, nat_trans.unflip_id],
  inv_hom_id' := by rw [← nat_trans.unflip_comp, e.inv_hom_id, nat_trans.unflip_id], }

end nat_iso

namespace functor

def flip_evaluation_comp_whiskering_right (C : Type*) {D E : Type*}
  [category C] [category D] [category E] (H : D ⥤ E) :
  (evaluation C D ⋙ (whiskering_right (C ⥤ D) D E).obj H).flip ≅
    (whiskering_right C D E).obj H := iso.refl _

def whiskering_right_obj_comp (C : Type*) {D₁ D₂ D₃ : Type*}
  [category C] [category D₁] [category D₂] [category D₃]
  (F₁₂ : D₁ ⥤ D₂) (F₂₃ : D₂ ⥤ D₃) :
  (whiskering_right C _ _).obj (F₁₂ ⋙ F₂₃) ≅
    (whiskering_right C _ _).obj F₁₂ ⋙
    (whiskering_right C _ _).obj F₂₃ := iso.refl _

end functor

end category_theory


import .basic category_theory.limits.limits

universes u u₁ u₂ v v₁ v₂

namespace category_theory
  open function
  variables {C : Sort u₁} [𝒞 : category.{v₁} C]
  include 𝒞

  lemma injective_hom_op (X Y : C) : injective (@has_hom.hom.op _ _ X Y) :=
  λ f f' hf, by rw [←@has_hom.hom.unop_op _ _ _ _ f, ←@has_hom.hom.unop_op _ _ _ _ f', hf]

  lemma injective_hom_unop (X Y : Cᵒᵖ) : injective (@has_hom.hom.unop _ _ X Y) :=
  λ f f' hf, by rw [←@has_hom.hom.op_unop _ _ _ _ f, ←@has_hom.hom.op_unop _ _ _ _ f', hf]

end category_theory

open category_theory

namespace category_theory.nat_trans

variables {C : Sort u₁} [𝒞 : category.{v₁} C] {D : Sort u₂} [𝒟 : category.{v₂} D]
include 𝒞 𝒟

protected def unop' (F F' : C ⥤ D) (η : F.op ⟶ F'.op) : F' ⟶ F :=
{ app := λ x, (η.app $ op x).unop,
  naturality' :=
    by { intros, apply injective_hom_op, have := η.naturality f.op, simp at this, simp [this] } }

protected def op' (F F' : Cᵒᵖ ⥤ Dᵒᵖ) (η : F.unop ⟶ F'.unop) : F' ⟶ F :=
{ app := λ x, (η.app $ unop x).op,
  naturality' :=
    by { intros, apply injective_hom_unop, have := η.naturality f.unop, simp at this, simp [this] } }

end category_theory.nat_trans

open category_theory
namespace category_theory.nat_iso

variables {C : Sort u₁} [𝒞 : category.{v₁} C] {D : Sort u₂} [𝒟 : category.{v₂} D]
include 𝒞 𝒟

protected def op_unop (F : C ⥤ D) : F.op.unop ≅ F :=
by { cases F, refl } -- maybe not the best definition

protected def unop_op (F : Cᵒᵖ ⥤ Dᵒᵖ) : F.unop.op ≅ F :=
by { cases F, refl } -- maybe not the best definition

protected def op_functor_const (d : D) :
  ((category_theory.functor.const C).obj d).op ≅ (category_theory.functor.const Cᵒᵖ).obj (op d) :=
by refl

end category_theory.nat_iso

open category_theory
namespace category_theory.limits

variables {J : Type v} [small_category J]
variables {C : Sort u} [category.{v+1} C]

-- protected def cocone.op {F : J ⥤ C} (s : cocone F) : cone F.op :=
-- ⟨op s.X, s.ι.op⟩

-- protected def cone.op {F : J ⥤ C} (s : cone F) : cocone F.op :=
-- ⟨op s.X, s.π.op⟩

-- protected def cocone.unop {F : Jᵒᵖ ⥤ Cᵒᵖ} (s : cocone F) : cone F.unop :=
-- ⟨unop s.X, s.ι.unop⟩

-- protected def cone.unop {F : Jᵒᵖ ⥤ Cᵒᵖ} (s : cone F) : cocone F.unop :=
-- ⟨unop s.X, s.π.unop⟩

-- protected def cocone.op' {F : Jᵒᵖ ⥤ Cᵒᵖ} (s : cocone F.unop) : cone F :=
-- ⟨op s.X, s.ι.op' F ((category_theory.functor.const Jᵒᵖ).obj $ op s.X)⟩

-- protected def cone.op' {F : Jᵒᵖ ⥤ Cᵒᵖ} (s : cone F.unop) : cocone F :=
-- ⟨op s.X, s.π.op' ((category_theory.functor.const Jᵒᵖ).obj $ op s.X) F⟩

-- protected def cocone.unop' {F : J ⥤ C} (s : cocone F.op) : cone F :=
-- ⟨unop s.X, s.ι.unop' F ((category_theory.functor.const J).obj $ unop s.X)⟩

-- protected def cone.unop' {F : J ⥤ C} (s : cone F.op) : cocone F :=
-- ⟨unop s.X, s.π.unop' ((category_theory.functor.const J).obj $ unop s.X) F⟩

-- def has_limit_op {F : J ⥤ C} (H : has_colimit F) : has_limit F.op :=
-- { cone := H.cocone.op,
--   is_limit :=
--   { lift := λ s, (H.is_colimit.desc s.unop').op,
--     fac' := omitted,
--     uniq' := omitted } }

-- def has_colimit_op {F : J ⥤ C} (H : has_limit F) : has_colimit F.op :=
-- { cocone := H.cone.op,
--   is_colimit :=
--   { desc := λ s, (H.is_limit.lift s.unop').op,
--     fac' := omitted,
--     uniq' := omitted } }

-- -- def has_limit_op {F : J ⥤ C} (H : has_colimit F) : has_limit F.op :=
-- -- { cone := H.cocone.op,
-- --   is_limit :=
-- --   { lift := λ s, begin unfreezeI, cases F, exact (H.is_colimit.desc s.unop).op end,
-- --     fac' := omitted,
-- --     uniq' := omitted } }

-- -- def has_colimit_op {F : J ⥤ C} (H : has_limit F) : has_colimit F.op :=
-- -- { cocone := H.cone.op,
-- --   is_colimit :=
-- --   { desc := λ s, begin unfreezeI, cases F, exact (H.is_limit.lift s.unop).op end,
-- --     fac' := omitted,
-- --     uniq' := omitted } }

-- def has_limit_unop {F : Jᵒᵖ ⥤ Cᵒᵖ} (H : has_colimit F) : has_limit F.unop :=
-- { cone := H.cocone.unop,
--   is_limit :=
--   { lift := λ s, (H.is_colimit.desc s.op').unop,
--     fac' := omitted,
--     uniq' := omitted } }

-- def has_colimit_unop {F : Jᵒᵖ ⥤ Cᵒᵖ} (H : has_limit F) : has_colimit F.unop :=
-- { cocone := H.cone.unop,
--   is_colimit :=
--   { desc := λ s, (H.is_limit.lift s.op').unop,
--     fac' := omitted,
--     uniq' := omitted } }

-- def has_limit_op' {F : Jᵒᵖ ⥤ Cᵒᵖ} (H : has_colimit F.unop) : has_limit F :=
-- { cone := H.cocone.op',
--   is_limit :=
--   { lift := λ s, (H.is_colimit.desc s.unop).op,
--     fac' := omitted,
--     uniq' := omitted } }

-- def has_colimit_op' {F : Jᵒᵖ ⥤ Cᵒᵖ} (H : has_limit F.unop) : has_colimit F :=
-- { cocone := H.cone.op',
--   is_colimit :=
--   { desc := λ s, (H.is_limit.lift s.unop).op,
--     fac' := omitted,
--     uniq' := omitted } }

-- def has_limit_unop' {F : J ⥤ C} (H : has_colimit F.op) : has_limit F :=
-- { cone := H.cocone.unop',
--   is_limit :=
--   { lift := λ s, (H.is_colimit.desc s.op).unop,
--     fac' := omitted,
--     uniq' := omitted } }

-- def has_colimit_unop' {F : J ⥤ C} (H : has_limit F.op) : has_colimit F :=
-- { cocone := H.cone.unop',
--   is_colimit :=
--   { desc := λ s, (H.is_limit.lift s.op).unop,
--     fac' := omitted,
--     uniq' := omitted } }

-- def has_limits_of_shape_op (H : has_colimits_of_shape J C) : has_limits_of_shape Jᵒᵖ Cᵒᵖ :=
-- λ F, has_limit_op' (H _)

end category_theory.limits


/-
Copyright (c) 2021 Luke Kershaw. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Luke Kershaw
-/
import category_theory.additive.basic
import category_theory.shift
import category_theory.preadditive.additive_functor
import category_theory.triangulated.basic
import category_theory.triangulated.rotate

/-!
# Pretriangulated Categories

This file contains the definition of pretriangulated categories and triangulated functors
between them.

## Implementation Notes

We work under the assumption that pretriangulated categories are preadditive categories,
but not necessarily additive categories, as is assumed in some sources.

TODO: generalise this to n-angulated categories as in https://arxiv.org/abs/1006.4592
-/

noncomputable theory

open category_theory
open category_theory.preadditive
open category_theory.limits

universes v v₀ v₁ v₂ u u₀ u₁ u₂

namespace category_theory.triangulated
open category_theory.category

/-
We work in an preadditive category `C` equipped with an additive shift.
-/
variables (C : Type u) [category.{v} C] [has_zero_object C] [has_shift C] [preadditive C]
  [functor.additive (shift C).functor]

/--
A preadditive category `C` with an additive shift, and a class of "distinguished triangles"
relative to that shift is called pretriangulated if the following hold:
* Any triangle that is isomorphic to a distinguished triangle is also distinguished.
* Any triangle of the form `(X,X,0,id,0,0)` is distinguished.
* For any morphism `f : X ⟶ Y` there exists a distinguished triangle of the form `(X,Y,Z,f,g,h)`.
* The triangle `(X,Y,Z,f,g,h)` is distinguished if and only if `(Y,Z,X⟦1⟧,g,h,-f⟦1⟧)` is.
* Given a diagram:
  ```
        f       g       h
    X  ───> Y  ───> Z  ───> X⟦1⟧
    │       │                │
    │a      │b               │a⟦1⟧'
    V       V                V
    X' ───> Y' ───> Z' ───> X'⟦1⟧
        f'      g'      h'
  ```
  where the left square commutes, and whose rows are distinguished triangles,
  there exists a morphism `c : Z ⟶ Z'` such that `(a,b,c)` is a triangle morphism.
See https://stacks.math.columbia.edu/tag/0145
-/
class pretriangulated :=
(distinguished_triangles [] : set (triangle C))
(isomorphic_distinguished : Π (T₁ ∈ distinguished_triangles) (T₂ : triangle C) (T₁ ≅ T₂),
  T₂ ∈ distinguished_triangles)
(contractible_distinguished : Π (X : C), (contractible_triangle C X) ∈ distinguished_triangles)
(distinguished_cocone_triangle : Π (X Y : C) (f: X ⟶ Y), (∃ (Z : C) (g : Y ⟶ Z) (h : Z ⟶ X⟦1⟧),
  triangle.mk _ f g h ∈ distinguished_triangles))
(rotate_distinguished_triangle : Π (T : triangle C),
  T ∈ distinguished_triangles ↔ T.rotate ∈ distinguished_triangles)
(complete_distinguished_triangle_morphism : Π (T₁ T₂ : triangle C)
  (h₁ : T₁ ∈ distinguished_triangles) (h₂ : T₂ ∈ distinguished_triangles) (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₃) ))

namespace pretriangulated
variables [pretriangulated C]

notation `dist_triang`:20 C := distinguished_triangles C
/--
Given any distinguished triangle `T`, then we know `T.rotate` is also distinguished.
-/
lemma rot_of_dist_triangle (T ∈ dist_triang C) : (T.rotate ∈ dist_triang C) :=
(rotate_distinguished_triangle T).mp H

/--
Given any distinguished triangle `T`, then we know `T.inv_rotate` is also distinguished.
-/
lemma inv_rot_of_dist_triangle (T ∈ dist_triang C) : (T.inv_rotate ∈ dist_triang C) :=
(rotate_distinguished_triangle (T.inv_rotate)).mpr
  (isomorphic_distinguished T H (T.inv_rotate.rotate) T (inv_rot_comp_rot.symm.app T))

/--
Given any distinguished triangle
```
      f       g       h
  X  ───> Y  ───> Z  ───> X⟦1⟧
```
the composition `f ≫ g = 0`.
See https://stacks.math.columbia.edu/tag/0146
-/
lemma comp_dist_triangle_mor_zero₁₂ (T ∈ dist_triang C) : T.mor₁ ≫ T.mor₂ = 0 :=
begin
  have h := contractible_distinguished T.obj₁,
  have f := complete_distinguished_triangle_morphism,
  specialize f (contractible_triangle C T.obj₁) T h H (𝟙 T.obj₁) T.mor₁,
  have t : (contractible_triangle C T.obj₁).mor₁ ≫ T.mor₁ = 𝟙 T.obj₁ ≫ T.mor₁,
    by refl,
  specialize f t,
  cases f with c f,
  rw ← f.left,
  simp only [limits.zero_comp, contractible_triangle_mor₂],
end -- TODO : tidy this proof up

/--
Given any distinguished triangle
```
      f       g       h
  X  ───> Y  ───> Z  ───> X⟦1⟧
```
the composition `g ≫ h = 0`.
See https://stacks.math.columbia.edu/tag/0146
-/
lemma comp_dist_triangle_mor_zero₂₃  (T ∈ dist_triang C) : T.mor₂ ≫ T.mor₃ = 0 :=
comp_dist_triangle_mor_zero₁₂ C T.rotate (rot_of_dist_triangle C T H)

/--
Given any distinguished triangle
```
      f       g       h
  X  ───> Y  ───> Z  ───> X⟦1⟧
```
the composition `h ≫ f⟦1⟧ = 0`.
See https://stacks.math.columbia.edu/tag/0146
-/
lemma comp_dist_triangle_mor_zero₃₁ (T ∈ dist_triang C) :
  T.mor₃ ≫ ((shift C).functor.map T.mor₁) = 0 :=
have H₂ : _ := rot_of_dist_triangle C T.rotate (rot_of_dist_triangle C T H),
by simpa using comp_dist_triangle_mor_zero₁₂ C (T.rotate.rotate) H₂

/-
TODO: If `C` is pretriangulated with respect to a shift,
then `Cᵒᵖ` is pretriangulated with respect to the inverse shift.
-/
end pretriangulated
end category_theory.triangulated

namespace category_theory.triangulated
namespace pretriangulated

variables (C : Type u₁) [category.{v₁} C] [has_zero_object C] [has_shift C] [preadditive C]
[functor.additive (shift C).functor] [functor.additive (shift C).inverse]
variables (D : Type u₂) [category.{v₂} D] [has_zero_object D] [has_shift D] [preadditive D]
[functor.additive (shift D).functor] [functor.additive (shift D).inverse]

/--
The underlying structure of a triangulated functor between pretriangulated categories `C` and `D`
is a functor `F : C ⥤ D` together with given functorial isomorphisms `ξ X : F(X⟦1⟧) ⟶ F(X)⟦1⟧`.
-/
structure triangulated_functor_struct extends (C ⥤ D) :=
(comm_shift : (shift C).functor ⋙ to_functor ≅ to_functor ⋙ (shift D).functor)

instance : inhabited (triangulated_functor_struct C C) :=
⟨{ obj := λ X, X,
  map := λ _ _ f, f,
  comm_shift := by refl }⟩

variables {C D}
/--
Given a `triangulated_functor_struct` we can define a function from triangles of `C` to
triangles of `D`.
-/
@[simp]
def triangulated_functor_struct.map_triangle (F : triangulated_functor_struct C D)
  (T : triangle C) : triangle D :=
triangle.mk _ (F.map T.mor₁) (F.map T.mor₂) (F.map T.mor₃ ≫ F.comm_shift.hom.app T.obj₁)

variables (C D)
/--
A triangulated functor between pretriangulated categories `C` and `D` is a functor `F : C ⥤ D`
together with given functorial isomorphisms `ξ X : F(X⟦1⟧) ⟶ F(X)⟦1⟧` such that for every
distinguished triangle `(X,Y,Z,f,g,h)` of `C`, the triangle
`(F(X), F(Y), F(Z), F(f), F(g), F(h) ≫ (ξ X))` is a distinguished triangle of `D`.
See https://stacks.math.columbia.edu/tag/014V
-/
structure triangulated_functor [pretriangulated C] [pretriangulated D] extends
  triangulated_functor_struct C D :=
(map_distinguished' : Π (T: triangle C), (T ∈ dist_triang C) →
  (to_triangulated_functor_struct.map_triangle T ∈ dist_triang D) )

instance [pretriangulated C] : inhabited (triangulated_functor C C) :=
⟨{obj := λ X, X,
  map := λ _ _ f, f,
  comm_shift := by refl ,
  map_distinguished' := begin
    rintros ⟨_,_,_,_⟩ Tdt,
    dsimp at *,
    rwa category.comp_id,
  end }⟩

variables {C D} [pretriangulated C] [pretriangulated D]
/--
Given a `triangulated_functor` we can define a function from triangles of `C` to triangles of `D`.
-/
@[simp]
def triangulated_functor.map_triangle (F : triangulated_functor C D) (T : triangle C) :
  triangle D :=
triangle.mk _ (F.map T.mor₁) (F.map T.mor₂) (F.map T.mor₃ ≫ F.comm_shift.hom.app T.obj₁)

/--
Given a `triangulated_functor` and a distinguished triangle `T` of `C`, then the triangle it
maps onto in `D` is also distinguished.
-/
lemma triangulated_functor.map_distinguished (F : triangulated_functor C D) (T : triangle C)
  (h : T ∈ dist_triang C) : (F.map_triangle T) ∈ dist_triang D := F.map_distinguished' T h

end pretriangulated
end category_theory.triangulated