import data.matrix.pequiv data.rat.basic tactic.fin_cases data.list.min_max partition

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) ℚ)
(offset : cvec m)
(to_partition : partition m n)
(restricted : finset (fin (m + n)))

namespace tableau
open partition

section predicates
variable (T : tableau m n)

/-- The affine subspace represented by the tableau ignoring nonnegativity restrictiions -/
def flat : set (cvec (m + n)) := { x | T.to_partition.rowp.to_matrix ⬝ x =
  T.to_matrix ⬝ T.to_partition.colp.to_matrix ⬝ x + T.offset }

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

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

/-- Predicate for a variable being unbounded below in the `sol_set` -/
def is_unbounded_below (i : fin (m + n)) : Prop :=
  ∀ q : ℚ, ∃ x : cvec (m + n), x ∈ sol_set T ∧ x i 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 (T : tableau m n) (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⟩

/-- 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 [mul_add, 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, mul_add, 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} {c : fin n}
  (hc : T.offset r 0 / T.to_matrix r c ≤ 0)
  (h : ∀ i : fin m, i ≠ r → T.to_partition.rowg i ∈ T.restricted →
    0 ≤ T.offset i 0 - T.to_matrix i c * T.offset r 0 / T.to_matrix r c) :
  (T.pivot r c).feasible :=
assume i hi,
if hir : i = r
  then begin
    subst hir,
    rw [offset_pivot_row],
    simpa [neg_div] using hc
  end
  else begin
    rw [to_partition_pivot, rowg_swap_of_ne _ hir, restricted_pivot] at hi,
    rw [offset_pivot_of_ne _ hir],
    simpa [offset_pivot_of_ne _ hir] using h _ hir hi
  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 _ _)

@[simp] lemma simplex_flat {T : tableau m n} (i : fin m) : flat (T.simplex i) = T.flat :=
iterate_flat _ _

@[simp] lemma simplex_sol_set {T : tableau m n} (i : fin m) : sol_set (T.simplex i) = T.sol_set :=
iterate_sol_set _ _

end simplex

section add_row

/-- adds a new row without making it a restricted variable. -/
def add_row (T : tableau m n) (fac : rvec (m + n)) (const : ℚ) : tableau (m + 1) n :=
{ to_matrix := λ i j, if hm : i.1 < m
    then T.to_matrix (fin.cast_lt i hm) j
    else fac 0 (T.to_partition.colg j) +
      univ.sum (λ i' : fin m, fac 0 (T.to_partition.rowg i') * T.to_matrix i' j),
  offset := λ i j, if hm : i.1 < m
    then T.offset (fin.cast_lt i hm) j
    else const +
      univ.sum (λ i' : fin m, fac 0 (T.to_partition.rowg i') * T.offset i' 0),
  to_partition := T.to_partition.add_row,
  restricted := T.restricted.map ⟨fin.castp,
    λ ⟨_, _⟩ ⟨_, _⟩ h, fin.eq_of_veq (fin.veq_of_eq h : _)⟩ }

@[simp] lemma add_row_to_partition (T : tableau m n) (fac : rvec (m + n)) (const : ℚ) :
  (T.add_row fac const).to_partition = T.to_partition.add_row := rfl

lemma add_row_to_matrix (T : tableau m n) (fac : rvec (m + n)) (const : ℚ) :
  (T.add_row fac const).to_matrix = λ i j, if hm : i.1 < m
    then T.to_matrix (fin.cast_lt i hm) j else fac 0 (T.to_partition.colg j) +
      univ.sum (λ i' : fin m, fac 0 (T.to_partition.rowg i') * T.to_matrix i' j) := rfl

lemma add_row_offset (T : tableau m n) (fac : rvec (m + n)) (const : ℚ) :
  (T.add_row fac const).offset = λ i j, if hm : i.1 < m
    then T.offset (fin.cast_lt i hm) j else const +
    univ.sum (λ i' : fin m, fac 0 (T.to_partition.rowg i') * T.offset i' 0) := rfl

lemma add_row_restricted (T : tableau m n) (fac : rvec (m + n)) (const : ℚ) :
  (T.add_row fac const).restricted = T.restricted.image fin.castp :=
by simp [add_row, map_eq_image]

@[simp] lemma fin.cast_lt_cast_succ {n : ℕ} (a : fin n) (h : a.1 < n) :
  a.cast_succ.cast_lt h = a := by cases a; refl

lemma minor_mem_flat_of_mem_add_row_flat {T : tableau m n} {fac : rvec (m + n)} {const : ℚ}
  {x : cvec (m + 1 + n)} : x ∈ (T.add_row fac const).flat → minor x fin.castp id ∈ T.flat :=
begin
  rw [mem_flat_iff, mem_flat_iff],
  intros h r,
  have := h (fin.cast_succ r),
  simp [add_row_rowg_cast_succ, add_row_offset, add_row_to_matrix,
    (show (fin.cast_succ r).val < m, from r.2), add_row_colg] at this,
  simpa
end

lemma minor_mem_sol_set_of_mem_add_row_sol_set {T : tableau m n} {fac : rvec (m + n)} {const : ℚ}
  {x : cvec (m + 1 + n)} : x ∈ (T.add_row fac const).sol_set → minor x fin.castp id ∈ T.sol_set :=
and_implies minor_mem_flat_of_mem_add_row_flat begin
  assume h v,
  simp only [set.mem_set_of_eq, add_row_restricted, mem_image, exists_imp_distrib] at h,
  simpa [add_row_restricted, matrix.minor, id.def] using h (fin.castp v) v
end

lemma add_row_new_eq_sum_fac (T : tableau m n) (fac : rvec (m + n)) (const : ℚ)
  (x : cvec (m + 1 + n)) (hx : x ∈ (T.add_row fac const).flat) :
  x fin.lastp 0 = univ.sum (λ v : fin (m + n), fac 0 v * x (fin.castp v) 0) + const :=
calc x fin.lastp 0 = x ((T.add_row fac const).to_partition.rowg (fin.last _)) 0 :
  by simp [add_row_rowg_last]
... = univ.sum (λ j : fin n, _) + (T.add_row fac const).offset _ _ : mem_flat_iff.1 hx _
... = const +
  univ.sum (λ j, (fac 0 (T.to_partition.colg j) * x (T.to_partition.add_row.colg j) 0)) +
  (univ.sum (λ j, univ.sum (λ i, fac 0 (T.to_partition.rowg i) * T.to_matrix i j *
      x (T.to_partition.add_row.colg j) 0))
    + univ.sum (λ i, fac 0 (T.to_partition.rowg i) * T.offset i 0)) :
  by simp [add_row_to_matrix, add_row_offset, fin.last, add_mul, sum_add_distrib, sum_mul]
... = const +
  univ.sum (λ j, (fac 0 (T.to_partition.colg j) * x (T.to_partition.add_row.colg j) 0)) +
  (univ.sum (λ i, univ.sum (λ j, fac 0 (T.to_partition.rowg i) * T.to_matrix i j *
    x (T.to_partition.add_row.colg j) 0))
    + univ.sum (λ i, fac 0 (T.to_partition.rowg i) * T.offset i 0)) : by rw [sum_comm]
... = const +
  univ.sum (λ j, (fac 0 (T.to_partition.colg j) * x (T.to_partition.add_row.colg j) 0)) +
  univ.sum (λ i : fin m, (fac 0 (T.to_partition.rowg i) * x (fin.castp (T.to_partition.rowg i)) 0)) :
begin
  rw [← sum_add_distrib],
  have : ∀ r : fin m, x (fin.castp (T.to_partition.rowg r)) 0 =
    sum univ (λ (c : fin n), T.to_matrix r c * x (fin.castp (T.to_partition.colg c)) 0) +
    T.offset r 0, from mem_flat_iff.1 (minor_mem_flat_of_mem_add_row_flat hx),
  simp [this, mul_add, add_row_colg, mul_sum, mul_assoc]
end
... = ((univ.image T.to_partition.colg).sum (λ v, (fac 0 v * x (fin.castp v) 0)) +
  (univ.image T.to_partition.rowg).sum (λ v, (fac 0 v * x (fin.castp v) 0))) + const :
  by rw [sum_image, sum_image];
    simp [add_row_rowg_cast_succ, add_row_colg, T.to_partition.injective_rowg.eq_iff,
      T.to_partition.injective_colg.eq_iff]
... = _ : begin
  rw [← sum_union],
  congr,
  simpa [finset.ext, eq_comm] using T.to_partition.eq_rowg_or_colg,
  { simp [finset.ext, eq_comm, T.to_partition.rowg_ne_colg] {contextual := tt} }
end

end add_row
open tableau.simplex

/-- Boolean returning whether  -/
def max_nonneg (T : tableau m n) (i : fin m) : bool :=
0 ≤ (simplex T i).offset i 0

lemma max_nonneg_iff (T : tableau m n) (hT : T.feasible) (i : fin m) :
  T.max_nonneg i ↔ ∃ x : cvec (m + n), x ∈ T.sol_set ∧ 0 ≤ x (T.to_partition.rowg i) 0 :=
by simp [max_nonneg, bool.of_to_bool_iff]; exact
⟨λ h, ⟨(T.simplex i).of_col 0, by rw [← simplex_sol_set i,
    ← feasible_iff_of_col_zero_mem_sol_set]; exact simplex_feasible hT _,
  _⟩ ,

_⟩

section assertge

end assertge

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 25 10 :=
{ to_matrix := list.to_matrix 25 10
    [[0, 0, 0, 0, 1, 0, 1, 0, 1, -1], [-1, 1, 0, -1, 1, 0, 1, -1, 0, 0],
     [0, -1, 1, 1, 1, 0, 0, 0, 1, 0], [1, 1, 1, 0, 1, -1, 1, -1, 1, -1],
     [0, 1, 1, -1, -1, 1, -1, 1, -1, 1], [0, -1, 1, -1, 1, 1, 0, 1, 0, -1],
     [-1, 0, 0, -1, -1, 1, 1, 0, -1, -1], [-1, 0, 0, -1, 0, -1, 0, 0, -1, 1],
     [-1, 0, 0, 1, -1, 1, -1, -1, 1, 0], [1, 0, 0, 0, 1, -1, 1, 0, -1, 1],
     [0, -1, 1, 0, 0, 1, 0, -1, 0, 0], [-1, 1, -1, 1, 1, 0, 1, 0, 1, 0],
     [1, 1, 1, 1, -1, 0, 0, 0, -1, 0], [-1, -1, 0, 0, 1, 0, 1, 1, -1, 0],
     [0, 0, -1, 1, -1, 0, 0, 1, 0, -1], [-1, 0, -1, 1, 1, 1, 0, 0, 0, 0], [
       1, 0, -1, 1, 0, -1, -1, 1, -1, 1], [-1, 1, -1, 1, -1, -1, -1, 1, -1, 1],
       [-1, 0, 0, 0, 1, -1, 1, -1, -1, 1], [-1, -1, -1, 1, 0, 1, -1, 1, 0, 0],
       [-1, 0, 0, 0, -1, -1, 1, -1, 0, 1], [-1, 0, 0, -1, 1, 1, 1, -1, 1, 0],
       [0, -1, 0, 0, 0, -1, 0, 1, 0, -1], [1, -1, 1, 0, 0, 1, 0, 1, 0, -1],
       [0, -1, -1, 0, 0, 0, -1, 0, 1, 0]],
  offset := λ i _, if i.1 < 8 then 0 else 1,
  to_partition := default _,
  restricted := univ }

def Beale : tableau 4 4 :=
{ to_matrix := list.to_matrix 4 4
    [[3/4, -150, 1/50, -6],
      [-1/4, 60,1/25,-9],
      [-1/2,90,1/50,-3],
      [0,0,-1,0]],
  offset := λ i k, if i = 3 then 1 else 0,
  to_partition := default _,
  restricted := univ }

def Yudin_golstein : tableau 4 4 :=
{ to_matrix := list.to_matrix 4 4
    [[1,-1,1,-1],
    [-2,3,5,-6],
    [-6,5,3,-2],
    [-3,-1,-2,-4]],
  offset := λ i k, if i = 3 then 1 else 0,
  to_partition := default _,
  restricted := univ }

def Kuhn : tableau 4 4 :=
{ to_matrix := list.to_matrix 4 4
    [[2,3,-1,-12],
    [2,9,-1,-9],
    [-1/3,-1,1/3,2],
    [-2,-3,1,12]],
  offset := λ i k, if i = 3 then 2 else 0,
  to_partition := default _,
  restricted := univ }

def me : tableau 3 2 :=
{ to_matrix := list.to_matrix 3 2
    [[1/2, 1], [1, 1], [-1, 1]],
  offset := 0,
  to_partition := default _,
  restricted := univ }

def tableau.flip_up : tableau m n → tableau m n :=
λ T,
{ to_matrix := λ i j, T.to_matrix ⟨(-i-1 : ℤ).nat_mod m, sorry⟩ j,
  offset := λ i j, T.offset ⟨(-i - 1 : ℤ).nat_mod m, sorry⟩ j,
  to_partition := T.to_partition,
  restricted := univ }

#eval let A := me in
  ((A.simplex 0).to_matrix, (A.flip_up.simplex 3).to_matrix)

-- 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 }
--set_option profiler true
#print algebra.sub
-- 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 := λ i _, 1,
--   to_partition := default _,
--   restricted := univ }
#print random_gen
#print tc.rec
#print nat
#eval let s := T.simplex 0 in (s.to_partition.row_indices).1

end test


/-
Copyright (c) 2022 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.inner_product_space.dual
import analysis.inner_product_space.orientation
import tactic.norm_fin

/-! # The cross-product on an oriented real inner product space of dimension three -/

noncomputable theory

open_locale real_inner_product_space
open finite_dimensional

local attribute [instance] fact_finite_dimensional_of_finrank_eq_succ

variables (E : Type*) [normed_add_comm_group E] [inner_product_space ℝ E]

/-- The identification of a finite-dimensional inner product space with its algebraic dual. -/
private def to_dual [finite_dimensional ℝ E] : E ≃ₗ[ℝ] (E →ₗ[ℝ] ℝ) :=
(inner_product_space.to_dual ℝ E).to_linear_equiv ≪≫ₗ linear_map.to_continuous_linear_map.symm

namespace orientation
variables {E} [fact (finrank ℝ E = 3)] (ω : orientation ℝ E (fin 3))

include ω

/-- Linear map from `E` to `E →ₗ[ℝ] E` constructed from a 3-form `Ω` on `E` and an identification of
`E` with its dual.  Effectively, the Hodge star operation.  (Under appropriate hypotheses it turns
out that the image of this map is in `𝔰𝔬(E)`, the skew-symmetric operators, which can be identified
with `Λ²E`.) -/
def cross_product : E →ₗ[ℝ] (E →ₗ[ℝ] E) :=
begin
  let z : alternating_map ℝ E ℝ (fin 0) ≃ₗ[ℝ] ℝ :=
    alternating_map.const_linear_equiv_of_is_empty.symm,
  let y : alternating_map ℝ E ℝ (fin 1) →ₗ[ℝ] E →ₗ[ℝ] ℝ :=
    (linear_map.llcomp ℝ E (alternating_map ℝ E ℝ (fin 0)) ℝ z) ∘ₗ
      alternating_map.curry_left_linear_map,
  let y' : alternating_map ℝ E ℝ (fin 1) →ₗ[ℝ] E :=
    (linear_map.llcomp ℝ (alternating_map ℝ E ℝ (fin 1)) (E →ₗ[ℝ] ℝ) E (to_dual E).symm) y,
  let u : alternating_map ℝ E ℝ (fin 2) →ₗ[ℝ] E →ₗ[ℝ] E :=
    (linear_map.llcomp ℝ E (alternating_map ℝ E ℝ (fin 1)) _ y') ∘ₗ
      alternating_map.curry_left_linear_map,
  exact u ∘ₗ (alternating_map.curry_left_linear_map ω.volume_form),
end

local infix `×₃`:100 := ω.cross_product

lemma cross_product_apply_self (v : E) : v ×₃ v = 0 := by simp [cross_product]

lemma inner_cross_product_apply (u v w : E) : ⟪u ×₃ v, w⟫ = ω.volume_form ![u, v, w] :=
by simp only [cross_product, to_dual, linear_equiv.trans_symm, linear_equiv.symm_symm,
  linear_isometry_equiv.to_linear_equiv_symm, alternating_map.curry_left_linear_map_apply,
  linear_map.coe_comp, function.comp_app, linear_map.llcomp_apply,
  linear_equiv.coe_coe, linear_equiv.trans_apply, linear_isometry_equiv.coe_to_linear_equiv,
  linear_isometry_equiv.norm_map, submodule.coe_norm,
  inner_product_space.to_dual_symm_apply, alternating_map.curry_left_apply_apply,
  alternating_map.const_linear_equiv_of_is_empty_symm_apply,
  eq_self_iff_true, linear_map.coe_to_continuous_linear_map', matrix.zero_empty]

lemma inner_cross_product_apply_self (u : E) (v : (ℝ ∙ u)ᗮ) : ⟪u ×₃ v, u⟫ = 0 :=
begin
  rw ω.inner_cross_product_apply u v u,
  refine ω.volume_form.map_eq_zero_of_eq ![u, v, u] _ (by norm_num : (0 : fin 3) ≠ 2),
  simp
end

lemma inner_cross_product_apply_apply_self (u : E) (v : (ℝ ∙ u)ᗮ) : ⟪u ×₃ v, v⟫ = 0 :=
begin
  rw ω.inner_cross_product_apply u v v,
  refine ω.volume_form.map_eq_zero_of_eq ![u, v, v] _ (by norm_num : (1 : fin 3) ≠ 2),
  simp
end

attribute [irreducible] cross_product

/-- The map `cross_product`, upgraded from linear to continuous-linear; useful for calculus. -/
def cross_product' : E →L[ℝ] (E →L[ℝ] E) :=
(↑(linear_map.to_continuous_linear_map : (E →ₗ[ℝ] E) ≃ₗ[ℝ] (E →L[ℝ] E))
  ∘ₗ (ω.cross_product)).to_continuous_linear_map

@[simp] lemma cross_product'_apply (v : E) : ω.cross_product' v = (ω.cross_product v).to_continuous_linear_map := rfl

lemma norm_cross_product (u : E) (v : (ℝ ∙ u)ᗮ) : ‖u ×₃ v‖ = ‖u‖ * ‖v‖ :=
begin
  classical,
  refine le_antisymm _ _,
  { cases eq_or_lt_of_le (norm_nonneg (u ×₃ v)) with h h,
    { rw ← h,
      positivity },
    refine le_of_mul_le_mul_right _ h,
    rw ← real_inner_self_eq_norm_mul_norm,
    simpa only [inner_cross_product_apply, fin.mk_zero, fin.prod_univ_succ, finset.card_singleton,
      finset.prod_const, fintype.univ_of_subsingleton, matrix.cons_val_fin_one, matrix.cons_val_succ,
      matrix.cons_val_zero, mul_assoc, nat.nat_zero_eq_zero, pow_one, submodule.coe_norm]
      using ω.volume_form_apply_le ![u, v, u ×₃ v] },
  let K : submodule ℝ E := submodule.span ℝ ({u, v} : set E),
  haveI : nontrivial Kᗮ,
  { apply @finite_dimensional.nontrivial_of_finrank_pos ℝ,
    have : finrank ℝ K ≤ finset.card {u, (v:E)},
    { simpa [set.to_finset_singleton] using finrank_span_le_card ({u, v} : set E) },
    have : finset.card {u, (v:E)} ≤ finset.card {(v:E)} + 1 := finset.card_insert_le u {v},
    have : finset.card {(v:E)} = 1 := finset.card_singleton (v:E),
    have : finrank ℝ K + finrank ℝ Kᗮ = finrank ℝ E := K.finrank_add_finrank_orthogonal,
    have : finrank ℝ E = 3 := fact.out _,
    linarith },
  obtain ⟨w, hw⟩ : ∃ w : Kᗮ, w ≠ 0 := exists_ne 0,
  have hw' : (w:E) ≠ 0 := λ h, hw (submodule.coe_eq_zero.mp h),
  have H : pairwise (λ i j, ⟪![u, v, w] i, ![u, v, w] j⟫ = 0),
  { intros i j hij,
    have h1 : ⟪u, v⟫ = 0 := v.2 _ (submodule.mem_span_singleton_self _),
    have h2 : ⟪(v:E), w⟫ = 0 := w.2 _ (submodule.subset_span (by simp)),
    have h3 : ⟪u, w⟫ = 0 := w.2 _ (submodule.subset_span (by simp)),
    fin_cases i; fin_cases j; norm_num at hij; simp [h1, h2, h3]; rw real_inner_comm; assumption },
  refine le_of_mul_le_mul_right _ (by rwa norm_pos_iff : 0 < ‖w‖),
  -- Cauchy-Schwarz inequality for `u ×₃ v` and `w`
  simpa only [inner_cross_product_apply, ω.abs_volume_form_apply_of_pairwise_orthogonal H,
    inner_cross_product_apply, fin.mk_zero, fin.prod_univ_succ, finset.card_singleton,
    finset.prod_const, fintype.univ_of_subsingleton, matrix.cons_val_fin_one, matrix.cons_val_succ,
    matrix.cons_val_zero, nat.nat_zero_eq_zero, pow_one, mul_assoc]
    using abs_real_inner_le_norm (u ×₃ v) w,
end

lemma isometry_on_cross_product (u : metric.sphere (0:E) 1) (v : (ℝ ∙ (u:E))ᗮ) : ‖u ×₃ v‖ = ‖v‖ :=
by simp [norm_cross_product]

end orientation


/-
Copyright (c) 2019 Joe Cool. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Hoang Le Truong.

-/
import manifold.manifold map
import analysis.normed_space.deriv  analysis.normed_space.bounded_linear_maps
open pfun

local attribute [instance] classical.prop_decidable

noncomputable theory
universes u v w

variables {α : Type } {β : Type v} {γ : Type w} {n : ℕ}

variable [nondiscrete_normed_field α]

namespace diff
variables {E  : cartesian α }
variables {F  : cartesian α   }

instance : normed_space α  (E →L[α] F) := bounded_linear_map.to_normed_space

def is_dif_at_within (f : E →. α )  (s: set E) (x : E) : Prop :=
 @differentiable_within_at α _ E _ α _ (@ext_by_zero α E _ f)  s x

def is_dif_at (f : E →. α ) (x : E)  : Prop := ∃g, @has_fderiv_at α _ _ _ _ _ (@ext_by_zero α E _ f) g x

def is_dif  (f : (E →. α) ) : Prop := ∀ x:f.dom, is_dif_at_within f f.dom x

def is_dif_map (E  : cartesian α) (F  : cartesian α)  : ( E →. F )→  Prop := λ f, ∀  i: fin (F.dim),  is_dif  (pfun.lift (cartesian.proj F i).to_fun ∘. f )

lemma exists_diff (f:E →. α ) (h:@is_dif α _ E f ) :
∀ (x:E)( H:x∈ f.dom),  ∃ g,  @has_fderiv_within_at α _ _ _ _ _ (ext_by_zero  f) g  (f.dom) x:=
by {
  simp [is_dif,is_dif_at_within] at h,
 repeat {intro},
 have h2:= @h x H,
 exact h2
}

def diff (f:E →. α ) [h:@is_dif α _ E f ]: E →. cartesian.dual E:=
λ x, { dom:= x ∈ f.dom,
  get:=λ y,
  let g:=classical.some (@exists_diff α _ E f h x y) in @is_bounded_linear_map.to_linear_map α _ E _ _ _  g (bounded_linear_map.is_bounded_linear_map g)}

def is_diff (f:E →. α ) [h:@is_dif α _ E f ]:Prop := @is_dif_map α _ E (@cartesian.dual α _ E) (@diff α _ E f h)

structure C1_diff_map  (f : E →. F )  :=
 (has_diff: ∀ i: fin (F.dim),  (is_dif (pfun.lift (cartesian.proj F i).to_fun ∘. f)) )
 (cont: ∀ i: fin (F.dim),   is_continuous  (@diff α _ E  (pfun.lift (cartesian.proj F i).to_fun ∘. f ) (has_diff i)))

structure C2_diff_map  (f : E →. F )  :=
 (has_diff: ∀ i: fin (F.dim),  (is_dif (pfun.lift (cartesian.proj F i).to_fun ∘. f)) )
 (has_C1_diff: ∀ i: fin (F.dim),   @is_diff α _ E (pfun.lift (cartesian.proj F i).to_fun ∘. f ) (has_diff i)  )
 (cont: ∀ i: fin (F.dim),   is_continuous  (@diff α _ E   (pfun.lift (cartesian.proj F i).to_fun ∘. f ) (has_diff i)))

def has_diff  (f : (E →. α )) (i:fin E.dim) : roption(E →. α ) :=
{dom:= @is_dif α _ E f,
 get:=λ y, (pfun.lift (cartesian.proj (cartesian.dual E) i).to_fun ∘. (@diff  α _  E f y ))}

def C:list(fin E.dim) → (E→. α )→ Prop
| []:= λ  f, is_continuous f
| (a::l):=λ f,    C l f → ∃g , g= @has_diff  α _  E f a ∧ (∀ x,  is_continuous (g.get x))

def 𝒞_n (n:ℕ ) (E  : cartesian α) (F  : cartesian α):   (E→. F )→ Prop :=
 λ f, ∀ (l: list(fin E.dim)) (i:fin F.dim), list.length l=n →  C l (pfun.lift (cartesian.proj F i).to_fun ∘. f)

def 𝒞_infinity (E  : cartesian α) (F  : cartesian α):  (E→. F )→ Prop :=
 λ f, ∀ n:ℕ, 𝒞_n n E F f

lemma const (c:α):is_dif (@const_fun α E _ c):=
by {
   rw[diff.is_dif],
   {repeat {intro},
   rw[diff.is_dif_at_within,ext_const],
   have h2:= @has_fderiv_within_at_const α _ E _ α  _ c x (@const_fun α E _ c).dom,
   refine ⟨ 0 , h2 ⟩},
   }

#check diff.is_dif

end  diff

class diff_manifold (E : cartesian α ) (X:Top)  extends manifold_prop E X :=
{equiv:(λ f, property f) = diff.is_dif   }

class C_infinity_manifold (E : cartesian α ) (X:Top)  extends manifold_prop E X :=
{equiv:(λ f, property f) = diff.𝒞_infinity E (cartesian.field α)    }

 class C_manifold (n:ℕ ) (E : cartesian α ) (X:Top)  extends manifold_prop E X :=
{equiv:(λ f, property f) = diff.𝒞_n n E (cartesian.field α)   }

class real_manifold (E : cartesian ℝ )(X:Top) extends diff_manifold (E : cartesian ℝ  ) (X:Top)

class complex_manifold (E : cartesian ℂ )(X:Top) extends diff_manifold (E : cartesian ℂ   ) (X:Top)


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
  begin
    assume (i j : ℤ) (hij : i ≠ j),
    -- If this were not true, then
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    -- $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
    have h3 : α * ↑i - (int.nat_abs (α * ↑i)) = int.fract (α * ↑i) := by auto [int.fract_eq_iff_nat_abs_sub_lt_one],
    have h4 : α * ↑j - (int.nat_abs (α * ↑j)) = int.fract (α * ↑j) := by auto [int.fract_eq_iff_nat_abs_sub_lt_one],
    have h5 : α * ↑i - (int.nat_abs (α * ↑i)) = α * ↑j - (int.nat_abs (α * ↑j)), from by auto [h2, h3, h4],
    -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
    have h6 : α = (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j), from by auto [int.nat_abs_mul, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg,
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [hα_irrat, int.fract_eq_iff_of_int_mul_eq_int],

  -- If this were not true, then
  -- $$
  -- i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
  -- $$
  -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h2 : ∀ i j : ℤ, i ≠ j → (α * ↑i - int.nat_abs (α * ↑i)) = int.fract (α * ↑i) → (α * ↑j - int.nat_abs (α * ↑j)) = int.fract (α * ↑j) → α = (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j), from by auto [int.fract_eq_iff_of_int_mul_eq_int, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg,
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
  begin
    assume (i j : ℤ) (hij : i ≠ j),
    -- $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
    have h1 : α * ↑i - int.nat_abs (α * ↑i) = int.fract (α * ↑i), from by auto [int.fract_eq_of_nat_abs_sub_lt_one],
    have h2 : int.fract (α * ↑i) = int.fract (α * ↑j), from by auto [hij],
    have h3 : int.fract (α * ↑j) = α * ↑j - int.nat_abs (α * ↑j), from by auto [int.fract_eq_of_nat_abs_sub_lt_one],
    -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
    have h4 : α = (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j), from by auto [h1, h2, h3, int.nat_abs_mul, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis

! This file was ported from Lean 3 source module tactic.linarith.frontend
! leanprover-community/mathlib commit 2967fae827b2d5ca57d15c7b721fe486c7e4cc63
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Linarith.Verification
import Mathbin.Tactic.Linarith.Preprocessing

/-!
# `linarith`: solving linear arithmetic goals

`linarith` is a tactic for solving goals with linear arithmetic.

Suppose we have a set of hypotheses in `n` variables
`S = {a₁x₁ + a₂x₂ + ... + aₙxₙ R b₁x₁ + b₂x₂ + ... + bₙxₙ}`,
where `R ∈ {<, ≤, =, ≥, >}`.
Our goal is to determine if the inequalities in `S` are jointly satisfiable, that is, if there is
an assignment of values to `x₁, ..., xₙ` such that every inequality in `S` is true.

Specifically, we aim to show that they are *not* satisfiable. This amounts to proving a
contradiction. If our goal is also a linear inequality, we negate it and move it to a hypothesis
before trying to prove `false`.

When the inequalities are over a dense linear order, `linarith` is a decision procedure: it will
prove `false` if and only if the inequalities are unsatisfiable. `linarith` will also run on some
types like `ℤ` that are not dense orders, but it will fail to prove `false` on some unsatisfiable
problems. It will run over concrete types like `ℕ`, `ℚ`, and `ℝ`, as well as abstract types that
are instances of `linear_ordered_comm_ring`.

## Algorithm sketch

First, the inequalities in the set `S` are rearranged into the form `tᵢ Rᵢ 0`, where
`Rᵢ ∈ {<, ≤, =}` and each `tᵢ` is of the form `∑ cⱼxⱼ`.

`linarith` uses an untrusted oracle to search for a certificate of unsatisfiability.
The oracle searches for a list of natural number coefficients `kᵢ` such that `∑ kᵢtᵢ = 0`, where for
at least one `i`, `kᵢ > 0` and `Rᵢ = <`.

Given a list of such coefficients, `linarith` verifies that `∑ kᵢtᵢ = 0` using a normalization
tactic such as `ring`. It proves that `∑ kᵢtᵢ < 0` by transitivity, since each component of the sum
is either equal to, less than or equal to, or less than zero by hypothesis. This produces a
contradiction.

## Preprocessing

`linarith` does some basic preprocessing before running. Most relevantly, inequalities over natural
numbers are cast into inequalities about integers, and rational division by numerals is canceled
into multiplication. We do this so that we can guarantee the coefficients in the certificate are
natural numbers, which allows the tactic to solve goals over types that are not fields.

Preprocessors are allowed to branch, that is, to case split on disjunctions. `linarith` will succeed
overall if it succeeds in all cases. This leads to exponential blowup in the number of `linarith`
calls, and should be used sparingly. The default preprocessor set does not include case splits.

## Fourier-Motzkin elimination

The oracle implemented to search for certificates uses Fourier-Motzkin variable elimination.
This technique transorms a set of inequalities in `n` variables to an equisatisfiable set in `n - 1`
variables. Once all variables have been eliminated, we conclude that the original set was
unsatisfiable iff the comparison `0 < 0` is in the resulting set.

While performing this elimination, we track the history of each derived comparison. This allows us
to represent any comparison at any step as a positive combination of comparisons from the original
set. In particular, if we derive `0 < 0`, we can find our desired list of coefficients
by counting how many copies of each original comparison appear in the history.

## Implementation details

`linarith` homogenizes numerical constants: the expression `1` is treated as a variable `t₀`.

Often `linarith` is called on goals that have comparison hypotheses over multiple types. This
creates multiple `linarith` problems, each of which is handled separately; the goal is solved as
soon as one problem is found to be contradictory.

Disequality hypotheses `t ≠ 0` do not fit in this pattern. `linarith` will attempt to prove equality
goals by splitting them into two weak inequalities and running twice. But it does not split
disequality hypotheses, since this would lead to a number of runs exponential in the number of
disequalities in the context.

The Fourier-Motzkin oracle is very modular. It can easily be replaced with another function of type
`certificate_oracle := list comp → ℕ → tactic (rb_map ℕ ℕ)`,
which takes a list of comparisons and the largest variable
index appearing in those comparisons, and returns a map from comparison indices to coefficients.
An alternate oracle can be specified in the `linarith_config` object.

A variant, `nlinarith`, adds an extra preprocessing step to handle some basic nonlinear goals.
There is a hook in the `linarith_config` configuration object to add custom preprocessing routines.

The certificate checking step is *not* by reflection. `linarith` converts the certificate into a
proof term of type `false`.

Some of the behavior of `linarith` can be inspected with the option
`set_option trace.linarith true`.
Because the variable elimination happens outside the tactic monad, we cannot trace intermediate
steps there.

## File structure

The components of `linarith` are spread between a number of files for the sake of organization.

* `lemmas.lean` contains proofs of some arithmetic lemmas that are used in preprocessing and in
  verification.
* `datatypes.lean` contains data structures that are used across multiple files, along with some
  useful auxiliary functions.
* `preprocessing.lean` contains functions used at the beginning of the tactic to transform
  hypotheses into a shape suitable for the main routine.
* `parsing.lean` contains functions used to compute the linear structure of an expression.
* `elimination.lean` contains the Fourier-Motzkin elimination routine.
* `verification.lean` contains the certificate checking functions that produce a proof of `false`.
* `frontend.lean` contains the control methods and user-facing components of the tactic.

## Tags

linarith, nlinarith, lra, nra, Fourier Motzkin, linear arithmetic, linear programming
-/

open Tactic Native

namespace Linarith

/-! ### Control -/

/-- If `e` is a comparison `a R b` or the negation of a comparison `¬ a R b`, found in the target,
`get_contr_lemma_name_and_type e` returns the name of a lemma that will change the goal to an
implication, along with the type of `a` and `b`.

For example, if `e` is `(a : ℕ) < b`, returns ``(`lt_of_not_ge, ℕ)``.
-/
unsafe def get_contr_lemma_name_and_type : expr → Option (Name × expr)
  | q(@LT.lt $(tp) $(_) _ _) => return (`lt_of_not_ge, tp)
  | q(@LE.le $(tp) $(_) _ _) => return (`le_of_not_gt, tp)
  | q(@Eq $(tp) _ _) => return (`` eq_of_not_lt_of_not_gt, tp)
  | q(@Ne $(tp) _ _) => return (`not.intro, tp)
  | q(@GE.ge $(tp) $(_) _ _) => return (`le_of_not_gt, tp)
  | q(@GT.gt $(tp) $(_) _ _) => return (`lt_of_not_ge, tp)
  | q(¬@LT.lt $(tp) $(_) _ _) => return (`not.intro, tp)
  | q(¬@LE.le $(tp) $(_) _ _) => return (`not.intro, tp)
  | q(¬@Eq $(tp) _ _) => return (`` Not.intro, tp)
  | q(¬@GE.ge $(tp) $(_) _ _) => return (`not.intro, tp)
  | q(¬@GT.gt $(tp) $(_) _ _) => return (`not.intro, tp)
  | _ => none
#align linarith.get_contr_lemma_name_and_type linarith.get_contr_lemma_name_and_type

/-- `apply_contr_lemma` inspects the target to see if it can be moved to a hypothesis by negation.
For example, a goal `⊢ a ≤ b` can become `a > b ⊢ false`.
If this is the case, it applies the appropriate lemma and introduces the new hypothesis.
It returns the type of the terms in the comparison (e.g. the type of `a` and `b` above) and the
newly introduced local constant.
Otherwise returns `none`.
-/
unsafe def apply_contr_lemma : tactic (Option (expr × expr)) := do
  let t ← target
  match get_contr_lemma_name_and_type t with
    | some (nm, tp) => do
      refine ((expr.const nm []) pexpr.mk_placeholder)
      let v ← intro1
      return <| some (tp, v)
    | none => return none
#align linarith.apply_contr_lemma linarith.apply_contr_lemma

/-- `partition_by_type l` takes a list `l` of proofs of comparisons. It sorts these proofs by
the type of the variables in the comparison, e.g. `(a : ℚ) < 1` and `(b : ℤ) > c` will be separated.
Returns a map from a type to a list of comparisons over that type.
-/
unsafe def partition_by_type (l : List expr) : tactic (rb_lmap expr expr) :=
  l.foldlM
    (fun m h => do
      let tp ← ineq_prf_tp h
      return <| m tp h)
    mk_rb_map
#align linarith.partition_by_type linarith.partition_by_type

/-- Given a list `ls` of lists of proofs of comparisons, `try_linarith_on_lists cfg ls` will try to
prove `false` by calling `linarith` on each list in succession. It will stop at the first proof of
`false`, and fail if no contradiction is found with any list.
-/
unsafe def try_linarith_on_lists (cfg : linarith_config) (ls : List (List expr)) : tactic expr :=
  (first <| ls.map <| prove_false_by_linarith cfg) <|>
    fail "linarith failed to find a contradiction"
#align linarith.try_linarith_on_lists linarith.try_linarith_on_lists

/-- Given a list `hyps` of proofs of comparisons, `run_linarith_on_pfs cfg hyps pref_type`
preprocesses `hyps` according to the list of preprocessors in `cfg`.
This results in a list of branches (typically only one),
each of which must succeed in order to close the goal.

In each branch, we partition the  list of hypotheses by type, and run `linarith` on each class
in the partition; one of these must succeed in order for `linarith` to succeed on this branch.
If `pref_type` is given, it will first use the class of proofs of comparisons over that type.
-/
unsafe def run_linarith_on_pfs (cfg : linarith_config) (hyps : List expr)
    (pref_type : Option expr) : tactic Unit :=
  let single_process := fun hyps : List expr => do
    linarith_trace_proofs ("after preprocessing, linarith has " ++ toString hyps ++ " facts:") hyps
    let hyp_set ← partition_by_type hyps
    linarith_trace f! "hypotheses appear in {hyp_set} different types"
    match pref_type with
      | some t =>
        prove_false_by_linarith cfg (hyp_set t) <|>
          try_linarith_on_lists cfg (rb_map.values (hyp_set t))
      | none => try_linarith_on_lists cfg (rb_map.values hyp_set)
  let preprocessors := cfg.preprocessors.getD default_preprocessors
  let preprocessors := if cfg.split_ne then linarith.remove_ne :: preprocessors else preprocessors
  do
  let hyps ← preprocess preprocessors hyps
  hyps fun hs => do
      set_goals [hs.1]
      single_process hs.2 >>= exact
#align linarith.run_linarith_on_pfs linarith.run_linarith_on_pfs

/--
`filter_hyps_to_type restr_type hyps` takes a list of proofs of comparisons `hyps`, and filters it
to only those that are comparisons over the type `restr_type`.
-/
unsafe def filter_hyps_to_type (restr_type : expr) (hyps : List expr) : tactic (List expr) :=
  hyps.filterM fun h => do
    let ht ← infer_type h
    match get_contr_lemma_name_and_type ht with
      | some (_, htype) => succeeds <| unify htype restr_type
      | none => return ff
#align linarith.filter_hyps_to_type linarith.filter_hyps_to_type

/-- A hack to allow users to write `{restr_type := ℚ}` in configuration structures. -/
unsafe def get_restrict_type (e : expr) : tactic expr := do
  let m ← mk_mvar
  unify q((some $(m) : Option Type)) e
  instantiate_mvars m
#align linarith.get_restrict_type linarith.get_restrict_type

end Linarith

/-! ### User facing functions -/

open Linarith

/--
`linarith reduce_semi only_on hyps cfg` tries to close the goal using linear arithmetic. It fails
if it does not succeed at doing this.

* If `reduce_semi` is true, it will unfold semireducible definitions when trying to match atomic
expressions.
* `hyps` is a list of proofs of comparisons to include in the search.
* If `only_on` is true, the search will be restricted to `hyps`. Otherwise it will use all
  comparisons in the local context.
-/
unsafe def tactic.linarith (reduce_semi : Bool) (only_on : Bool) (hyps : List pexpr)
    (cfg : linarith_config := { }) : tactic Unit :=
  focus1 do
    let t ← target
    -- if the target is an equality, we run `linarith` twice, to prove ≤ and ≥.
        if t then
        linarith_trace "target is an equality: splitting" >>
          seq' (applyc `` eq_of_not_lt_of_not_gt) tactic.linarith
      else do
        let hyps ← hyps fun e => i_to_expr e >>= note_anon none
        when cfg (linarith_trace "trying to split hypotheses" >> try auto.split_hyps)
        let pref_type_and_new_var_from_tgt
          ←/- If we are proving a comparison goal (and not just `false`), we consider the type of the
               elements in the comparison to be the "preferred" type. That is, if we find comparison
               hypotheses in multiple types, we will run `linarith` on the goal type first.
               In this case we also recieve a new variable from moving the goal to a hypothesis.
               Otherwise, there is no preferred type and no new variable; we simply change the goal to `false`.
            -/
            apply_contr_lemma
        when pref_type_and_new_var_from_tgt <|
            if cfg then linarith_trace "using exfalso" >> exfalso
            else fail "linarith failed: target is not a valid comparison"
        let cfg := cfg reduce_semi
        let (pref_type, new_var) := pref_type_and_new_var_from_tgt (none, none) (Prod.map some some)
        let hyps
          ←-- set up the list of hypotheses, considering the `only_on` and `restrict_type` options
              if only_on then return (new_var [] singleton ++ hyps)
            else (· ++ hyps) <$> local_context
        let hyps ←
          (do
                let t ← get_restrict_type cfg
                filter_hyps_to_type t hyps) <|>
              return hyps
        linarith_trace_proofs "linarith is running on the following hypotheses:" hyps
        run_linarith_on_pfs cfg hyps pref_type
#align tactic.linarith tactic.linarith

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- Tries to prove a goal of `false` by linear arithmetic on hypotheses.
If the goal is a linear (in)equality, tries to prove it by contradiction.
If the goal is not `false` or an inequality, applies `exfalso` and tries linarith on the
hypotheses.

* `linarith` will use all relevant hypotheses in the local context.
* `linarith [t1, t2, t3]` will add proof terms t1, t2, t3 to the local context.
* `linarith only [h1, h2, h3, t1, t2, t3]` will use only the goal (if relevant), local hypotheses
  `h1`, `h2`, `h3`, and proofs `t1`, `t2`, `t3`. It will ignore the rest of the local context.
* `linarith!` will use a stronger reducibility setting to identify atoms.

Config options:
* `linarith {exfalso := ff}` will fail on a goal that is neither an inequality nor `false`
* `linarith {restrict_type := T}` will run only on hypotheses that are inequalities over `T`
* `linarith {discharger := tac}` will use `tac` instead of `ring` for normalization.
  Options: `ring2`, `ring SOP`, `simp`
* `linarith {split_hypotheses := ff}` will not destruct conjunctions in the context.
-/
unsafe def tactic.interactive.linarith (red : parse (tk "!")?) (restr : parse (tk "only")?)
    (hyps : parse pexpr_list ?) (cfg : linarith_config := { }) : tactic Unit :=
  tactic.linarith red.isSome restr.isSome (hyps.getD []) cfg
#align tactic.interactive.linarith tactic.interactive.linarith

add_hint_tactic linarith

/-- `linarith` attempts to find a contradiction between hypotheses that are linear (in)equalities.
Equivalently, it can prove a linear inequality by assuming its negation and proving `false`.

In theory, `linarith` should prove any goal that is true in the theory of linear arithmetic over
the rationals. While there is some special handling for non-dense orders like `nat` and `int`,
this tactic is not complete for these theories and will not prove every true goal. It will solve
goals over arbitrary types that instantiate `linear_ordered_comm_ring`.

An example:
```lean
example (x y z : ℚ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0)
        (h3 : 12*y - 4* z < 0)  : false :=
by linarith
```

`linarith` will use all appropriate hypotheses and the negation of the goal, if applicable.

`linarith [t1, t2, t3]` will additionally use proof terms `t1, t2, t3`.

`linarith only [h1, h2, h3, t1, t2, t3]` will use only the goal (if relevant), local hypotheses
`h1`, `h2`, `h3`, and proofs `t1`, `t2`, `t3`. It will ignore the rest of the local context.

`linarith!` will use a stronger reducibility setting to try to identify atoms. For example,
```lean
example (x : ℚ) : id x ≥ x :=
by linarith
```
will fail, because `linarith` will not identify `x` and `id x`. `linarith!` will.
This can sometimes be expensive.

`linarith {discharger := tac, restrict_type := tp, exfalso := ff}` takes a config object with five
optional arguments:
* `discharger` specifies a tactic to be used for reducing an algebraic equation in the
  proof stage. The default is `ring`. Other options currently include `ring SOP` or `simp` for basic
  problems.
* `restrict_type` will only use hypotheses that are inequalities over `tp`. This is useful
  if you have e.g. both integer and rational valued inequalities in the local context, which can
  sometimes confuse the tactic.
* `transparency` controls how hard `linarith` will try to match atoms to each other. By default
  it will only unfold `reducible` definitions.
* If `split_hypotheses` is true, `linarith` will split conjunctions in the context into separate
  hypotheses.
* If `exfalso` is false, `linarith` will fail when the goal is neither an inequality nor `false`.
  (True by default.)

A variant, `nlinarith`, does some basic preprocessing to handle some nonlinear goals.

The option `set_option trace.linarith true` will trace certain intermediate stages of the `linarith`
routine.
-/
add_tactic_doc
  { Name := "linarith"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.linarith]
    tags := ["arithmetic", "decision procedure", "finishing"] }

/--
An extension of `linarith` with some preprocessing to allow it to solve some nonlinear arithmetic
problems. (Based on Coq's `nra` tactic.) See `linarith` for the available syntax of options,
which are inherited by `nlinarith`; that is, `nlinarith!` and `nlinarith only [h1, h2]` all work as
in `linarith`. The preprocessing is as follows:

* For every subterm `a ^ 2` or `a * a` in a hypothesis or the goal,
  the assumption `0 ≤ a ^ 2` or `0 ≤ a * a` is added to the context.
* For every pair of hypotheses `a1 R1 b1`, `a2 R2 b2` in the context, `R1, R2 ∈ {<, ≤, =}`,
  the assumption `0 R' (b1 - a1) * (b2 - a2)` is added to the context (non-recursively),
  where `R ∈ {<, ≤, =}` is the appropriate comparison derived from `R1, R2`.
-/
unsafe def tactic.interactive.nlinarith (red : parse (tk "!")?) (restr : parse (tk "only")?)
    (hyps : parse pexpr_list ?) (cfg : linarith_config := { }) : tactic Unit :=
  tactic.linarith red.isSome restr.isSome (hyps.getD [])
    { cfg with
      preprocessors := some <| cfg.preprocessors.getD default_preprocessors ++ [nlinarith_extras] }
#align tactic.interactive.nlinarith tactic.interactive.nlinarith

add_hint_tactic nlinarith

add_tactic_doc
  { Name := "nlinarith"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.nlinarith]
    tags := ["arithmetic", "decision procedure", "finishing"] }


import data.nat.basic

variables (a b c d e : ℕ)
variable h1 : a = b
variable h2 : b = c + 1
variable h3 : c = d
variable h4 : e = 1 + d

theorem T : a = e :=
calc
  a   = b     : h1
  ... = c + 1 : h2
  ... = d + 1 : congr_arg _ h3
  ... = 1 + d : add_comm _ _
  ... = e     : eq.symm h4

include h1 h2 h3 h4
theorem T' : a = e :=
calc
  a   = b     : by rw h1
  ... = c + 1 : by rw h2
  ... = d + 1 : by rw h3
  ... = 1 + d : by rw add_comm
  ... = e     : by rw h4

#print T
#print T'

theorem T'' : a = e :=
calc
  a   = d + 1 : by rw [h1, h2, h3]
  ... = 1 + d : by rw add_comm
  ... = e     : by rw h4

#print T''

theorem T''' : a = e :=
by rw [h1, h2, h3, add_comm, h4]

#print T'''

theorem T₁ : a = e :=
by simp [h1, h2, h3, h4, add_comm]

#print T₁


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .extra

namespace fin

lemma ne_zero_of_fin : ∀ {n : ℕ}, fin n → n ≠ 0
| 0 i := fin.elim0 i
| (n+1) _ := nat.succ_ne_zero n

lemma zero_ne_of_fin : ∀ {n : ℕ}, fin n → 0 ≠ n :=
λ _ i, ne.symm $ ne_zero_of_fin i

@[simp] lemma val_mk {n : ℕ} (i : ℕ) (hi : i < n) : (mk i hi).val = i := rfl
@[simp] lemma is_lt_mk {n : ℕ} (i : ℕ) (hi : i < n) : (mk i hi).is_lt = hi := rfl

definition zero (n : ℕ) : fin (n+1) := ⟨0, nat.succ_pos n⟩
definition last (n : ℕ) : fin (n+1) := ⟨n, nat.lt_succ_self n⟩

definition lift {n : ℕ} : fin n → fin (n+1) := λ ⟨i, hi⟩, ⟨i, nat.lt_succ_of_lt hi⟩
definition drop {n : ℕ} : Π (i : fin (n+1)), i ≠ last n → fin n :=
λ ⟨i, hi⟩ h, ⟨i, lt_of_le_of_ne (nat.le_of_lt_succ hi) (fin.vne_of_ne h)⟩

@[simp] lemma zero_val {n : ℕ} : (fin.zero n).val = 0 := rfl
@[simp] lemma last_val {n : ℕ} : (fin.last n).val = n := rfl

@[simp] lemma succ_val {n : ℕ} : ∀ (i : fin n), (fin.succ i).val = i.val + 1 := λ ⟨_,_⟩, rfl
@[simp] lemma pred_val {n : ℕ} : ∀ (i : fin (n+1)) {h : i ≠ fin.zero n}, (fin.pred i h).val = i.val - 1 := λ ⟨_,_⟩, rfl

@[simp] lemma lift_val {n : ℕ} : ∀ (i : fin n), (fin.lift i).val = i.val := λ ⟨_,_⟩, rfl
@[simp] lemma drop_val {n : ℕ} : ∀ (i : fin (n+1)) {h : i ≠ fin.zero n}, (fin.pred i h).val = i.val - 1 := λ ⟨_,_⟩, rfl

lemma succ_inj {n : ℕ} {i j : fin n} : fin.succ i = fin.succ j → i = j :=
begin
intro h, let h := veq_of_eq h, simp at h,
apply eq_of_veq,
exact nat.succ_inj h,
end

lemma lift_inj {n : ℕ} {i j : fin n} : fin.lift i = fin.lift j → i = j :=
begin
intro h, let h := veq_of_eq h, simp at h,
apply eq_of_veq,
exact h,
end

lemma succ_ne_zero {n : ℕ} : ∀ i, fin.succ i ≠ fin.zero n := λ ⟨i, hi⟩, fin.ne_of_vne (nat.succ_ne_zero i)
lemma lift_ne_last {n : ℕ} : ∀ i, fin.lift i ≠ fin.last n := λ ⟨i, hi⟩, fin.ne_of_vne (ne_of_lt hi)

lemma pred_succ {n : ℕ} : ∀ (i : fin n), fin.pred (fin.succ i) (fin.succ_ne_zero i) = i := λ ⟨_,_⟩, eq_of_veq $ rfl
lemma drop_lift {n : ℕ} : ∀ (i : fin n), fin.drop (fin.lift i) (fin.lift_ne_last i) = i := λ ⟨_,_⟩, eq_of_veq $ rfl

lemma lift_drop {n : ℕ} : ∀ (i : fin (n+1)) (h : i ≠ fin.last n), fin.lift (fin.drop i h) = i := λ ⟨_,_⟩ _, eq_of_veq $ rfl
lemma succ_pred {n : ℕ} : ∀ (i : fin (n+1)) (h : i ≠ fin.zero n), fin.succ (fin.pred i h) = i
:= λ ⟨i,_⟩ h, have i ≠ 0, from fin.vne_of_ne h,
eq_of_veq $ nat.succ_pred_eq_of_pos (nat.pos_of_ne_zero this)

lemma succ_lift_eq_lift_succ {n : ℕ} : ∀ (i : fin n), fin.lift (fin.succ i) = fin.succ (fin.lift i) := λ ⟨_,_⟩, eq_of_veq $ rfl

definition lift_by {m : ℕ} (n : ℕ) : fin m → fin (m+n) := λ ⟨i,hi⟩, ⟨i, nat.lt_add_right i m n hi⟩
definition push_by {n : ℕ} (m : ℕ) : fin n → fin (m+n) := λ ⟨i,h⟩, ⟨m+i, nat.add_lt_add_left h m⟩
definition succ_by {n : ℕ} (m : ℕ) : fin n → fin (m+n) := λ ⟨i,h⟩, ⟨i+m, eq.rec_on (add_comm m i) $ nat.add_lt_add_left h m⟩

@[simp] lemma lift_by_val {m n : ℕ} : ∀ {i : fin m}, (lift_by n i).val = i.val := λ ⟨_,_⟩, rfl
@[simp] lemma push_by_val {m n : ℕ} : ∀ {i : fin m}, (push_by n i).val = n + i.val := λ ⟨_,_⟩, rfl
@[simp] lemma succ_by_val {m n : ℕ} : ∀ {i : fin m}, (succ_by n i).val = i.val + n := λ ⟨_,_⟩, rfl

lemma lift_by_inj {m n : ℕ} {i j : fin m} : lift_by n i = lift_by n j → i = j :=
begin
intro h, let h := veq_of_eq h, simp at h,
apply eq_of_veq,
exact h,
end

lemma push_by_inj {m n : ℕ} {i j : fin m} : push_by n i = push_by n j → i = j :=
begin
intro h, let h := veq_of_eq h, simp at h,
apply eq_of_veq,
apply add_left_cancel h,
end

lemma succ_by_inj {m n : ℕ} {i j : fin m} : succ_by n i = succ_by n j → i = j :=
begin
intro h, let h := veq_of_eq h, simp at h,
apply eq_of_veq,
apply add_left_cancel h,
end

lemma push_by_eq_succ_by {m n : ℕ} (i : fin m) : push_by n i = succ_by n i :=
by apply eq_of_veq; simp

lemma lift_by_ne_push_by {m n : ℕ} (i : fin m) (j : fin n) : lift_by n i ≠ push_by m j :=
begin
apply ne_of_vne, simp,
intro h,
have h' : ¬ (m > m + j.val), from not_lt_of_ge (nat.le_add_right m j.val),
rw ← h at h',
exact h' i.is_lt,
end

end fin