import data.matrix.pequiv data.rat.basic tactic.fin_cases .argmin .partition2

open matrix fintype finset function pequiv

local notation `rvec`:2000 n := matrix (fin 1) (fin n) ℚ
local notation `cvec`:2000 m := matrix (fin m) (fin 1) ℚ
local infix ` ⬝ `:70 := matrix.mul
local postfix `ᵀ` : 1500 := transpose

section
universes u v
variables {l m n o : Type u} [fintype l] [fintype m] [fintype n] [fintype o] {R : Type v}

/- Belongs in mathlib -/
lemma mul_right_eq_of_mul_eq [semiring R] {M : matrix l m R} {N : matrix m n R} {O : matrix l n R}
  {P : matrix n o R} (h : M ⬝ N = O) : M ⬝ (N ⬝ P) = O ⬝ P :=
by rw [← matrix.mul_assoc, h]

end

variables {m n : ℕ}

/-- The tableau consists of a matrix and a constant `offset` column.
  `to_partition` stores the indices of the current row and column variables.
  `restricted` is the set of variables that are restricted to be nonnegative  -/
structure tableau (m n : ℕ) :=
(to_matrix : matrix (fin m) (fin n) ℚ)
(to_partition : partition m n)
(unrestricted : fin (m + n) → bool)
(dead : fin (m + n) → bool)
(offset : fin n)
(objective : fin m)

namespace tableau
open partition

section predicates
variable (T : tableau m n)

def dual (T : tableau m n) : tableau n m :=
{ to_matrix := -T.to_matrixᵀ,
  to_partition := T.to_partition.dual,
  unrestricted := T.dead ∘ fin.cast (add_comm _ _),
  dead := T.unrestricted ∘ fin.cast (add_comm _ _),
  offset := T.objective,
  objective := T.offset }

@[simp] lemma dual_dual (T : tableau m n) : T.dual.dual = T :=
by cases T;
  simp [dual, matrix.transpose_transpose, function.funext_iff, fin.cast, fin.cast_le, fin.cast_lt]

def subspace : set (cvec (m + n)) := { x | T.to_partition.rowp.to_matrix ⬝ x =
  T.to_matrix ⬝ T.to_partition.colp.to_matrix ⬝ x }

/-- The affine subspace represented by the tableau ignoring nonnegativity restrictions, and dead
  variables-/
def flat : set (cvec (m + n)) :=
T.subspace ∩ {x | x (T.to_partition.colg T.offset) 0 = 1}

/-- The set including variables constrained to be zero. -/
def dead_set : set (cvec (m + n)) :=
flat T ∩ { x | ∀ v, v ∈ T.dead → x v 0 = 0 }

/-- The sign_set is the subset of ℚ^(m+n) that satisifies the tableau -/
def sign_set : set (cvec (m + n)) :=
flat T ∩ { x | ∀ i, i ∉ T.unrestricted → 0 ≤ x i 0 }

def sol_set : set (cvec (m + n)) :=
dead_set T ∩ { x | ∀ i, i ∉ T.unrestricted → 0 ≤ x i 0 }

/-- Predicate for a variable being unbounded above in the `sol_set` -/
def is_unbounded_above (v : fin (m + n)) : Prop :=
∀ q : ℚ, ∃ x : cvec (m + n), x ∈ sol_set T ∧ q ≤ x v 0

/-- Predicate for a variable being unbounded below in the `sol_set` -/
def is_unbounded_below (v : fin (m + n)) : Prop :=
∀ q : ℚ, ∃ x : cvec (m + n), x ∈ sol_set T ∧ x v 0 ≤ q

def is_maximised (x : cvec (m + n)) (i : fin (m + n)) : Prop :=
∀ y : cvec (m + n), y ∈ sol_set T → y i 0 ≤ x i 0

/-- Is this equivalent to `∀ (x : cvec (m + n)), x ∈ sol_set T → x i 0 = x j 0`? No -/
def equal_in_flat (i j : fin (m + n)) : Prop :=
∀ (x : cvec (m + n)), x ∈ flat T → x i 0 = x j 0

/-- Returns an element of the `flat` after assigning values to the column variables -/
def of_col (x : cvec n) : cvec (m + n) :=
T.to_partition.colp.to_matrixᵀ ⬝ x + T.to_partition.rowp.to_matrixᵀ ⬝
  (T.to_matrix ⬝ x + T.offset)

/-- A `tableau` is feasible if its `offset` column is nonnegative in restricted rows -/
def feasible : Prop :=
∀ i, T.to_partition.rowg i ∈ T.restricted → 0 ≤ T.offset i 0

/-- Given a row index `r` and a column index `s` it returns a tableau with `r` and `s` switched,
  but with the same `sol_set` -/
def pivot (r : fin m) (c : fin n) : tableau m n :=
let p := (T.to_matrix r c)⁻¹ in
{ to_matrix := λ i j,
    if i = r
      then if j = c
        then p
        else -T.to_matrix r j * p
      else if j = c
        then T.to_matrix i c * p
        else T.to_matrix i j - T.to_matrix i c * T.to_matrix r j * p,
  to_partition := T.to_partition.swap r c,
  offset := λ i k,
    if i = r
      then -T.offset r k * p
      else T.offset i k - T.to_matrix i c * T.offset r k * p,
  restricted := T.restricted  }

end predicates

section predicate_lemmas
variable {T : tableau m n}

lemma mem_flat_iff {x : cvec (m + n)} : x ∈ T.flat ↔
  ∀ r, x (T.to_partition.rowg r) 0 = univ.sum
    (λ c : fin n, T.to_matrix r c * x (T.to_partition.colg c) 0) +
  T.offset r 0 :=
have hx : x ∈ T.flat ↔ ∀ i, (T.to_partition.rowp.to_matrix ⬝ x) i 0 =
    (T.to_matrix ⬝ T.to_partition.colp.to_matrix ⬝ x + T.offset) i 0,
  by rw [flat, set.mem_set_of_eq, matrix.ext_iff.symm, forall_swap,
      unique.forall_iff];
    refl,
begin
  rw hx,
  refine forall_congr (λ i, _),
  rw [mul_matrix_apply, add_val, rowp_eq_some_rowg, matrix.mul_assoc, matrix.mul],
  conv in (T.to_matrix _ _ * (T.to_partition.colp.to_matrix ⬝ x) _ _)
  { rw [mul_matrix_apply, colp_eq_some_colg] },
end

variable (T)

@[simp] lemma colp_mul_of_col (x : cvec n) :
  T.to_partition.colp.to_matrix ⬝ of_col T x = x :=
by simp [matrix.mul_assoc, matrix.mul_add, of_col, flat,
    mul_right_eq_of_mul_eq (rowp_mul_colp_transpose _),
    mul_right_eq_of_mul_eq (rowp_mul_rowp_transpose _),
    mul_right_eq_of_mul_eq (colp_mul_colp_transpose _),
    mul_right_eq_of_mul_eq (colp_mul_rowp_transpose _)]

@[simp] lemma rowp_mul_of_col (x : cvec n) :
  T.to_partition.rowp.to_matrix ⬝ of_col T x = T.to_matrix ⬝ x + T.offset :=
by simp [matrix.mul_assoc, matrix.mul_add, of_col, flat,
    mul_right_eq_of_mul_eq (rowp_mul_colp_transpose _),
    mul_right_eq_of_mul_eq (rowp_mul_rowp_transpose _),
    mul_right_eq_of_mul_eq (colp_mul_colp_transpose _),
    mul_right_eq_of_mul_eq (colp_mul_rowp_transpose _)]

lemma of_col_mem_flat (x : cvec n) : T.of_col x ∈ T.flat :=
by simp [matrix.mul_assoc, matrix.mul_add, flat]

@[simp] lemma of_col_colg (x : cvec n) (c : fin n) :
  of_col T x (T.to_partition.colg c) = x c :=
funext $ λ v,
  calc of_col T x (T.to_partition.colg c) v =
      (T.to_partition.colp.to_matrix ⬝ of_col T x) c v :
    by rw [mul_matrix_apply, colp_eq_some_colg]
  ... = x c v : by rw [colp_mul_of_col]

@[simp] lemma of_col_rowg (c : cvec n) (r : fin m) :
  of_col T c (T.to_partition.rowg r) = (T.to_matrix ⬝ c + T.offset) r :=
funext $ λ v,
  calc of_col T c (T.to_partition.rowg r) v =
      (T.to_partition.rowp.to_matrix ⬝ of_col T c) r v :
    by rw [mul_matrix_apply, rowp_eq_some_rowg]
  ... = (T.to_matrix ⬝ c + T.offset) r v : by rw [rowp_mul_of_col]

variable {T}

/-- Condition for the solution given by setting column index `j` to `q` and all other columns to
  zero being in the `sol_set` -/
lemma of_col_single_mem_sol_set {q : ℚ} {c : fin n} (hT : T.feasible)
  (hi : ∀ i, T.to_partition.rowg i ∈ T.restricted → 0 ≤ q * T.to_matrix i c)
  (hj : T.to_partition.colg c ∉ T.restricted ∨ 0 ≤ q) :
  T.of_col (q • (single c 0).to_matrix) ∈ T.sol_set :=
⟨of_col_mem_flat _ _,
  λ v, (T.to_partition.eq_rowg_or_colg v).elim
    begin
      rintros ⟨r, hr⟩ hres,
      subst hr,
      rw [of_col_rowg, add_val, matrix.mul_smul, smul_val, matrix_mul_apply,
        symm_single, single_apply],
      exact add_nonneg (hi _ hres) (hT _ hres)
    end
    begin
      rintros ⟨j, hj⟩ hres,
      subst hj,
      simp [of_col_colg, smul_val, pequiv.single, pequiv.to_matrix],
      by_cases hjc : j = c; simp [*, le_refl] at *
    end⟩

lemma feasible_iff_of_col_zero_mem_sol_set : T.feasible ↔ T.of_col 0 ∈ T.sol_set :=
suffices (∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → 0 ≤ T.offset i 0) ↔
    ∀ v : fin (m + n), v ∈ T.restricted → (0 : ℚ) ≤ T.of_col 0 v 0,
by simpa [sol_set, feasible, of_col_mem_flat],
⟨λ h v hv, (T.to_partition.eq_rowg_or_colg v).elim
    (by rintros ⟨i, hi⟩; subst hi; simp; tauto)
    (by rintros ⟨j, hj⟩; subst hj; simp),
  λ h i hi, by simpa using h _ hi⟩

lemma is_unbounded_above_colg_aux {c : fin n} (hT : T.feasible)
  (h : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → 0 ≤ T.to_matrix i c) (q : ℚ):
  of_col T (max q 0 • (single c 0).to_matrix) ∈ sol_set T ∧
    q ≤ of_col T (max q 0 • (single c 0).to_matrix) (T.to_partition.colg c) 0 :=
⟨of_col_single_mem_sol_set hT (λ i hi, mul_nonneg (le_max_right _ _) (h _ hi))
    (or.inr (le_max_right _ _)),
  by simp [of_col_colg, smul_val, pequiv.single, pequiv.to_matrix, le_refl q]⟩

/-- A column variable is unbounded above if it is in a column where every negative entry is
  in a row owned by an unrestricted variable -/
lemma is_unbounded_above_colg {c : fin n} (hT : T.feasible)
  (h : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → 0 ≤ T.to_matrix i c) :
  T.is_unbounded_above (T.to_partition.colg c) :=
λ q, ⟨_, is_unbounded_above_colg_aux hT h q⟩

lemma is_unbounded_below_colg_aux {c : fin n} (hT : T.feasible)
  (hres : T.to_partition.colg c ∉ T.restricted)
  (h : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → T.to_matrix i c ≤ 0) (q : ℚ) :
  of_col T (min q 0 • (single c 0).to_matrix) ∈ sol_set T ∧
    of_col T (min q 0 • (single c 0).to_matrix) (T.to_partition.colg c) 0 ≤ q :=
⟨of_col_single_mem_sol_set hT
    (λ i hi, mul_nonneg_of_nonpos_of_nonpos (min_le_right _ _) (h _ hi))
    (or.inl hres),
  by simp [of_col_colg, smul_val, pequiv.single, pequiv.to_matrix, le_refl q]⟩

/-- A column variable is unbounded below if it is unrestricted and it is in a column where every
  positive entry is in a row owned by an unrestricted variable -/
lemma is_unbounded_below_colg {c : fin n} (hT : T.feasible)
  (hres : T.to_partition.colg c ∉ T.restricted)
  (h : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → T.to_matrix i c ≤ 0) :
  T.is_unbounded_below (T.to_partition.colg c) :=
λ q, ⟨_, is_unbounded_below_colg_aux hT hres h q⟩

/- Belongs in mathlib -/
lemma le_div_iff_of_neg {α : Type*} [linear_ordered_field α] {a b c : α}
  (hc : c < 0) : a ≤ b / c ↔ b ≤ a * c :=
by rw [← neg_neg c, mul_neg_eq_neg_mul_symm, div_neg _ (ne_of_gt (neg_pos.2 hc)), le_neg,
    div_le_iff (neg_pos.2 hc), neg_mul_eq_neg_mul_symm]

/-- A row variable `r` is unbounded above if it is unrestricted and there is a column `s`
  where every restricted row variable has a nonpositive entry in that column, and
  `r` has a negative entry in that column. -/
lemma is_unbounded_above_rowg_of_nonpos {r : fin m} (hT : T.feasible) (s : fin n)
  (hres : T.to_partition.colg s ∉ T.restricted)
  (h : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → T.to_matrix i s ≤ 0)
  (his : T.to_matrix r s < 0) : is_unbounded_above T (T.to_partition.rowg r) :=
λ q, ⟨T.of_col (min ((q - T.offset r 0) / T.to_matrix r s) 0 • (single s 0).to_matrix),
  of_col_single_mem_sol_set hT
    (λ i' hi', mul_nonneg_of_nonpos_of_nonpos (min_le_right _ _) (h _ hi'))
    (or.inl hres),
  begin
    rw [of_col_rowg, add_val, matrix.mul_smul, smul_val, matrix_mul_apply,
      symm_single_apply],
    cases le_total 0 ((q - T.offset r 0) / T.to_matrix r s) with hq hq,
    { rw [min_eq_right hq],
      rw [le_div_iff_of_neg his, zero_mul, sub_nonpos] at hq,
      simpa },
    { rw [min_eq_left hq, div_mul_cancel _ (ne_of_lt his)],
      simp }
  end⟩

/-- A row variable `r` is unbounded above if there is a column `s`
  where every restricted row variable has a nonpositive entry in that column, and
  `r` has a positive entry in that column. -/
lemma is_unbounded_above_rowg_of_nonneg {r : fin m} (hT : T.feasible) (s : fin n)
  (hs : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → 0 ≤ T.to_matrix i s)
  (his : 0 < T.to_matrix r s) : is_unbounded_above T (T.to_partition.rowg r) :=
λ q, ⟨T.of_col (max ((q - T.offset r 0) / T.to_matrix r s) 0 • (single s 0).to_matrix),
  of_col_single_mem_sol_set hT
    (λ i hi, mul_nonneg (le_max_right _ _) (hs i hi))
    (or.inr (le_max_right _ _)),
  begin
    rw [of_col_rowg, add_val, matrix.mul_smul, smul_val, matrix_mul_apply,
      symm_single_apply],
    cases le_total ((q - T.offset r 0) / T.to_matrix r s) 0 with hq hq,
    { rw [max_eq_right hq],
      rw [div_le_iff his, zero_mul, sub_nonpos] at hq,
      simpa },
    { rw [max_eq_left hq, div_mul_cancel _ (ne_of_gt his)],
      simp }
  end⟩

/-- The sample solution of a feasible tableau maximises the variable in row `r`,
  if every entry in that row is nonpositive and every entry in that row owned by a restricted
  variable is `0`  -/
lemma is_maximised_of_col_zero {r : fin m} (hf : T.feasible)
  (h : ∀ j, T.to_matrix r j ≤ 0 ∧ (T.to_partition.colg j ∉ T.restricted → T.to_matrix r j = 0)) :
  T.is_maximised (T.of_col 0) (T.to_partition.rowg r) :=
λ x hx, begin
  rw [of_col_rowg, matrix.mul_zero, zero_add, mem_flat_iff.1 hx.1],
  refine add_le_of_nonpos_of_le _ (le_refl _),
  refine sum_nonpos (λ j _, _),
  by_cases hj : (T.to_partition.colg j) ∈ T.restricted,
  { refine mul_nonpos_of_nonpos_of_nonneg (h _).1 (hx.2 _ hj) },
  { rw [(h _).2 hj, _root_.zero_mul] }
end

/-- Expression for the sum of all but one entries in the a row of a tableau. -/
lemma row_sum_erase_eq {x : cvec (m + n)} (hx : x ∈ T.flat) {r : fin m} {s : fin n} :
  (univ.erase s).sum (λ j : fin n, T.to_matrix r j * x (T.to_partition.colg j) 0) =
    x (T.to_partition.rowg r) 0 - T.offset r 0 - T.to_matrix r s * x (colg (T.to_partition) s) 0 :=
begin
  rw [mem_flat_iff] at hx,
  conv_rhs { rw [hx r, ← insert_erase (mem_univ s), sum_insert (not_mem_erase _ _)] },
  simp
end

/-- An expression for a column variable in terms of row variables. -/
lemma colg_eq {x : cvec (m + n)} (hx : x ∈ T.flat) {r : fin m} {s : fin n}
  (hrs : T.to_matrix r s ≠ 0) : x (T.to_partition.colg s) 0 =
    (x (T.to_partition.rowg r) 0
    -(univ.erase s).sum (λ j : fin n, T.to_matrix r j * x (T.to_partition.colg j) 0)
        - T.offset r 0) * (T.to_matrix r s)⁻¹ :=
by simp [row_sum_erase_eq hx, mul_left_comm (T.to_matrix r s)⁻¹, mul_assoc,
    mul_left_comm (T.to_matrix r s), mul_inv_cancel hrs]

/-- Another expression for a column variable in terms of row variables. -/
lemma colg_eq' {x : cvec (m + n)} (hx : x ∈ T.flat) {r : fin m} {s : fin n}
  (hrs : T.to_matrix r s ≠ 0) : x (T.to_partition.colg s) 0 =
  univ.sum (λ (j : fin n), (if j = s then (T.to_matrix r s)⁻¹
    else (-(T.to_matrix r j * (T.to_matrix r s)⁻¹))) *
      x (colg (swap (T.to_partition) r s) j) 0) -
  (T.offset r 0) * (T.to_matrix r s)⁻¹ :=
have (univ.erase s).sum
    (λ j : fin n, ite (j = s) (T.to_matrix r s)⁻¹ (-(T.to_matrix r j * (T.to_matrix r s)⁻¹)) *
      x (colg (swap (T.to_partition) r s) j) 0) =
    (univ.erase s).sum (λ j : fin n,
      -T.to_matrix r j * x (T.to_partition.colg j) 0 * (T.to_matrix r s)⁻¹),
  from finset.sum_congr rfl $ λ j hj,
    by simp [if_neg (mem_erase.1 hj).1, colg_swap_of_ne _ (mem_erase.1 hj).1,
      mul_comm, mul_assoc, mul_left_comm],
by rw [← finset.insert_erase (mem_univ s), finset.sum_insert (not_mem_erase _ _),
    if_pos rfl, colg_swap, colg_eq hx hrs, this, ← finset.sum_mul];
  simp [_root_.add_mul, mul_comm, _root_.mul_add]

/-- Pivoting twice in the same place does nothing -/
@[simp] lemma pivot_pivot {r : fin m} {s : fin n} (hrs : T.to_matrix r s ≠ 0) :
  (T.pivot r s).pivot r s = T :=
begin
  cases T,
  simp [pivot, function.funext_iff],
  split; intros; split_ifs;
  simp [*, mul_assoc, mul_left_comm (T_to_matrix r s), mul_left_comm (T_to_matrix r s)⁻¹,
    mul_comm (T_to_matrix r s), inv_mul_cancel hrs]
end

/- These two sets are equal_in_flat, the stronger lemma is `flat_pivot` -/
private lemma subset_flat_pivot {r : fin m} {s : fin n} (h : T.to_matrix r s ≠ 0) :
  T.flat ⊆ (T.pivot r s).flat :=
λ x hx,
have ∀ i : fin m, (univ.erase s).sum (λ j : fin n,
  ite (j = s) (T.to_matrix i s * (T.to_matrix r s)⁻¹)
    (T.to_matrix i j + -(T.to_matrix i s * T.to_matrix r j * (T.to_matrix r s)⁻¹))
      * x ((T.to_partition.swap r s).colg j) 0) =
  (univ.erase s).sum (λ j : fin n, T.to_matrix i j * x (T.to_partition.colg j) 0 -
    T.to_matrix r j *
      x (T.to_partition.colg j) 0 * T.to_matrix i s * (T.to_matrix r s)⁻¹),
  from λ i, finset.sum_congr rfl (λ j hj,
    by rw [if_neg (mem_erase.1 hj).1, colg_swap_of_ne _ (mem_erase.1 hj).1];
      simp [_root_.mul_add, _root_.add_mul, mul_comm, mul_assoc, mul_left_comm]),
begin
  rw mem_flat_iff,
  assume i,
  by_cases hir : i = r,
  { rw eq_comm at hir,
    subst hir,
    dsimp [pivot],
    simp [mul_inv_cancel h, neg_mul_eq_neg_mul_symm, if_true,
      add_comm, mul_inv_cancel, rowg_swap, eq_self_iff_true, colg_eq' hx h],
    congr, funext, congr },
  { dsimp [pivot],
    simp only [if_neg hir],
    rw [← insert_erase (mem_univ s), sum_insert (not_mem_erase _ _),
      if_pos rfl, colg_swap, this, sum_sub_distrib, ← sum_mul, ← sum_mul,
      row_sum_erase_eq hx, rowg_swap_of_ne _ hir],
    simp [row_sum_erase_eq hx, _root_.mul_add, _root_.add_mul,
      mul_comm, mul_left_comm, mul_assoc],
    simp [mul_assoc, mul_left_comm (T.to_matrix r s), mul_left_comm (T.to_matrix r s)⁻¹,
      mul_comm (T.to_matrix r s), inv_mul_cancel h] }
end

variable (T)

@[simp] lemma pivot_pivot_element (r : fin m) (s : fin n) :
  (T.pivot r s).to_matrix r s = (T.to_matrix r s)⁻¹ :=
by simp [pivot, if_pos rfl]

@[simp] lemma pivot_pivot_row {r : fin m} {j s : fin n} (h : j ≠ s) :
  (T.pivot r s).to_matrix r j = -T.to_matrix r j / T.to_matrix r s :=
by dsimp [pivot]; rw [if_pos rfl, if_neg h, div_eq_mul_inv]

@[simp] lemma pivot_pivot_column {i r : fin m} {s : fin n} (h : i ≠ r) :
  (T.pivot r s).to_matrix i s = T.to_matrix i s / T.to_matrix r s :=
by dsimp [pivot]; rw [if_neg h, if_pos rfl, div_eq_mul_inv]

@[simp] lemma pivot_of_ne_of_ne {i r : fin m} {j s : fin n} (hir : i ≠ r)
  (hjs : j ≠ s) : (T.pivot r s).to_matrix i j =
  T.to_matrix i j - T.to_matrix i s * T.to_matrix r j / T.to_matrix r s :=
by dsimp [pivot]; rw [if_neg hir, if_neg hjs, div_eq_mul_inv]

@[simp] lemma offset_pivot_row {r : fin m} {s : fin n} : (T.pivot r s).offset r 0 =
  -T.offset r 0 / T.to_matrix r s :=
by simp [pivot, if_pos rfl, div_eq_mul_inv]

@[simp] lemma offset_pivot_of_ne {i r : fin m} {s : fin n} (hir : i ≠ r) : (T.pivot r s).offset i 0
  = T.offset i 0 - T.to_matrix i s * T.offset r 0 / T.to_matrix r s :=
by dsimp [pivot]; rw [if_neg hir, div_eq_mul_inv]

@[simp] lemma restricted_pivot (r s) : (T.pivot r s).restricted = T.restricted := rfl

@[simp] lemma to_partition_pivot (r s) : (T.pivot r s).to_partition = T.to_partition.swap r s := rfl

variable {T}

@[simp] lemma flat_pivot {r : fin m} {s : fin n} (hrs : T.to_matrix r s ≠ 0) :
  (T.pivot r s).flat = T.flat :=
set.subset.antisymm
  (by conv_rhs { rw ← pivot_pivot hrs };
    exact subset_flat_pivot (by simp [hrs]))
  (subset_flat_pivot hrs)

@[simp] lemma sol_set_pivot {r : fin m} {s : fin n} (hrs : T.to_matrix r s ≠ 0) :
  (T.pivot r s).sol_set = T.sol_set :=
by rw [sol_set, flat_pivot hrs]; refl

-- lemma feasible_pivot (hTf : T.feasible) {r : fin m} {s : fin n}
--   (hs : T.to_partition.colg s ∈ T.restricted → T.offset r 0 / T.to_matrix r s ≤ 0)
--   (h : ∀ i : fin m, i ≠ r → T.to_partition.rowg i ∈ T.restricted →
--     0 ≤ T.offset i 0 - T.to_matrix i s * T.offset r 0 / T.to_matrix r s) :
--   (T.pivot r s).feasible :=
-- assume i hi,
-- if hir : i = r
--   then begin
--     subst hir,
--     rw [offset_pivot_row],
--     simp at *,
--   end
--   else begin
--     rw [to_partition_pivot, rowg_swap_of_ne _ hir, restricted_pivot] at hi,
--     rw [offset_pivot_of_ne _ hir, sub_nonneg, mul_div_assoc],
--     sorry

--   end

/-- Two row variables are `equal_in_flat` iff the corresponding rows of the tableau are equal -/
lemma equal_in_flat_row_row {i i' : fin m} :
  T.equal_in_flat (T.to_partition.rowg i) (T.to_partition.rowg i')
  ↔ (T.offset i 0 = T.offset i' 0 ∧ ∀ j : fin n, T.to_matrix i j = T.to_matrix i' j) :=
⟨λ h, have Hoffset : T.offset i 0 = T.offset i' 0,
    by simpa [of_col_rowg] using h (T.of_col 0) (of_col_mem_flat _ _),
  ⟨Hoffset,
    λ j, begin
      have := h (T.of_col (single j (0 : fin 1)).to_matrix) (of_col_mem_flat _ _),
      rwa [of_col_rowg, of_col_rowg, add_val, add_val, matrix_mul_apply, matrix_mul_apply,
        symm_single_apply, Hoffset, add_right_cancel_iff] at this,
    end⟩,
λ h x hx, by simp [mem_flat_iff.1 hx, h.1, h.2]⟩

/-- A row variable is equal_in_flat to a column variable iff its row has zeros, and a single
  one in that column. -/
lemma equal_in_flat_row_col {i : fin m} {j : fin n} :
  T.equal_in_flat (T.to_partition.rowg i) (T.to_partition.colg j)
  ↔ (∀ j', j' ≠ j → T.to_matrix i j' = 0) ∧ T.offset i 0 = 0 ∧ T.to_matrix i j = 1 :=
⟨λ h, have Hoffset : T.offset i 0 = 0,
    by simpa using h (T.of_col 0) (of_col_mem_flat _ _),
  ⟨assume j' hj', begin
      have := h (T.of_col (single j' (0 : fin 1)).to_matrix) (of_col_mem_flat _ _),
      rwa [of_col_rowg, of_col_colg, add_val, Hoffset, add_zero, matrix_mul_apply,
        symm_single_apply, pequiv.to_matrix, single_apply_of_ne hj',
        if_neg (option.not_mem_none _)] at this
    end,
  Hoffset,
  begin
    have := h (T.of_col (single j (0 : fin 1)).to_matrix) (of_col_mem_flat _ _),
    rwa [of_col_rowg, of_col_colg, add_val, Hoffset, add_zero, matrix_mul_apply,
        symm_single_apply, pequiv.to_matrix, single_apply] at this
  end⟩,
by rintros ⟨h₁, h₂, h₃⟩ x hx;
  rw [mem_flat_iff.1 hx, h₂, sum_eq_single j]; simp *; tauto⟩

end predicate_lemmas

/-- definition used to define well-foundedness of a pivot rule -/
inductive rel_gen {α : Type*} (f : α → option α) : α → α → Prop
| of_mem : ∀ {x y}, x ∈ f y → rel_gen x y
| trans : ∀ {x y z}, rel_gen x y → rel_gen y z → rel_gen x z

/-- A pivot rule is a function that selects a nonzero pivot, given a tableau, such that
  iterating using this pivot rule terminates. -/
structure pivot_rule (m n : ℕ) : Type :=
(pivot_indices : tableau m n → option (fin m × fin n))
(well_founded : well_founded (rel_gen (λ T, pivot_indices T >>= λ i, T.pivot i.1 i.2)))
(ne_zero : ∀ {T r s}, (r, s) ∈ pivot_indices T → T.to_matrix r s ≠ 0)

def pivot_rule.rel (p : pivot_rule m n) : tableau m n → tableau m n → Prop :=
rel_gen (λ T, p.pivot_indices T >>= λ i, T.pivot i.1 i.2)

lemma pivot_rule.rel_wf (p : pivot_rule m n) : well_founded p.rel := p.well_founded

def iterate (p : pivot_rule m n) : tableau m n → tableau m n
| T :=
have ∀ (r : fin m) (s : fin n), (r, s) ∈ p.pivot_indices T → p.rel (T.pivot r s) T,
  from λ r s hrs, rel_gen.of_mem $ by rw option.mem_def.1 hrs; exact rfl,
option.cases_on (p.pivot_indices T) (λ _, T)
  (λ i this,
    have wf : p.rel (T.pivot i.1 i.2) T, from this _ _ (by cases i; exact rfl),
    iterate (T.pivot i.1 i.2))
  this
using_well_founded { rel_tac := λ _ _, `[exact ⟨_, p.rel_wf⟩],
  dec_tac := tactic.assumption }

lemma iterate_pivot {p : pivot_rule m n} {T : tableau m n} {r : fin m} {s : fin n}
  (hrs : (r, s) ∈ p.pivot_indices T) : (T.pivot r s).iterate p = T.iterate p :=
by conv_rhs {rw iterate}; simp [option.mem_def.1 hrs]

@[simp] lemma pivot_indices_iterate (p : pivot_rule m n) : ∀ (T : tableau m n),
  p.pivot_indices (T.iterate p) = none
| T :=
have ∀ r s, (r, s) ∈ p.pivot_indices T → p.rel (T.pivot r s) T,
  from λ r s hrs, rel_gen.of_mem $ by rw option.mem_def.1 hrs; exact rfl,
begin
  rw iterate,
  cases h : p.pivot_indices T with i,
  { simp [h] },
  { cases i with r s,
    simp [h, pivot_indices_iterate (T.pivot r s)] }
end
using_well_founded { rel_tac := λ _ _, `[exact ⟨_, p.rel_wf⟩], dec_tac := `[tauto] }

/- Is there some nice elaborator attribute for this, to avoid `P` having to be explicit? -/
lemma iterate_induction_on (P : tableau m n → Prop) (p : pivot_rule m n) :
  ∀ T : tableau m n, P T → (∀ T' r s, P T' → (r, s) ∈ p.pivot_indices T'
    → P (T'.pivot r s)) → P (T.iterate p)
| T := λ hT ih,
have ∀ r s, (r, s) ∈ p.pivot_indices T → p.rel (T.pivot r s) T,
  from λ r s hrs, rel_gen.of_mem $ by rw option.mem_def.1 hrs; exact rfl,
begin
  rw iterate,
  cases h : p.pivot_indices T with i,
  { simp [hT, h] },
  { cases i with r s,
    simp [h, iterate_induction_on _ (ih _ _ _ hT h) ih] }
end
using_well_founded { rel_tac := λ _ _, `[exact ⟨_, p.rel_wf⟩], dec_tac := `[tauto] }

@[simp] lemma iterate_flat (p : pivot_rule m n) (T : tableau m n) :
  (T.iterate p).flat = T.flat :=
iterate_induction_on (λ T', T'.flat = T.flat) p T rfl $
  assume T' r s (hT' : T'.flat = T.flat) hrs, by rw [← hT', flat_pivot (p.ne_zero hrs)]

@[simp] lemma iterate_sol_set (p : pivot_rule m n) (T : tableau m n) :
  (T.iterate p).sol_set = T.sol_set :=
iterate_induction_on (λ T', T'.sol_set = T.sol_set) p T rfl $
  assume T' r s (hT' : T'.sol_set = T.sol_set) hrs,
    by rw [← hT', sol_set_pivot (p.ne_zero hrs)]

namespace simplex

def find_pivot_column (T : tableau m n) (obj : fin m) : option (fin n) :=
option.cases_on (fin.find (λ c : fin n, T.to_matrix obj c ≠ 0 ∧ T.to_partition.colg c ∉ T.restricted))
  (fin.find (λ c : fin n, 0 < T.to_matrix obj c))
  some

def find_pivot_row (T : tableau m n) (obj: fin m) (c : fin n) : option (fin m) :=
let l := (list.fin_range m).filter (λ r : fin m, obj ≠ r ∧ T.to_partition.rowg r ∈ T.restricted
  ∧ T.to_matrix obj c / T.to_matrix r c < 0) in
l.argmin (λ r', abs (T.offset r' 0 / T.to_matrix r' c))

lemma find_pivot_column_spec {T : tableau m n} {obj : fin m} {s : fin n} :
  s ∈ find_pivot_column T obj → (T.to_matrix obj s ≠ 0 ∧ T.to_partition.colg s ∉ T.restricted)
  ∨ (0 < T.to_matrix obj s ∧ T.to_partition.colg s ∈ T.restricted) :=
begin
  simp [find_pivot_column],
  cases h : fin.find (λ s : fin n, T.to_matrix obj s ≠ 0 ∧ T.to_partition.colg s ∉ T.restricted),
  { finish [h, fin.find_eq_some_iff, fin.find_eq_none_iff, lt_irrefl (0 : ℚ)] },
  { finish [fin.find_eq_some_iff] }
end

-- lemma find_pivot_column_eq_none_aux {T : tableau m n} {i : fin m} {s : fin n} :
--   find_pivot_column T i = none ↔ (∀ s, T.to_matrix i s ≤ 0) :=
-- begin
--   simp [find_pivot_column, fin.find_eq_none_iff],
--   cases h : fin.find (λ s : fin n, T.to_matrix i s ≠ 0 ∧ T.to_partition.colg s ∉ T.restricted),
--   { finish [fin.find_eq_none_iff] },
--   { simp [find_eq_some_iff] at *, }

-- end

lemma find_pivot_column_eq_none {T : tableau m n} {obj : fin m} (hT : T.feasible)
  (h : find_pivot_column T obj = none) : T.is_maximised (T.of_col 0) (T.to_partition.rowg obj) :=
is_maximised_of_col_zero hT
begin
  revert h,
  simp [find_pivot_column],
  cases h : fin.find (λ c : fin n, T.to_matrix obj c ≠ 0 ∧ T.to_partition.colg c ∉ T.restricted),
  { finish [fin.find_eq_none_iff] },
  { simp [h] }
end

lemma find_pivot_row_spec {T : tableau m n} {obj r : fin m} {c : fin n} :
  r ∈ find_pivot_row T obj c →
  obj ≠ r ∧ T.to_partition.rowg r ∈ T.restricted ∧
  T.to_matrix obj c / T.to_matrix r c < 0 ∧
  (∀ r' : fin m, obj ≠ r' → T.to_partition.rowg r' ∈ T.restricted →
    T.to_matrix obj c / T.to_matrix r' c < 0 →
  abs (T.offset r 0 / T.to_matrix r c) ≤ abs (T.offset r' 0 / T.to_matrix r' c)) :=
by simp only [list.mem_argmin_iff, list.mem_filter, find_pivot_row,
    list.mem_fin_range, true_and, and_imp]; tauto

lemma find_pivot_row_eq_none_aux {T : tableau m n} {obj : fin m} {c : fin n}
  (hrow : find_pivot_row T obj c = none) (hs : c ∈ find_pivot_column T obj) :
  ∀ r, obj ≠ r → T.to_partition.rowg r ∈ T.restricted → 0 ≤ T.to_matrix obj c / T.to_matrix r c :=
by simpa [find_pivot_row, list.filter_eq_nil] using hrow

lemma find_pivot_row_eq_none {T : tableau m n} {obj : fin m} {c : fin n} (hT : T.feasible)
  (hrow : find_pivot_row T obj c = none) (hs : c ∈ find_pivot_column T obj) :
  T.is_unbounded_above (T.to_partition.rowg obj) :=
have hrow : ∀ r, obj ≠ r → T.to_partition.rowg r ∈ T.restricted →
    0 ≤ T.to_matrix obj c / T.to_matrix r c,
  from find_pivot_row_eq_none_aux hrow hs,
have hc : (T.to_matrix obj c ≠ 0 ∧ T.to_partition.colg c ∉ T.restricted)
    ∨ (0 < T.to_matrix obj c ∧ T.to_partition.colg c ∈ T.restricted),
  from find_pivot_column_spec hs,
have hToc : T.to_matrix obj c ≠ 0, from λ h, by simpa [h, lt_irrefl] using hc,
(lt_or_gt_of_ne hToc).elim
  (λ hToc : T.to_matrix obj c < 0, is_unbounded_above_rowg_of_nonpos hT c
    (hc.elim and.right (λ h, (not_lt_of_gt hToc h.1).elim))
    (λ i hi, classical.by_cases
      (λ hoi : obj = i, le_of_lt (hoi ▸ hToc))
      (λ hoi : obj ≠ i, inv_nonpos.1 $ nonpos_of_mul_nonneg_right (hrow _ hoi hi) hToc))
    hToc)
  (λ hToc : 0 < T.to_matrix obj c, is_unbounded_above_rowg_of_nonneg hT c
    (λ i hi, classical.by_cases
      (λ hoi : obj = i, le_of_lt (hoi ▸ hToc))
      (λ hoi : obj ≠ i, inv_nonneg.1 $ nonneg_of_mul_nonneg_left (hrow _ hoi hi) hToc))
    hToc)

/-- This `pivot_rule` maximises the sample value of `i` -/
def simplex_pivot_rule (i : fin m) : pivot_rule m n :=
{ pivot_indices := λ T, find_pivot_column T i >>= λ s,
    find_pivot_row T i s >>= λ r, some (r, s),
  well_founded := sorry,
  ne_zero := λ T r s, begin
    simp only [option.mem_def, option.bind_eq_some,
      find_pivot_row, list.argmin_eq_some_iff, and_imp,
      exists_imp_distrib, prod.mk.inj_iff, list.mem_filter],
    intros,
    substs x r,
    assume h,
    simp [h, lt_irrefl, *] at *
  end  }

end simplex

def simplex (T : tableau m n) (i : fin m) : tableau m n :=
T.iterate (simplex.simplex_pivot_rule i)

namespace simplex

/-- The simplex algorithm does not pivot the variable it is trying to optimise -/
lemma simplex_pivot_indices_ne {T : tableau m n} {i : fin m} {r s} :
  (r, s) ∈ (simplex_pivot_rule i).pivot_indices T → i ≠ r :=
by simp only [simplex_pivot_rule, find_pivot_row, fin.find_eq_some_iff, option.mem_def, list.mem_filter,
  option.bind_eq_some, prod.mk.inj_iff, exists_imp_distrib, and_imp, list.argmin_eq_some_iff,
  @forall_swap _ (_ = r), @forall_swap (_ ≠ r), imp_self, forall_true_iff] {contextual := tt}

/-- `simplex` does not move the row variable it is trying to maximise. -/
lemma rowg_simplex (T : tableau m n) (i : fin m) :
  (T.simplex i).to_partition.rowg i = T.to_partition.rowg i :=
iterate_induction_on (λ T', T'.to_partition.rowg i = T.to_partition.rowg i) _ _ rfl $
  assume T' r s (hT' : T'.to_partition.rowg i = T.to_partition.rowg i) hrs,
    by rw [to_partition_pivot, rowg_swap_of_ne _ (simplex_pivot_indices_ne hrs), hT']

lemma simplex_pivot_rule_eq_none {T : tableau m n} {i : fin m} (hT : T.feasible)
  (h : (simplex_pivot_rule i).pivot_indices T = none) :
  is_maximised T (T.of_col 0) (T.to_partition.rowg i) ∨
    is_unbounded_above T (T.to_partition.rowg i) :=
begin
  cases hs : find_pivot_column T i with s,
  { exact or.inl (find_pivot_column_eq_none hT hs) },
  { dsimp [simplex_pivot_rule] at h,
    rw [hs, option.some_bind, option.bind_eq_none] at h,
    have : find_pivot_row T i s = none,
    { exact option.eq_none_iff_forall_not_mem.2 (λ r, by simpa using h (r, s) r) },
    exact or.inr (find_pivot_row_eq_none hT this hs) }
end

@[simp] lemma mem_simplex_pivot_rule_indices {T : tableau m n} {i : fin m} {r s} :
  (r, s) ∈ (simplex_pivot_rule i).pivot_indices T ↔
  s ∈ find_pivot_column T i ∧ r ∈ find_pivot_row T i s :=
begin
  simp only [simplex_pivot_rule,  option.mem_def, option.bind_eq_some,
    prod.mk.inj_iff, and_comm _ (_ = r), @and.left_comm _ (_ = r), exists_eq_left, and.assoc],
  simp only [and_comm _ (_ = s), @and.left_comm _ (_ = s), exists_eq_left]
end

lemma simplex_pivot_rule_feasible {T : tableau m n} {i : fin m} (hT : T.feasible)
  {r s} (hrs : (r, s) ∈ (simplex_pivot_rule i).pivot_indices T) : (T.pivot r s).feasible :=
λ i' hi', begin
  rw [mem_simplex_pivot_rule_indices] at hrs,
  have hs := find_pivot_column_spec hrs.1,
  have hr := find_pivot_row_spec hrs.2,
  dsimp only [pivot],
  by_cases hir : i' = r,
  { subst i',
    rw [if_pos rfl, neg_mul_eq_neg_mul_symm, neg_nonneg],
    exact mul_nonpos_of_nonneg_of_nonpos (hT _ hr.2.1)
      (le_of_lt (neg_of_mul_neg_left hr.2.2.1 (le_of_lt (by simp * at *)))) },
  { rw if_neg hir,
    rw [to_partition_pivot, rowg_swap_of_ne _ hir, restricted_pivot] at hi',
    by_cases hii : i = i',
    { subst i',
      refine add_nonneg (hT _ hi') (neg_nonneg.2 _),
      rw [mul_assoc, mul_left_comm],
      exact mul_nonpos_of_nonneg_of_nonpos (hT _ hr.2.1) (le_of_lt hr.2.2.1) },
    { by_cases hTi'r : 0 < T.to_matrix i' s / T.to_matrix r s,
      { have hTi's0 : T.to_matrix i' s ≠ 0, from λ h, by simpa [h, lt_irrefl] using hTi'r,
        have hTrs0 : T.to_matrix r s ≠ 0, from λ h, by simpa [h, lt_irrefl] using hTi'r,
        have hTii' : T.to_matrix i s / T.to_matrix i' s < 0,
        { suffices : (T.to_matrix i s / T.to_matrix r s) / (T.to_matrix i' s / T.to_matrix r s) < 0,
          { simp only [div_eq_mul_inv, mul_assoc, mul_inv', inv_inv',
              mul_left_comm (T.to_matrix r s), mul_left_comm (T.to_matrix r s)⁻¹,
              mul_comm (T.to_matrix r s), inv_mul_cancel hTrs0, mul_one] at this,
            simpa [mul_comm, div_eq_mul_inv] },
        { exact div_neg_of_neg_of_pos hr.2.2.1 hTi'r } },
        have := hr.2.2.2 _ hii hi' hTii',
        rwa [abs_div, abs_div, abs_of_nonneg (hT _ hr.2.1), abs_of_nonneg (hT _ hi'),
          le_div_iff (abs_pos_iff.2 hTi's0), div_eq_mul_inv, mul_right_comm,
          ← abs_inv, mul_assoc, ← abs_mul, ← div_eq_mul_inv,
          abs_of_nonneg (le_of_lt hTi'r), ← sub_nonneg, ← mul_div_assoc, div_eq_mul_inv,
          mul_comm (T.offset r 0)] at this },
      { refine add_nonneg (hT _ hi') (neg_nonneg.2 _),
        rw [mul_assoc, mul_left_comm],
        exact mul_nonpos_of_nonneg_of_nonpos (hT _ hr.2.1) (le_of_not_gt hTi'r) } } }
end

lemma simplex_feasible {T : tableau m n} (hT : T.feasible) (i : fin m) : (simplex T i).feasible :=
iterate_induction_on feasible _ _ hT (λ _ _ _ hT, simplex_pivot_rule_feasible hT)

lemma simplex_unbounded_or_maximised {T : tableau m n} (hT : T.feasible) (i : fin m) :
  is_maximised (simplex T i) ((simplex T i).of_col 0) (T.to_partition.rowg i) ∨
    is_unbounded_above (simplex T i) (T.to_partition.rowg i) :=
by rw ← rowg_simplex;
  exact simplex_pivot_rule_eq_none (simplex_feasible hT i) (pivot_indices_iterate _ _)

end simplex

end tableau

section test

open tableau tableau.simplex

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

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

-- def T : tableau 4 5 :=
-- { to_matrix := list.to_matrix 4 5 [[1, 3/4, -20, 1/2, -6], [0, 1/4, -8, -1, 9],
--     [0, 1/2, -12, 1/2, 3], [0,0,0,1,0]],
--   offset := (list.to_matrix 1 4 [[-3,0,0,1]])ᵀ,
--   to_partition := default _,
--   restricted := univ.erase 6 }

-- def T : tableau 4 5 :=
-- { to_matrix := list.to_matrix 4 5 [[1, 3/5, 20, 1/2, -6], [19, 1, -8, -1, 9],
--     [5, 1/2, -12, 1/2, 3], [13,0.1,11,21,0]],
--   offset := (list.to_matrix 1 4 [[3,1,51,1]])ᵀ,
--   to_partition := default _,
--   restricted := univ }

def T : tableau 25 10 :=
{ to_matrix := list.to_matrix 25 10
  [[1,0,1,-1,-1,-1,1,-1,1,1],[0,1,-1,1,1,1,-1,1,-1,1],[0,1,-1,1,-1,0,-1,-1,-1,0],[1,1,-1,-1,-1,-1,-1,1,-1,-1],[0,-1,1,1,0,-1,1,-1,1,-1],[0,1,1,0,1,1,0,1,0,1],[0,1,0,1,0,1,1,0,-1,-1],[0,0,-1,1,1,0,0,0,1,-1],[0,0,1,0,1,-1,-1,0,1,1],[0,-1,0,0,1,-1,-1,1,0,0],[0,-1,1,0,0,1,0,-1,1,0],[1,1,1,-1,1,-1,-1,0,-1,1],[1,1,-1,-1,-1,1,-1,1,-1,-1],[-1,-1,-1,1,1,1,1,1,-1,-1],[0,1,0,0,1,-1,0,0,-1,1],[-1,-1,-1,-1,1,1,1,0,-1,1],[0,0,-1,-1,0,1,1,-1,1,1],[1,0,1,0,0,0,1,0,0,1],[-1,0,-1,0,1,1,-1,1,1,-1],[0,1,-1,1,-1,0,0,-1,-1,-1],[1,1,0,1,1,0,1,1,-1,1],[0,0,0,0,0,1,-1,1,0,-1],[1,1,0,0,-1,1,0,0,1,0],[0,0,-1,1,-1,1,-1,1,-1,-1],[0,0,0,0,1,-1,1,1,-1,-1]],
  offset := λ _ _, 1,
  to_partition := default _,
  restricted := univ }

#print tc.rec

#eval let s := T.simplex 0 in (s.to_matrix, s.offset)

end test


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module category_theory.category.Cat.limit
! leanprover-community/mathlib commit 10bf4f825ad729c5653adc039dafa3622e7f93c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Category.Cat
import Mathbin.CategoryTheory.Limits.Types
import Mathbin.CategoryTheory.Limits.Preserves.Basic

/-!
# The category of small categories has all small limits.

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

An object in the limit consists of a family of objects,
which are carried to one another by the functors in the diagram.
A morphism between two such objects is a family of morphisms between the corresponding objects,
which are carried to one another by the action on morphisms of the functors in the diagram.

## Future work
Can the indexing category live in a lower universe?
-/

noncomputable section

universe v u

open CategoryTheory.Limits

namespace CategoryTheory

variable {J : Type v} [SmallCategory J]

namespace Cat

namespace HasLimits

/- warning: category_theory.Cat.has_limits.category_objects -> CategoryTheory.Cat.HasLimits.categoryObjects is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u1}} [_inst_1 : CategoryTheory.SmallCategory.{u1} J] {F : CategoryTheory.Functor.{u1, u2, u1, succ u2} J _inst_1 CategoryTheory.Cat.{u2, u2} CategoryTheory.Cat.category.{u2, u2}} {j : J}, CategoryTheory.SmallCategory.{u2} (CategoryTheory.Functor.obj.{u1, u2, u1, succ u2} J _inst_1 Type.{u2} CategoryTheory.types.{u2} (CategoryTheory.Functor.comp.{u1, u2, u2, u1, succ u2, succ u2} J _inst_1 CategoryTheory.Cat.{u2, u2} CategoryTheory.Cat.category.{u2, u2} Type.{u2} CategoryTheory.types.{u2} F CategoryTheory.Cat.objects.{u2, u2}) j)
but is expected to have type
  forall {J : Type.{u1}} [_inst_1 : CategoryTheory.SmallCategory.{u1} J] {F : CategoryTheory.Functor.{u1, u2, u1, succ u2} J _inst_1 CategoryTheory.Cat.{u2, u2} CategoryTheory.Cat.category.{u2, u2}} {j : J}, CategoryTheory.SmallCategory.{u2} (Prefunctor.obj.{succ u1, succ u2, u1, succ u2} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} J (CategoryTheory.Category.toCategoryStruct.{u1, u1} J _inst_1)) Type.{u2} (CategoryTheory.CategoryStruct.toQuiver.{u2, succ u2} Type.{u2} (CategoryTheory.Category.toCategoryStruct.{u2, succ u2} Type.{u2} CategoryTheory.types.{u2})) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u1, succ u2} J _inst_1 Type.{u2} CategoryTheory.types.{u2} (CategoryTheory.Functor.comp.{u1, u2, u2, u1, succ u2, succ u2} J _inst_1 CategoryTheory.Cat.{u2, u2} CategoryTheory.Cat.category.{u2, u2} Type.{u2} CategoryTheory.types.{u2} F CategoryTheory.Cat.objects.{u2, u2})) j)
Case conversion may be inaccurate. Consider using '#align category_theory.Cat.has_limits.category_objects CategoryTheory.Cat.HasLimits.categoryObjectsₓ'. -/
instance categoryObjects {F : J ⥤ Cat.{u, u}} {j} :
    SmallCategory ((F ⋙ Cat.objects.{u, u}).obj j) :=
  (F.obj j).str
#align category_theory.Cat.has_limits.category_objects CategoryTheory.Cat.HasLimits.categoryObjects

#print CategoryTheory.Cat.HasLimits.homDiagram /-
/-- Auxiliary definition:
the diagram whose limit gives the morphism space between two objects of the limit category. -/
@[simps]
def homDiagram {F : J ⥤ Cat.{v, v}} (X Y : limit (F ⋙ Cat.objects.{v, v})) : J ⥤ Type v
    where
  obj j := limit.π (F ⋙ Cat.objects) j X ⟶ limit.π (F ⋙ Cat.objects) j Y
  map j j' f g := by
    refine' eq_to_hom _ ≫ (F.map f).map g ≫ eq_to_hom _
    exact (congr_fun (limit.w (F ⋙ Cat.objects) f) X).symm
    exact congr_fun (limit.w (F ⋙ Cat.objects) f) Y
  map_id' X := by
    ext f; dsimp
    simp [functor.congr_hom (F.map_id X) f]
  map_comp' X Y Z f g := by
    ext h; dsimp
    simp [functor.congr_hom (F.map_comp f g) h, eq_to_hom_map]
    rfl
#align category_theory.Cat.has_limits.hom_diagram CategoryTheory.Cat.HasLimits.homDiagram
-/

@[simps]
instance (F : J ⥤ Cat.{v, v}) : Category (limit (F ⋙ Cat.objects))
    where
  Hom X Y := limit (homDiagram X Y)
  id X := Types.Limit.mk.{v, v} (homDiagram X X) (fun j => 𝟙 _) fun j j' f => by simp
  comp X Y Z f g :=
    Types.Limit.mk.{v, v} (homDiagram X Z)
      (fun j => limit.π (homDiagram X Y) j f ≫ limit.π (homDiagram Y Z) j g) fun j j' h =>
      by
      rw [← congr_fun (limit.w (hom_diagram X Y) h) f, ← congr_fun (limit.w (hom_diagram Y Z) h) g]
      dsimp
      simp
  id_comp' _ _ _ := by
    ext
    simp only [category.id_comp, types.limit.π_mk']
  comp_id' _ _ _ := by
    ext
    simp only [types.limit.π_mk', category.comp_id]

#print CategoryTheory.Cat.HasLimits.limitConeX /-
/-- Auxiliary definition: the limit category. -/
@[simps]
def limitConeX (F : J ⥤ Cat.{v, v}) : Cat.{v, v} where α := limit (F ⋙ Cat.objects)
#align category_theory.Cat.has_limits.limit_cone_X CategoryTheory.Cat.HasLimits.limitConeX
-/

#print CategoryTheory.Cat.HasLimits.limitCone /-
/-- Auxiliary definition: the cone over the limit category. -/
@[simps]
def limitCone (F : J ⥤ Cat.{v, v}) : Cone F
    where
  pt := limitConeX F
  π :=
    { app := fun j =>
        { obj := limit.π (F ⋙ Cat.objects) j
          map := fun X Y => limit.π (homDiagram X Y) j }
      naturality' := fun j j' f =>
        CategoryTheory.Functor.ext (fun X => (congr_fun (limit.w (F ⋙ Cat.objects) f) X).symm)
          fun X Y h => (congr_fun (limit.w (homDiagram X Y) f) h).symm }
#align category_theory.Cat.has_limits.limit_cone CategoryTheory.Cat.HasLimits.limitCone
-/

#print CategoryTheory.Cat.HasLimits.limitConeLift /-
/-- Auxiliary definition: the universal morphism to the proposed limit cone. -/
@[simps]
def limitConeLift (F : J ⥤ Cat.{v, v}) (s : Cone F) : s.pt ⟶ limitConeX F
    where
  obj :=
    limit.lift (F ⋙ Cat.objects)
      { pt := s.pt
        π :=
          { app := fun j => (s.π.app j).obj
            naturality' := fun j j' f => (congr_arg Functor.obj (s.π.naturality f) : _) } }
  map X Y f := by
    fapply Types.Limit.mk.{v, v}
    · intro j
      refine' eq_to_hom _ ≫ (s.π.app j).map f ≫ eq_to_hom _ <;> simp
    · intro j j' h
      dsimp
      simp only [category.assoc, functor.map_comp, eq_to_hom_map, eq_to_hom_trans,
        eq_to_hom_trans_assoc]
      rw [← functor.comp_map]
      have := (s.π.naturality h).symm
      conv at this =>
        congr
        skip
        dsimp
        simp
      erw [functor.congr_hom this f]
      dsimp
      simp
  map_id' X := by simp
  map_comp' X Y Z f g := by simp
#align category_theory.Cat.has_limits.limit_cone_lift CategoryTheory.Cat.HasLimits.limitConeLift
-/

/- warning: category_theory.Cat.has_limits.limit_π_hom_diagram_eq_to_hom -> CategoryTheory.Cat.HasLimits.limit_π_homDiagram_eqToHom is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u1}} [_inst_1 : CategoryTheory.SmallCategory.{u1} J] {F : CategoryTheory.Functor.{u1, u1, u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1}} (X : CategoryTheory.Limits.limit.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 (CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 CategoryTheory.Limits.Types.Sort.CategoryTheory.Limits.hasLimits.{u1}) (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}))) (Y : CategoryTheory.Limits.limit.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 (CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 CategoryTheory.Limits.Types.Sort.CategoryTheory.Limits.hasLimits.{u1}) (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}))) (j : J) (h : Eq.{succ u1} (CategoryTheory.Limits.limit.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 (CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 CategoryTheory.Limits.Types.Sort.CategoryTheory.Limits.hasLimits.{u1}) (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}))) X Y), Eq.{succ u1} (CategoryTheory.Functor.obj.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Cat.HasLimits.homDiagram.{u1} J _inst_1 F X Y) j) (CategoryTheory.Limits.limit.π.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Cat.HasLimits.homDiagram.{u1} J _inst_1 F X Y) (CategoryTheory.Cat.HasLimits.CategoryTheory.Limits.Limit.CategoryTheory.Category._proof_3.{u1} J _inst_1 F X Y) j (CategoryTheory.eqToHom.{u1, u1} (CategoryTheory.Limits.limit.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 (CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 CategoryTheory.Limits.Types.Sort.CategoryTheory.Limits.hasLimits.{u1}) (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}))) (CategoryTheory.Cat.HasLimits.CategoryTheory.Limits.Limit.CategoryTheory.category.{u1} J _inst_1 F) X Y h)) (CategoryTheory.eqToHom.{u1, u1} (CategoryTheory.Functor.obj.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) j) (CategoryTheory.Cat.HasLimits.categoryObjects.{u1, u1} J _inst_1 F j) (CategoryTheory.Limits.limit.π.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Cat.HasLimits.homDiagram._proof_5.{u1} J _inst_1 F) j X) (CategoryTheory.Limits.limit.π.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Cat.HasLimits.homDiagram._proof_6.{u1} J _inst_1 F) j Y) (congr_arg.{succ u1, succ u1} (CategoryTheory.Limits.limit.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 (CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 CategoryTheory.Limits.Types.Sort.CategoryTheory.Limits.hasLimits.{u1}) (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}))) (CategoryTheory.Functor.obj.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) j) X Y (CategoryTheory.Limits.limit.π.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.hasLimitOfHasLimitsOfShape.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 (CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, succ u1} Type.{u1} CategoryTheory.types.{u1} J _inst_1 CategoryTheory.Limits.Types.Sort.CategoryTheory.Limits.hasLimits.{u1}) (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1})) j) h))
but is expected to have type
  forall {J : Type.{u1}} [_inst_1 : CategoryTheory.SmallCategory.{u1} J] {F : CategoryTheory.Functor.{u1, u1, u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1}} (X : CategoryTheory.Limits.limit.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.Types.hasLimit'.{u1} J _inst_1 (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}))) (Y : CategoryTheory.Limits.limit.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.Types.hasLimit'.{u1} J _inst_1 (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}))) (j : J) (h : Eq.{succ u1} (CategoryTheory.Limits.limit.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.Types.hasLimit'.{u1} J _inst_1 (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}))) X Y), Eq.{succ u1} (Prefunctor.obj.{succ u1, succ u1, u1, succ u1} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} J (CategoryTheory.Category.toCategoryStruct.{u1, u1} J _inst_1)) Type.{u1} (CategoryTheory.CategoryStruct.toQuiver.{u1, succ u1} Type.{u1} (CategoryTheory.Category.toCategoryStruct.{u1, succ u1} Type.{u1} CategoryTheory.types.{u1})) (CategoryTheory.Functor.toPrefunctor.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Cat.HasLimits.homDiagram.{u1} J _inst_1 F X Y)) j) (CategoryTheory.Limits.limit.π.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Cat.HasLimits.homDiagram.{u1} J _inst_1 F X Y) (CategoryTheory.Cat.HasLimits.instCategoryLimitTypeTypesCompCatCategoryObjectsHasLimit'.proof_2.{u1} J _inst_1 F X Y) j (CategoryTheory.eqToHom.{u1, u1} (CategoryTheory.Limits.limit.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.Types.hasLimit'.{u1} J _inst_1 (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}))) (CategoryTheory.Cat.HasLimits.instCategoryLimitTypeTypesCompCatCategoryObjectsHasLimit'.{u1} J _inst_1 F) X Y h)) (CategoryTheory.eqToHom.{u1, u1} (Prefunctor.obj.{succ u1, succ u1, u1, succ u1} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} J (CategoryTheory.Category.toCategoryStruct.{u1, u1} J _inst_1)) Type.{u1} (CategoryTheory.CategoryStruct.toQuiver.{u1, succ u1} Type.{u1} (CategoryTheory.Category.toCategoryStruct.{u1, succ u1} Type.{u1} CategoryTheory.types.{u1})) (CategoryTheory.Functor.toPrefunctor.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1})) j) (CategoryTheory.Cat.HasLimits.categoryObjects.{u1, u1} J _inst_1 F j) (CategoryTheory.Limits.limit.π.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.Types.hasLimit'.{u1} J _inst_1 (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1})) j X) (CategoryTheory.Limits.limit.π.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.Types.hasLimit'.{u1} J _inst_1 (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1})) j Y) (congr_arg.{succ u1, succ u1} (CategoryTheory.Limits.limit.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.Types.hasLimit'.{u1} J _inst_1 (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}))) (Prefunctor.obj.{succ u1, succ u1, u1, succ u1} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} J (CategoryTheory.Category.toCategoryStruct.{u1, u1} J _inst_1)) Type.{u1} (CategoryTheory.CategoryStruct.toQuiver.{u1, succ u1} Type.{u1} (CategoryTheory.Category.toCategoryStruct.{u1, succ u1} Type.{u1} CategoryTheory.types.{u1})) (CategoryTheory.Functor.toPrefunctor.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1})) j) X Y (CategoryTheory.Limits.limit.π.{u1, u1, u1, succ u1} J _inst_1 Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1}) (CategoryTheory.Limits.Types.hasLimit'.{u1} J _inst_1 (CategoryTheory.Functor.comp.{u1, u1, u1, u1, succ u1, succ u1} J _inst_1 CategoryTheory.Cat.{u1, u1} CategoryTheory.Cat.category.{u1, u1} Type.{u1} CategoryTheory.types.{u1} F CategoryTheory.Cat.objects.{u1, u1})) j) h))
Case conversion may be inaccurate. Consider using '#align category_theory.Cat.has_limits.limit_π_hom_diagram_eq_to_hom CategoryTheory.Cat.HasLimits.limit_π_homDiagram_eqToHomₓ'. -/
@[simp]
theorem limit_π_homDiagram_eqToHom {F : J ⥤ Cat.{v, v}} (X Y : limit (F ⋙ Cat.objects.{v, v}))
    (j : J) (h : X = Y) :
    limit.π (homDiagram X Y) j (eqToHom h) =
      eqToHom (congr_arg (limit.π (F ⋙ Cat.objects.{v, v}) j) h) :=
  by
  subst h
  simp
#align category_theory.Cat.has_limits.limit_π_hom_diagram_eq_to_hom CategoryTheory.Cat.HasLimits.limit_π_homDiagram_eqToHom

#print CategoryTheory.Cat.HasLimits.limitConeIsLimit /-
/-- Auxiliary definition: the proposed cone is a limit cone. -/
def limitConeIsLimit (F : J ⥤ Cat.{v, v}) : IsLimit (limitCone F)
    where
  lift := limitConeLift F
  fac s j := CategoryTheory.Functor.ext (by tidy) fun X Y f => Types.Limit.π_mk _ _ _ _
  uniq s m w := by
    symm
    fapply CategoryTheory.Functor.ext
    · intro X
      ext
      dsimp
      simp only [types.limit.lift_π_apply', ← w j]
      rfl
    · intro X Y f
      dsimp
      simp [fun j => functor.congr_hom (w j).symm f]
      congr
#align category_theory.Cat.has_limits.limit_cone_is_limit CategoryTheory.Cat.HasLimits.limitConeIsLimit
-/

end HasLimits

/-- The category of small categories has all small limits. -/
instance : HasLimits Cat.{v, v}
    where HasLimitsOfShape J _ :=
    { HasLimit := fun F => ⟨⟨⟨has_limits.limit_cone F, has_limits.limit_cone_is_limit F⟩⟩⟩ }

instance : PreservesLimits Cat.objects.{v, v}
    where PreservesLimitsOfShape J _ :=
    {
      PreservesLimit := fun F =>
        preserves_limit_of_preserves_limit_cone (has_limits.limit_cone_is_limit F)
          (limits.is_limit.of_iso_limit (limit.is_limit (F ⋙ Cat.objects))
            (cones.ext (by rfl) (by tidy))) }

end Cat

end CategoryTheory


import Mathlib.Init.Set
import Mathlib.Logic.Denumerable
import Fine.Util.ConsExp

inductive Form : Type
  | atom : Nat → Form
  | neg  : Form → Form
  | and  : Form → Form → Form
  | or   : Form → Form → Form
  | impl : Form → Form → Form
  deriving DecidableEq

prefix:max "#" => Form.atom
infix:256 "⊃"  => Form.impl
infixr:512 "&" => Form.and
infixr:512 "¦" => Form.or
prefix:max "~" => Form.neg

def Form.toConsExp : Form → ConsExp
  | atom n => .cons (.nat 0) (.nat n)
  | neg f => .cons (.nat 1) f.toConsExp
  | and f g => .cons (.nat 2) (.cons f.toConsExp g.toConsExp)
  | or f g => .cons (.nat 3) (.cons f.toConsExp g.toConsExp)
  | impl f g => .cons (.nat 4) (.cons f.toConsExp g.toConsExp)

theorem Form.toConsExp_injective : Function.Injective Form.toConsExp := by
  intros f1 f2
  induction f1 generalizing f2 <;> cases f2 <;> simp! <;> aesop

theorem Form.nat_injection : Function.Injective Form.atom := by
  unfold Function.Injective;
  intros n m h₁
  injection h₁

def ConsExp.toForm : ConsExp → Option Form
  | .cons (.nat 0) (.nat n) => .some (.atom n)
  | .cons (.nat 1) f => .neg <$> f.toForm
  | .cons (.nat 2) (.cons f g) => .and <$> f.toForm <*> g.toForm
  | .cons (.nat 3) (.cons f g) => .or <$> f.toForm <*> g.toForm
  | .cons (.nat 4) (.cons f g) => .impl <$> f.toForm <*> g.toForm
  | _ => .none

instance {f : Form} : Decidable (∃g h, f = g ¦ h) := by
  cases f
  case or f₁ f₂ => exact isTrue ⟨f₁, f₂, rfl⟩
  repeat
    apply isFalse
    intros h₁
    have ⟨g, h, h₂⟩ := h₁
    injection h₂

theorem toForm_toConsExp_eq (f : Form) : f.toConsExp.toForm = some f := by
  induction f <;> simp! [*]

instance Form.infinite : Infinite Form :=
  Infinite.of_injective Form.atom Form.nat_injection

def Form.encodable : Encodable Form where
  encode f := Encodable.encode f.toConsExp
  decode n := Option.bind (Encodable.decode n) ConsExp.toForm
  encodek := by
    intro f
    simp [toForm_toConsExp_eq]

instance : Denumerable Form := @Denumerable.ofEncodableOfInfinite Form Form.encodable Form.infinite

instance Form.disjunctions_encodable : Encodable {f : Form // ∃g h : Form, f = g ¦ h} := Encodable.Subtype.encodable

instance Form.disjunctions_infinite : Infinite {f : Form // ∃g h : Form, f = g ¦ h} := by
  apply Infinite.of_injective (λn : Nat => ⟨#n ¦ #n, ⟨#n, #n, rfl⟩⟩)
  unfold Function.Injective
  intros n₁ n₂ h₁
  injection h₁ with h₁
  injection h₁ with h₁ h₂
  injection h₁

instance : Denumerable {f : Form // ∃g h : Form, f = g ¦ h} :=
  Denumerable.ofEncodableOfInfinite {f : Form // ∃g h : Form, f = g ¦ h}

instance : ToString Form where
  toString := display
  where display: Form → String
    | #n => s!"A{n}"
    | ~f => "~" ++ display f
    | f1 & f2 => "(" ++ display f1 ++ "&" ++ display f2 ++ ")"
    | f1 ¦ f2 => "(" ++ display f1 ++ "¦" ++ display f2 ++ ")"
    | Form.impl f1 f2 => "(" ++ display f1 ++ " ⊃ " ++ display f2 ++ ")"
    --can't pattern match using ⊃ because of collision with set

#check (#1 ⊃ ~(~#2 ⊃ #3) : Form )
#eval (#1 ⊃ ~(~#2 ⊃ #3) : Form )

abbrev Ctx := Set Form

instance instMembership : Membership Form Ctx where
  mem p Γ := Γ p

def Form.conjoinList (f : Form) : List Form → Form
  | [] => f
  | a :: as => f & Form.conjoinList a as


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module order.category.Frm
! leanprover-community/mathlib commit e8ac6315bcfcbaf2d19a046719c3b553206dac75
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Category.Lat
import Mathbin.Order.Hom.CompleteLattice
import Mathbin.Topology.Category.CompHaus.Basic
import Mathbin.Topology.Sets.Opens

/-!
# The category of frames

This file defines `Frm`, the category of frames.

## References

* [nLab, *Frm*](https://ncatlab.org/nlab/show/Frm)
-/

universe u

open CategoryTheory Opposite Order TopologicalSpace

/-- The category of frames. -/
def Frm :=
  Bundled Frame
#align Frm Frm

namespace Frm

instance : CoeSort Frm (Type _) :=
  Bundled.hasCoeToSort

instance (X : Frm) : Frame X :=
  X.str

/-- Construct a bundled `Frm` from a `frame`. -/
def of (α : Type _) [Frame α] : Frm :=
  Bundled.of α
#align Frm.of Frm.of

@[simp]
theorem coe_of (α : Type _) [Frame α] : ↥(of α) = α :=
  rfl
#align Frm.coe_of Frm.coe_of

instance : Inhabited Frm :=
  ⟨of PUnit⟩

/-- An abbreviation of `frame_hom` that assumes `frame` instead of the weaker `complete_lattice`.
Necessary for the category theory machinery. -/
abbrev Hom (α β : Type _) [Frame α] [Frame β] : Type _ :=
  FrameHom α β
#align Frm.hom Frm.Hom

instance bundledHom : BundledHom Hom :=
  ⟨fun α β [Frame α] [Frame β] => (coeFn : FrameHom α β → α → β), fun α [Frame α] => FrameHom.id α,
    fun α β γ [Frame α] [Frame β] [Frame γ] => FrameHom.comp, fun α β [Frame α] [Frame β] =>
    FunLike.coe_injective⟩
#align Frm.bundled_hom Frm.bundledHom

deriving instance LargeCategory, ConcreteCategory for Frm

instance hasForgetToLat : HasForget₂ Frm Lat
    where forget₂ :=
    { obj := fun X => ⟨X⟩
      map := fun X Y => FrameHom.toLatticeHom }
#align Frm.has_forget_to_Lat Frm.hasForgetToLat

/-- Constructs an isomorphism of frames from an order isomorphism between them. -/
@[simps]
def Iso.mk {α β : Frm.{u}} (e : α ≃o β) : α ≅ β
    where
  Hom := e
  inv := e.symm
  hom_inv_id' := by
    ext
    exact e.symm_apply_apply _
  inv_hom_id' := by
    ext
    exact e.apply_symm_apply _
#align Frm.iso.mk Frm.Iso.mk

end Frm

/-- The forgetful functor from `Topᵒᵖ` to `Frm`. -/
@[simps]
def topOpToFrame : TopCatᵒᵖ ⥤ Frm
    where
  obj X := Frm.of (Opens (unop X : TopCat))
  map X Y f := Opens.comap <| Quiver.Hom.unop f
  map_id' X := Opens.comap_id
#align Top_op_to_Frame topOpToFrame

-- Note, `CompHaus` is too strong. We only need `t0_space`.
instance CompHausOpToFrame.faithful : Faithful (compHausToTop.op ⋙ topOpToFrame.{u}) :=
  ⟨fun X Y f g h => Quiver.Hom.unop_inj <| Opens.comap_injective h⟩
#align CompHaus_op_to_Frame.faithful CompHausOpToFrame.faithful