import data.matrix data.rat.basic .misc tactic.fin_cases
import .matrix_pequiv

open matrix fintype finset function

variables {m n : ℕ}

local notation `rvec`:2000 n := matrix (fin 1) (fin n) ℚ
local notation `cvec`:2000 m := matrix (fin m) (fin 1) ℚ

def list.to_matrix (m :ℕ) (n : ℕ) (l : list (list ℚ)) : matrix (fin m) (fin n) ℚ :=
λ i j, (l.nth_le i sorry).nth_le j sorry

local attribute [instance] matrix.ordered_comm_group matrix.decidable_le
open pequiv

lemma cvec_one_lt_iff {a b : cvec 1} : a < b ↔ a 0 0 < b 0 0 :=
begin
  simp only [lt_iff_le_not_le],
  show (∀ i j, a i j ≤ b i j) ∧ (¬ ∀ i j, b i j ≤ a i j) ↔ _,
  simp [unique.forall_iff], refl,
end

instance : discrete_linear_ordered_field (cvec 1) :=
{ mul_nonneg := λ a b ha0 hb0 i j, by simp [matrix.mul];
    exact mul_nonneg (ha0 _ _) (hb0 _ _),
  mul_pos := λ a b ha0 hb0,
    begin
      rw [cvec_one_lt_iff] at *,
      simp [matrix.mul],
      exact mul_pos ha0 hb0
    end,
  le_total := λ a b, (le_total (a 0 0) (b 0 0)).elim
    (λ hab, or.inl $ λ i j, by fin_cases i; fin_cases j; exact hab)
    (λ hba, or.inr $ λ i j, by fin_cases i; fin_cases j; exact hba),
  zero_lt_one := dec_trivial,
  decidable_le := matrix.decidable_le,
  ..matrix.discrete_field,
  ..matrix.ordered_comm_group }

instance : decidable_linear_order (cvec 1) :=
{ ..matrix.discrete_linear_ordered_field }

local infix ` ⬝ `:70 := matrix.mul
local postfix `ᵀ` : 1500 := transpose

lemma cvec_le_iff (a b : cvec n) : a ≤ b ↔
  (∀ i : fin n, (single (0 : fin 1) i).to_matrix ⬝ a ≤ (single 0 i).to_matrix ⬝ b) :=
show (∀ i j, a i j ≤ b i j) ↔
  (∀ i j k, ((single (0 : fin 1) i).to_matrix ⬝ a) j k ≤ ((single 0 i).to_matrix ⬝ b) j k),
begin
  simp only [mul_matrix_apply],
  split,
  { intros h i j k,
    fin_cases j, fin_cases k,
    exact h _ _ },
  { intros h i j,
    fin_cases j,
    exact h i 0 0 }
end

lemma rvec_le_iff (a b : rvec n) : a ≤ b ↔
  (∀ j : fin n, a ⬝ (single j (0 : fin 1)).to_matrix ≤ b ⬝ (single j 0).to_matrix) :=
show (∀ i k, a i k ≤ b i k) ↔
  (∀ j i k, (a ⬝ (single j (0 : fin 1)).to_matrix) i k ≤ (b ⬝ (single j 0).to_matrix) i k),
begin
  simp only [matrix_mul_apply],
  split,
  { intros h i j k,
    fin_cases j, fin_cases k,
    exact h _ _ },
  { intros h i j,
    fin_cases i,
    exact h _ 0 0 }
end

def rvec.to_list {n : ℕ} (x : rvec n) : list ℚ :=
(vector.of_fn (x 0)).1

instance has_repr_fin_fun {n : ℕ} {α : Type*} [has_repr α] : has_repr (fin n → α) :=
⟨λ f, repr (vector.of_fn f).to_list⟩

instance {m n} : has_repr (matrix (fin m) (fin n) ℚ) := has_repr_fin_fun

namespace simplex

open list

def pequiv_of_vector (v : vector (fin n) m) (hv : v.1.nodup) : fin m ≃. fin n :=
{ to_fun := λ i, some $ v.nth i,
  inv_fun := λ j, fin.find (λ i, v.nth i = j),
  inv := λ i j, ⟨λ h, by rw ← fin.find_spec _ h; exact rfl,
    λ h, fin.mem_find_of_unique
      (begin
        rintros ⟨i, him⟩ ⟨j, hjm⟩ h₁ h₂,
        cases v,
        refine fin.eq_of_veq (list.nodup_iff_nth_le_inj.1 hv i j _ _ (h₁.trans h₂.symm));
        simpa [v.2]
      end)
      (option.some_inj.1 h)⟩ }

def nonbasis_vector_of_vector (v : vector (fin n) m) (hv : v.to_list.nodup) :
  {v : vector (fin n) (n - m) // v.to_list.nodup} :=
⟨⟨(fin_range n).diff v.to_list,
  have h : m ≤ n,
    by rw [← list.length_fin_range n, ← v.2];
      exact list.length_le_of_subperm
        (subperm_of_subset_nodup hv (λ _ _, list.mem_fin_range _)),
  begin
    rw [← add_right_inj m, nat.sub_add_cancel h],
    conv in m { rw [← vector.to_list_length v] },
    rw ← length_append,
    conv_rhs { rw ← length_fin_range n },
    exact list.perm_length ((perm_ext
      (nodup_append.2 ⟨nodup_diff (nodup_fin_range _), hv,
        by simp [list.disjoint, mem_diff_iff_of_nodup (nodup_fin_range n), imp_false]⟩)
      (nodup_fin_range _)).2
      (by simp only [list.mem_diff_iff_of_nodup (nodup_fin_range n),
          list.mem_append, mem_fin_range, true_and, iff_true];
        exact λ _, or.symm (decidable.em _))),
  end⟩,
  nodup_diff (nodup_fin_range _)⟩

def pre_nonbasis_of_vector (v : vector (fin n) m) (hv : v.1.nodup) : fin (n - m) ≃. fin n :=
pequiv_of_vector (nonbasis_vector_of_vector v hv).1 (nonbasis_vector_of_vector v hv).2

structure prebasis (m n : ℕ) : Type :=
( basis : fin m ≃. fin n )
( nonbasis : fin (n - m) ≃. fin n )
( basis_trans_basis_symm : basis.trans basis.symm = pequiv.refl (fin m) )
( nonbasis_trans_nonbasis_symm : nonbasis.trans nonbasis.symm = pequiv.refl (fin (n - m)) )
( basis_trans_nonbasis_symm : basis.trans nonbasis.symm = ⊥ )

namespace prebasis
open pequiv

attribute [simp] basis_trans_basis_symm nonbasis_trans_nonbasis_symm basis_trans_nonbasis_symm

lemma is_some_basis (B : prebasis m n) : ∀ (i : fin m), (B.basis i).is_some :=
by rw [← trans_symm_eq_iff_forall_is_some, basis_trans_basis_symm]

lemma is_some_nonbasis (B : prebasis m n) : ∀ (k : fin (n - m)), (B.nonbasis k).is_some :=
by rw [← trans_symm_eq_iff_forall_is_some, nonbasis_trans_nonbasis_symm]

lemma injective_basis (B : prebasis m n) : injective B.basis :=
injective_of_forall_is_some (is_some_basis B)

lemma injective_nonbasis (B : prebasis m n) : injective B.nonbasis :=
injective_of_forall_is_some (is_some_nonbasis B)

def basisg (B : prebasis m n) (r : fin m) : fin n :=
option.get (B.is_some_basis r)

def nonbasisg (B : prebasis m n) (s : fin (n - m)) : fin n :=
option.get (B.is_some_nonbasis s)

lemma injective_basisg (B : prebasis m n) : injective B.basisg :=
λ x y h, by rw [basisg, basisg, ← option.some_inj, option.some_get, option.some_get] at h;
  exact injective_basis B h

lemma injective_nonbasisg (B : prebasis m n) : injective B.nonbasisg :=
λ x y h, by rw [nonbasisg, nonbasisg, ← option.some_inj, option.some_get, option.some_get] at h;
  exact injective_nonbasis B h

local infix ` ♣ `: 70 := pequiv.trans

def swap (B : prebasis m n) (r : fin m) (s : fin (n - m)) : prebasis m n :=
{ basis := B.basis.trans (equiv.swap (B.basisg r) (B.nonbasisg s)).to_pequiv,
  nonbasis := B.nonbasis.trans (equiv.swap (B.basisg r) (B.nonbasisg s)).to_pequiv,
  basis_trans_basis_symm := by rw [symm_trans_rev, ← trans_assoc, trans_assoc B.basis,
      ← equiv.to_pequiv_symm,  ← equiv.to_pequiv_trans];
    simp,
  nonbasis_trans_nonbasis_symm := by rw [symm_trans_rev, ← trans_assoc, trans_assoc B.nonbasis,
      ← equiv.to_pequiv_symm, ← equiv.to_pequiv_trans];
    simp,
  basis_trans_nonbasis_symm := by rw [symm_trans_rev, ← trans_assoc, trans_assoc B.basis,
      ← equiv.to_pequiv_symm, ← equiv.to_pequiv_trans];
    simp }

lemma not_is_some_nonbasis_of_is_some_basis (B : prebasis m n) (j : fin n) :
  (B.basis.symm j).is_some → (B.nonbasis.symm j).is_some → false :=
begin
  rw [option.is_some_iff_exists, option.is_some_iff_exists],
  rintros ⟨i, hi⟩ ⟨k, hk⟩,
  have : B.basis.trans B.nonbasis.symm i = none,
  { rw [B.basis_trans_nonbasis_symm, pequiv.bot_apply] },
  rw [pequiv.trans_eq_none] at this,
  rw [pequiv.eq_some_iff] at hi,
  exact (this j k).resolve_left (not_not.2 hi) hk
end

lemma nonbasis_ne_none_of_basis_eq_none (B : prebasis m n) (j : fin n)
  (hb : B.basis.symm j = none) (hnb : B.nonbasis.symm j = none) : false :=
have hs : card (univ.image B.basis) = m,
  by rw [card_image_of_injective _ (B.injective_basis), card_univ, card_fin],
have ht : card (univ.image B.nonbasis) = (n - m),
  by rw [card_image_of_injective _ (B.injective_nonbasis), card_univ, card_fin],
have hst : disjoint (univ.image B.basis) (univ.image B.nonbasis),
  from finset.disjoint_left.2 begin
    simp only [mem_image, exists_imp_distrib, not_exists],
    assume j i _ hbasis k _ hnonbasis,
    cases option.is_some_iff_exists.1 (is_some_basis B i) with x hi,
    cases option.is_some_iff_exists.1 (is_some_nonbasis B k) with y hk,
    have hxy : x = y,
    { rw [← option.some_inj, ← hk, ← hi, hbasis, hnonbasis] }, subst hxy,
    rw [← eq_some_iff] at hi hk,
    refine not_is_some_nonbasis_of_is_some_basis B x _ _;
    simp [hi, hk]
  end,
have (univ.image B.basis) ∪ (univ.image B.nonbasis) = univ.image (@some (fin n)),
  from eq_of_subset_of_card_le
    begin
      assume i h,
      simp only [finset.mem_image, finset.mem_union] at h,
      rcases h with ⟨j, _, hj⟩ | ⟨k, _, hk⟩,
      { simpa [hj.symm, option.is_some_iff_exists, eq_comm] using is_some_basis B j },
      { simpa [hk.symm, option.is_some_iff_exists, eq_comm] using is_some_nonbasis B k }
    end
    (begin
      rw [card_image_of_injective, card_univ, card_fin, card_disjoint_union hst, hs, ht],
      { rw add_comm,
        exact nat.le_sub_add _ _ },
      { intros _ _ h, injection h }
    end),
begin
  simp only [option.eq_none_iff_forall_not_mem, mem_iff_mem B.basis,
    mem_iff_mem B.nonbasis] at hb hnb,
  have := (finset.ext.1 this (some j)).2 (mem_image_of_mem _ (mem_univ _)),
  simp only [hb, hnb, mem_image, finset.mem_union, option.mem_def.symm] at this, tauto
end

lemma is_some_basis_iff (B : prebasis m n) (j : fin n) :
  (B.basis.symm j).is_some ↔ ¬(B.nonbasis.symm j).is_some :=
⟨not_is_some_nonbasis_of_is_some_basis B j,
  by erw [option.not_is_some_iff_eq_none, ← option.ne_none_iff_is_some, forall_swap];
    exact nonbasis_ne_none_of_basis_eq_none B j⟩

@[simp] lemma nonbasis_basisg_eq_none (B : prebasis m n) (r : fin m) :
  B.nonbasis.symm (B.basisg r) = none :=
option.not_is_some_iff_eq_none.1 ((B.is_some_basis_iff _).1 (is_some_symm_get _ _))

@[simp] lemma basis_nonbasisg_eq_none (B : prebasis m n) (s : fin (n - m)) :
  B.basis.symm (B.nonbasisg s) = none :=
option.not_is_some_iff_eq_none.1 (mt (B.is_some_basis_iff _).1 $ not_not.2 (is_some_symm_get _ _))

@[simp] lemma basisg_mem (B : prebasis m n) (r : fin m) :
  (B.basisg r) ∈ B.basis r :=
option.get_mem _

@[simp] lemma nonbasisg_mem (B : prebasis m n) (s : fin (n - m)) :
  (B.nonbasisg s) ∈ B.nonbasis s :=
option.get_mem _

@[simp] lemma basis_basisg (B : prebasis m n) (r : fin m) : B.basis.symm (B.basisg r) = some r:=
B.basis.mem_iff_mem.2 (basisg_mem _ _)

@[simp] lemma nonbasis_nonbasisg (B : prebasis m n) (s : fin (n - m)) :
  B.nonbasis.symm (B.nonbasisg s) = some s :=
B.nonbasis.mem_iff_mem.2 (nonbasisg_mem _ _)

lemma eq_basisg_or_nonbasisg (B : prebasis m n) (i : fin n) :
  (∃ j, i = B.basisg j) ∨ (∃ j, i = B.nonbasisg j) :=
begin
  dsimp only [basisg, nonbasisg],
  by_cases h : ↥(B.basis.symm i).is_some,
  { cases option.is_some_iff_exists.1 h with j hj,
    exact or.inl ⟨j, by rw [B.basis.eq_some_iff] at hj;
      rw [← option.some_inj, ← hj, option.some_get]⟩ },
  { rw [(@not_iff_comm _ _ (classical.dec _) (classical.dec _)).1 (B.is_some_basis_iff _).symm] at h,
    cases option.is_some_iff_exists.1 h with j hj,
    exact or.inr ⟨j, by rw [B.nonbasis.eq_some_iff] at hj;
      rw [← option.some_inj, ← hj, option.some_get]⟩ }
end

lemma basisg_ne_nonbasisg (B : prebasis m n) (i : fin m) (j : fin (n - m)):
  B.basisg i ≠ B.nonbasisg j :=
λ h, by simpa using congr_arg B.basis.symm h

lemma single_basisg_mul_basis (B : prebasis m n) (i : fin m) :
  ((single (0 : fin 1) (B.basisg i)).to_matrix : matrix _ _ ℚ) ⬝
    B.basis.to_matrixᵀ = (single (0 : fin 1) i).to_matrix :=
by rw [← to_matrix_symm, ← to_matrix_trans, single_trans_of_mem _ (basis_basisg _ _)]

lemma single_basisg_mul_nonbasis (B : prebasis m n) (i : fin m) :
  ((single (0 : fin 1) (B.basisg i)).to_matrix : matrix _ _ ℚ) ⬝
    B.nonbasis.to_matrixᵀ = 0 :=
by rw [← to_matrix_symm, ← to_matrix_trans, single_trans_of_eq_none _ (nonbasis_basisg_eq_none _ _),
  to_matrix_bot]; apply_instance

lemma single_nonbasisg_mul_nonbasis (B : prebasis m n) (k : fin (n - m)) :
  ((single (0 : fin 1) (B.nonbasisg k)).to_matrix : matrix _ _ ℚ) ⬝
    B.nonbasis.to_matrixᵀ = (single (0 : fin 1) k).to_matrix :=
by rw [← to_matrix_symm, ← to_matrix_trans, single_trans_of_mem _ (nonbasis_nonbasisg _ _)]

lemma single_nonbasisg_mul_basis (B : prebasis m n) (k : fin (n - m)) :
  ((single (0 : fin 1) (B.nonbasisg k)).to_matrix : matrix _ _ ℚ) ⬝
    B.basis.to_matrixᵀ = 0 :=
by rw [← to_matrix_symm, ← to_matrix_trans, single_trans_of_eq_none _ (basis_nonbasisg_eq_none _ _),
  to_matrix_bot]; apply_instance

lemma nonbasis_trans_basis_symm (B : prebasis m n) : B.nonbasis.trans B.basis.symm = ⊥ :=
symm_injective $ by rw [symm_trans_rev, symm_symm, basis_trans_nonbasis_symm, symm_bot]

@[simp] lemma nonbasis_mul_basis_transpose (B : prebasis m n) :
  (B.nonbasis.to_matrix : matrix _ _ ℚ) ⬝ B.basis.to_matrixᵀ = 0 :=
by rw [← to_matrix_bot, ← B.nonbasis_trans_basis_symm, to_matrix_trans, to_matrix_symm]

@[simp] lemma basis_mul_nonbasis_transpose (B : prebasis m n) :
  (B.basis.to_matrix : matrix _ _ ℚ) ⬝ B.nonbasis.to_matrixᵀ = 0 :=
by rw [← to_matrix_bot, ← B.basis_trans_nonbasis_symm, to_matrix_trans, to_matrix_symm]

@[simp] lemma nonbasis_mul_nonbasis_transpose (B : prebasis m n) :
  (B.nonbasis.to_matrix : matrix _ _ ℚ) ⬝ B.nonbasis.to_matrixᵀ = 1 :=
by rw [← to_matrix_refl, ← B.nonbasis_trans_nonbasis_symm, to_matrix_trans, to_matrix_symm]

@[simp] lemma basis_mul_basis_transpose (B : prebasis m n) :
  (B.basis.to_matrix : matrix _ _ ℚ) ⬝ B.basis.to_matrixᵀ = 1 :=
by rw [← to_matrix_refl, ← B.basis_trans_basis_symm, to_matrix_trans, to_matrix_symm]

lemma transpose_mul_add_tranpose_mul (B : prebasis m n) :
  (B.basis.to_matrixᵀ ⬝ B.basis.to_matrix : matrix (fin n) (fin n) ℚ) +
  B.nonbasis.to_matrixᵀ ⬝ B.nonbasis.to_matrix  = 1 :=
begin
  ext,
  repeat {rw [← to_matrix_symm, ← to_matrix_trans] },
  simp only [add_val, pequiv.symm_trans, pequiv.to_matrix, one_val,
    pequiv.mem_of_set_iff, set.mem_set_of_eq],
  have := is_some_basis_iff B j,
  split_ifs; tauto
end

lemma swap_basis_eq (B : prebasis m n) (r : fin m) (s : fin (n - m)) :
  (B.swap r s).basis.to_matrix = (B.basis.to_matrix : matrix _ _ ℚ)
  - (single r (B.basisg r)).to_matrix + (single r (B.nonbasisg s)).to_matrix :=
begin
  dsimp [swap],
  rw [to_matrix_trans, to_matrix_swap],
  simp only [matrix.mul_add, sub_eq_add_neg, matrix.mul_one, matrix.mul_neg,
    (to_matrix_trans _ _).symm, trans_single_of_mem _ (basisg_mem B r),
    trans_single_of_eq_none _ (basis_nonbasisg_eq_none B s), to_matrix_bot, neg_zero, add_zero]
end

lemma nonbasis_trans_swap_basis_symm (B : prebasis m n) (r : fin m) (s : fin (n - m)) :
  B.nonbasis.trans (B.swap r s).basis.symm = single s r :=
begin
  rw [swap, symm_trans_rev, ← equiv.to_pequiv_symm, ← equiv.perm.inv_def, equiv.swap_inv],
  ext i j,
  rw [mem_single_iff],
  dsimp [pequiv.trans, equiv.to_pequiv, equiv.swap_apply_def],
  simp only [coe, coe_mk_apply, option.mem_def, option.bind_eq_some'],
  rw [option.mem_def.1 (nonbasisg_mem B i)],
  simp [B.injective_nonbasisg.eq_iff, (B.basisg_ne_nonbasisg _ _).symm],
  split_ifs; simp [*, eq_comm]
end

lemma nonbasis_mul_swap_basis_tranpose (B : prebasis m n) (r : fin m) (s : fin (n - m)) :
  (B.nonbasis.to_matrix : matrix _ _ ℚ) ⬝ (B.swap r s).basis.to_matrixᵀ = (single s r).to_matrix :=
by rw [← nonbasis_trans_swap_basis_symm, to_matrix_trans, to_matrix_symm]

lemma basis_trans_swap_basis_transpose (B : prebasis m n) (r : fin m) (s : fin (n - m)) :
  B.basis.trans (B.swap r s).basis.symm = of_set {i | i ≠ r} :=
begin
  rw [swap, symm_trans_rev, ← equiv.to_pequiv_symm, ← equiv.perm.inv_def, equiv.swap_inv],
  ext i j,
  dsimp [pequiv.trans, equiv.to_pequiv, equiv.swap_apply_def],
  simp only [coe, coe_mk_apply, option.mem_def, option.bind_eq_some'],
  rw [option.mem_def.1 (basisg_mem B i)],
  simp [B.injective_basisg.eq_iff, B.basisg_ne_nonbasisg],
  split_ifs,
  { simp * },
  { simp *; split; intros; simp * at * }
end

lemma swap_basis_transpose_apply_single_of_ne (B : prebasis m n) {r : fin m}
  (s : fin (n - m)) {i : fin m} (hir : i ≠ r) :
  ((B.swap r s).basis.to_matrixᵀ : matrix (fin n) (fin m) ℚ) ⬝ (single i (0 : fin 1)).to_matrix =
  B.basis.to_matrixᵀ ⬝ (single i 0).to_matrix :=
begin
  simp only [swap_basis_eq, sub_eq_add_neg, matrix.mul_add, matrix.mul_neg, matrix.mul_one,
    matrix.add_mul, (to_matrix_trans _ _).symm, (to_matrix_symm _).symm, transpose_add,
    transpose_neg, matrix.neg_mul, symm_trans_rev, trans_assoc],
  rw [trans_single_of_mem _ (basis_basisg _ _), trans_single_of_eq_none, trans_single_of_eq_none,
    to_matrix_bot, neg_zero, add_zero, add_zero];
  {dsimp [single]; simp [*, B.injective_basisg.eq_iff]} <|> apply_instance
end

lemma swap_basis_transpose_apply_single (B : prebasis m n) (r : fin m) (s : fin (n - m)) :
  ((B.swap r s).basis.to_matrixᵀ : matrix (fin n) (fin m) ℚ) ⬝ (single r (0 : fin 1)).to_matrix =
  B.nonbasis.to_matrixᵀ ⬝ (single s (0 : fin 1)).to_matrix :=
begin
  simp only [swap_basis_eq, sub_eq_add_neg, matrix.mul_add, matrix.mul_neg, matrix.mul_one,
    matrix.add_mul, (to_matrix_trans _ _).symm, (to_matrix_symm _).symm, transpose_add,
    transpose_neg, matrix.neg_mul, symm_trans_rev, trans_assoc, symm_single],
  rw [trans_single_of_mem _ (basis_basisg _ _), trans_single_of_mem _ (mem_single _ _),
    trans_single_of_mem _ (mem_single _ _), trans_single_of_mem _ (nonbasis_nonbasisg _ _)],
  simp,
  all_goals {apply_instance}
end

def equiv_aux : prebasis m n ≃ Σ' (basis : fin m ≃. fin n)
  (nonbasis : fin (n - m) ≃. fin n)
  ( basis_trans_basis_symm : basis.trans basis.symm = pequiv.refl (fin m) )
( nonbasis_trans_nonbasis_symm : nonbasis.trans nonbasis.symm = pequiv.refl (fin (n - m)) ),
  basis.trans nonbasis.symm = ⊥ :=
{ to_fun := λ ⟨a, b, c, d, e⟩, ⟨a, b, c, d, e⟩,
  inv_fun := λ ⟨a, b, c, d, e⟩, ⟨a, b, c, d, e⟩,
  left_inv := λ ⟨_, _, _, _, _⟩, rfl,
  right_inv := λ ⟨_, _, _, _, _⟩, rfl }

--instance : fintype (prebasis m n) := sorry

end prebasis

open prebasis

/- By convention `A_bar` and `b_bar` are in tableau form, so definitions may only be correct
  assuming `A ⬝ B.basis.to_matrixᵀ = 1` and `b_bar = 0` -/

def pivot_element (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ) (r : fin m)
  (s : fin (n - m)) : cvec 1 :=
(single 0 r).to_matrix ⬝ A_bar ⬝ B.nonbasis.to_matrixᵀ ⬝ (single s 0).to_matrix

def swap_inverse (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ)
  (r : fin m) (s : fin (n - m)) : matrix (fin m) (fin m) ℚ :=
(1 + (1 - A_bar ⬝ B.nonbasis.to_matrixᵀ ⬝ (single s (0 : fin 1)).to_matrix ⬝
    (single (0 : fin 1) r).to_matrix) ⬝ (single r (0 : fin 1)).to_matrix ⬝
    (pivot_element B A_bar r s)⁻¹ ⬝ (single (0 : fin 1) r).to_matrix)

def ratio (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ) (b_bar : cvec m)
  (r : fin m) (s : fin (n - m)) : cvec 1 :=
(pivot_element B A_bar r s)⁻¹ ⬝ ((single 0 r).to_matrix ⬝ b_bar)

lemma swap_mul_swap_inverse {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ}
  {r : fin m} {s : fin (n - m)} (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (hpivot : pivot_element B A_bar r s ≠ 0) :
  swap_inverse B A_bar r s ⬝ (A_bar ⬝ (B.swap r s).basis.to_matrixᵀ) = 1 :=
have ((single (0 : fin 1) r).to_matrix ⬝ (single r 0).to_matrix : cvec 1) = 1,
  by rw [← to_matrix_trans]; simp,
begin
  refine mul_single_ext (λ i, _),
  simp only [swap_inverse, matrix.mul_add, matrix.add_mul, sub_eq_add_neg, matrix.neg_mul, matrix.mul_neg,
    matrix.one_mul, matrix.mul_one, matrix.mul_assoc, transpose_add, transpose_neg,
     mul_right_eq_of_mul_eq this, pivot_element],
  rw [pivot_element, matrix.mul_assoc, matrix.mul_assoc] at hpivot,
  by_cases h : i = r,
  { simp only [h, swap_basis_transpose_apply_single, mul_right_eq_of_mul_eq hA_bar,
      one_by_one_inv_mul_cancel hpivot, inv_eq_inverse],
    simp },
  { have : ((single (0 : fin 1) r).to_matrix ⬝ (single i 0).to_matrix : cvec 1) = 0,
    { rw [← to_matrix_trans, single_trans_single_of_ne (ne.symm h), to_matrix_bot] },
    simp [swap_basis_transpose_apply_single_of_ne _ _ h,
      mul_right_eq_of_mul_eq hA_bar, this] }
end

lemma has_left_inverse_swap {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ}
  {r : fin m} {s : fin (n - m)} (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (hpivot : pivot_element B A_bar r s ≠ 0) :
  (A_bar ⬝ (B.swap r s).basis.to_matrixᵀ).has_left_inverse :=
⟨_, swap_mul_swap_inverse hA_bar hpivot⟩

lemma has_left_inverse_swap_inverse {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ}
  {r : fin m} {s : fin (n - m)} (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (hpivot : pivot_element B A_bar r s ≠ 0) :
  (swap_inverse B A_bar r s).has_left_inverse :=
has_right_inverse_iff_has_left_inverse.1 ⟨_, swap_mul_swap_inverse hA_bar hpivot⟩

lemma inverse_swap_eq {A_bar : matrix (fin m) (fin n) ℚ} {B : prebasis m n}
  {r : fin m} {s : fin (n - m)} (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (hpivot : pivot_element B A_bar r s ≠ 0) :
  inverse (A_bar ⬝ (B.swap r s).basis.to_matrixᵀ) = swap_inverse B A_bar r s :=
eq.symm $ eq_inverse_of_mul_eq_one $ by rw [swap_mul_swap_inverse hA_bar hpivot]

def adjust (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ) (b_bar : cvec m)
  (s : fin (n - m)) (a : cvec 1) : cvec n :=
B.basis.to_matrixᵀ ⬝ b_bar + (B.nonbasis.to_matrixᵀ -
  B.basis.to_matrixᵀ ⬝ A_bar ⬝ B.nonbasis.to_matrixᵀ) ⬝ (single s 0).to_matrix ⬝ a

lemma adjust_is_solution {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ} (b_bar : cvec m)
  (s : fin (n - m)) (a : cvec 1) (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1) :
  A_bar ⬝ adjust B A_bar b_bar s a = b_bar :=
by simp [matrix.mul_assoc, matrix.mul_add, adjust, matrix.add_mul, mul_right_eq_of_mul_eq hA_bar]

lemma single_pivot_mul_adjust (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ) (b_bar : cvec m)
  (s : fin (n - m)) (a : cvec 1) :
  (single 0 s).to_matrix ⬝ B.nonbasis.to_matrix ⬝ adjust B A_bar b_bar s a = a :=
by simp [matrix.mul_assoc, matrix.add_mul, matrix.mul_add, adjust,
  mul_right_eq_of_mul_eq (nonbasis_mul_basis_transpose B),
  mul_right_eq_of_mul_eq (nonbasis_mul_nonbasis_transpose B)]

lemma basis_mul_adjust (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ) (b_bar : cvec m)
  (s : fin (n - m)) (a : cvec 1) : B.basis.to_matrix ⬝ adjust B A_bar b_bar s a = b_bar -
  A_bar ⬝ B.nonbasis.to_matrixᵀ ⬝ (single s 0).to_matrix ⬝ a :=
by simp [matrix.mul_assoc, matrix.add_mul, matrix.mul_add, adjust,
  mul_right_eq_of_mul_eq (basis_mul_basis_transpose B),
  mul_right_eq_of_mul_eq (basis_mul_nonbasis_transpose B)]

lemma nonbasis_mul_adjust (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ)
  (b_bar : cvec m) (s : fin (n - m)) (a : cvec 1) :
  B.nonbasis.to_matrix ⬝ adjust B A_bar b_bar s a = to_matrix (single s 0) ⬝ a :=
by simp [matrix.mul_assoc, matrix.add_mul, matrix.mul_add, adjust,
  mul_right_eq_of_mul_eq (nonbasis_mul_basis_transpose B),
  mul_right_eq_of_mul_eq (nonbasis_mul_nonbasis_transpose B)]

lemma adjust_nonneg_iff {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ}
  {b_bar : cvec m} {s : fin (n - m)} {a : cvec 1} (ha : 0 ≤ a) (hb : 0 ≤ b_bar) :
  0 ≤ adjust B A_bar b_bar s a ↔
    ∀ (i : fin m), 0 < pivot_element B A_bar i s → a ≤ ratio B A_bar b_bar i s :=
have ∀ i : fin m, (single (0 : fin 1) (B.basisg i)).to_matrix ⬝ 0 ≤
  (single 0 (B.basisg i)).to_matrix ⬝ (B.basis.to_matrixᵀ ⬝ b_bar +
    (B.nonbasis.to_matrixᵀ - B.basis.to_matrixᵀ ⬝ A_bar ⬝ B.nonbasis.to_matrixᵀ) ⬝
    to_matrix (single s 0) ⬝ a) ↔
    0 < pivot_element B A_bar i s → a ≤ ratio B A_bar b_bar i s,
  begin
    assume i,
    simp only [matrix.mul_zero, ratio, matrix.mul_add, matrix.add_mul, matrix.mul_assoc,
      sub_eq_add_neg, matrix.mul_neg, matrix.neg_mul, matrix.mul_assoc,
      mul_right_eq_of_mul_eq (single_basisg_mul_basis B i),
      mul_right_eq_of_mul_eq (single_basisg_mul_nonbasis B i), matrix.zero_mul, zero_add],
    rw [← sub_eq_add_neg, sub_nonneg],
    simp only [pivot_element, matrix.mul_assoc],
    cases classical.em (0 < (single (0 : fin 1) i).to_matrix ⬝
      (A_bar ⬝ (B.nonbasis.to_matrixᵀ ⬝ (single s (0 : fin 1)).to_matrix))) with hpos hpos,
    { rw [← matrix.mul_eq_mul, ← mul_comm, ← div_eq_mul_inv, le_div_iff hpos, mul_comm,
        matrix.mul_eq_mul],
      simp [matrix.mul_assoc, hpos] },
    { simp only [hpos, forall_prop_of_false, iff_true, not_false_iff],
      simp only [(matrix.mul_assoc _ _ _).symm, (matrix.mul_eq_mul _ _).symm] at *,
      intros,
      refine le_trans (mul_nonpos_of_nonpos_of_nonneg (le_of_not_gt hpos) ha) _,
      rw [cvec_le_iff] at hb,
      simpa using hb i },
  end,
begin
  rw [adjust, cvec_le_iff],
  split,
  { assume h i,
    rw [← this],
    exact h (B.basisg i) },
  { assume h j,
    rcases eq_basisg_or_nonbasisg B j with ⟨i, hi⟩ | ⟨k, hk⟩,
    { rw [hi, this], exact h _ },
    { simp only [hk, matrix.mul_assoc,
        mul_right_eq_of_mul_eq (single_nonbasisg_mul_basis _ _),
        matrix.mul_add, matrix.add_mul, matrix.mul_neg,
        mul_right_eq_of_mul_eq (single_nonbasisg_mul_nonbasis _ _),
        add_zero, matrix.neg_mul, matrix.zero_mul,
        zero_add, matrix.mul_zero, sub_eq_add_neg, neg_zero],
      by_cases hks : k = s,
      { simpa [hks] },
      { rw [mul_right_eq_of_mul_eq (single_mul_single_of_ne hks _ _), matrix.zero_mul],
        exact le_refl _ } } }
end

def reduced_cost (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ) (c : rvec n) :
  rvec (n - m) :=
c ⬝ (B.nonbasis.to_matrixᵀ - B.basis.to_matrixᵀ ⬝ A_bar ⬝ B.nonbasis.to_matrixᵀ)

noncomputable def solution_of_basis (B : prebasis m n) (A : matrix (fin m) (fin n) ℚ) (b : cvec m) :
  cvec n :=
B.basis.to_matrixᵀ ⬝ inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ b

lemma solution_of_basis_is_solution {A : matrix (fin m) (fin n) ℚ} {B : prebasis m n}
  (b : cvec m) (hA : (A ⬝ B.basis.to_matrixᵀ).has_left_inverse) :
  A ⬝ solution_of_basis B A b = b :=
by rw [solution_of_basis, ← matrix.mul_assoc, ← matrix.mul_assoc,
    mul_inverse (has_right_inverse_iff_has_left_inverse.2 hA), matrix.one_mul]

noncomputable def objective_function_of_basis (A : matrix (fin m) (fin n) ℚ) (B : prebasis m n)
  (b : cvec m) (c : rvec n) : cvec 1 :=
c ⬝ solution_of_basis B A b

/-- For proving `solution_of_basis_eq_adjust`, it suffices to prove they are equal after
  left multiplication by `A_bar` and after left multiplication by `B.nonbasis.to_matrix`.
  This lemma helps prove that. -/
lemma basis_transpose_add_nonbasis_transpose_mul_nonbasis {B : prebasis m n}
  {A_bar : matrix (fin m) (fin n) ℚ} (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1) :
  (B.basis.to_matrixᵀ ⬝ A_bar + B.nonbasis.to_matrixᵀ ⬝ B.nonbasis.to_matrix) ⬝
  (1 - B.basis.to_matrixᵀ ⬝ A_bar ⬝ B.nonbasis.to_matrixᵀ ⬝ B.nonbasis.to_matrix) = 1 :=
by rw [← transpose_mul_add_tranpose_mul B];
  simp [matrix.mul_add, matrix.add_mul, matrix.mul_neg, matrix.mul_assoc,
    mul_right_eq_of_mul_eq hA_bar,
    mul_right_eq_of_mul_eq (nonbasis_mul_basis_transpose _),
    mul_right_eq_of_mul_eq (nonbasis_mul_nonbasis_transpose _)]

lemma solution_of_basis_eq_adjust {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ}
  (b_bar : cvec m) {r : fin m} {s : fin (n - m)} (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (hpivot : pivot_element B A_bar r s ≠ 0) :
  solution_of_basis (B.swap r s) A_bar b_bar = adjust B A_bar b_bar s (ratio B A_bar b_bar r s) :=
/- It suffices to prove they are equal after left multiplication by `A_bar` and by
`B.nonbasis.to_matrix` -/
suffices A_bar ⬝ (B.swap r s).basis.to_matrixᵀ
    ⬝ inverse (A_bar ⬝ (B.swap r s).basis.to_matrixᵀ) ⬝ b_bar =
    A_bar ⬝ adjust B A_bar b_bar s (ratio B A_bar b_bar r s) ∧
    B.nonbasis.to_matrix ⬝ (B.swap r s).basis.to_matrixᵀ
    ⬝ inverse (A_bar ⬝ (B.swap r s).basis.to_matrixᵀ) ⬝ b_bar =
    B.nonbasis.to_matrix ⬝ adjust B A_bar b_bar s (ratio B A_bar b_bar r s),
  begin
    rw [solution_of_basis, ← matrix.mul_left_inj ⟨_, mul_eq_one_comm.1
      (basis_transpose_add_nonbasis_transpose_mul_nonbasis hA_bar)⟩, matrix.add_mul,
      matrix.add_mul],
    simp only [matrix.mul_assoc] at *,
    rw [this.1, this.2]
  end,
{ left := by rw [adjust_is_solution _ _ _ hA_bar, matrix.mul_inverse
    (has_right_inverse_iff_has_left_inverse.2 (has_left_inverse_swap hA_bar hpivot)),
    matrix.one_mul],
  right :=
/- This `have` would be unnecessary with a powerful `assoc_rw` tactic -/
    have (single s r).to_matrix ⬝ (A_bar ⬝ (B.nonbasis.to_matrixᵀ ⬝ ((single s (0 : fin 1)).to_matrix
      ⬝ ((single 0 r).to_matrix ⬝ ((single r 0).to_matrix ⬝ (inverse (pivot_element B A_bar r s)
      ⬝ ((single 0 r).to_matrix ⬝ b_bar))))))) = (single s (0 : fin 1)).to_matrix
      ⬝ (single 0 r).to_matrix ⬝ b_bar,
      begin
        rw [pivot_element, mul_right_eq_of_mul_eq (single_mul_single (0 : fin 1) r (0 : fin 1)),
          single_subsingleton_eq_refl, to_matrix_refl, matrix.one_mul,
          ← single_mul_single s (0 : fin 1) r],
        simp only [(matrix.mul_assoc _ _ _).symm],
        simp only [(single s (0 : fin 1)).to_matrix.mul_assoc],
        rw [one_by_one_mul_inv_cancel, matrix.one_mul],
        { simpa [pivot.matrix.mul_assoc] using hpivot }
      end,
    begin
      simp only [adjust, matrix.mul_add, zero_add, sub_eq_add_neg, matrix.neg_mul,
        mul_right_eq_of_mul_eq (nonbasis_mul_basis_transpose _), matrix.zero_mul,
        nonbasis_mul_swap_basis_tranpose, matrix.mul_assoc, matrix.add_mul, matrix.mul_neg,
        mul_right_eq_of_mul_eq (nonbasis_mul_nonbasis_transpose _), matrix.one_mul, neg_zero,
        add_zero, inverse_swap_eq hA_bar hpivot, swap_inverse, ratio, this, inv_eq_inverse],
      simp
    end }

lemma cvec_eq_basis_add_nonbasis (B : prebasis m n) (x : cvec n) :
  x = B.basis.to_matrixᵀ ⬝ B.basis.to_matrix ⬝ x + B.nonbasis.to_matrixᵀ ⬝ B.nonbasis.to_matrix ⬝ x :=
by simp only [(matrix.mul_assoc _ _ _).symm, (matrix.add_mul _ _ _).symm,
  B.transpose_mul_add_tranpose_mul, matrix.one_mul]

lemma objective_function_eq {B : prebasis m n}
  {A_bar : matrix (fin m) (fin n) ℚ}  {b_bar : cvec m} {c : rvec n} {x : cvec n}
  (hAx : A_bar ⬝ x = b_bar) (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1) :
  c ⬝ x = c ⬝ B.basis.to_matrixᵀ ⬝ b_bar +
  reduced_cost B A_bar c ⬝ B.nonbasis.to_matrix ⬝ x :=
have B.basis.to_matrix ⬝ x = b_bar - A_bar ⬝ B.nonbasis.to_matrixᵀ
    ⬝ B.nonbasis.to_matrix ⬝ x,
  by rw [eq_sub_iff_add_eq, ← (B.basis.to_matrix).one_mul, ← hA_bar,
    matrix.mul_assoc, matrix.mul_assoc, matrix.mul_assoc, matrix.mul_assoc,
    ← matrix.mul_add, ← matrix.mul_assoc, ← matrix.mul_assoc, ← matrix.add_mul,
    transpose_mul_add_tranpose_mul, matrix.one_mul, hAx],
begin
  conv_lhs {rw [cvec_eq_basis_add_nonbasis B x, matrix.mul_assoc, this]},
  simp [matrix.mul_add, matrix.mul_assoc, matrix.add_mul, reduced_cost]
end

lemma objective_function_swap_eq {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ}
  (b_bar : cvec m) (c : rvec n) {r : fin m} {s : fin (n - m)}
  (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1) (hpivot : pivot_element B A_bar r s ≠ 0) :
  objective_function_of_basis A_bar (B.swap r s) b_bar c =
  objective_function_of_basis A_bar B b_bar c +
  reduced_cost B A_bar c ⬝ (single s (0 : fin 1)).to_matrix ⬝ ratio B A_bar b_bar r s :=
have h₁ : A_bar ⬝ (B.basis.to_matrixᵀ ⬝ b_bar) = b_bar,
  by rw [← matrix.mul_assoc, hA_bar, matrix.one_mul],
have h₂ : (A_bar ⬝ (to_matrix ((swap B r s).basis))ᵀ).has_left_inverse,
  from has_left_inverse_swap hA_bar hpivot,
begin
  rw [objective_function_of_basis, objective_function_eq
    (solution_of_basis_is_solution _ h₂) hA_bar,
    solution_of_basis_eq_adjust _ hA_bar hpivot, objective_function_of_basis,
    solution_of_basis, hA_bar, inverse_one, matrix.mul_one, c.mul_assoc,
    matrix.mul_assoc, matrix.mul_assoc],
  congr' 2,
  rw [adjust],
  simp only [matrix.mul_add, matrix.mul_assoc, sub_eq_add_neg,
    matrix.add_mul, matrix.neg_mul, matrix.mul_neg,
    mul_right_eq_of_mul_eq (nonbasis_mul_basis_transpose _),
    mul_right_eq_of_mul_eq (nonbasis_mul_nonbasis_transpose _)],
  simp
end

lemma swap_nonneg_iff {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ} (b_bar : cvec m)
  {r : fin m} {s : fin (n - m)} (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (hpivot : 0 < pivot_element B A_bar r s) (h0b : 0 ≤ b_bar) :
  0 ≤ solution_of_basis (B.swap r s) A_bar b_bar ↔
  (∀ i : fin m, 0 < pivot_element B A_bar i s →
    ratio B A_bar b_bar r s ≤ ratio B A_bar b_bar i s) :=
begin
  rw [solution_of_basis_eq_adjust _ hA_bar (ne_of_lt hpivot).symm, adjust_nonneg_iff _ h0b, ratio],
  rw cvec_le_iff at h0b,
  exact mul_nonneg (inv_nonneg.2 (le_of_lt hpivot)) (by simpa using h0b r)
end

lemma swap_inverse_mul_nonneg {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ} (b_bar : cvec m)
  {r : fin m} {s : fin (n - m)} (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (hpivot : 0 < pivot_element B A_bar r s) (h0b : 0 ≤ b_bar) :
  (∀ i : fin m, 0 < pivot_element B A_bar i s →
    ratio B A_bar b_bar r s ≤ ratio B A_bar b_bar i s) →
  0 ≤ swap_inverse B A_bar r s ⬝ b_bar:=
begin
  rw [← swap_nonneg_iff b_bar hA_bar hpivot h0b, solution_of_basis,
    inverse_swap_eq hA_bar (ne_of_lt hpivot).symm],
  assume hratio,
  rw [cvec_le_iff] at *,
  assume i,
  simpa [mul_right_eq_of_mul_eq (single_basisg_mul_basis _ _), matrix.mul_assoc]
    using hratio ((B.swap r s).basisg i)
end

def is_unbounded (A : matrix (fin m) (fin n) ℚ) (b : cvec m) (c : rvec n) : Prop :=
∀ q : cvec 1, ∃ x, 0 ≤ x ∧ A ⬝ x = b ∧ q ≤ c ⬝ x

def is_optimal (A : matrix (fin m) (fin n) ℚ) (b : cvec m) (c : rvec n) (x : cvec n) : Prop :=
0 ≤ x ∧ A ⬝ x = b ∧ ∀ y, 0 ≤ y → A ⬝ y = b → c ⬝ y ≤ c ⬝ x

def is_optimal_basis (B : prebasis m n) (A : matrix (fin m) (fin n) ℚ)
  (b : cvec m) (c : rvec n) : Prop :=
(A ⬝ B.basis.to_matrixᵀ).has_left_inverse ∧
  is_optimal A b c (B.basis.to_matrixᵀ ⬝ inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ b)

lemma is_unbounded_of_pivot_element_nonpos {B : prebasis m n}
  {A_bar : matrix (fin m) (fin n) ℚ} (b_bar : cvec m) (c : rvec n)
  {s : fin (n - m)} (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (h0b : 0 ≤ b_bar) (hs : reduced_cost B A_bar c ⬝ (single s (0 : fin 1)).to_matrix > 0)
  (h : ∀ r, pivot_element B A_bar r s ≤ 0) : is_unbounded A_bar b_bar c :=
begin
  assume q,
  let a := (reduced_cost B A_bar c ⬝ (single s (0 : fin 1)).to_matrix)⁻¹ ⬝
    (q - c ⬝ ((to_matrix (B.basis))ᵀ ⬝ b_bar)),
  use adjust B A_bar b_bar s (max 0 a),
  simp only [adjust_is_solution b_bar _ _ hA_bar, true_and, eq_self_iff_true],
  simp only [objective_function_eq (adjust_is_solution b_bar _ _ hA_bar) hA_bar]
    {single_pass := tt},
  simp only [nonbasis_mul_adjust, matrix.mul_assoc],
  split,
  { rw adjust_nonneg_iff (le_max_left _ _) h0b,
    assume i hi,
    exact absurd hi (not_lt_of_ge (h _)), },
  { cases le_total a 0 with ha0 ha0,
    { rw [max_eq_left ha0],
      simp only [a, (mul_eq_mul _ _).symm] at ha0,
      rw [mul_comm, ← div_eq_mul_inv, div_le_iff hs, _root_.zero_mul, sub_nonpos] at ha0,
      simpa },
    { simp only [max_eq_right ha0],
      rw [← (reduced_cost _ _ _).mul_assoc],
      dsimp only [a],
      rw [← matrix.mul_assoc (reduced_cost _ _ _ ⬝ _ ), ← mul_eq_mul,
        ← mul_eq_mul, mul_inv_cancel (ne_of_lt hs).symm, one_mul],
      simp [le_refl] } }
end

lemma is_optimal_basis_of_reduced_cost_nonpos {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ}
  (b_bar : cvec m) (c : rvec n) (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (h0b : 0 ≤ b_bar) (hs : reduced_cost B A_bar c ≤ 0) :
  is_optimal_basis B A_bar b_bar c :=
begin
  rw [is_optimal_basis, hA_bar, inverse_one, matrix.mul_one],
  refine ⟨⟨1, matrix.one_mul _⟩, matrix.mul_nonneg (by rw [← to_matrix_symm]; exact pequiv_nonneg _) h0b,
    by rw [← matrix.mul_assoc, hA_bar, matrix.one_mul], _⟩,
  assume x h0x hAx,
  rw [objective_function_eq hAx hA_bar, ← le_sub_iff_add_le', ← matrix.mul_assoc, sub_self],
  exact matrix.mul_nonpos_of_nonpos_of_nonneg
    (matrix.mul_nonpos_of_nonpos_of_nonneg hs (pequiv_nonneg _)) h0x
end

def choose_pivot_column (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ) (b_bar : cvec m)
  (c : rvec n) : option (fin (n - m)) :=
(fin.find (λ j : fin n, ∃ h : (B.nonbasis.symm j).is_some,
  0 < reduced_cost B A_bar c ⬝ (single (option.get h) (0 : fin 1)).to_matrix)).bind
    B.nonbasis.symm

lemma choose_pivot_column_eq_none (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ)
  (b_bar : cvec m) (c : rvec n) (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (h0b : 0 ≤ b_bar)
  (h : choose_pivot_column B A_bar b_bar c = none) :
  is_optimal_basis B A_bar b_bar c :=
is_optimal_basis_of_reduced_cost_nonpos _ _ hA_bar h0b $
  begin
    rw [choose_pivot_column, option.bind_eq_none] at h,
    have : ∀ j, j ∉ fin.find (λ j : fin n, ∃ h : (B.nonbasis.symm j).is_some,
      0 < reduced_cost B A_bar c ⬝ (single (option.get h) (0 : fin 1)).to_matrix),
    { assume j hj,
      cases option.is_some_iff_exists.1 (fin.find_spec _ hj).fst with s hs,
      exact h s j hj hs },
    rw [← option.eq_none_iff_forall_not_mem, fin.find_eq_none_iff] at this,
    rw [rvec_le_iff],
    assume j,
    refine le_of_not_gt (λ h0j, _),
    have hj : ↥(B.nonbasis.symm (B.nonbasisg j)).is_some,
      from option.is_some_iff_exists.2 ⟨j, nonbasis_nonbasisg _ _⟩,
    have hjg : j = option.get hj, { rw [← option.some_inj, option.some_get, nonbasis_nonbasisg] },
    exact this (B.nonbasisg j) ⟨hj, by { rw ← hjg, rwa [matrix.zero_mul] at h0j} ⟩
  end

lemma choose_pivot_column_spec (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ)
  (b_bar : cvec m) (c : rvec n) (s : fin (n - m)) (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (h0b : 0 ≤ b_bar) (h : choose_pivot_column B A_bar b_bar c = some s) :
  0 < reduced_cost B A_bar c ⬝ (single s (0 : fin 1)).to_matrix :=
begin
  rw [choose_pivot_column, option.bind_eq_some'] at h,
  cases h with j hj,
  have := fin.find_spec _ hj.1,
  have hs : s = option.get this.fst,
  { rw [← option.some_inj, option.some_get, hj.2] },
  exact hs.symm ▸ this.snd
end

set_option class.instance_max_depth 60

def choose_pivot_row (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ) (b_bar : cvec m)
  (c : rvec n) (s : fin (n - m)) : option (fin m) :=
(fin.find (λ j : fin n, ∃ h : (B.basis.symm j).is_some,
  0 < pivot_element B A_bar (option.get h) s ∧
  ∀ i : fin m, ((0 : cvec 1) < pivot_element B A_bar i s) →
    ratio B A_bar b_bar (option.get h) s ≤ ratio B A_bar b_bar i s)).bind B.basis.symm

lemma choose_pivot_row_spec (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ)
  (b_bar : cvec m) (c : rvec n) (r : fin m) (s : fin (n - m))
  (hr : r ∈ choose_pivot_row B A_bar b_bar c s) :
  0 < pivot_element B A_bar r s ∧
  ∀ i : fin m, 0 < pivot_element B A_bar i s →
    ratio B A_bar b_bar r s ≤ ratio B A_bar b_bar i s :=
begin
  rw [choose_pivot_row, option.mem_def, option.bind_eq_some'] at hr,
  cases hr with j hj,
  have hrj : r = option.get (fin.find_spec _ hj.1).fst,
  { rw [← option.some_inj, option.some_get, ← hj.2] },
  rw hrj,
  exact (fin.find_spec _ hj.1).snd
end

lemma choose_pivot_row_eq_none (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ)
  (b_bar : cvec m) (c : rvec n) (r : fin m) (s : fin (n - m))
  (hn : choose_pivot_row B A_bar b_bar c s = none) :
  pivot_element B A_bar r s ≤ 0 :=
le_of_not_gt $ λ hpivot, begin
  rw [choose_pivot_row, option.bind_eq_none] at hn,
  cases @finset.min_of_mem _ _
    ((univ.filter (λ j, 0 < pivot_element B A_bar j s)).image
      (λ i, ratio B A_bar b_bar i s)) (ratio B A_bar b_bar r s)
      (mem_image_of_mem _ (finset.mem_filter.2 ⟨mem_univ _, hpivot⟩)) with q hq,
  rcases mem_image.1 (mem_of_min hq) with ⟨i, hip, hiq⟩,
  subst hiq,
  have : ∀ j : fin n, j ∉ fin.find (λ j : fin n, ∃ h : (B.basis.symm j).is_some,
    0 < pivot_element B A_bar (option.get h) s ∧
    ∀ i : fin m, 0 < pivot_element B A_bar i s →
      ratio B A_bar b_bar (option.get h) s ≤ ratio B A_bar b_bar i s),
  { assume j hj,
    cases option.is_some_iff_exists.1 (fin.find_spec _ hj).fst with r hr,
    exact hn _ _ hj hr },
  rw [← option.eq_none_iff_forall_not_mem, fin.find_eq_none_iff] at this,
  have hi : ↥(B.basis.symm (B.basisg i)).is_some,
    from option.is_some_iff_exists.2 ⟨i, basis_basisg _ _⟩,
  have hig : i = option.get hi, { rw [← option.some_inj, option.some_get, basis_basisg] },
  exact this (B.basisg i) ⟨(option.is_some_iff_exists.2 ⟨i, basis_basisg _ _⟩),
    begin
      rw [← hig],
      clear_aux_decl,
      refine ⟨by simpa using hip, _⟩,
      assume j hj,
      refine min_le_of_mem (mem_image.2 ⟨j, _⟩) hq,
      simp [hj]
    end⟩
end

lemma is_unbounded_of_choose_pivot_row_eq_none (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ)
  (b_bar : cvec m) (c : rvec n) (s : fin (n - m))
  (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1) (h0b : 0 ≤ b_bar)
  (hs : 0 < reduced_cost B A_bar c ⬝ (single s (0 : fin 1)).to_matrix)
  (hn : choose_pivot_row B A_bar b_bar c s = none) : is_unbounded A_bar b_bar c :=
is_unbounded_of_pivot_element_nonpos _ _ hA_bar h0b hs
  (λ _, choose_pivot_row_eq_none _ _ _ _ _ _ hn)

lemma is_unbounded_swap {B : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ} {b_bar : cvec m}
  {c : rvec n} {r : fin m} {s : fin (n - m)} (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (hpivot : pivot_element B A_bar r s ≠ 0) :
  is_unbounded (swap_inverse B A_bar r s ⬝ A_bar) (swap_inverse B A_bar r s ⬝ b_bar) c →
  is_unbounded A_bar b_bar c :=
by simp only [is_unbounded, matrix.mul_assoc, matrix.mul_left_inj
  (has_left_inverse_swap_inverse hA_bar hpivot), imp_self]

lemma is_optimal_basis_swap {B  : prebasis m n} {A_bar : matrix (fin m) (fin n) ℚ}
  {b_bar : cvec m} {c : rvec n} (S : matrix (fin m) (fin m) ℚ)
  (hS : S.has_left_inverse) (h : is_optimal_basis B (S ⬝ A_bar) (S ⬝ b_bar) c) :
  is_optimal_basis B A_bar b_bar c :=
begin
  rw [is_optimal_basis, matrix.mul_assoc, ← has_left_inverse_mul hS] at h,
  simp only [is_optimal_basis, is_optimal, matrix.mul_assoc, matrix.mul_left_inj
    hS, h.1, inverse_one, matrix.one_mul,
    matrix.mul_one, matrix.mul_left_inj
    (inverse_has_left_inverse (has_right_inverse_iff_has_left_inverse.2 hS)),
    inverse_mul hS, inverse_one, mul_right_eq_of_mul_eq (inverse_mul hS),
    matrix.one_mul, matrix.mul_one, mul_inverse_rev hS h.1, *] at *,
  tauto,
end

axiom wf (p : Prop) : p

def simplex : Π (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ)
  (b_bar : cvec m) (c : rvec n) (hA_bar : A_bar ⬝ B.basis.to_matrixᵀ = 1)
  (h0b : 0 ≤ b_bar),
  { o : option (Σ (B : prebasis m n) (A_bar : matrix (fin m) (fin n) ℚ), cvec m) //
    option.cases_on o (is_unbounded A_bar b_bar c)
      (λ P, is_optimal_basis P.1 A_bar b_bar c) }
| B A_bar b_bar c hA_bar h0b :=
  match choose_pivot_column B A_bar b_bar c,
    (λ s, choose_pivot_column_spec B A_bar b_bar c s hA_bar h0b),
      choose_pivot_column_eq_none B A_bar b_bar c hA_bar h0b with
  | none,   _, hn := ⟨some ⟨B, A_bar, b_bar⟩, hn rfl⟩
  | some s, hs, _ :=
    match choose_pivot_row B A_bar b_bar c s,
      (λ r, choose_pivot_row_spec B A_bar b_bar c r s),
      is_unbounded_of_choose_pivot_row_eq_none B A_bar b_bar c s hA_bar h0b (hs _ rfl) with
    | none,     _, hnone  := ⟨none, hnone rfl⟩
    | (some r), hr, _ := let S := swap_inverse B A_bar r s in
      have wf : prebasis.sizeof m n (swap B r s) < prebasis.sizeof m n B, from wf _,
      let o := simplex (B.swap r s) (S ⬝ A_bar) (S ⬝ b_bar) c
        (by rw [matrix.mul_assoc, swap_mul_swap_inverse hA_bar (ne_of_lt (hr r rfl).1).symm])
        (swap_inverse_mul_nonneg b_bar hA_bar (hr _ rfl).1 h0b (hr _ rfl).2) in
      ⟨o.1, option.cases_on o.1 (is_unbounded_swap hA_bar (ne_of_lt (hr r rfl).1).symm)
        (λ P, is_optimal_basis_swap S (has_left_inverse_swap_inverse hA_bar
          (ne_of_lt (hr r rfl).1).symm))
        o.2⟩
    end
  end

#print axioms simplex.simplex

def rel (A : matrix (fin m) (fin n) ℚ) (b : cvec m) (c : rvec n) :
  prebasis m n → prebasis m n → Prop :=
tc (λ B C, ∃ hs : (choose_pivot_column B
    (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ A) (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ b) c).is_some,
  ∃ hr : (choose_pivot_row B
    (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ A) (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ b)
      c (option.get hs)).is_some,
  C = B.swap (option.get hr) (option.get hs))

#eval inverse (list.to_matrix 3 3
  [[1,2,3],[0,1,5],[0,0,1]])

-- def ex.A := list.to_matrix 2 5 [[1,1,0,1,0],
--                                 [0,1,-1,0,1]]

-- def ex.b : cvec 2 := (λ i _, (list.nth_le [8,0] i sorry))

-- def ex.c : rvec 5 := λ _ i, (list.nth_le [1, 1, 1, 0, 0] i sorry)

-- def ex.B : prebasis 2 5 :=
--   ⟨pequiv_of_vector ⟨[3, 4], rfl⟩ dec_trivial,
--     pre_nonbasis_of_vector ⟨[3, 4], rfl⟩ dec_trivial, sorry, sorry, sorry⟩

-- #eval ex.A ⬝ ex.B.basis.to_matrixᵀ

-- #eval (simplex ex.B ex.A ex.b ex.c dec_trivial dec_trivial).1.is_some

def ex.A := list.to_matrix 3 7 [[1/4, - 8, -  1, 9, 1, 0, 0],
                                [1/2, -12, -1/2, 3, 0, 1, 0],
                                [  0,   0,    1, 0, 0, 0, 1]]

def ex.b : cvec 3 := (λ i _, list.nth_le [0,0,1] i sorry)
--#eval ex.b
def ex.c : rvec 7 := λ _ i, (list.nth_le [3/4, -20, 1/2, -6, 0, 0, 0] i sorry)
--#eval ex.c
def ex.B : prebasis 3 7 :=
  ⟨pequiv_of_vector ⟨[4, 5, 6], rfl⟩ dec_trivial,
    pre_nonbasis_of_vector ⟨[4,5,6], rfl⟩ dec_trivial, sorry, sorry, sorry⟩

--#eval (simplex ex.B ex.A ex.b ex.c dec_trivial dec_trivial).1.is_some

#eval (find_optimal_solution_from_starting_basis ex.A ex.c ex.b ex.B)
--set_option trace.fun_info true
#eval (is_optimal_bool ex.A ex.c ex.b ex.B)

-- (some [[2064/445]])
-- (some [[6401/1895]])
#eval (is_feasible_basis ex.A ex.c ex.b ex.B : bool)
-- #eval (show matrix _ _ ℚ, from minor ex.A id ex.B.read) *
--   _root_.inverse (show matrix _ _ ℚ, from minor ex.A id ex.B.read )
-- #eval ((1 : cvec 1) - (minor ex.c id ex.B.read) ⬝
--   _root_.inverse (minor ex.A id ex.B.read) ⬝
--   (minor ex.A id ex.NB.read))

#eval finishing_basis ex.A ex.c ex.b ex.B

#eval test ex.A ex.c ex.b ex.B

#eval (let x : cvec 4 := λ i _, list.nth_le [0, 80/89, 62/89, 196/89] i sorry in
  let A := list.to_matrix 3 4 [[12, -1, 1, 1],
                     [1, 1.45, 1, 0],
                     [1, 2, 0, 1]]
                     in A ⬝ x
 )


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

/-!
# Kernels and cokernels

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

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

## Main statements

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

and the corresponding dual statements.

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

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

## References

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

noncomputable theory

universes v u u' u₂

open category_theory
open category_theory.limits.walking_parallel_pair

namespace category_theory.limits

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

/-- A morphism `f` has a kernel if the functor `parallel_pair f 0` has a limit. -/
abbreviation has_kernel {X Y : C} (f : X ⟶ Y) : Prop := has_limit (parallel_pair f 0)
/-- A morphism `f` has a cokernel if the functor `parallel_pair f 0` has a colimit. -/
abbreviation has_cokernel {X Y : C} (f : X ⟶ Y) : Prop := has_colimit (parallel_pair f 0)

variables {X Y : C} (f : X ⟶ Y)

section

/-- A kernel fork is just a fork where the second morphism is a zero morphism. -/
abbreviation kernel_fork := fork f 0

variables {f}

@[simp, reassoc] lemma kernel_fork.condition (s : kernel_fork f) : fork.ι s ≫ f = 0 :=
by erw [fork.condition, has_zero_morphisms.comp_zero]

@[simp] lemma kernel_fork.app_one (s : kernel_fork f) : s.π.app one = 0 :=
by rw [←fork.app_zero_left, kernel_fork.condition]

/-- A morphism `ι` satisfying `ι ≫ f = 0` determines a kernel fork over `f`. -/
abbreviation kernel_fork.of_ι {Z : C} (ι : Z ⟶ X) (w : ι ≫ f = 0) : kernel_fork f :=
fork.of_ι ι $ by rw [w, has_zero_morphisms.comp_zero]

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

section
local attribute [tidy] tactic.case_bash

/-- Every kernel fork `s` is isomorphic (actually, equal) to `fork.of_ι (fork.ι s) _`. -/
def iso_of_ι (s : fork f 0) : s ≅ fork.of_ι (fork.ι s) (fork.condition s) :=
cones.ext (iso.refl _) $ by tidy

/-- If `ι = ι'`, then `fork.of_ι ι _` and `fork.of_ι ι' _` are isomorphic. -/
def of_ι_congr {P : C} {ι ι' : P ⟶ X} {w : ι ≫ f = 0} (h : ι = ι') :
  kernel_fork.of_ι ι w ≅ kernel_fork.of_ι ι' (by rw [←h, w]) :=
cones.ext (iso.refl _) $ by tidy

/-- If `F` is an equivalence, then applying `F` to a diagram indexing a (co)kernel of `f` yields
    the diagram indexing the (co)kernel of `F.map f`. -/
def comp_nat_iso {D : Type u'} [category.{v} D] [has_zero_morphisms D] (F : C ⥤ D)
  [is_equivalence F] : parallel_pair f 0 ⋙ F ≅ parallel_pair (F.map f) 0 :=
nat_iso.of_components (λ j, match j with
  | zero := iso.refl _
  | one := iso.refl _
  end) $ by tidy

end

/-- If `s` is a limit kernel fork and `k : W ⟶ X` satisfies ``k ≫ f = 0`, then there is some
    `l : W ⟶ s.X` such that `l ≫ fork.ι s = k`. -/
def kernel_fork.is_limit.lift' {s : kernel_fork f} (hs : is_limit s) {W : C} (k : W ⟶ X)
  (h : k ≫ f = 0) : {l : W ⟶ s.X // l ≫ fork.ι s = k} :=
⟨hs.lift $ kernel_fork.of_ι _ h, hs.fac _ _⟩

/-- This is a slightly more convenient method to verify that a kernel fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content -/
def is_limit_aux (t : kernel_fork f)
  (lift : Π (s : kernel_fork f), s.X ⟶ t.X)
  (fac : ∀ (s : kernel_fork f), lift s ≫ t.ι = s.ι)
  (uniq : ∀ (s : kernel_fork f) (m : s.X ⟶ t.X) (w : m ≫ t.ι = s.ι), m = lift s) :
  is_limit t :=
{ lift := lift,
  fac' := λ s j, by { cases j, { exact fac s, }, { simp, }, },
  uniq' := λ s m w, uniq s m (w limits.walking_parallel_pair.zero), }

/--
This is a more convenient formulation to show that a `kernel_fork` constructed using
`kernel_fork.of_ι` is a limit cone.
-/
def is_limit.of_ι {W : C} (g : W ⟶ X) (eq : g ≫ f = 0)
  (lift : Π {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0), W' ⟶ W)
  (fac : ∀ {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0), lift g' eq' ≫ g = g')
  (uniq :
    ∀ {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0) (m : W' ⟶ W) (w : m ≫ g = g'), m = lift g' eq') :
  is_limit (kernel_fork.of_ι g eq) :=
is_limit_aux _ (λ s, lift s.ι s.condition) (λ s, fac s.ι s.condition) (λ s, uniq s.ι s.condition)

/-- Every kernel of `f` induces a kernel of `f ≫ g` if `g` is mono. -/
def is_kernel_comp_mono  {c : kernel_fork f} (i : is_limit c) {Z} (g : Y ⟶ Z) [hg : mono g] :
  is_limit (kernel_fork.of_ι c.ι (by simp) : kernel_fork (f ≫ g)) :=
fork.is_limit.mk' _ $ λ s,
  let s' : kernel_fork f := fork.of_ι s.ι (by apply hg.right_cancellation; simp [s.condition]) in
  let l := kernel_fork.is_limit.lift' i s'.ι s'.condition in
  ⟨l.1, l.2, λ m hm, by apply fork.is_limit.hom_ext i; rw fork.ι_of_ι at hm; rw hm; exact l.2.symm⟩

end

section
variables [has_kernel f]

/-- The kernel of a morphism, expressed as the equalizer with the 0 morphism. -/
abbreviation kernel : C := equalizer f 0

/-- The map from `kernel f` into the source of `f`. -/
abbreviation kernel.ι : kernel f ⟶ X := equalizer.ι f 0

@[simp] lemma equalizer_as_kernel : equalizer.ι f 0 = kernel.ι f := rfl

@[simp, reassoc] lemma kernel.condition : kernel.ι f ≫ f = 0 :=
kernel_fork.condition _

/-- The kernel built from `kernel.ι f` is limiting. -/
def kernel_is_kernel :
  is_limit (fork.of_ι (kernel.ι f) ((kernel.condition f).trans (comp_zero.symm))) :=
is_limit.of_iso_limit (limit.is_limit _) (fork.ext (iso.refl _) (by tidy))

/-- Given any morphism `k : W ⟶ X` satisfying `k ≫ f = 0`, `k` factors through `kernel.ι f`
    via `kernel.lift : W ⟶ kernel f`. -/
abbreviation kernel.lift {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : W ⟶ kernel f :=
limit.lift (parallel_pair f 0) (kernel_fork.of_ι k h)

@[simp, reassoc]
lemma kernel.lift_ι {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : kernel.lift f k h ≫ kernel.ι f = k :=
limit.lift_π _ _

@[simp]
lemma kernel.lift_zero {W : C} {h} : kernel.lift f (0 : W ⟶ X) h = 0 :=
by { ext, simp, }

instance kernel.lift_mono {W : C} (k : W ⟶ X) (h : k ≫ f = 0) [mono k] : mono (kernel.lift f k h) :=
⟨λ Z g g' w,
begin
  replace w := w =≫ kernel.ι f,
  simp only [category.assoc, kernel.lift_ι] at w,
  exact (cancel_mono k).1 w,
end⟩

/-- Any morphism `k : W ⟶ X` satisfying `k ≫ f = 0` induces a morphism `l : W ⟶ kernel f` such that
    `l ≫ kernel.ι f = k`. -/
def kernel.lift' {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : {l : W ⟶ kernel f // l ≫ kernel.ι f = k} :=
⟨kernel.lift f k h, kernel.lift_ι _ _ _⟩

/-- A commuting square induces a morphism of kernels. -/
abbreviation kernel.map {X' Y' : C} (f' : X' ⟶ Y') [has_kernel f']
  (p : X ⟶ X') (q : Y ⟶ Y') (w : f ≫ q = p ≫ f') : kernel f ⟶ kernel f' :=
kernel.lift f' (kernel.ι f ≫ p) (by simp [←w])

/--
Given a commutative diagram
    X --f--> Y --g--> Z
    |        |        |
    |        |        |
    v        v        v
    X' -f'-> Y' -g'-> Z'
with horizontal arrows composing to zero,
then we obtain a commutative square
   X ---> kernel g
   |         |
   |         | kernel.map
   |         |
   v         v
   X' --> kernel g'
-/
lemma kernel.lift_map {X Y Z X' Y' Z' : C}
  (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel g] (w : f ≫ g = 0)
  (f' : X' ⟶ Y') (g' : Y' ⟶ Z') [has_kernel g'] (w' : f' ≫ g' = 0)
  (p : X ⟶ X') (q : Y ⟶ Y') (r : Z ⟶ Z') (h₁ : f ≫ q = p ≫ f') (h₂ : g ≫ r = q ≫ g') :
  kernel.lift g f w ≫ kernel.map g g' q r h₂ = p ≫ kernel.lift g' f' w' :=
by { ext, simp [h₁], }

/-- Every kernel of the zero morphism is an isomorphism -/
instance kernel.ι_zero_is_iso : is_iso (kernel.ι (0 : X ⟶ Y)) :=
equalizer.ι_of_self _

lemma eq_zero_of_epi_kernel [epi (kernel.ι f)] : f = 0 :=
(cancel_epi (kernel.ι f)).1 (by simp)

/-- The kernel of a zero morphism is isomorphic to the source. -/
def kernel_zero_iso_source : kernel (0 : X ⟶ Y) ≅ X :=
equalizer.iso_source_of_self 0

@[simp] lemma kernel_zero_iso_source_hom :
  kernel_zero_iso_source.hom = kernel.ι (0 : X ⟶ Y) := rfl

@[simp] lemma kernel_zero_iso_source_inv :
  kernel_zero_iso_source.inv = kernel.lift (0 : X ⟶ Y) (𝟙 X) (by simp) :=
by { ext, simp [kernel_zero_iso_source], }

/-- If two morphisms are known to be equal, then their kernels are isomorphic. -/
def kernel_iso_of_eq {f g : X ⟶ Y} [has_kernel f] [has_kernel g] (h : f = g) :
  kernel f ≅ kernel g :=
has_limit.iso_of_nat_iso (by simp[h])

@[simp]
lemma kernel_iso_of_eq_refl {h : f = f} : kernel_iso_of_eq h = iso.refl (kernel f) :=
by { ext, simp [kernel_iso_of_eq], }

@[simp, reassoc]
lemma kernel_iso_of_eq_hom_comp_ι {f g : X ⟶ Y} [has_kernel f] [has_kernel g] (h : f = g) :
  (kernel_iso_of_eq h).hom ≫ kernel.ι _ = kernel.ι _ :=
by { unfreezingI { induction h, simp } }

@[simp, reassoc]
lemma kernel_iso_of_eq_inv_comp_ι {f g : X ⟶ Y} [has_kernel f] [has_kernel g] (h : f = g) :
  (kernel_iso_of_eq h).inv ≫ kernel.ι _ = kernel.ι _ :=
by { unfreezingI { induction h, simp } }

@[simp, reassoc]
lemma lift_comp_kernel_iso_of_eq_hom {Z} {f g : X ⟶ Y} [has_kernel f] [has_kernel g]
  (h : f = g) (e : Z ⟶ X) (he) :
  kernel.lift _ e he ≫ (kernel_iso_of_eq h).hom = kernel.lift _ e (by simp [← h, he]) :=
by { unfreezingI { induction h, simp } }

@[simp, reassoc]
lemma lift_comp_kernel_iso_of_eq_inv {Z} {f g : X ⟶ Y} [has_kernel f] [has_kernel g]
  (h : f = g) (e : Z ⟶ X) (he) :
  kernel.lift _ e he ≫ (kernel_iso_of_eq h).inv = kernel.lift _ e (by simp [h, he]) :=
by { unfreezingI { induction h, simp } }

@[simp]
lemma kernel_iso_of_eq_trans {f g h : X ⟶ Y} [has_kernel f] [has_kernel g] [has_kernel h]
  (w₁ : f = g) (w₂ : g = h) :
  kernel_iso_of_eq w₁ ≪≫ kernel_iso_of_eq w₂ = kernel_iso_of_eq (w₁.trans w₂) :=
by { unfreezingI { induction w₁, induction w₂, }, ext, simp [kernel_iso_of_eq], }

variables {f}

lemma kernel_not_epi_of_nonzero (w : f ≠ 0) : ¬epi (kernel.ι f) :=
λ I, by exactI w (eq_zero_of_epi_kernel f)

lemma kernel_not_iso_of_nonzero (w : f ≠ 0) : (is_iso (kernel.ι f)) → false :=
λ I, kernel_not_epi_of_nonzero w $ by { resetI, apply_instance }

instance has_kernel_comp_mono {X Y Z : C} (f : X ⟶ Y) [has_kernel f] (g : Y ⟶ Z) [mono g] :
  has_kernel (f ≫ g) :=
⟨⟨{ cone := _, is_limit := is_kernel_comp_mono (limit.is_limit _) g }⟩⟩

/--
When `g` is a monomorphism, the kernel of `f ≫ g` is isomorphic to the kernel of `f`.
-/
@[simps]
def kernel_comp_mono {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel f] [mono g] :
  kernel (f ≫ g) ≅ kernel f :=
{ hom := kernel.lift _ (kernel.ι _) (by { rw [←cancel_mono g], simp, }),
  inv := kernel.lift _ (kernel.ι _) (by simp), }

instance has_kernel_iso_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] [has_kernel g] :
  has_kernel (f ≫ g) :=
{ exists_limit :=
  ⟨{ cone := kernel_fork.of_ι (kernel.ι g ≫ inv f) (by simp),
     is_limit := is_limit_aux _ (λ s, kernel.lift _ (s.ι ≫ f) (by tidy)) (by tidy)
       (λ s m w, by { simp_rw [←w], ext, simp, }), }⟩ }

/--
When `f` is an isomorphism, the kernel of `f ≫ g` is isomorphic to the kernel of `g`.
-/
@[simps]
def kernel_is_iso_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] [has_kernel g] :
  kernel (f ≫ g) ≅ kernel g :=
{ hom := kernel.lift _ (kernel.ι _ ≫ f) (by simp),
  inv := kernel.lift _ (kernel.ι _ ≫ inv f) (by simp), }

end

section has_zero_object
variables [has_zero_object C]

open_locale zero_object

/-- The morphism from the zero object determines a cone on a kernel diagram -/
def kernel.zero_cone : cone (parallel_pair f 0) :=
{ X := 0,
  π := { app := λ j, 0 }}

/-- The map from the zero object is a kernel of a monomorphism -/
def kernel.is_limit_cone_zero_cone [mono f] : is_limit (kernel.zero_cone f) :=
fork.is_limit.mk _ (λ s, 0)
  (λ s, by { erw zero_comp,
    convert (zero_of_comp_mono f _).symm,
    exact kernel_fork.condition _ })
  (λ _ _ _, zero_of_to_zero _)

/-- The kernel of a monomorphism is isomorphic to the zero object -/
def kernel.of_mono [has_kernel f] [mono f] : kernel f ≅ 0 :=
functor.map_iso (cones.forget _) $ is_limit.unique_up_to_iso
  (limit.is_limit (parallel_pair f 0)) (kernel.is_limit_cone_zero_cone f)

/-- The kernel morphism of a monomorphism is a zero morphism -/
lemma kernel.ι_of_mono [has_kernel f] [mono f] : kernel.ι f = 0 :=
zero_of_source_iso_zero _ (kernel.of_mono f)

/-- If `g ≫ f = 0` implies `g = 0` for all `g`, then `0 : 0 ⟶ X` is a kernel of `f`. -/
def zero_kernel_of_cancel_zero {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (Z : C) (g : Z ⟶ X) (hgf : g ≫ f = 0), g = 0) :
    is_limit (kernel_fork.of_ι (0 : 0 ⟶ X) (show 0 ≫ f = 0, by simp)) :=
fork.is_limit.mk _ (λ s, 0)
  (λ s, by rw [hf _ _ (kernel_fork.condition s), zero_comp])
  (λ s m h, by ext)

end has_zero_object

section transport

/-- If `i` is an isomorphism such that `l ≫ i.hom = f`, then any kernel of `f` is a kernel of `l`.-/
def is_kernel.of_comp_iso {Z : C} (l : X ⟶ Z) (i : Z ≅ Y) (h : l ≫ i.hom = f)
  {s : kernel_fork f} (hs : is_limit s) : is_limit (kernel_fork.of_ι (fork.ι s) $
    show fork.ι s ≫ l = 0, by simp [←i.comp_inv_eq.2 h.symm]) :=
fork.is_limit.mk _
  (λ s, hs.lift $ kernel_fork.of_ι (fork.ι s) $ by simp [←h])
  (λ s, by simp)
  (λ s m h, by { apply fork.is_limit.hom_ext hs, simpa using h walking_parallel_pair.zero })

/-- If `i` is an isomorphism such that `l ≫ i.hom = f`, then the kernel of `f` is a kernel of `l`.-/
def kernel.of_comp_iso [has_kernel f]
  {Z : C} (l : X ⟶ Z) (i : Z ≅ Y) (h : l ≫ i.hom = f) :
  is_limit (kernel_fork.of_ι (kernel.ι f) $
    show kernel.ι f ≫ l = 0, by simp [←i.comp_inv_eq.2 h.symm]) :=
is_kernel.of_comp_iso f l i h $ limit.is_limit _

/-- If `s` is any limit kernel cone over `f` and if  `i` is an isomorphism such that
    `i.hom ≫ s.ι  = l`, then `l` is a kernel of `f`. -/
def is_kernel.iso_kernel {Z : C} (l : Z ⟶ X) {s : kernel_fork f} (hs : is_limit s)
  (i : Z ≅ s.X) (h : i.hom ≫ fork.ι s = l) : is_limit (kernel_fork.of_ι l $
    show l ≫ f = 0, by simp [←h]) :=
is_limit.of_iso_limit hs $ cones.ext i.symm $ λ j,
  by { cases j, { exact (iso.eq_inv_comp i).2 h }, { simp } }

/-- If `i` is an isomorphism such that `i.hom ≫ kernel.ι f = l`, then `l` is a kernel of `f`. -/
def kernel.iso_kernel [has_kernel f]
  {Z : C} (l : Z ⟶ X) (i : Z ≅ kernel f) (h : i.hom ≫ kernel.ι f = l) :
  is_limit (kernel_fork.of_ι l $ by simp [←h]) :=
is_kernel.iso_kernel f l (limit.is_limit _) i h

end transport

section
variables (X Y)

/-- The kernel morphism of a zero morphism is an isomorphism -/
lemma kernel.ι_of_zero : is_iso (kernel.ι (0 : X ⟶ Y)) :=
equalizer.ι_of_self _

end

section

/-- A cokernel cofork is just a cofork where the second morphism is a zero morphism. -/
abbreviation cokernel_cofork := cofork f 0

variables {f}

@[simp, reassoc] lemma cokernel_cofork.condition (s : cokernel_cofork f) : f ≫ cofork.π s = 0 :=
by rw [cofork.condition, zero_comp]

@[simp] lemma cokernel_cofork.app_zero (s : cokernel_cofork f) : s.ι.app zero = 0 :=
by rw [←cofork.left_app_one, cokernel_cofork.condition]

/-- A morphism `π` satisfying `f ≫ π = 0` determines a cokernel cofork on `f`. -/
abbreviation cokernel_cofork.of_π {Z : C} (π : Y ⟶ Z) (w : f ≫ π = 0) : cokernel_cofork f :=
cofork.of_π π $ by rw [w, zero_comp]

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

/-- Every cokernel cofork `s` is isomorphic (actually, equal) to `cofork.of_π (cofork.π s) _`. -/
def iso_of_π (s : cofork f 0) : s ≅ cofork.of_π (cofork.π s) (cofork.condition s) :=
cocones.ext (iso.refl _) $ λ j, by cases j; tidy

/-- If `π = π'`, then `cokernel_cofork.of_π π _` and `cokernel_cofork.of_π π' _` are isomorphic. -/
def of_π_congr {P : C} {π π' : Y ⟶ P} {w : f ≫ π = 0} (h : π = π') :
  cokernel_cofork.of_π π w ≅ cokernel_cofork.of_π π' (by rw [←h, w]) :=
cocones.ext (iso.refl _) $ λ j, by cases j; tidy

/-- If `s` is a colimit cokernel cofork, then every `k : Y ⟶ W` satisfying `f ≫ k = 0` induces
    `l : s.X ⟶ W` such that `cofork.π s ≫ l = k`. -/
def cokernel_cofork.is_colimit.desc' {s : cokernel_cofork f} (hs : is_colimit s) {W : C} (k : Y ⟶ W)
  (h : f ≫ k = 0) : {l : s.X ⟶ W // cofork.π s ≫ l = k} :=
⟨hs.desc $ cokernel_cofork.of_π _ h, hs.fac _ _⟩

/--
This is a slightly more convenient method to verify that a cokernel cofork is a colimit cocone.
It only asks for a proof of facts that carry any mathematical content -/
def is_colimit_aux (t : cokernel_cofork f)
  (desc : Π (s : cokernel_cofork f), t.X ⟶ s.X)
  (fac : ∀ (s : cokernel_cofork f), t.π ≫ desc s = s.π)
  (uniq : ∀ (s : cokernel_cofork f) (m : t.X ⟶ s.X) (w : t.π ≫ m = s.π), m = desc s) :
  is_colimit t :=
{ desc := desc,
  fac' := λ s j, by { cases j, { simp, }, { exact fac s, }, },
  uniq' := λ s m w, uniq s m (w limits.walking_parallel_pair.one), }

/--
This is a more convenient formulation to show that a `cokernel_cofork` constructed using
`cokernel_cofork.of_π` is a limit cone.
-/
def is_colimit.of_π {Z : C} (g : Y ⟶ Z) (eq : f ≫ g = 0)
  (desc : Π {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0), Z ⟶ Z')
  (fac : ∀ {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0), g ≫ desc g' eq' = g')
  (uniq :
    ∀ {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0) (m : Z ⟶ Z') (w : g ≫ m = g'), m = desc g' eq') :
  is_colimit (cokernel_cofork.of_π g eq) :=
is_colimit_aux _ (λ s, desc s.π s.condition) (λ s, fac s.π s.condition) (λ s, uniq s.π s.condition)

/-- Every cokernel of `f` induces a cokernel of `g ≫ f` if `g` is epi. -/
def is_cokernel_epi_comp  {c : cokernel_cofork f} (i : is_colimit c) {W} (g : W ⟶ X) [hg : epi g] :
  is_colimit (cokernel_cofork.of_π c.π (by simp) : cokernel_cofork (g ≫ f)) :=
cofork.is_colimit.mk' _ $ λ s,
  let s' : cokernel_cofork f := cofork.of_π s.π
    (by apply hg.left_cancellation; simp [←category.assoc, s.condition]) in
  let l := cokernel_cofork.is_colimit.desc' i s'.π s'.condition in
  ⟨l.1, l.2,
    λ m hm, by apply cofork.is_colimit.hom_ext i; rw cofork.π_of_π at hm; rw hm; exact l.2.symm⟩

end

section
variables [has_cokernel f]

/-- The cokernel of a morphism, expressed as the coequalizer with the 0 morphism. -/
abbreviation cokernel : C := coequalizer f 0

/-- The map from the target of `f` to `cokernel f`. -/
abbreviation cokernel.π : Y ⟶ cokernel f := coequalizer.π f 0

@[simp] lemma coequalizer_as_cokernel : coequalizer.π f 0 = cokernel.π f := rfl

@[simp, reassoc] lemma cokernel.condition : f ≫ cokernel.π f = 0 :=
cokernel_cofork.condition _

/-- The cokernel built from `cokernel.π f` is colimiting. -/
def cokernel_is_cokernel :
  is_colimit (cofork.of_π (cokernel.π f) ((cokernel.condition f).trans (zero_comp.symm))) :=
is_colimit.of_iso_colimit (colimit.is_colimit _) (cofork.ext (iso.refl _) (by tidy))

/-- Given any morphism `k : Y ⟶ W` such that `f ≫ k = 0`, `k` factors through `cokernel.π f`
    via `cokernel.desc : cokernel f ⟶ W`. -/
abbreviation cokernel.desc {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) : cokernel f ⟶ W :=
colimit.desc (parallel_pair f 0) (cokernel_cofork.of_π k h)

@[simp, reassoc]
lemma cokernel.π_desc {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) :
  cokernel.π f ≫ cokernel.desc f k h = k :=
colimit.ι_desc _ _

@[simp]
lemma cokernel.desc_zero {W : C} {h} : cokernel.desc f (0 : Y ⟶ W) h = 0 :=
by { ext, simp, }

instance cokernel.desc_epi
  {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) [epi k] : epi (cokernel.desc f k h) :=
⟨λ Z g g' w,
begin
  replace w := cokernel.π f ≫= w,
  simp only [cokernel.π_desc_assoc] at w,
  exact (cancel_epi k).1 w,
end⟩

/-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = 0` induces `l : cokernel f ⟶ W` such that
    `cokernel.π f ≫ l = k`. -/
def cokernel.desc' {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) :
  {l : cokernel f ⟶ W // cokernel.π f ≫ l = k} :=
⟨cokernel.desc f k h, cokernel.π_desc _ _ _⟩

/-- A commuting square induces a morphism of cokernels. -/
abbreviation cokernel.map {X' Y' : C} (f' : X' ⟶ Y') [has_cokernel f']
  (p : X ⟶ X') (q : Y ⟶ Y') (w : f ≫ q = p ≫ f') : cokernel f ⟶ cokernel f' :=
cokernel.desc f (q ≫ cokernel.π f') (by simp [reassoc_of w])

/--
Given a commutative diagram
    X --f--> Y --g--> Z
    |        |        |
    |        |        |
    v        v        v
    X' -f'-> Y' -g'-> Z'
with horizontal arrows composing to zero,
then we obtain a commutative square
   cokernel f ---> Z
   |               |
   | cokernel.map  |
   |               |
   v               v
   cokernel f' --> Z'
-/
lemma cokernel.map_desc {X Y Z X' Y' Z' : C}
  (f : X ⟶ Y) [has_cokernel f] (g : Y ⟶ Z) (w : f ≫ g = 0)
  (f' : X' ⟶ Y') [has_cokernel f'] (g' : Y' ⟶ Z') (w' : f' ≫ g' = 0)
  (p : X ⟶ X') (q : Y ⟶ Y') (r : Z ⟶ Z') (h₁ : f ≫ q = p ≫ f') (h₂ : g ≫ r = q ≫ g') :
  cokernel.map f f' p q h₁ ≫ cokernel.desc f' g' w' = cokernel.desc f g w ≫ r :=
by { ext, simp [h₂], }

/-- The cokernel of the zero morphism is an isomorphism -/
instance cokernel.π_zero_is_iso :
  is_iso (cokernel.π (0 : X ⟶ Y)) :=
coequalizer.π_of_self _

lemma eq_zero_of_mono_cokernel [mono (cokernel.π f)] : f = 0 :=
(cancel_mono (cokernel.π f)).1 (by simp)

/-- The cokernel of a zero morphism is isomorphic to the target. -/
def cokernel_zero_iso_target : cokernel (0 : X ⟶ Y) ≅ Y :=
coequalizer.iso_target_of_self 0

@[simp] lemma cokernel_zero_iso_target_hom :
  cokernel_zero_iso_target.hom = cokernel.desc (0 : X ⟶ Y) (𝟙 Y) (by simp) :=
by { ext, simp [cokernel_zero_iso_target], }

@[simp] lemma cokernel_zero_iso_target_inv :
  cokernel_zero_iso_target.inv = cokernel.π (0 : X ⟶ Y) := rfl

/-- If two morphisms are known to be equal, then their cokernels are isomorphic. -/
def cokernel_iso_of_eq {f g : X ⟶ Y} [has_cokernel f] [has_cokernel g] (h : f = g) :
  cokernel f ≅ cokernel g :=
has_colimit.iso_of_nat_iso (by simp[h])

@[simp]
lemma cokernel_iso_of_eq_refl {h : f = f} : cokernel_iso_of_eq h = iso.refl (cokernel f) :=
by { ext, simp [cokernel_iso_of_eq], }

@[simp, reassoc]
lemma π_comp_cokernel_iso_of_eq_hom {f g : X ⟶ Y} [has_cokernel f] [has_cokernel g] (h : f = g) :
  cokernel.π _ ≫ (cokernel_iso_of_eq h).hom = cokernel.π _ :=
by { unfreezingI { induction h, simp } }

@[simp, reassoc]

@[simp, reassoc]
lemma cokernel_iso_of_eq_hom_comp_desc {Z} {f g : X ⟶ Y} [has_cokernel f] [has_cokernel g]
  (h : f = g) (e : Y ⟶ Z) (he) :
  (cokernel_iso_of_eq h).hom ≫ cokernel.desc _ e he = cokernel.desc _ e (by simp [h, he]) :=
by { unfreezingI { induction h, simp } }

@[simp, reassoc]
lemma cokernel_iso_of_eq_inv_comp_desc {Z} {f g : X ⟶ Y} [has_cokernel f] [has_cokernel g]
  (h : f = g) (e : Y ⟶ Z) (he) :
  (cokernel_iso_of_eq h).inv ≫ cokernel.desc _ e he = cokernel.desc _ e (by simp [← h, he]) :=
by { unfreezingI { induction h, simp } }

@[simp]
lemma cokernel_iso_of_eq_trans {f g h : X ⟶ Y} [has_cokernel f] [has_cokernel g] [has_cokernel h]
  (w₁ : f = g) (w₂ : g = h) :
  cokernel_iso_of_eq w₁ ≪≫ cokernel_iso_of_eq w₂ = cokernel_iso_of_eq (w₁.trans w₂) :=
by { unfreezingI { induction w₁, induction w₂, }, ext, simp [cokernel_iso_of_eq], }

variables {f}

lemma cokernel_not_mono_of_nonzero (w : f ≠ 0) : ¬mono (cokernel.π f) :=
λ I, by exactI w (eq_zero_of_mono_cokernel f)

lemma cokernel_not_iso_of_nonzero (w : f ≠ 0) : (is_iso (cokernel.π f)) → false :=
λ I, cokernel_not_mono_of_nonzero w $ by { resetI, apply_instance }

-- TODO the remainder of this section has obvious generalizations to `has_coequalizer f g`.

instance has_cokernel_comp_iso {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel f] [is_iso g] :
  has_cokernel (f ≫ g) :=
{ exists_colimit :=
  ⟨{ cocone := cokernel_cofork.of_π (inv g ≫ cokernel.π f) (by simp),
     is_colimit := is_colimit_aux _ (λ s, cokernel.desc _ (g ≫ s.π)
       (by { rw [←category.assoc, cokernel_cofork.condition], }))
       (by tidy)
       (λ s m w, by { simp_rw [←w], ext, simp, }), }⟩ }

/--
When `g` is an isomorphism, the cokernel of `f ≫ g` is isomorphic to the cokernel of `f`.
-/
@[simps]
def cokernel_comp_is_iso {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel f] [is_iso g] :
  cokernel (f ≫ g) ≅ cokernel f :=
{ hom := cokernel.desc _ (inv g ≫ cokernel.π f) (by simp),
  inv := cokernel.desc _ (g ≫ cokernel.π (f ≫ g)) (by rw [←category.assoc, cokernel.condition]), }

instance has_cokernel_epi_comp {X Y : C} (f : X ⟶ Y) [has_cokernel f] {W} (g : W ⟶ X) [epi g] :
  has_cokernel (g ≫ f) :=
⟨⟨{ cocone := _, is_colimit := is_cokernel_epi_comp (colimit.is_colimit _) g }⟩⟩

/--
When `f` is an epimorphism, the cokernel of `f ≫ g` is isomorphic to the cokernel of `g`.
-/
@[simps]
def cokernel_epi_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z)
  [epi f] [has_cokernel g] :
  cokernel (f ≫ g) ≅ cokernel g :=
{ hom := cokernel.desc _ (cokernel.π g) (by simp),
  inv := cokernel.desc _ (cokernel.π (f ≫ g)) (by { rw [←cancel_epi f, ←category.assoc], simp, }), }

end

section has_zero_object
variables [has_zero_object C]

open_locale zero_object

/-- The morphism to the zero object determines a cocone on a cokernel diagram -/
def cokernel.zero_cocone : cocone (parallel_pair f 0) :=
{ X := 0,
  ι := { app := λ j, 0 } }

/-- The morphism to the zero object is a cokernel of an epimorphism -/
def cokernel.is_colimit_cocone_zero_cocone [epi f] : is_colimit (cokernel.zero_cocone f) :=
cofork.is_colimit.mk _ (λ s, 0)
  (λ s, by { erw zero_comp,
    convert (zero_of_epi_comp f _).symm,
    exact cokernel_cofork.condition _ })
  (λ _ _ _, zero_of_from_zero _)

/-- The cokernel of an epimorphism is isomorphic to the zero object -/
def cokernel.of_epi [has_cokernel f] [epi f] : cokernel f ≅ 0 :=
functor.map_iso (cocones.forget _) $ is_colimit.unique_up_to_iso
  (colimit.is_colimit (parallel_pair f 0)) (cokernel.is_colimit_cocone_zero_cocone f)

/-- The cokernel morphism of an epimorphism is a zero morphism -/
lemma cokernel.π_of_epi [has_cokernel f] [epi f] : cokernel.π f = 0 :=
zero_of_target_iso_zero _ (cokernel.of_epi f)

end has_zero_object

section mono_factorisation
variables {f}

@[simp] lemma mono_factorisation.kernel_ι_comp [has_kernel f] (F : mono_factorisation f) :
  kernel.ι f ≫ F.e = 0 :=
by rw [← cancel_mono F.m, zero_comp, category.assoc, F.fac, kernel.condition]

end mono_factorisation

section has_image

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

(This result requires that the factorisation through the image is an epimorphism.
This holds in any category with equalizers.)
-/
@[simps]
def cokernel_image_ι {X Y : C} (f : X ⟶ Y)
  [has_image f] [has_cokernel (image.ι f)] [has_cokernel f] [epi (factor_thru_image f)] :
  cokernel (image.ι f) ≅ cokernel f :=
{ hom := cokernel.desc _ (cokernel.π f)
  begin
    have w := cokernel.condition f,
    conv at w { to_lhs, congr, rw ←image.fac f, },
    rw [←has_zero_morphisms.comp_zero (limits.factor_thru_image f), category.assoc, cancel_epi]
      at w,
    exact w,
  end,
  inv := cokernel.desc _ (cokernel.π _)
  begin
    conv { to_lhs, congr, rw ←image.fac f, },
    rw [category.assoc, cokernel.condition, has_zero_morphisms.comp_zero],
  end, }

end has_image

section
variables (X Y)

/-- The cokernel of a zero morphism is an isomorphism -/
lemma cokernel.π_of_zero :
  is_iso (cokernel.π (0 : X ⟶ Y)) :=
coequalizer.π_of_self _

end

section has_zero_object
variables [has_zero_object C]

open_locale zero_object

/-- The kernel of the cokernel of an epimorphism is an isomorphism -/
instance kernel.of_cokernel_of_epi [has_cokernel f]
  [has_kernel (cokernel.π f)] [epi f] : is_iso (kernel.ι (cokernel.π f)) :=
equalizer.ι_of_eq $ cokernel.π_of_epi f

/-- The cokernel of the kernel of a monomorphism is an isomorphism -/
instance cokernel.of_kernel_of_mono [has_kernel f]
  [has_cokernel (kernel.ι f)] [mono f] : is_iso (cokernel.π (kernel.ι f)) :=
coequalizer.π_of_eq $ kernel.ι_of_mono f

/-- If `f ≫ g = 0` implies `g = 0` for all `g`, then `0 : Y ⟶ 0` is a cokernel of `f`. -/
def zero_cokernel_of_zero_cancel {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (Z : C) (g : Y ⟶ Z) (hgf : f ≫ g = 0), g = 0) :
    is_colimit (cokernel_cofork.of_π (0 : Y ⟶ 0) (show f ≫ 0 = 0, by simp)) :=
cofork.is_colimit.mk _ (λ s, 0)
  (λ s, by rw [hf _ _ (cokernel_cofork.condition s), comp_zero])
  (λ s m h, by ext)

end has_zero_object

section transport

/-- If `i` is an isomorphism such that `i.hom ≫ l = f`, then any cokernel of `f` is a cokernel of
    `l`. -/
def is_cokernel.of_iso_comp {Z : C} (l : Z ⟶ Y) (i : X ≅ Z) (h : i.hom ≫ l = f)
  {s : cokernel_cofork f} (hs : is_colimit s) : is_colimit (cokernel_cofork.of_π (cofork.π s) $
    show l ≫ cofork.π s = 0, by simp [i.eq_inv_comp.2 h]) :=
cofork.is_colimit.mk _
  (λ s, hs.desc $ cokernel_cofork.of_π (cofork.π s) $ by simp [←h])
  (λ s, by simp)
  (λ s m h, by { apply cofork.is_colimit.hom_ext hs, simpa using h walking_parallel_pair.one })

/-- If `i` is an isomorphism such that `i.hom ≫ l = f`, then the cokernel of `f` is a cokernel of
    `l`. -/
def cokernel.of_iso_comp [has_cokernel f]
  {Z : C} (l : Z ⟶ Y) (i : X ≅ Z) (h : i.hom ≫ l = f) :
  is_colimit (cokernel_cofork.of_π (cokernel.π f) $
    show l ≫ cokernel.π f = 0, by simp [i.eq_inv_comp.2 h]) :=
is_cokernel.of_iso_comp f l i h $ colimit.is_colimit _

/-- If `s` is any colimit cokernel cocone over `f` and `i` is an isomorphism such that
    `s.π ≫ i.hom = l`, then `l` is a cokernel of `f`. -/
def is_cokernel.cokernel_iso {Z : C} (l : Y ⟶ Z) {s : cokernel_cofork f} (hs : is_colimit s)
  (i : s.X ≅ Z) (h : cofork.π s ≫ i.hom = l) : is_colimit (cokernel_cofork.of_π l $
    show f ≫ l = 0, by simp [←h]) :=
is_colimit.of_iso_colimit hs $ cocones.ext i $ λ j, by { cases j, { simp }, { exact h } }

/-- If `i` is an isomorphism such that `cokernel.π f ≫ i.hom = l`, then `l` is a cokernel of `f`. -/
def cokernel.cokernel_iso [has_cokernel f]
  {Z : C} (l : Y ⟶ Z) (i : cokernel f ≅ Z) (h : cokernel.π f ≫ i.hom = l) :
  is_colimit (cokernel_cofork.of_π l $ by simp [←h]) :=
is_cokernel.cokernel_iso f l (colimit.is_colimit _) i h

end transport

section comparison

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

/--
The comparison morphism for the kernel of `f`.
This is an isomorphism iff `G` preserves the kernel of `f`; see
`category_theory/limits/preserves/shapes/kernels.lean`
-/
def kernel_comparison [has_kernel f] [has_kernel (G.map f)] :
  G.obj (kernel f) ⟶ kernel (G.map f) :=
kernel.lift _ (G.map (kernel.ι f)) (by simp only [←G.map_comp, kernel.condition, functor.map_zero])

@[simp, reassoc]
lemma kernel_comparison_comp_ι [has_kernel f] [has_kernel (G.map f)] :
  kernel_comparison f G ≫ kernel.ι (G.map f) = G.map (kernel.ι f) :=
kernel.lift_ι _ _ _

@[simp, reassoc]
lemma map_lift_kernel_comparison [has_kernel f] [has_kernel (G.map f)]
  {Z : C} {h : Z ⟶ X} (w : h ≫ f = 0) :
    G.map (kernel.lift _ h w) ≫ kernel_comparison f G =
      kernel.lift _ (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :=
by { ext, simp [← G.map_comp] }

/-- The comparison morphism for the cokernel of `f`. -/
def cokernel_comparison [has_cokernel f] [has_cokernel (G.map f)] :
  cokernel (G.map f) ⟶ G.obj (cokernel f) :=
cokernel.desc _ (G.map (coequalizer.π _ _))
  (by simp only [←G.map_comp, cokernel.condition, functor.map_zero])

@[simp, reassoc]
lemma π_comp_cokernel_comparison [has_cokernel f] [has_cokernel (G.map f)] :
  cokernel.π (G.map f) ≫ cokernel_comparison f G = G.map (cokernel.π _) :=
cokernel.π_desc _ _ _

@[simp, reassoc]
lemma cokernel_comparison_map_desc [has_cokernel f] [has_cokernel (G.map f)]
  {Z : C} {h : Y ⟶ Z} (w : f ≫ h = 0) :
  cokernel_comparison f G ≫ G.map (cokernel.desc _ h w) =
    cokernel.desc _ (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :=
by { ext, simp [← G.map_comp] }

end comparison

end category_theory.limits

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

variables [has_zero_morphisms C]

/-- `has_kernels` represents the existence of kernels for every morphism. -/
class has_kernels : Prop :=
(has_limit : Π {X Y : C} (f : X ⟶ Y), has_kernel f . tactic.apply_instance)

/-- `has_cokernels` represents the existence of cokernels for every morphism. -/
class has_cokernels : Prop :=
(has_colimit : Π {X Y : C} (f : X ⟶ Y), has_cokernel f . tactic.apply_instance)

attribute [instance, priority 100] has_kernels.has_limit has_cokernels.has_colimit

@[priority 100]
instance has_kernels_of_has_equalizers [has_equalizers C] : has_kernels C :=
{}

@[priority 100]
instance has_cokernels_of_has_coequalizers [has_coequalizers C] : has_cokernels C :=
{}

end category_theory.limits


import algebra.category.Group.limits
import category_theory.limits.concrete_category

universes u v

namespace Ab

open category_theory
open category_theory.limits

variables {J : Type u} [category_theory.small_category J] (K : J ⥤ Ab.{max u v})

lemma comp_apply {A B C : Ab} (f : A ⟶ B) (g : B ⟶ C) (a : A) :
  (f ≫ g) a = g (f a) := rfl

instance : add_comm_group (K ⋙ category_theory.forget _).sections :=
{ add := λ u v, ⟨ u + v, λ i j f, begin
    have u2 := u.2 f,
    have v2 := v.2 f,
    dsimp at *,
    simp [u2,v2],
  end⟩,
  add_assoc := λ a b c, by { ext, simp [add_assoc] },
  zero := ⟨0, λ i j f, by { dsimp, simp }⟩,
  zero_add := λ a, by { ext, dsimp, simp },
  add_zero := λ a, by { ext, dsimp, simp },
  neg := λ t, ⟨ -t, begin
    intros i j f,
    have t2 := t.2 f,
    dsimp at *,
    simp [t2],
  end ⟩,
  add_left_neg := λ a, by { ext, change - (a.1 x) + a.1 x = 0, simp },
  add_comm := λ a b, by { ext, change (a.1 x) + (b.1 x) = (b.1 x) + (a.1 x), rw [add_comm] } }

def explicit_limit_cone : cone K :=
{ X := AddCommGroup.of (K ⋙ category_theory.forget _).sections,
  π :=
  { app := λ j,
    { to_fun := λ t, t.1 j,
      map_zero' := rfl,
      map_add' := λ x y, rfl },
    naturality' := begin
      intros i j f,
      ext,
      simpa using (x.2 f).symm,
    end } }

def explicit_limit_cone_is_limit : is_limit (explicit_limit_cone K) :=
{ lift := λ S,
  { to_fun := λ t, ⟨λ j, S.π.app j t, begin
      intros i j f,
      dsimp,
      rw ← S.w f,
      refl,
    end⟩,
    map_zero' := by { ext, dsimp, simpa },
    map_add' := λ x y, by { ext, dsimp, simpa } },
  fac' := begin
    intros S j,
    ext,
    refl,
  end,
  uniq' := begin
    intros S m hm,
    ext,
    simpa [← hm],
  end }

noncomputable
def barx : preserves_limit K (forget Ab.{max u v}) :=
preserves_limits_of_shape.preserves_limit

noncomputable
instance foo {K : J ⥤ Ab.{u}} : preserves_limit K (forget Ab.{u}) :=
barx.{u u} K

lemma is_limit_ext {K : J ⥤ Ab.{u}} (C : limit_cone K) (x y : C.cone.X)
  (h : ∀ j : J, C.cone.π.app j x = C.cone.π.app j y) : x = y :=
limits.concrete.is_limit_ext.{(max u u) (max u u)+1} K C.2 _ _ h

noncomputable
instance forget_creates_limit (J : Type u) [small_category J] (K : J ⥤ Ab.{max u v}) :
  creates_limit K (forget Ab) :=
creates_limit_of_reflects_iso $ λ C hC,
{ lifted_cone := explicit_limit_cone _,
  valid_lift := (types.limit_cone_is_limit _).unique_up_to_iso hC,
  makes_limit := explicit_limit_cone_is_limit _ }

-- Do we have this somewhere else?
noncomputable
instance forget_creates_limits : creates_limits (forget Ab.{max u v}) :=
by { constructor, introsI J hJ, constructor, intros K, apply Ab.forget_creates_limit.{_ u} J K }

-- Do we have this somewhere else?
noncomputable
instance forget_creates_limits' : creates_limits (forget Ab.{u}) :=
Ab.forget_creates_limits.{u u}

end Ab


import algebra.char_p.two

/-! # IMO 2015 A4 (P5), Generalized Version -/

namespace IMOSL
namespace IMO2015A4

open function
open_locale non_zero_divisors

def good {R : Type*} [ring R] (f : R → R) := ∀ x y : R, f (x + f (x + y)) + f (x * y) = x + f (x + y) + f x * y

/-- Final solution, case 1: `char(R) ≠ 2` -/
theorem final_solution_char_ne_two {R : Type*} [ring R] [is_domain R] (Rchar : ring_char R ≠ 2) :
  ∀ f : R → R, good f ↔ f = (λ x, x) ∨ f = (λ x, 2 - x) :=
begin
  intros f; symmetry; refine ⟨λ h x y, _, λ h, _⟩,
  rcases h with rfl | rfl; simp only [],
  rw [← add_sub_assoc, ← add_sub_assoc, add_sub_add_left_eq_sub, sub_sub_cancel,
      sub_mul, ← add_sub_assoc, sub_left_inj, two_mul, sub_add_add_cancel, add_comm],

  ---- One important equality and the case `f(0) ≠ 0`
  have h0 : ∀ t : R, f (t + f (t + 1)) = t + f (t + 1) :=
    λ t, by replace h := h t 1; rwa [mul_one, mul_one, add_left_inj] at h,
  cases ne_or_eq (f 0) 0 with h1 h1,
  right; funext x,
  replace h := h 0 (x - 1 + f (x - 1 + 1)),
  rwa [zero_add, zero_add, zero_mul, h0, h0, add_right_inj, sub_add_cancel, eq_comm,
       ← sub_eq_zero, ← mul_sub_one, mul_eq_zero, or_iff_right h1, sub_eq_zero,
       ← add_sub_right_comm, sub_eq_iff_eq_add, ← eq_sub_iff_add_eq'] at h,

  ---- The main case, `f(0) = 0`
  ---- First obtain `f(1) = 1` and reduce to `f` being odd
  left; have h2 := h0 (-1),
  rw [neg_add_self, h1, add_zero] at h2,
  replace h2 : f 1 = 1 :=
  begin
    replace h := h 1 (-1),
    rwa [add_neg_self, h1, add_zero, one_mul, h2, mul_neg_one, add_neg_eq_iff_eq_add,
         add_right_comm, eq_add_neg_iff_add_eq, ← two_mul, ← two_mul,
         mul_eq_mul_left_iff, or_iff_left (ring.two_ne_zero Rchar)] at h,
  end,
  suffices h3 : ∀ x : R, f (-x) = -f x,
  { funext x,
    replace h0 := h 1 x,
    rw [one_mul, h2, one_mul] at h0,
    replace h1 := h (-1) (-x),
    rw [← neg_add, h3, ← neg_add, h3, h3, h2, neg_mul_neg, one_mul] at h1,
    generalize_hyp : 1 + f (1 + x) = c at h0 h1,
    replace h0 := congr_arg2 has_add.add h0 h1,
    rwa [add_add_add_comm, add_neg_self, zero_add, add_add_add_comm, add_neg_self, zero_add,
         ← two_mul, ← two_mul, mul_eq_mul_left_iff, or_iff_left (ring.two_ne_zero Rchar)] at h0 },

  ---- Now prove that `f` is odd
  intros x,
  rw [← mul_neg_one, ← add_right_inj (f (x + f (x + -1))), h,
      mul_neg_one, add_left_inj, eq_comm, ← sub_eq_add_neg],
  obtain ⟨y, rfl⟩ : ∃ y : R, y + (1 + 1) = x := ⟨x - (1 + 1), sub_add_cancel x _⟩,
  rw [add_sub_assoc, add_sub_cancel, ← bit0, add_right_comm],
  replace h0 := h0 y,
  have h3 := h (y + 1) 0,
  rw [add_zero, mul_zero, mul_zero, add_zero, h1, add_zero, add_right_comm] at h3,
  generalize_hyp : y + f (y + 1) = t at h0 h3 ⊢; clear y,
  replace h := h 1 t,
  rwa [h2, one_mul, h0, add_left_inj, add_comm 1 t, h3, add_left_comm] at h
end

/-- Final solution, case 2: `char(R) = 2` -/
theorem final_solution_char_eq_two {R : Type*} [ring R] [is_domain R] [char_p R 2] :
  ∀ f : R → R, good f ↔ f = (λ x, x) :=
begin
  ---- Easy case and changing `f` to `g + id`
  intros f; symmetry; refine ⟨λ h x y, by subst h, λ h, _⟩,
  unfold good at h,
  obtain ⟨g, rfl⟩ : ∃ g : R → R, g + (λ x, x) = f := ⟨f - id, sub_add_cancel f id⟩,
  rw add_left_eq_self; simp only [pi.add_apply] at h,
  conv at h { find (_ = _) { rw [← add_assoc, add_mul, ← add_assoc _ _ (x * y),
    add_left_inj, add_right_comm _ _ (g (x * y)), add_comm, add_right_inj,
    add_left_comm, ← add_assoc x, char_two.add_self_eq_zero, zero_add] } },

  ---- Reduce into two equalities, then obtain `g(0) = 0` and `g(1) = 0`
  suffices : (∀ t : R, g (t + 1) * (t + 1) = g t * t) ∧ ∀ t : R, g (g t * t) = g t,
  { cases this with h0 h1,
    funext t,
    have h2 := h1 t,
    rw [← h0, h1] at h2,
    replace h0 := h0 t,
    rwa [h2, mul_add_one, add_right_eq_self] at h0 },
  have h0 := h 1 1,
  rw [mul_one, mul_one, add_left_eq_self, char_two.add_self_eq_zero] at h0,
  have h1 := h 0 (g 0 + 1),
  rw [zero_mul, zero_add, h0, zero_add, h0, zero_add, mul_add_one, self_eq_add_left, ← sq] at h1,
  replace h1 := pow_eq_zero h1,
  rw [h1, zero_add] at h0,
  refine ⟨λ t, _, λ t, _⟩,

  ---- The first equality
  { replace h : ∀ t : R, g (t + 1) + g (t * (t + 1)) = g t * (t + 1) :=
      λ t, by convert h t (t + 1) using 2;
        rw [← add_assoc t, char_two.add_self_eq_zero, zero_add, h0, zero_add],
    replace h0 := h (t + 1),
    rw [add_assoc, char_two.add_self_eq_zero, add_zero] at h0,
    rw [mul_add_one, ← h0, add_one_mul, ← mul_add_one, add_assoc, add_comm (g (t * _)),
        h, mul_add_one, add_left_comm, char_two.add_self_eq_zero, add_zero] },

  ---- The second equality
  { replace h0 := h t 0,
    rw [add_zero, add_zero, mul_zero, h1, add_zero, mul_zero] at h0,
    have h2 := h 0 t,
    rw [zero_add, zero_mul, h1, zero_mul, add_zero] at h2,
    replace h1 := h (g t) t,
    rw [h2, zero_add, h0, zero_mul, add_eq_zero_iff_eq_neg, char_two.neg_eq] at h1,
    exact h1.symm }
end

/-- Final solution -/
theorem final_solution {R : Type*} [ring R] [is_domain R] :
  ∀ f : R → R, good f ↔ f = (λ x, x) ∨ f = (λ x, 2 - x) :=
begin
  cases ne_or_eq (ring_char R) 2 with h h,
  exact final_solution_char_ne_two h,
  haveI : char_p R 2 := ring_char.of_eq h,
  simp only [char_two.two_eq_zero, char_two.sub_eq_add, zero_add, or_self],
  exact final_solution_char_eq_two
end

end IMO2015A4
end IMOSL


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.multiset.basic
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Sections of a multiset
-/

namespace multiset

/--
The sections of a multiset of multisets `s` consists of all those multisets
which can be put in bijection with `s`, so each element is an member of the corresponding multiset.
-/
def sections {α : Type u_1} (s : multiset (multiset α)) : multiset (multiset α) :=
  multiset.rec_on s (singleton 0)
    (fun (s : multiset α) (_x c : multiset (multiset α)) => bind s fun (a : α) => map (cons a) c)
    sorry

@[simp] theorem sections_zero {α : Type u_1} : sections 0 = 0 ::ₘ 0 := rfl

@[simp] theorem sections_cons {α : Type u_1} (s : multiset (multiset α)) (m : multiset α) :
    sections (m ::ₘ s) = bind m fun (a : α) => map (cons a) (sections s) :=
  rec_on_cons m s

theorem coe_sections {α : Type u_1} (l : List (List α)) :
    sections ↑(list.map (fun (l : List α) => ↑l) l) =
        ↑(list.map (fun (l : List α) => ↑l) (list.sections l)) :=
  sorry

@[simp] theorem sections_add {α : Type u_1} (s : multiset (multiset α))
    (t : multiset (multiset α)) :
    sections (s + t) = bind (sections s) fun (m : multiset α) => map (Add.add m) (sections t) :=
  sorry

theorem mem_sections {α : Type u_1} {s : multiset (multiset α)} {a : multiset α} :
    a ∈ sections s ↔ rel (fun (s : multiset α) (a : α) => a ∈ s) s a :=
  sorry

theorem card_sections {α : Type u_1} {s : multiset (multiset α)} :
    coe_fn card (sections s) = prod (map (⇑card) s) :=
  sorry

theorem prod_map_sum {α : Type u_1} [comm_semiring α] {s : multiset (multiset α)} :
    prod (map sum s) = sum (map prod (sections s)) :=
  sorry

end Mathlib